(file) Return to Prefs.pm CVS log (file) (dir) Up to [RizwankCVS] / geekymedia_web / twiki / lib / TWiki

  1 rizwank 1.1 # Module of TWiki Collaboration Platform, http://TWiki.org/
  2             #
  3             # Copyright (C) 2000-2004 Peter Thoeny, peter@thoeny.com
  4             #
  5             # For licensing info read license.txt file in the TWiki root.
  6             # This program is free software; you can redistribute it and/or
  7             # modify it under the terms of the GNU General Public License
  8             # as published by the Free Software Foundation; either version 2
  9             # of the License, or (at your option) any later version.
 10             #
 11             # This program is distributed in the hope that it will be useful,
 12             # but WITHOUT ANY WARRANTY; without even the implied warranty of
 13             # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 14             # GNU General Public License for more details, published at 
 15             # http://www.gnu.org/copyleft/gpl.html
 16             #
 17             # Notes:
 18             # - Latest version at http://twiki.org/
 19             # - Installation instructions in $dataDir/TWiki/TWikiDocumentation.txt
 20             # - Customize variables in wikicfg.pm when installing TWiki.
 21             # - Optionally change wikicfg.pm for custom extensions of rendering rules.
 22 rizwank 1.1 # - Files wiki[a-z]+.pm are included by wiki.pm
 23             # - Upgrading TWiki is easy as long as you only customize wikicfg.pm.
 24             # - Check web server error logs for errors, i.e. % tail /var/log/httpd/error_log
 25             use strict;
 26             
 27             =begin twiki
 28             
 29             ---+ TWiki::Prefs Module
 30             
 31             This module reads TWiki preferences of site-level, web-level and user-level
 32             topics and implements routines to access those preferences.
 33             
 34             =cut
 35             
 36             $TWiki::Prefs::finalPrefsName = "FINALPREFERENCES";
 37             $TWiki::Prefs::formPrefPrefix = "FORM_";
 38             
 39             package TWiki::Prefs::Parser;
 40             
 41             =pod
 42             
 43 rizwank 1.1 ---++ Prefs::Parser Object
 44             
 45             This Prefs-internal class is used to parse * Set statements from arbitrary
 46             text, and extract settings from meta objects.  It is used by TopicPrefs to
 47             parse preference settings from topics.
 48             
 49             This class does no validation or duplicate-checking on the settings; it
 50             simply returns the recognized settings in the order it sees them in.
 51             
 52             ---+++ sub new()
 53             
 54             Returns a new TopicParser object.
 55             
 56             ---+++ sub parseText( $text, $prefs )
 57             
 58             Parse settings from text and add them to the preferences in $prefs
 59             
 60             =cut
 61             
 62             sub new { return bless {}, $_[0]; }
 63             
 64 rizwank 1.1 sub parseText {
 65                 my( $self, $text, $prefs ) = @_;
 66             
 67                 $text =~ s/\r/\n/g;
 68                 $text =~ s/\n+/\n/g;
 69             
 70                 my $key = "";
 71                 my $value ="";
 72                 my $isKey = 0;
 73                 foreach( split( /\n/, $text ) ) {
 74                     if( /^\t+\*\sSet\s(\w+)\s\=\s*(.*)/ ) {
 75                         if( $isKey ) {
 76                             $prefs->_insertPrefsValue( $key, $value );
 77                         }
 78                         $key = $1;
 79                         $value = defined $2 ? $2 : "";
 80                         $isKey = 1;
 81                     } elsif( $isKey ) {
 82                         if(( /^\t+/ ) &&( ! /^\t+\*/ ) ) {
 83                             # follow up line, extending value
 84                             $value .= "\n$_";
 85 rizwank 1.1             } else {
 86                             $prefs->_insertPrefsValue( $key, $value );
 87                             $isKey = 0;
 88                         }
 89                     }
 90                 }
 91                 if( $isKey ) {
 92                     $prefs->_insertPrefsValue( $key, $value );
 93                 }
 94             }
 95             
 96             =pod
 97             
 98             ---+++ sub parseMeta( $metaObject, $prefs )
 99             
100             Traverses through all FIELD attributes of the meta object, creating one setting
101             named with $TWiki::Prefs::formPrefPrefix . $fieldTitle for each.  If the
102             field's attribute list includes a 'S', it also creates an entry named with the
103             field "name", which is a cleaned-up, space-removed version of the title.
104             
105             Settings are added to the $prefs passed.
106 rizwank 1.1 
107             =cut
108             
109             sub parseMeta {
110                 my( $self, $meta, $prefs ) = @_;
111             
112                 my %form = $meta->findOne( "FORM" );
113                 if( %form ) {
114                     my @fields = $meta->find( "FIELD" );
115                     foreach my $field( @fields ) {
116                         my $title = $field->{"title"};
117                         my $prefixedTitle = $TWiki::Prefs::formPrefPrefix . $title;
118                         my $value = $field->{"value"};
119                         $prefs->_insertPrefsValue( $prefixedTitle, $value );
120                         my $attributes = $field->{"attributes"};
121                         if( $attributes && $attributes =~ /[S]/o ) {
122                             my $name = $field->{"name"};
123                             $prefs->_insertPrefsValue( $name, $value );
124                         }
125                     }
126                 }
127 rizwank 1.1 }
128             
129             package TWiki::Prefs::TopicPrefs;
130             
131             =pod
132             
133             ---++ TopicPrefs Object
134             
135             This Prefs-internal class is used to cache preferences read in from a single
136             topic.
137             
138             ---+++ sub new( $web, $topic )
139             
140             Reads preferences from the specified topic into a new TopicPrefs object.
141             
142             =cut
143             
144             sub new {
145                 my( $class, $theWeb, $theTopic ) = @_;
146                 my $self = {};
147                 bless $self, $class;
148 rizwank 1.1 
149                 $self->{web} = $theWeb;
150                 $self->{topic} = $theTopic;
151             
152                 $self->readPrefs();
153             
154                 return $self;
155             }
156             
157             =pod
158             
159             ---+++ sub readPrefs()
160             
161             Rereads preferences from the topic, updating the TopicPrefs object.
162             
163             =cut
164             
165             sub readPrefs {
166                 my $self = shift;
167             
168                 my $theWeb = $self->{web};
169 rizwank 1.1     my $theTopic = $self->{topic};
170             
171                 $self->{prefs} = {};
172             
173                 my $parser = TWiki::Prefs::Parser->new();
174                 my( $meta, $text ) = TWiki::Store::readTopic( $theWeb, $theTopic, 1 );
175             
176                 $parser->parseText( $text, $self );
177                 $parser->parseMeta( $meta, $self );
178             }
179             
180             =pod
181             
182             ---+++ sub _insertPrefsValue( $key, $value )
183             
184             Adds a key-value pair to the TopicPrefs object.
185             SMELL: this is almost the same as insertPreference, below.
186             
187             =cut
188             
189             sub _insertPrefsValue {
190 rizwank 1.1     my( $self, $theKey, $theValue ) = @_;
191             
192                 return if exists $self->{finalHash}{$theKey}; # key is final, may not be overridden
193             
194                 $theValue =~ s/\t/ /g;                 # replace TAB by space
195                 $theValue =~ s/([^\\])\\n/$1\n/g;      # replace \n by new line
196                 $theValue =~ s/([^\\])\\\\n/$1\\n/g;   # replace \\n by \n
197                 $theValue =~ s/`//g;                   # filter out dangerous chars
198             
199                 if( $theKey eq $TWiki::Prefs::finalPrefsName &&
200                     defined( $self->{prefs}{$theKey} )) {
201             
202                     # key exists, need to deal with existing preference
203                     # merge final preferences lists
204                     $theValue = $self->{prefs}{$theKey} . ", $theValue";
205                 }
206                 $self->{prefs}{$theKey} = $theValue;
207             }
208             
209             # =============================================================================
210             package TWiki::Prefs::PrefsCache;
211 rizwank 1.1 
212             use vars qw( %topicCache );
213             
214             =pod
215             
216             ---++ PrefsCache Static Package Functions
217             
218             The PrefsCache package holds a cache of topics that have been read in, using
219             the TopicPrefs class.  These functions manage that cache.
220             
221             ---+++ sub clearCache()
222             
223             This non-member function clears cached topic preferences, forcing all settings
224             to be reread.
225             
226             ---+++ sub invalidateCache( $web, $topic )
227             
228             This non-member function invalidates the cache on a particular topic.
229             
230             =cut
231             
232 rizwank 1.1 sub clearCache { undef %topicCache; }
233             sub invalidateCache { delete $topicCache{$_[0]}{$_[1]}; }
234             
235             =pod
236             
237             ---++ PrefsCache Object
238             
239             This defines an object used internally by the functions in TWiki::Prefs to hold
240             preferences.  This object handles the cascading of preferences from site, to
241             web, to topic/user.
242             
243             ---+++ sub new( $type, $parent, @target )
244             
245             | Description: | Creates a new Prefs object. |
246             | Parameter: =$type= | Type of prefs object to create, see notes. |
247             | Parameter: =$parent= | Prefs object from which to inherit higher-level settings. |
248             | Parameter: =@target= | What this object stores preferences for, see notes. |
249             
250             *Notes:* =$type= should be one of "global", "web", "request", or "copy". If the
251             type is "global", no parent or target should be specified; the object will
252             cache sitewide preferences.  If the type is "web", =$parent= should hold global
253 rizwank 1.1 preferences, and @target should contain only the web's name.  If the type is
254             "request", then $parent should be a "web" preferences object for the current
255             web, and =@target= should be( $topicName, $userName ).  $userName should be
256             just the WikiName, with no web specifier.  If the type is "copy", the result is
257             a simple copy of =$parent=; no =@target= is needed.
258             
259             Call like this: =$mainWebPrefs = TWiki::Prefs->new("web", "Main");=
260             
261             =cut
262             
263             sub new {
264                 my( $theClass, $theType, $theParent, @theTarget ) = @_;
265             
266                 my $self;
267             
268                 if( $theType eq "copy" ) {
269                     $self = { %$theParent };
270                     bless $self, $theClass;
271             
272                     $self->inheritPrefs( $theParent );
273                 } else {
274 rizwank 1.1         $self = {};
275                     bless $self, $theClass;
276             
277                     $self->{type} = $theType;
278                     $self->{parent} = $theParent;
279                     $self->{web} = $theTarget[0] if( $theType eq "web" );
280             
281                     if( $theType eq "request" ) {
282                         $self->{topic} = $theTarget[0];
283                         $self->{user} = $theTarget[1];
284                     }
285             
286                     $self->loadPrefs( 1 );
287                 }
288             
289                 return $self;
290             }
291             
292             =pod
293             
294             ---+++ sub loadPrefs( $allowCache )
295 rizwank 1.1 
296             Requests for Prefs object to load preferences from its defining topics,
297             re-cascading the overrides.  If =$allowCache= is set, the topic cache will be
298             used to load preferences when applicable.  Topics that must be read will be
299             placed in the cache regardless of the setting of $allowCache.
300             
301             =cut
302             
303             sub loadPrefs {
304                 my( $self, $allowCache ) = @_;
305             
306                 $self->{finalHash} = {};
307             
308                 $self->inheritPrefs( $self->{parent} ) if defined $self->{parent};
309             
310                 if( $self->{type} eq "global" ) {
311                     # global prefs
312                     $self->loadPrefsFromTopic( $TWiki::twikiWebname,
313                                                $TWiki::wikiPrefsTopicname,
314                                                "", $allowCache );
315                     $self->loadPrefsFromTopic( $TWiki::mainWebname,
316 rizwank 1.1                                    $TWiki::wikiPrefsTopicname,
317                                                "", $allowCache );
318             
319                 } elsif( $self->{type} eq "web" ) {
320                     # web prefs
321                     $self->loadPrefsFromTopic( $self->{web},
322                                                $TWiki::webPrefsTopicname,
323                                                "", $allowCache);
324             
325                 } elsif( $self->{type} eq "request" ) {
326                     # request prefs - read topic and user
327                     my $parent = $self->{parent};
328                     my $topicPrefsSetting = $parent->getPreferenceFlag("READTOPICPREFS");
329                     my $topicPrefsOverride = $parent->getPreferenceFlag("TOPICOVERRIDESUSER");
330                     if( $topicPrefsSetting && !$topicPrefsOverride ) {
331                         # topic prefs overridden by user prefs
332                         $self->loadPrefsFromTopic( $parent->{web},
333                                                    $self->{topic},
334                                                    "", $allowCache);
335                     }
336                     $self->loadPrefsFromTopic( $TWiki::mainWebname,
337 rizwank 1.1                                    $self->{user},
338                                                "", $allowCache );
339                     if( $topicPrefsSetting && $topicPrefsOverride ) {
340                         # topic prefs override user prefs
341                         $self->loadPrefsFromTopic( $parent->{web},
342                                                    $self->{topic},
343                                                    "", $allowCache );
344                     }
345                 }
346             }
347             
348             =pod
349             
350             ---+++ sub loadPrefsFromTopic( $web, $topic, $keyPrefix, $allowCache )
351             
352             Loads preferences from a topic.  If =$allowCache= is set then cached
353             settings are used where available.  All settings loaded are prefixed
354             with =$keyPrefix=.
355             
356             =cut
357             
358 rizwank 1.1 sub loadPrefsFromTopic {
359                 my( $self, $theWeb, $theTopic, $theKeyPrefix, $allowCache ) = @_;
360             
361                 my $topicPrefs;
362             
363                 if( $allowCache && exists( $topicCache{$theWeb}{$theTopic} )) {
364                     $topicPrefs = $topicCache{$theWeb}{$theTopic};
365                 } else {
366                     $topicPrefs = TWiki::Prefs::TopicPrefs->new( $theWeb, $theTopic );
367                 }
368             
369                 $theKeyPrefix = "" unless defined $theKeyPrefix;
370             
371                 foreach my $key ( keys %{$topicPrefs->{prefs}} ) {
372                     $self->_insertPreference( $theKeyPrefix . $key,
373                                               $topicPrefs->{prefs}{$key} );
374                 }
375             
376                 if ( defined( $self->{prefs}{$TWiki::Prefs::finalPrefsName} )) {
377                     my $finalPrefs = $self->{prefs}{$TWiki::Prefs::finalPrefsName};
378                     my @finalPrefsList = split /[\s,]+/, $finalPrefs;
379 rizwank 1.1         $self->{finalHash} = { map { $_ => 1 } @finalPrefsList };
380                 }
381             }
382             
383             # Private function to insert a value into a PrefsCache object
384             # SMELL: This is almost the same as insertPrefsValue
385             sub _insertPreference {
386                 my( $self, $theKey, $theValue ) = @_;
387             
388                 return if (exists $self->{finalHash}{$theKey}); # $theKey is in FINALPREFERENCES, don't update it
389             
390                 if ( $theKey eq $TWiki::Prefs::finalPrefsName &&
391                      defined( $self->{prefs}{$theKey} )) {
392             
393                     # key exists, need to deal with existing preference
394                     # merge final preferences lists
395                     $theValue = $self->{prefs}{$theKey} . ", $theValue";
396                 }
397                 $self->{prefs}{$theKey} = $theValue;
398             }
399             
400 rizwank 1.1 =pod
401             
402             ---+++ sub inheritPrefs( $otherPrefsObject )
403             
404             Simply copies the preferences contained in the $otherPrefsObject into the
405             current one, overwriting anything that may currently be there.
406             
407             =cut
408             
409             sub inheritPrefs {
410                 my( $self, $otherPrefsObject ) = @_;
411             
412                 foreach my $key( keys( %{$otherPrefsObject->{prefs}} ) ) {
413                     $self->{prefs}{$key} = $otherPrefsObject->{prefs}{$key};
414                 }
415             }
416             
417             =pod
418             
419             ---+++ sub replacePreferencesTags( $text )
420             
421 rizwank 1.1 Substitutes preferences values for =%PREF%= tags in =$text=, modifying that
422             parameter in-place.
423             
424             =cut
425             
426             sub replacePreferencesTags {
427                 #my( $self, $text ) = @_;
428                 $_[1] =~ s/%(\w+)%/&_exvar( $1, @_ )/ge;
429             }
430             
431             sub _exvar {
432                 #my( $vbl,$self ) = @_
433                 my $v = $_[1]->{prefs}{$_[0]};
434                 return $v if( defined( $v ));
435                 return "%$_[0]%";
436             }
437             
438             =pod
439             
440             ---+++ sub getPreferenceValue( $key )
441             
442 rizwank 1.1 Returns the stored preference with key =$key=, or "" if no such preference
443             exists.
444             
445             =cut
446             
447             sub getPreferenceValue {
448                 return $_[0]->{prefs}{$_[1]} or "";
449             }
450             
451             =pod
452             
453             ---+++ sub getPreferenceFlag( $key )
454             
455             Returns a preference as a flag.  See
456             =[[#sub_formatAsFlag_prefValue][Prefs::formatAsFlag]]= for details on how
457             preference values are converted to flags.
458             
459             =cut
460             
461             sub getPreferenceFlag {
462                 my( $self, $theKey ) = @_;
463 rizwank 1.1 
464                 my $value = $self->getPreferenceValue( $theKey );
465                 return TWiki::Prefs::formatAsFlag( $value );
466             }
467             
468             # =============================================================================
469             package TWiki::Prefs;
470             
471             use vars qw(
472                         $globalPrefs %webPrefs $requestPrefs $requestWeb
473                         $finalPrefsName
474                       );
475             
476             
477             =pod
478             
479             ---++ TWiki::Prefs package
480             
481             This is the external interface to the Prefs module, and is how the rest of the
482             TWiki code accesses preferences.
483             
484 rizwank 1.1 ---+++ sub initializePrefs( $webName )
485             
486             Resets all preference globals (for mod_perl compatibility), and reads
487             preferences from TWiki::TWikiPreferences, Main::TWikiPreferences, and
488             $webName::WebPreferences.
489             
490             =cut
491             
492             sub initializePrefs {
493                 my( $theWebName ) = @_;
494             
495                 TWiki::Prefs::PrefsCache::clearCache(); # for mod_perl compatibility
496             
497                 $requestWeb = $theWebName;
498                 $globalPrefs = TWiki::Prefs::PrefsCache->new("global");
499                 $webPrefs{$requestWeb} = TWiki::Prefs::PrefsCache->new("web", $globalPrefs, $requestWeb);
500                 $requestPrefs = TWiki::Prefs::PrefsCache->new("copy", $webPrefs{$requestWeb});
501             
502                 return;
503             }
504             
505 rizwank 1.1 # =========================
506             
507             =pod
508             
509             ---+++ sub initializeUserPrefs( $userPrefsTopic )
510             
511             Called after user is known (potentially by Plugin), this function reads
512             preferences from the user's personal topic.  The parameter is the topic to read
513             user-level preferences from (Generally "Main.CurrentUserName").
514             
515             =cut
516             
517             sub initializeUserPrefs {
518                 my( $theWikiUserName ) = @_;
519             
520                 $theWikiUserName = "Main.TWikiGuest" unless $theWikiUserName;
521             
522                 if( $theWikiUserName =~ /^(.*)\.(.*)$/ ) {
523                     $requestPrefs = TWiki::Prefs::PrefsCache->new("request", $webPrefs{$requestWeb}, $TWiki::topicName, $2);
524                 }
525             
526 rizwank 1.1     return;
527             }
528             
529             
530             # =========================
531             
532             =pod
533             
534             ---+++ sub getPrefsFromTopic( $web, $topic, $keyPrefix )
535             
536             Reads preferences from the topic at =$theWeb.$theTopic=, prefixes them with
537             =$theKeyPrefix= if one is provided, and adds them to the preference cache.
538             
539             =cut
540             
541             sub getPrefsFromTopic {
542                 my( $web, $topic, $keyPrefix ) = @_;
543                 $requestPrefs->loadPrefsFromTopic( $web, $topic, $keyPrefix, 1 );
544             }
545             
546             # =========================
547 rizwank 1.1 
548             =pod
549             
550             ---+++ sub updateSetFromForm( $meta, $text )
551             Return value: $newText
552             
553             If there are any settings "Set SETTING = value" in =$text= for a setting
554             that is set in form metadata in =$meta=, these are changed so that the
555             value in the =$text= setting is the same as the one set in the =$meta= form.
556             =$text= is not modified; rather, a new copy with these changes is returned.
557             
558             =cut
559             
560             sub updateSetFromForm {
561                 my( $meta, $text ) = @_;
562                 my( $key, $value );
563             
564                 my %form = $meta->findOne( "FORM" );
565                 if( %form ) {
566                     my @fields = $meta->find( "FIELD" );
567                     foreach my $field ( @fields ) {
568 rizwank 1.1             $key = $field->{"name"};
569                         $value = $field->{"value"};
570                         my $attributes = $field->{"attributes"};
571                         if( $attributes && $attributes =~ /[S]/o ) {
572                             $value =~ s/\n/\\\n/o;
573                             # SMELL: Worry about verbatim?  Multi-lines?
574                             $text =~ s/^(\t+\*\sSet\s$key\s\=\s*).*$/$1$value/gm;
575                         }
576                     }
577                 }
578             
579                 return $text;
580             }
581             
582             # =========================
583             
584             =pod
585             
586             ---+++ sub handlePreferencesTags( $text )
587             
588             Replaces %PREF% and %<nop>VAR{"pref"}% syntax in $text, modifying that parameter in-place.
589 rizwank 1.1 
590             =cut
591             
592             sub handlePreferencesTags {
593                 my $textRef = \$_[0];
594             
595                 $requestPrefs->replacePreferencesTags( $$textRef );
596             
597                 # handle web specific variables
598                 $$textRef =~ s/\%VAR{(.*?)}\%/prvGetWebVariable( $1 )/ge;
599             }
600             
601             =pod
602             
603             ---+++ sub prvGetWebVariable( $attributeString )
604             
605             Returns the value for a %<nop>VAR{"foo" web="bar"}% syntax, given the stuff inside the {}'s.
606             
607             =cut
608             
609             sub prvGetWebVariable {
610 rizwank 1.1     my( $attributeString ) = @_;
611             
612                 my $key = &TWiki::extractNameValuePair( $attributeString );
613                 my $attrWeb = &TWiki::extractNameValuePair( $attributeString, "web" );
614                 if( $attrWeb =~ /%[A-Z]+%/ ) { # handle %MAINWEB%-type cases 
615                     &TWiki::handleInternalTags( $attrWeb, $requestWeb, "dummy" );
616                 }
617             
618                 return getPreferencesValue( $key, $attrWeb);
619             }
620             
621             =pod
622             
623             ---+++ sub formatAsFlag( $prefValue )
624             
625             Returns 1 if the =$prefValue= is "on", and 0 otherwise.  "On" means set to
626             something with a true Perl-truth-value, with the special cases that "off" and
627             "no" are forced to false.  (Both of the latter are case-insensitive.)  Note
628             also that leading and trailing whitespace on =$prefValue= will be stripped
629             prior to this conversion.
630             
631 rizwank 1.1 =cut
632             
633             sub formatAsFlag {
634                 my( $value ) = @_;
635             
636                 $value =~ s/^\s*(.*?)\s*$/$1/gi;
637                 $value =~ s/off//gi;
638                 $value =~ s/no//gi;
639                 if( $value ) {
640                     return 1;
641                 } else {
642                     return 0;
643                 }
644             }
645             
646             =pod
647             
648             ---+++ sub formatAsNumber( $prefValue )
649             
650             Converts the string =$prefValue= to a number.  First any whitespace and commas
651             are removed.  <em>L10N note: assumes thousands separator is comma and decimal
652 rizwank 1.1 point is period.</em>  Then, if the first character is a zero, the value is
653             passed to oct(), which will interpret hex (0x prefix), octal (leading zero
654             only), or binary (0b prefix) numbers.  If the first character is a digit
655             greater than zero, the value is assumed to be a decimal number and returned.
656             If the =$prefValue= is empty or not a number, zero is returned.  Finally, if
657             =$prefValue= is undefined, an undefined value is returned.  <strong>Undefined
658             preferences are automatically converted to empty strings, and so this function
659             will always return zero for these, rather than 'undef'.</strong>
660             
661             =cut
662             
663             sub formatAsNumber {
664                 my( $strValue ) = @_;
665                 return undef unless defined( $strValue ); 
666             
667                 $strValue =~ s/[,\s]+//g;    
668             
669                 if( $strValue =~ /^0/ ) {
670                     return oct( $strValue ); # hex/octal/binary
671                 } elsif( $strValue =~ /^(\d|\.\d )/) {
672                     return $strValue;      # decimal
673 rizwank 1.1     } else {
674                     return 0;              # empty/non-numeric
675                 }
676             }
677             
678             =pod
679             
680             ---+++ sub getPreferencesValue( $theKey, $theWeb )
681             
682             Returns the value of the preference =$theKey=.  If =$theWeb= is also specified,
683             looks up the value with respect to that web instead of the current one; also,
684             in this case user/topic preferences are not considered.
685             
686             In any case, if a plugin supports sessions and provides a value for =$theKey=,
687             this value overrides all preference settings in any web.
688             
689             =cut
690             
691             sub getPreferencesValue {
692                 my( $theKey, $theWeb ) = @_;
693             
694 rizwank 1.1     my $sessionValue = &TWiki::getSessionValue( $theKey );
695                 if( defined( $sessionValue ) ) {
696                     return $sessionValue;
697                 }
698             
699                 if( $theWeb ) {
700                     if (!exists $webPrefs{$theWeb}) {
701                         $webPrefs{$theWeb} = TWiki::Prefs::PrefsCache->new("web", $globalPrefs, $theWeb);
702                     }
703                     return $webPrefs{$theWeb}->getPreferenceValue( $theKey );
704                 } else {
705                     return $requestPrefs->getPreferenceValue( $theKey ) if defined $requestPrefs;
706                     if (exists $webPrefs{$requestWeb}) {
707                         return $webPrefs{$requestWeb}->getPreferenceValue( $theKey ); # user/topic prefs not yet init'd
708                     }
709                 }
710             }
711             
712             # =========================
713             
714             =pod
715 rizwank 1.1 
716             ---+++ sub getPreferencesFlag( $theKey, $theWeb )
717             
718             Returns the preference =$theKey= from =$theWeb= as a flag.  See
719             =getPreferencesValue= for the semantics of the parameters, and
720             =[[#sub_formatAsFlag_prefValue][formatAsFlag]]= for the method of interpreting
721             a value as a flag.
722             
723             =cut
724             
725             sub getPreferencesFlag {
726                 my( $theKey, $theWeb ) = @_;
727             
728                 my $value = getPreferencesValue( $theKey, $theWeb );
729                 return formatAsFlag( $value );
730             }
731             
732             =pod
733             
734             ---+++ sub getPreferencesNumber( $theKey, $theWeb )
735             
736 rizwank 1.1 Returns the preference =$theKey= from =$theWeb= as a flag.  See
737             =getPreferencesValue= for the semantics of the parameters, and
738             =[[#sub_formatAsNumber_prefValue][formatAsNumber]]= for the method of
739             interpreting a value as a number.
740             
741             =cut
742             
743             sub getPreferencesNumber {
744                 my( $theKey, $theWeb ) = @_;
745             
746                 my $value = getPreferencesValue( $theKey, $theWeb );
747                 return formatAsNumber( $value );
748             }
749             
750             # =========================
751             
752             1;
753             
754             =end twiki
755             
756             =cut
757 rizwank 1.1 
758             # EOF
759             

Rizwan Kassim
Powered by
ViewCVS 0.9.2