# Module of TWiki Collaboration Platform, http://TWiki.org/ # # Copyright (C) 2000-2003 Peter Thoeny, peter@thoeny.com # # For licensing info read license.txt file in the TWiki root. # This program is free software; you can redistribute it and/or # modify it under the terms of the GNU General Public License # as published by the Free Software Foundation; either version 2 # of the License, or (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details, published at # http://www.gnu.org/copyleft/gpl.html # # Notes: # - Latest version at http://twiki.org/ # - Installation instructions in $dataDir/TWiki/TWikiDocumentation.txt # - Customize variables in wikicfg.pm when installing TWiki. # - Optionally change wikicfg.pm for custom extensions of rendering rules. # - Files wiki[a-z]+.pm are included by wiki.pm # - Upgrading TWiki is easy as long as you only customize wikicfg.pm. # - Check web server error logs for errors, i.e. % tail /var/log/httpd/error_log # # Michael Rausch 2003-06-04 cache preferences in a Storable file # package TWiki::Prefs; use strict; use vars qw( %otherwebprefs %prefs $defaultWebName $something_changed $userstore $storeDir ); # Possibile optimizations... #use Memoize; #memoize('getPreferencesValue'); use Data::Dump qw(pp); use Storable qw(lock_store lock_retrieve store retrieve); use Time::HiRes qw(gettimeofday tv_interval); # ========================= BEGIN { $storeDir = "$TWiki::dataDir/.store"; } # ========================= END { finishPrefs(); } # ========================= sub initializePrefs { my( $theWikiUserName, $theWebName ) = @_; $defaultWebName = $theWebName; my ($t0,$t1) = (0,0); # print STDERR "Retrieving prefs data\n"; $t0 += gettimeofday(); $userstore = "$storeDir/userprefs.$theWebName.$theWikiUserName.store"; if( -e $userstore ) { %prefs = %{ lock_retrieve($userstore) }; } else { %prefs = (); } $t1 += gettimeofday(); # print STDERR "Vorhandene Prefs: ".pp( %prefs )."\n"; $t0 += gettimeofday(); if( -e "$storeDir/otherwebprefs.store" ) { %otherwebprefs = %{ lock_retrieve("$storeDir/otherwebprefs.store") }; } else { %otherwebprefs = (); } $t1 += gettimeofday(); # print STDERR "Vorhandene Prefs: ".pp( keys(%otherwebprefs) )."\n"; $something_changed = 0; #%otherwebprefs = (); #%prefs = (); my ($userweb, $usertopic) = (undef,undef); if( $theWikiUserName =~ /^(.*)\.(.*)$/ ) { ($userweb, $usertopic) = ($1,$2); } if( !%prefs || verifyforreloadPrefsTimestamp( $TWiki::twikiWebname, $TWiki::wikiPrefsTopicname ) || verifyforreloadPrefsTimestamp( $TWiki::mainWebname, $TWiki::wikiPrefsTopicname ) || verifyforreloadPrefsTimestamp( $theWebName, $TWiki::webPrefsTopicname ) || verifyforreloadPrefsTimestamp( $userweb, $usertopic ) ) { $something_changed = 1; #print STDERR "Populating user prefs"."\n"; getPrefsFromTopic( $TWiki::twikiWebname, $TWiki::wikiPrefsTopicname ); # site-level getPrefsFromTopic( $TWiki::mainWebname, $TWiki::wikiPrefsTopicname ); # alternate site-level #%otherwebprefs = (); #$otherwebprefs{'SITETOTAL'} = { %prefs }; # save for otherweb use %otherwebprefs = ( 'SITETOTAL' => { %prefs } ); # save for otherweb use, muss noch mit timestamps optimiert werden!!! #print STDERR "Vorhandene Prefs: ".pp( %otherwebprefs )."\n"; getPrefsFromTopic( $theWebName, $TWiki::webPrefsTopicname ); # web-level $otherwebprefs{$theWebName} = { %prefs }; # save web-level for otherweb use, muss noch mit timestamps optimiert werden!!! if( defined($usertopic) ) { getPrefsFromTopic( $userweb, $usertopic ); # user-level } } # all plugin prefs are loaded later on and are included in %pref # print STDERR "Loading took from ". ($t1-$t0) ." seconds\n"; } # ========================= sub verifyforreloadPrefsTimestamp { my ( $theWeb, $theTopic) = @_; my $filetimestamp = &TWiki::Store::topicExists($theWeb,$theTopic); my $hashtimestamp = $prefs{'TIMESTAMPS'}{ "$theWeb.$theTopic" }; #print STDERR "checking: $theWeb.$theTopic hash:$hashtimestamp file:$filetimestamp\n"; return !($hashtimestamp == $filetimestamp); # return !( (defined($hashtimestamp) && ($hashtimestamp >= $filetimestamp)) || (!defined($hashtimestamp) && !defined($filetimestamp)) ); } # ========================= sub finishPrefs { if($something_changed) { my ($t0,$t1); $t0 = gettimeofday(); print STDERR "Storing prefs data\n"; if ( ! -d $storeDir ) { umask( 0 ); mkdir( $storeDir, 0777 ); } lock_store \%otherwebprefs, "$storeDir/otherwebprefs.store"; if(defined($userstore)) { lock_store \%prefs, $userstore; } $t1 = gettimeofday(); print STDERR "Saving took ". ($t1-$t0) ." seconds\n"; } $something_changed=0; $userstore = undef; } # ========================= sub getPrefsFromTopic { my ( $theWeb, $theTopic, $theKeyPrefix ) = @_; my $filetimestamp = &TWiki::Store::topicExists($theWeb,$theTopic); my $hashtimestamp = $prefs{'TIMESTAMPS'}{ "$theWeb.$theTopic" }; #print STDERR "checking: $theWeb.$theTopic hash:$hashtimestamp file:$filetimestamp\n"; if(defined($hashtimestamp) && ($hashtimestamp >= $filetimestamp)) { #print STDERR "Timestamps vorhanden: $theWeb.$theTopic hash:$hashtimestamp file:$filetimestamp\n"; return; } $prefs{'TIMESTAMPS'}{ "$theWeb.$theTopic" } = $filetimestamp; #print STDERR "Timestamps: ". pp($prefs{'TIMESTAMPS'}) ."\n"; my( $meta, $text ) = &TWiki::Store::readTopic( $theWeb, $theTopic, 1 ); $text =~ s/\r/\n/go; $text =~ s/\n+/\n/go; my $keyPrefix = $theKeyPrefix || ''; # prefix is for plugin prefs my $key = ''; my $value = ''; my $isKey = 0; foreach( split( /\n/, $text ) ) { if( /^\t+\*\sSet\s([a-zA-Z0-9_]*)\s\=\s*(.*)/ ) { if( $isKey ) { prvAddToPrefsList( $key, $value ); } $key = "$keyPrefix$1"; $value = $2 || ''; # $value = defined $2 ? $2 : ''; $isKey = 1; } elsif ( $isKey ) { if( ( /^\t+/ ) && ( ! /^\t+\*/ ) ) { # follow up line, extending value $value .= "\n$_"; } else { prvAddToPrefsList( $key, $value ); $isKey = 0; } } } if( $isKey ) { prvAddToPrefsList( $key, $value ); } } # ========================= sub prvAddToPrefsList { my ( $theKey, $theValue ) = @_; # this key is final, may not be overridden #if(1) { if( exists($prefs{'FINALPREFERENCES'}) && $prefs{'FINALPREFERENCES'} =~ /[\,\s]+${theKey}[\,\s]+/g ) { return; } #}else{ # if( $prefs{'FINALPREFERENCES'}{ $theKey } ) { return; } #} $theValue =~ s/\t/ /go; # replace TAB by space $theValue =~ s/([^\\])\\n/$1\n/go; # replace \n by new line $theValue =~ s/([^\\])\\\\n/$1\\n/go; # replace \\n by \n $theValue =~ s/`//go; # filter out dangerous chars if( $theKey eq 'FINALPREFERENCES' ) { #if(1) { if( ! exists($prefs{$theKey}) ) { $prefs{$theKey} = " $theValue "; } else { $prefs{$theKey} .= ", $theValue "; } #} else { # if( ! exists($prefs{$theKey}) ) { # $prefs{$theKey} = {}; # } # # foreach my $thefinalpref ( split( /[\,\s]+/, $theValue ) ) { # $prefs{ $theKey }{ $thefinalpref } = 1; # } ## my $finalPrefs = $prefs{$theKey}; ## foreach my $thefinalpref ( split( /[\,\s]+/, $theValue ) ) { ## $finalPrefs->{ $thefinalpref } = 1; ## } ## $prefs{$theKey} = $finalPrefs; #} } else { $prefs{$theKey} = $theValue; } } # ========================= sub prvHandleWebVariable { my( $attributes ) = @_; my $key = &TWiki::extractNameValuePair( $attributes ); my $attrWeb = &TWiki::extractNameValuePair( $attributes, 'web' ); if( $attrWeb =~ /%[A-Z]+%/ ) { &TWiki::handleInternalTags( $attrWeb, $defaultWebName, 'dummy' ); } my $val = getPreferencesValue( $key, $attrWeb ); return $val; } # ========================= sub handlePreferencesTags { # modify argument directly, e.g. call by reference foreach my $x (keys(%prefs)) { #my $term = "\%$x\%"; #$_[0] =~ s/$term/$prefs{$x}/ge; ##if($x eq 'FINALPREFERENCES') { #if(0) { # my $fPN = ''; # my $p = $prefs{$x}; # ## $fPN = pp($p); # foreach my $y ( keys %{ $p } ) { # $fPN .= "$y, "; # } # chop $fPN; chop $fPN; # remove last ", " # # $_[0] =~ s/%$x%/$fPN/ge; #} else { $_[0] =~ s/%$x%/$prefs{$x}/ge; #} } if( $_[0] =~ /%VAR{(.*?)}%/go ) { # handle web specific variables $_[0] =~ s/%VAR{(.*?)}%/&prvHandleWebVariable($1)/geo; } } # ========================= sub getPreferencesValue { my ( $theKey, $theWeb ) = @_; my $sessionValue = &TWiki::getSessionValue( $theKey ); if( defined( $sessionValue ) ) { return $sessionValue; } if( ( ! $theWeb ) || ( $theWeb eq $defaultWebName ) ) { # search the default web return $prefs{$theKey} || ''; } elsif( &TWiki::Store::webExists( $theWeb ) ) { # search the alternate web, rebuild prefs if necessary if( ! exists($otherwebprefs{$theWeb}) || ( &TWiki::Store::topicExists($theWeb,$TWiki::webPrefsTopicname) != $otherwebprefs{$theWeb}{'TIMESTAMPS'}{ "$theWeb.$TWiki::webPrefsTopicname" } ) ) { $something_changed = 1; #print STDERR "$theWeb noch nicht geladen oder verändert worden\n"; my %save = %prefs; # quick hack, this stinks %prefs = %{ $otherwebprefs{'SITETOTAL'} }; getPrefsFromTopic( $theWeb, $TWiki::webPrefsTopicname ); $otherwebprefs{$theWeb} = { %prefs }; # quick hack, this stinks %prefs = %save; # quick hack, this stinks } else { #print STDERR "$theWeb schonmal geladen\n"; } return $otherwebprefs{$theWeb}{$theKey} || ''; } return ''; } # ========================= sub getPreferencesFlag { my ( $theKey, $theWeb ) = @_; my $flag = getPreferencesValue( $theKey, $theWeb ); $flag =~ s/^\s*(.*?)\s*$/$1/goi; # $flag =~ s/off//goi; $flag =~ s/no//goi; $flag =~ s/off|no//goi; return ($flag)?1:0; } # ========================= 1; # EOF