diff -urNw -x .svn -x ldap.cfg -x tdb -x twiki_dav -x '*-my.pm' -x Plugins -x Contrib -x CPAN -x '*-Cache.pm' -x '*-Orig.pm' -x Users -x HFile -x Beautifier -x Output -x '*.swp' -x LocalSite.cfg MAIN.orig/lib/TWiki/Cache/DB_File.pm MAIN/lib/TWiki/Cache/DB_File.pm --- MAIN.orig/lib/TWiki/Cache/DB_File.pm 1970-01-01 01:00:00.000000000 +0100 +++ MAIN/lib/TWiki/Cache/DB_File.pm 2007-03-02 18:14:43.000000000 +0100 @@ -0,0 +1,176 @@ +# Module of TWiki Enterprise Collaboration Platform, http://TWiki.org/ +# +# Copyright (C) 2007 Michael Daum http://wikiring.com +# +# All Rights Reserved. TWiki Contributors +# are listed in the AUTHORS file in the root of this distribution. +# NOTE: Please extend that file, not this notice. +# +# Additional copyrights apply to some or all of the code in this +# file as follows: +# +# 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. For +# more details read LICENSE in the root of this distribution. +# +# 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. +# +# As per the GPL, removal of this notice is prohibited. + +=pod + +---+ package TWiki::Cache::DB_File; + +Implementation of a TWiki::Cache using DB_File; + +=cut + +package TWiki::Cache::DB_File; + +use strict; +use DB_File; +use Storable qw(freeze thaw); +use TWiki::Cache; + +@TWiki::Cache::DB_File::ISA = ( 'TWiki::Cache' ); + +=pod + +---++ ClassMethod new( $session ) -> $object + +Construct a new cache object. + +=cut + +sub new { + my ($class, $session) = @_; + + return bless($class->SUPER::new($session), $class); +} + +=pod + +---++ ObjectMethod init($session) + +this is called after creating a cache object and when reusing it +on a second call + +=cut + +sub init { + my ($this, $session) = @_; + + $this->SUPER::init($session); + unless($this->{handler}) { + my $filename = $TWiki::cfg{Cache}{DBFile} || '/tmp/twiki_db'; + + $this->{handler} = tie %{$this->{tie}}, + 'DB_File', + $filename, + O_CREAT|O_RDWR, + 0664, + $DB_HASH + or die "Cannot open file $filename: $!"; + } +} + +=pod + +---++ ObjectMetohd set($key, $object) -> $boolean + +cache an $object under the given $key + +returns true if it was stored sucessfully + +WARNING: the DB_File backend does not implement exptime per se +you need to come up with an external cronjob to do so. + +=cut + +sub set { + my ($this, $key, $obj) = @_; + + return 0 unless $this->{handler}; + + my $value = freeze(\$obj); + $this->{tie}->{$this->genKey($key)} = $value; + + return 1; +} + +=pod + +---++ ObjectMethod get($key) -> $object + +retrieve a cached object, returns undef if it does not exist + +=cut + +sub get { + my ($this, $key) = @_; + + return 0 unless $this->{handler}; + + my $value = $this->{tie}->{$this->genKey($key)}; + my $obj; + $obj = ${thaw($value)} if $value; + + return $obj; +} + +=pod + +---++ ObjectMethod delete($key) + +delete an entry for a given $key + +returns true if the key was found and deleted, and false otherwise + +=cut + +sub delete { + my ($this, $key) = @_; + + return 0 unless $this->{handler}; + + $key = $this->genKey($key); + my $found = defined($this->{tie}->{$key}); + delete $this->{tie}->{$key}; + + return $found +} + +=pod + +---++ ObjectMethod clear() + +removes all objects from the cache. + +=cut + +sub clear { + my $this = shift; + + return unless $this->{handler}; + %{$this->{tie}} = (); +} + +=pod + +finish up internal structures + +=cut + +sub finish { + my $this = shift; + + $this->SUPER::finish(); + $this->{handler} = undef; + untie %{$this->{tie}}; +} + +1; diff -urNw -x .svn -x ldap.cfg -x tdb -x twiki_dav -x '*-my.pm' -x Plugins -x Contrib -x CPAN -x '*-Cache.pm' -x '*-Orig.pm' -x Users -x HFile -x Beautifier -x Output -x '*.swp' -x LocalSite.cfg MAIN.orig/lib/TWiki/Cache/FastMmap.pm MAIN/lib/TWiki/Cache/FastMmap.pm --- MAIN.orig/lib/TWiki/Cache/FastMmap.pm 1970-01-01 01:00:00.000000000 +0100 +++ MAIN/lib/TWiki/Cache/FastMmap.pm 2007-02-28 16:59:46.000000000 +0100 @@ -0,0 +1,111 @@ +# Module of TWiki Enterprise Collaboration Platform, http://TWiki.org/ +# +# Copyright (C) 2007 Michael Daum http://wikiring.com +# +# All Rights Reserved. TWiki Contributors +# are listed in the AUTHORS file in the root of this distribution. +# NOTE: Please extend that file, not this notice. +# +# Additional copyrights apply to some or all of the code in this +# file as follows: +# +# 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. For +# more details read LICENSE in the root of this distribution. +# +# 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. +# +# As per the GPL, removal of this notice is prohibited. + +=pod + +---+ package TWiki::Cache::FastMmap + +Implementation of a TWiki::Cache using Cache::FastMmap + +=cut + +package TWiki::Cache::FastMmap; + +use strict; +use Cache::FastMmap; +use TWiki::Cache; + +@TWiki::Cache::FastMmap::ISA = ( 'TWiki::Cache' ); + +=pod + +---++ ClassMethod new( $session ) -> $object + +Construct a new cache object. + +=cut + +sub new { + my ($class, $session) = @_; + + return bless($class->SUPER::new($session), $class); +} + +=pod + +---++ ObjectMethod init($session) + +this is called after creating a cache object and when reusing it +on a second call + +=cut + +sub init { + my ($this, $session) = @_; + + $this->SUPER::init($session); + unless($this->{handler}) { + $this->{handler} = new Cache::FastMmap( + 'share_file' => $TWiki::cfg{Cache}{ShareFile} || '/tmp/twiki_mmap', + 'cache_size' => $TWiki::cfg{Cache}{MaxSize}, + 'raw_values' => 0, + ); + } +} + +=pod + +---++ ObjectMetohd set($key, $object) -> $boolean + +cache an $object under the given $key + +returns true if it was stored sucessfully + +WARNING: Cache::FastMmap does not implement per object expiration times + +=cut + +sub set { + my ($this, $key, $obj) = @_; + + return 0 unless $this->{handler}; + return $this->{handler}->set($this->genKey($key), $obj); +} + +=pod + +---++ ObjectMethod clear() + +removes all objects from the cache. + +=cut + +sub clear { + my $this = shift; + + return unless $this->{handler}; + $this->{handler}->clear(); +} + + +1; diff -urNw -x .svn -x ldap.cfg -x tdb -x twiki_dav -x '*-my.pm' -x Plugins -x Contrib -x CPAN -x '*-Cache.pm' -x '*-Orig.pm' -x Users -x HFile -x Beautifier -x Output -x '*.swp' -x LocalSite.cfg MAIN.orig/lib/TWiki/Cache/FileCache.pm MAIN/lib/TWiki/Cache/FileCache.pm --- MAIN.orig/lib/TWiki/Cache/FileCache.pm 1970-01-01 01:00:00.000000000 +0100 +++ MAIN/lib/TWiki/Cache/FileCache.pm 2007-02-28 20:08:50.000000000 +0100 @@ -0,0 +1,114 @@ +# Module of TWiki Enterprise Collaboration Platform, http://TWiki.org/ +# +# Copyright (C) 2007 Michael Daum http://wikiring.com +# +# All Rights Reserved. TWiki Contributors +# are listed in the AUTHORS file in the root of this distribution. +# NOTE: Please extend that file, not this notice. +# +# Additional copyrights apply to some or all of the code in this +# file as follows: +# +# 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. For +# more details read LICENSE in the root of this distribution. +# +# 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. +# +# As per the GPL, removal of this notice is prohibited. + +=pod + +---+ package TWiki::Cache::FileCache + +Implementation of a TWiki::Cache using Cache::FileCache + +=cut + +package TWiki::Cache::FileCache; + +use strict; +use Cache::FileCache; +use TWiki::Cache; + +@TWiki::Cache::FileCache::ISA = ( 'TWiki::Cache' ); + +=pod + +---++ ClassMethod new( $session ) -> $object + +Construct a new cache object. + +=cut + +sub new { + my ($class, $session) = @_; + + return bless($class->SUPER::new($session), $class); +} + +=pod + +---++ ObjectMethod init($session) + +this is called after creating a cache object and when reusing it +on a second call + +=cut + +sub init { + my ($this, $session) = @_; + + $this->SUPER::init($session); + unless($this->{handler}) { + $this->{handler} = new Cache::FileCache({ + 'namespace' => $this->{namespace}, # also encoded into object keys, see TWiki::Cache::genKey() + 'auto_purge_on_set' => 1, + 'cache_root' => $TWiki::cfg{Cache}{RootDir} || '/tmp/twiki_cache', + 'cache_depth' => $TWiki::cfg{Cache}{SubDirs} || 3, + 'directory_umask' => $TWiki::cfg{Cache}{Umask} || 077, + }); + } +} + +=pod + +---++ ObjectMetohd set($key, $object [, $exptime]) -> $boolean + +cache an $object under the given $key + +returns true if it was stored sucessfully + +=cut + +sub set { + my ($this, $key, $obj, $exptime) = @_; + + return 0 unless $this->{handler}; + + $exptime ||= $Cache::Cache::EXPIRES_NEVER; + + return $this->{handler}->set($this->genKey($key), $obj, $exptime); +} + +=pod + +---++ ObjectMethod clear() + +removes all objects from the cache. + +=cut + +sub clear { + my $this = shift; + + return unless $this->{handler}; + $this->{handler}->clear(); +} + + +1; diff -urNw -x .svn -x ldap.cfg -x tdb -x twiki_dav -x '*-my.pm' -x Plugins -x Contrib -x CPAN -x '*-Cache.pm' -x '*-Orig.pm' -x Users -x HFile -x Beautifier -x Output -x '*.swp' -x LocalSite.cfg MAIN.orig/lib/TWiki/Cache/Memcached.pm MAIN/lib/TWiki/Cache/Memcached.pm --- MAIN.orig/lib/TWiki/Cache/Memcached.pm 1970-01-01 01:00:00.000000000 +0100 +++ MAIN/lib/TWiki/Cache/Memcached.pm 2007-02-28 15:13:21.000000000 +0100 @@ -0,0 +1,116 @@ +# Module of TWiki Enterprise Collaboration Platform, http://TWiki.org/ +# +# Copyright (C) 2007 Michael Daum http://wikiring.com +# +# All Rights Reserved. TWiki Contributors +# are listed in the AUTHORS file in the root of this distribution. +# NOTE: Please extend that file, not this notice. +# +# Additional copyrights apply to some or all of the code in this +# file as follows: +# +# 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. For +# more details read LICENSE in the root of this distribution. +# +# 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. +# +# As per the GPL, removal of this notice is prohibited. + +=pod + +---+ package TWiki::Cache::Memcached + +implementation of a TWiki::Cache using memcached + +=cut + +package TWiki::Cache::Memcached; + +use strict; +use Cache::Memcached; +use TWiki::Cache; + +@TWiki::Cache::Memcached::ISA = ( 'TWiki::Cache' ); + +# static poor man's debugging tools +sub writeDebug { + print STDERR "TWiki::Cache::Memcached - $_[0]\n" if $TWiki::cfg{Cache}{Debug}; +} + +=pod + +---++ ClassMethod new( $session ) -> $object + +Construct a new cache connecting to a memcached server pool. + +=cut + +sub new { + my ($class, $session) = @_; + + my $this = bless($class->SUPER::new($session), $class); + + return $this; +} + +=pod + +---++ ObjectMethod init($session) + +connect to the memcached if we didn't already + +=cut + +sub init { + my ($this, $session) = @_; + + $this->SUPER::init($session); + unless ($this->{handler}) { + $this->{servers} = $TWiki::cfg{Cache}{Servers} || '127.0.0.1:11211'; + $this->{compress_threshold} = $TWiki::cfg{Cache}{CompressThreshold} || 10000; + #$this->{debug} = $TWiki::cfg{Cache}{Debug} || 0; + + my @servers = split(/,\s/, $this->{servers}); + # connect to new cache + $this->{handler} = new Cache::Memcached { + 'servers'=>[@servers], + 'debug'=>$this->{debug}, + 'compress_threshold'=>$this->{compress_threshold}, + }; + } +} + +=pod + +commit the dependency changes and finish up internal structures + +=cut +sub finish { + my $this = shift; + + $this->SUPER::finish(); +# $this->{handler}->disconnect_all() if $this->{handler}; +# $this->{handler} = undef; +} + +=pod + +Implements TWiki::Cache::delete() + +Cache::Memcached uses delete() while all Cache::Cache impls use +remove() + +=cut + +sub delete { + my $this = shift; + + return $this->{handler}->delete($this->genKey($_[0])); +} + +1; diff -urNw -x .svn -x ldap.cfg -x tdb -x twiki_dav -x '*-my.pm' -x Plugins -x Contrib -x CPAN -x '*-Cache.pm' -x '*-Orig.pm' -x Users -x HFile -x Beautifier -x Output -x '*.swp' -x LocalSite.cfg MAIN.orig/lib/TWiki/Cache/MemoryCache.pm MAIN/lib/TWiki/Cache/MemoryCache.pm --- MAIN.orig/lib/TWiki/Cache/MemoryCache.pm 1970-01-01 01:00:00.000000000 +0100 +++ MAIN/lib/TWiki/Cache/MemoryCache.pm 2007-02-28 15:13:21.000000000 +0100 @@ -0,0 +1,111 @@ +# Module of TWiki Enterprise Collaboration Platform, http://TWiki.org/ +# +# Copyright (C) 2007 Michael Daum http://wikiring.com +# +# All Rights Reserved. TWiki Contributors +# are listed in the AUTHORS file in the root of this distribution. +# NOTE: Please extend that file, not this notice. +# +# Additional copyrights apply to some or all of the code in this +# file as follows: +# +# 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. For +# more details read LICENSE in the root of this distribution. +# +# 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. +# +# As per the GPL, removal of this notice is prohibited. + +=pod + +---+ package TWiki::Cache::MemoryCache + +Implementation of a TWiki::Cache using Cache::MemoryCache + +=cut + +package TWiki::Cache::MemoryCache; + +use strict; +use Cache::MemoryCache; +use TWiki::Cache; + +@TWiki::Cache::MemoryCache::ISA = ( 'TWiki::Cache' ); + +=pod + +---++ ClassMethod new( $session ) -> $object + +Construct a new cache object. + +=cut + +sub new { + my ($class, $session) = @_; + + return bless($class->SUPER::new($session), $class); +} + +=pod + +---++ ObjectMethod init($session) + +this is called after creating a cache object and when reusing it +on a second call + +=cut + +sub init { + my ($this, $session) = @_; + + $this->SUPER::init($session); + unless($this->{handler}) { + $this->{handler} = new Cache::MemoryCache({ + 'namespace' => $this->{namespace}, # also encoded into object keys, see TWiki::Cache::genKey() + 'auto_purge_on_set' => 1, + }); + } +} + +=pod + +---++ ObjectMetohd set($key, $object [, $exptime]) -> $boolean + +cache an $object under the given $key + +returns true if it was stored sucessfully + +=cut + +sub set { + my ($this, $key, $obj, $exptime) = @_; + + return 0 unless $this->{handler}; + + $exptime ||= $Cache::Cache::EXPIRES_NEVER; + + return $this->{handler}->set($this->genKey($key), $obj, $exptime); +} + +=pod + +---++ ObjectMethod clear() + +removes all objects from the cache. + +=cut + +sub clear { + my $this = shift; + + return unless $this->{handler}; + $this->{handler}->clear(); +} + + +1; diff -urNw -x .svn -x ldap.cfg -x tdb -x twiki_dav -x '*-my.pm' -x Plugins -x Contrib -x CPAN -x '*-Cache.pm' -x '*-Orig.pm' -x Users -x HFile -x Beautifier -x Output -x '*.swp' -x LocalSite.cfg MAIN.orig/lib/TWiki/Cache/SizeAwareFileCache.pm MAIN/lib/TWiki/Cache/SizeAwareFileCache.pm --- MAIN.orig/lib/TWiki/Cache/SizeAwareFileCache.pm 1970-01-01 01:00:00.000000000 +0100 +++ MAIN/lib/TWiki/Cache/SizeAwareFileCache.pm 2007-02-28 15:13:21.000000000 +0100 @@ -0,0 +1,115 @@ +# Module of TWiki Enterprise Collaboration Platform, http://TWiki.org/ +# +# Copyright (C) 2007 Michael Daum http://wikiring.com +# +# All Rights Reserved. TWiki Contributors +# are listed in the AUTHORS file in the root of this distribution. +# NOTE: Please extend that file, not this notice. +# +# Additional copyrights apply to some or all of the code in this +# file as follows: +# +# 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. For +# more details read LICENSE in the root of this distribution. +# +# 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. +# +# As per the GPL, removal of this notice is prohibited. + +=pod + +---+ package TWiki::Cache::SizeAwareFileCache + +Implementation of a TWiki::Cache using Cache::SizeAwareFileCache + +=cut + +package TWiki::Cache::SizeAwareFileCache; + +use strict; +use Cache::SizeAwareFileCache; +use TWiki::Cache; + +@TWiki::Cache::SizeAwareFileCache::ISA = ( 'TWiki::Cache' ); + +=pod + +---++ ClassMethod new( $session ) -> $object + +Construct a new cache object. + +=cut + +sub new { + my ($class, $session) = @_; + + return bless($class->SUPER::new($session), $class); +} + +=pod + +---++ ObjectMethod init($session) + +this is called after creating a cache object and when reusing it +on a second call + +=cut + +sub init { + my ($this, $session) = @_; + + $this->SUPER::init($session); + unless($this->{handler}) { + $this->{handler} = new Cache::SizeAwareFileCache({ + 'namespace' => $this->{namespace}, # also encoded into object keys, see TWiki::Cache::genKey() + 'auto_purge_on_set' => 1, + 'cache_root' => $TWiki::cfg{Cache}{RootDir} || '/tmp/twiki_cache', + 'cache_depth' => $TWiki::cfg{Cache}{SubDirs} || 3, + 'directory_umask' => $TWiki::cfg{Cache}{Umask} || 077, + 'max_size' => $TWiki::cfg{Cache}{MaxSize} || 10000, + }); + } +} + +=pod + +---++ ObjectMetohd set($key, $object [, $exptime]) -> $boolean + +cache an $object under the given $key + +returns true if it was stored sucessfully + +=cut + +sub set { + my ($this, $key, $obj, $exptime) = @_; + + return 0 unless $this->{handler}; + + $exptime ||= $Cache::Cache::EXPIRES_NEVER; + + return $this->{handler}->set($this->genKey($key), $obj, $exptime); +} + +=pod + +---++ ObjectMethod clear() + +removes all objects from the cache. + +=cut + +sub clear { + my $this = shift; + + return unless $this->{handler}; + $this->{handler}->clear(); +} + + +1; diff -urNw -x .svn -x ldap.cfg -x tdb -x twiki_dav -x '*-my.pm' -x Plugins -x Contrib -x CPAN -x '*-Cache.pm' -x '*-Orig.pm' -x Users -x HFile -x Beautifier -x Output -x '*.swp' -x LocalSite.cfg MAIN.orig/lib/TWiki/Cache/SizeAwareMemoryCache.pm MAIN/lib/TWiki/Cache/SizeAwareMemoryCache.pm --- MAIN.orig/lib/TWiki/Cache/SizeAwareMemoryCache.pm 1970-01-01 01:00:00.000000000 +0100 +++ MAIN/lib/TWiki/Cache/SizeAwareMemoryCache.pm 2007-02-28 15:13:21.000000000 +0100 @@ -0,0 +1,112 @@ +# Module of TWiki Enterprise Collaboration Platform, http://TWiki.org/ +# +# Copyright (C) 2007 Michael Daum http://wikiring.com +# +# All Rights Reserved. TWiki Contributors +# are listed in the AUTHORS file in the root of this distribution. +# NOTE: Please extend that file, not this notice. +# +# Additional copyrights apply to some or all of the code in this +# file as follows: +# +# 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. For +# more details read LICENSE in the root of this distribution. +# +# 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. +# +# As per the GPL, removal of this notice is prohibited. + +=pod + +---+ package TWiki::Cache::SizeAwareMemoryCache + +Implementation of a TWiki::Cache using Cache::SizeAwareMemoryCache + +=cut + +package TWiki::Cache::SizeAwareMemoryCache; + +use strict; +use Cache::SizeAwareMemoryCache; +use TWiki::Cache; + +@TWiki::Cache::SizeAwareMemoryCache::ISA = ( 'TWiki::Cache' ); + +=pod + +---++ ClassMethod new( $session ) -> $object + +Construct a new cache object. + +=cut + +sub new { + my ($class, $session) = @_; + + return bless($class->SUPER::new($session), $class); +} + +=pod + +---++ ObjectMethod init($session) + +this is called after creating a cache object and when reusing it +on a second call + +=cut + +sub init { + my ($this, $session) = @_; + + $this->SUPER::init($session); + unless($this->{handler}) { + $this->{handler} = new Cache::SizeAwareMemoryCache({ + 'namespace' => $this->{namespace}, # also encoded into object keys, see TWiki::Cache::genKey() + 'auto_purge_on_set' => 1, + 'max_size' => $TWiki::cfg{Cache}{MaxSize} || 10000, + }); + } +} + +=pod + +---++ ObjectMetohd set($key, $object [, $exptime]) -> $boolean + +cache an $object under the given $key + +returns true if it was stored sucessfully + +=cut + +sub set { + my ($this, $key, $obj, $exptime) = @_; + + return 0 unless $this->{handler}; + + $exptime ||= $Cache::Cache::EXPIRES_NEVER; + + return $this->{handler}->set($this->genKey($key), $obj, $exptime); +} + +=pod + +---++ ObjectMethod clear() + +removes all objects from the cache. + +=cut + +sub clear { + my $this = shift; + + return unless $this->{handler}; + $this->{handler}->clear(); +} + + +1; diff -urNw -x .svn -x ldap.cfg -x tdb -x twiki_dav -x '*-my.pm' -x Plugins -x Contrib -x CPAN -x '*-Cache.pm' -x '*-Orig.pm' -x Users -x HFile -x Beautifier -x Output -x '*.swp' -x LocalSite.cfg MAIN.orig/lib/TWiki/Cache/TDB_File.pm MAIN/lib/TWiki/Cache/TDB_File.pm --- MAIN.orig/lib/TWiki/Cache/TDB_File.pm 1970-01-01 01:00:00.000000000 +0100 +++ MAIN/lib/TWiki/Cache/TDB_File.pm 2007-03-02 18:14:53.000000000 +0100 @@ -0,0 +1,177 @@ +# Module of TWiki Enterprise Collaboration Platform, http://TWiki.org/ +# +# Copyright (C) 2007 Michael Daum http://wikiring.com +# +# All Rights Reserved. TWiki Contributors +# are listed in the AUTHORS file in the root of this distribution. +# NOTE: Please extend that file, not this notice. +# +# Additional copyrights apply to some or all of the code in this +# file as follows: +# +# 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. For +# more details read LICENSE in the root of this distribution. +# +# 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. +# +# As per the GPL, removal of this notice is prohibited. + +=pod + +---+ package TWiki::Cache::TDB_File; + +Implementation of a TWiki::Cache using TDB_File; + +=cut + +package TWiki::Cache::TDB_File; + +use strict; +use TDB_File qw(:flags); +use Storable qw(freeze thaw); +use TWiki::Cache; +use Fcntl; + +@TWiki::Cache::TDB_File::ISA = ( 'TWiki::Cache' ); + +=pod + +---++ ClassMethod new( $session ) -> $object + +Construct a new cache object. + +=cut + +sub new { + my ($class, $session) = @_; + + return bless($class->SUPER::new($session), $class); +} + +=pod + +---++ ObjectMethod init($session) + +this is called after creating a cache object and when reusing it +on a second call + +=cut + +sub init { + my ($this, $session) = @_; + + $this->SUPER::init($session); + unless($this->{handler}) { + my $filename = $TWiki::cfg{Cache}{TDBFile} || '/tmp/twiki_tdb'; + + $this->{handler} = tie %{$this->{tie}}, + 'TDB_File', + $filename, + TDB_DEFAULT, + O_CREAT|O_RDWR, + 0664 + or die "Cannot open file $filename: $!"; + } +} + +=pod + +---++ ObjectMetohd set($key, $object) -> $boolean + +cache an $object under the given $key + +returns true if it was stored sucessfully + +WARNING: the TDB_File backend does not implement exptime per se +you need to come up with an external cronjob to do so. + +=cut + +sub set { + my ($this, $key, $obj) = @_; + + return 0 unless $this->{handler}; + + my $value = freeze(\$obj); + $this->{tie}->{$this->genKey($key)} = $value; + + return 1; +} + +=pod + +---++ ObjectMethod get($key) -> $object + +retrieve a cached object, returns undef if it does not exist + +=cut + +sub get { + my ($this, $key) = @_; + + return 0 unless $this->{handler}; + + my $value = $this->{tie}->{$this->genKey($key)}; + my $obj; + $obj = ${thaw($value)} if $value; + + return $obj; +} + +=pod + +---++ ObjectMethod delete($key) + +delete an entry for a given $key + +returns true if the key was found and deleted, and false otherwise + +=cut + +sub delete { + my ($this, $key) = @_; + + return 0 unless $this->{handler}; + + $key = $this->genKey($key); + my $found = defined($this->{tie}->{$key}); + delete $this->{tie}->{$key}; + + return $found +} + +=pod + +---++ ObjectMethod clear() + +removes all objects from the cache. + +=cut + +sub clear { + my $this = shift; + + return unless $this->{handler}; + %{$this->{tie}} = (); +} + +=pod + +finish up internal structures + +=cut + +sub finish { + my $this = shift; + + $this->SUPER::finish(); + $this->{handler} = undef; + untie %{$this->{tie}}; +} + +1; diff -urNw -x .svn -x ldap.cfg -x tdb -x twiki_dav -x '*-my.pm' -x Plugins -x Contrib -x CPAN -x '*-Cache.pm' -x '*-Orig.pm' -x Users -x HFile -x Beautifier -x Output -x '*.swp' -x LocalSite.cfg MAIN.orig/lib/TWiki/Cache.pm MAIN/lib/TWiki/Cache.pm --- MAIN.orig/lib/TWiki/Cache.pm 1970-01-01 01:00:00.000000000 +0100 +++ MAIN/lib/TWiki/Cache.pm 2007-03-02 18:18:26.000000000 +0100 @@ -0,0 +1,598 @@ +# Module of TWiki Enterprise Collaboration Platform, http://TWiki.org/ +# +# Copyright (C) 2006-2007 Michael Daum http://wikiring.com +# +# and TWiki Contributors. All Rights Reserved. TWiki Contributors +# are listed in the AUTHORS file in the root of this distribution. +# NOTE: Please extend that file, not this notice. +# +# 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. For +# more details read LICENSE in the root of this distribution. +# +# 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. +# +# As per the GPL, removal of this notice is prohibited. + +=pod +---+ package TWiki::Cache + +TWiki::Cache interface + +=cut + +package TWiki::Cache; + +use strict; +use vars qw(%sharedCache); + +# static poor man's debugging tools +sub writeDebug { + print STDERR "TWiki::Cache - $_[0]\n" if $TWiki::cfg{Cache}{Debug}; +} + +=pod + +---++ Static Method makeTWikiCache($twiki, $impl) -> $object + +factory method to create a new TWiki::Cache object + +=cut + +sub makeTWikiCache { + + my ($session, $impl) = @_; + $impl ||= $TWiki::cfg{CacheManager} || 'TWiki::Cache'; + if ($impl eq 'TWiki::Cache' || $impl eq 'none') { + $impl = 'TWiki::Cache'; + $TWiki::cfg{Cache}{Enabled} = 0; + } + + + #writeDebug("impl=$impl"); + + # try to get a shared instance of this class + my $cache = $sharedCache{$impl}; + if ($cache) { + #writeDebug("reusing cache for $impl"); + $cache->init($session); + } else { + eval 'use '.$impl; + throw Error::Simple( $@ ) if $@; + $cache = $impl->new($session); + $sharedCache{$impl} = $cache; + } + + # check if the cache is up 'n running +# if ($TWiki::cfg{Cache}{Debug} && $TWiki::cfg{Cache}{Enabled}) { +# my $myValue='Some Value'; +# $cache->set('my_key', $myValue); +# my $yourValue = $cache->get('my_key') || ''; +# if ($myValue ne $yourValue) { +# writeDebug("WARNING: failed to cache something"); +# $TWiki::cfg{Cache}{Enabled} = 0; +# } else { +# writeDebug("SUCCESS: cache is up and running"); +# } +# } + + return $cache; +} + +=pod + +---++ ClassMethod new( $session ) -> $object + +Construct a new cache delegator. + +=cut + +sub new { + my ($class, $session) = @_; + + my $this = {}; + bless($this, $class); + $this->init($session); + + return $this; +} + +=pod + +---++ ObjectMethod init($session) + +initializes a cache object to be used for the current request. this +object might be _shared_ on multiple requests when TWiki is accelerated +using mod_perl or speedy-cgi and using the TWiki::Cache::MemoryCache +handler. + +=cut + +sub init { + my ($this, $session) = @_; + + $this->{session} = $session; + $this->{namespace} = $TWiki::cfg{Cache}{Namespace} || + $TWiki::cfg{DefaultUrlHost}.':'.$TWiki::cfg{ScriptUrlPath}; + # All hosts are at least distinguished by their url and script path + $this->{namespace} =~ s/[\s\/]+/_/go; +} + +=pod + +explicite destructor to break cyclic links + +=cut + +sub DESTROY { + my $this = shift; + $this->finish(); +} + +=pod + +finish up internal structures + +=cut + +sub finish { + my $this = shift; + + $this->{session} = undef; +} + + + +=pod + +---++ ObjectMethod genkey($string, ...) -> $key + +Static function to generate a key for the current cache. + +Some cache implementations don't have a namespace feature. Those which do, are +only able to serve objects from within one namespace per cache object. + +So by default we encode the namespace into the key here, even when this is +redundant, given that you specify the namespace for Cache::Cache +implementations during the constructor already. + +=cut + +sub genKey { + my $this = shift; + my $key = $this->{namespace}.':'.join(':', @_); + $key =~ s/[\s\/]+/_/go; + return $key; +} + +=pod + +---++ ObjectMethod genVariationKey() -> $key + +method to generate a key for the current webtopic being produced; this reads +information from the current session and url params + +=cut + +sub genVariationKey { + my $this = shift; + + my $session = $this->{session}; + my $result = $session->{cgiQuery}->query_string() || ''; + + # filter out some params that are not relevant + $result =~ s/(refresh|twiki_redirect_cache)=[^&]*$//go; + + # get information from the session object + my $sessionValues = $session->{loginManager}->getSessionValues(); + foreach my $key (keys %$sessionValues) { + next if $key =~ /^BREADCRUMB_TRAIL$/o; # SMELL: this is a list of stuff that gets stored + next if $key =~ /^VALIDATION$/o; # in the session object that shall not distinguish + next if $key =~ /^_SESSION_/o; # pages in cache ... we need a standardized way to + next if $key =~ /^REMEMBER$/o; # filter that out + # + next if $key =~ /^AUTHUSER/o; # using login name below + $sessionValues->{$key} = 'undef' unless defined $sessionValues->{$key}; + $result .= ":$key=$sessionValues->{$key}"; + } + $result .= ':'.$session->{user}->login(); + + #writeDebug("variation key = $result"); + + return $result; +} + +=pod + +---++ ObjectMethod cachePage($html) -> $boolean + +Cache a html page. every page is stored in a page bucket +that contains all variations (stored for other users or other session parameters) +of this page, as well as dependency and expiration information + +A pageBucket has the following structure + +$pageBucket = { + variations => (), # hash of page variations, each indexed using genVariationKey() + exptime => seconds, # seconds til automatic expiration of this item in the cache + revDeps => (), # names of other pages that depend on this page + deps => (), # names of pages this one depends on +} + +Note, that the dependencies are fired in reverse logic as the depending pages +have to notify this page if they changed. + +=cut + +sub cachePage { + return 0 unless $TWiki::cfg{Cache}{Enabled}; + + my $this = shift; + my $session = $this->{session}; + my $webTopic = $session->{webName}.'.'.$session->{topicName}; + + #writeDebug("cachePage($webTopic)"); + + # delete page and all variations if we ask for a refresh + if (TWiki::isTrue($session->{cgiQuery}->param('refresh'))) { + $this->deletePage($webTopic); + } + + # assert the manual dependencies + my $topicDeps = + $session->{prefs}->getPreferencesValue('DEPENDENCIES') || ''; + my $pageBucket = $this->get('TWiki::Cache::'.$webTopic); + + foreach my $topic (split(/,\s/, $topicDeps)) { + my ($depWeb, $depTopic) = + $this->{session}->normalizeWebTopicName($this->{session}->{webName}, $topic); + $depWeb =~ s/\./\\/go; + $pageBucket->{revDeps}{$depWeb.'.'.$depTopic} = 1; + #writeDebug("adding dependency $webTopic->$topic"); + } + + # assert the autodetected dependencies to the target topics, + # that is in reverse logic + foreach my $topic (keys %{$this->{deps}}) { + next if $topic eq $webTopic; + my $bucket = $this->get('TWiki::Cache::'.$topic); + $pageBucket->{deps}{$topic} = 1; + $bucket->{revDeps}{$webTopic} = 1; + #writeDebug("adding dependency $topic->$webTopic"); + $this->set('TWiki::Cache::'.$topic, $bucket, $bucket->{exptime}); + } + + # remove the session id + if ($_[0] =~ s/\r?\n?Set-Cookie: $CGI::Session::NAME=.*?\r?\n//go) { + #writeDebug("removed session id"); + } + + # get expiration time + my $exptime = $session->{prefs}->getPreferencesValue('CACHEEXPTIME') || 0; + $pageBucket->{exptime} = $exptime; + + # store page + $pageBucket->{variations}{$this->genVariationKey()} = $_[0]; + return $this->set('TWiki::Cache::'.$webTopic, $pageBucket, $exptime); +} + + +=pod + +retrieve a html page for the current session from cache + +=cut + +sub getPage { + return undef unless $TWiki::cfg{Cache}{Enabled}; + + my ($this, $webTopic) = @_; + + # check url param + my $session = $this->{session}; + return undef if TWiki::isTrue($session->{cgiQuery}->param('refresh')); + + + # check cacheability + $webTopic ||= $session->{webName}.'.'.$session->{topicName}; + return undef unless $this->isCacheable($webTopic); + + # check availability + my $pageBucket = $this->get('TWiki::Cache::'.$webTopic); + return undef unless $pageBucket; + + return $pageBucket->{variations}{$this->genVariationKey()}; +} + +=pod + +remove a page from the cache; this removes all of the information +that we have about this page stored in its bucket + +=cut + +sub deletePage { + my ($this, $webTopic) = @_; + + if ($this->delete('TWiki::Cache::'.$webTopic)) { + #writeDebug("deleted page $webTopic"); + } else { + #writeDebug("tried to delete page $webTopic, but it was not there"); + } +} + +=pod + +check if the current page is cacheable + +1. check refresh url param +2. check CACHEABLE pref value +3. ask plugins what they think (e.g. the blacklist plugin may want + to prevent the blacklist message from being cached) + +=cut + +sub isCacheable { + my ($this, $webTopic) = @_; + + # DEBUG + #writeDebug("isCacheable($webTopic)"); + # /DEBUG + + return $this->{isCacheable}{$webTopic} if defined $this->{isCacheable}{$webTopic}; + + # DEBUG + #writeDebug("... checking"); + # /DEBUG + + # by default we try to cache as much as possible + $this->{isCacheable}{$webTopic} = 1; + + # check global config options + $this->{isCacheable}{$webTopic} = 0 unless $TWiki::cfg{Cache}{Enabled}; + + # check prefs value + my $flag = $this->{session}->{prefs}->getPreferencesValue('CACHEABLE'); + $this->{isCacheable}{$webTopic} = 0 if defined $flag && !TWiki::isTrue($flag); + + # TODO: give plugins a chance - create a callback + + # DEBUG + #writeDebug("isCacheable=$this->{isCacheable}{$webTopic}"); + # /DEBUG + + return $this->{isCacheable}{$webTopic}; +} + +=pod + +add a web.topic to the dependencies of the current page + +=cut + +sub addDependency { + my ($this, $depWeb, $depTopic) = @_; + + #writeDebug("addDependency($depWeb, $depTopic)"); + + # normalize + ($depWeb, $depTopic) = + $this->{session}->normalizeWebTopicName($depWeb, $depTopic); + $depWeb =~ s/\./\\/go; + + # collect them; defer writing them to the database til we cache this page + $this->{deps}{$depWeb.'.'.$depTopic} = 1; +} + +=pod + +return dependencies for a given web.topic + +=cut + +sub getDependencies { + my ($this, $webTopic) = @_; + + my $pageBucket = $this->get('TWiki::Cache::'.$webTopic); + my @result = (); + @result = keys %{$pageBucket->{deps}} if $pageBucket; + return \@result; +} + +=pod + +return reverse dependencies for a given web.topic + +=cut + +sub getRevDependencies { + my ($this, $webTopic) = @_; + + my $pageBucket = $this->get('TWiki::Cache::'.$webTopic); + my @result = (); + @result = keys %{$pageBucket->{revDeps}} if $pageBucket; + return \@result; +} + +=pod + +returns dependencies that hold for all topics in a web. + +=cut + +sub getWebDependencies { + my $this = shift; + + unless (defined $this->{webDeps}) { + my $webDeps = $this->{session}->{prefs}->getPreferencesValue( + 'WEBDEPENDENCIES', $this->{session}->{webName}) || ''; + + $this->{webDeps} = (); + + # normalize topics + foreach my $dep (split(/,\s/, $webDeps)) { + my ($depWeb, $depTopic) = + $this->{session}->normalizeWebTopicName($this->{session}->{webName}, $dep); + writeDebug("found webdep $depWeb.$depTopic"); + $this->{webDeps}{$depWeb.'.'.$depTopic} = 1; + } + + } + my @result = keys %{$this->{webDeps}}; + return \@result; +} + + +=pod + +fire a dependency invalidating the related cache entries + +=cut + +sub fireDependency { + my ($this, $webTopic, $depth, $seen) = @_; + + $seen ||= {}; + $depth ||= 1; + return if $seen->{$webTopic} || $depth > 3; + $seen->{$webTopic} = 1; + + if ($depth == 1) { + foreach my $dep (@{$this->getWebDependencies()}) { + $this->fireDependency($dep, $depth+1, $seen); + } + } + + #writeDebug("FIRING $webTopic at depth $depth"); + my $deps = $this->getRevDependencies($webTopic); + $this->deletePage($webTopic); + foreach my $dep (@$deps) { + $this->fireDependency($dep, $depth+1, $seen); # fire recursively + } +} + +=pod + +extract dirty areas and render them; this happens after storing a +page including the un-rendered dirty areas into the cache and after +retrieving it again + +=cut + +sub renderDirtyAreas { + my ($this, $page) = @_; + + # remember the current page length to recompute the content length below + my $oldLen = do { use bytes; length( $$page ); }; + my $found = 0; + + # handle tags in dirty areas + while ($$page =~ s/]*?)>(?!.*/$this->_handleDirtyArea($1, $2)/geos) { + $found = 1; + } + + if ($found) { + # recompute the content length + #writeDebug("found dirty area(s)"); + my $newLen = do { use bytes; length( $$page ); }; + $$page =~ s/((?:[\n\r]|^)Content-length: )(.*)([\n\r])/$1.($2+$newLen-$oldLen).$3/e; + } +} + +=pod + +called by renderDirtyAreas() to process each dirty area in isolation + +=cut + +sub _handleDirtyArea { + my ($this, $args, $text) = @_; + + #writeDebug("_handleDirtyArea() called"); + #writeDebug("in text='$text'"); + + my $params = new TWiki::Attrs( $args ); + + # get web and topic params + my $topic = $params->{topic} || $this->{session}{topicName}; + my $web = $params->{web} || $this->{session}{webName}; + ($web, $topic) = $this->{session}->normalizeWebTopicName($web, $topic); + + $text = $this->{session}->handleCommonTags($text, $web, $topic); + $text = $this->{session}->{renderer}->getRenderedVersion($text, $web, $topic); + #writeDebug("out text='$text'"); + return $text; +} + +=pod + +---++ ObjectMetohd set($key, $object [, $exptime]) -> $boolean + +cache an $object under the given $key + +returns true if it was stored sucessfully + +=cut + +sub set { + my ($this, $key, $obj, $exptime) = @_; + + return 0 unless $this->{handler}; + + return $this->{handler}->set($this->genKey($key), $obj, $exptime); +} + +=pod + +---++ ObjectMethod get($key) -> $object + +retrieve a cached object, returns undef if it does not exist + +=cut + +sub get { + my ($this, $key) = @_; + + return 0 unless $this->{handler}; + + return $this->{handler}->get($this->genKey($key)); +} + +=pod + +---++ ObjectMethod delete($key) + +delete an entry for a given $key + +returns true if the key was found and deleted, and false otherwise + +=cut + +sub delete { + my ($this, $key) = @_; + + return 0 unless $this->{handler}; + return $this->{handler}->remove($this->genKey($key)); +} + + +=pod + +---++ ObjectMethod clear() + +removes all objects from the cache. Note, that this is not doable +with some backends + +=cut + +sub clear { + + # to be implemented +} + + +1; diff -urNw -x .svn -x ldap.cfg -x tdb -x twiki_dav -x '*-my.pm' -x Plugins -x Contrib -x CPAN -x '*-Cache.pm' -x '*-Orig.pm' -x Users -x HFile -x Beautifier -x Output -x '*.swp' -x LocalSite.cfg MAIN.orig/lib/TWiki/Prefs.pm MAIN/lib/TWiki/Prefs.pm --- MAIN.orig/lib/TWiki/Prefs.pm 2007-02-28 15:15:25.000000000 +0100 +++ MAIN/lib/TWiki/Prefs.pm 2007-01-16 11:14:05.000000000 +0100 @@ -319,7 +319,7 @@ ---++ ObjectMethod getWebPreferencesValue( $key, $web ) -> $value -Recover a preferences value that is defined in the webhome topic of +Recover a preferences value that is defined in the webpreferences topic of a specific web.. Does not recover user or global settings, but does recover settings from containing webs. diff -urNw -x .svn -x ldap.cfg -x tdb -x twiki_dav -x '*-my.pm' -x Plugins -x Contrib -x CPAN -x '*-Cache.pm' -x '*-Orig.pm' -x Users -x HFile -x Beautifier -x Output -x '*.swp' -x LocalSite.cfg MAIN.orig/lib/TWiki/Render.pm MAIN/lib/TWiki/Render.pm --- MAIN.orig/lib/TWiki/Render.pm 2007-02-28 15:15:25.000000000 +0100 +++ MAIN/lib/TWiki/Render.pm 2007-02-28 15:32:15.000000000 +0100 @@ -1,3 +1,4 @@ + # Module of TWiki Enterprise Collaboration Platform, http://TWiki.org/ # # Copyright (C) 2001-2007 Peter Thoeny, peter@thoeny.org @@ -522,6 +523,10 @@ } if( $topicExists) { + # add a dependency so that the page gets invalidated as soon as the + # topic is deleted + $this->{session}->{cache}->addDependency($theWeb, $theTopic) + if $TWiki::cfg{Cache}{Enabled}; return _renderExistingWikiWord($this, $theWeb, $theTopic, $theLinkText, $theAnchor); } @@ -530,6 +535,11 @@ # if ($singular && $singular ne $theTopic) { # #unshift( @topics, $singular); # } + + # add a dependency so that the page gets invalidated as soon as the + # WikiWord comes into existance + $this->{session}->{cache}->addDependency($theWeb, $theTopic) + if $TWiki::cfg{Cache}{Enabled}; return _renderNonExistingWikiWord($this, $theWeb, $theTopic, $theLinkText); } diff -urNw -x .svn -x ldap.cfg -x tdb -x twiki_dav -x '*-my.pm' -x Plugins -x Contrib -x CPAN -x '*-Cache.pm' -x '*-Orig.pm' -x Users -x HFile -x Beautifier -x Output -x '*.swp' -x LocalSite.cfg MAIN.orig/lib/TWiki/Search.pm MAIN/lib/TWiki/Search.pm --- MAIN.orig/lib/TWiki/Search.pm 2007-02-28 15:15:25.000000000 +0100 +++ MAIN/lib/TWiki/Search.pm 2007-02-28 15:10:25.000000000 +0100 @@ -698,6 +698,11 @@ } } + # add dependencies + foreach my $topic ( @topicList ) { + $session->{cache}->addDependency($web,$topic); + } + # output the list of topics in $web my $ntopics = 0; my $headerDone = $noHeader; diff -urNw -x .svn -x ldap.cfg -x tdb -x twiki_dav -x '*-my.pm' -x Plugins -x Contrib -x CPAN -x '*-Cache.pm' -x '*-Orig.pm' -x Users -x HFile -x Beautifier -x Output -x '*.swp' -x LocalSite.cfg MAIN.orig/lib/TWiki/Store/RcsFile.pm MAIN/lib/TWiki/Store/RcsFile.pm --- MAIN.orig/lib/TWiki/Store/RcsFile.pm 2007-02-28 15:15:16.000000000 +0100 +++ MAIN/lib/TWiki/Store/RcsFile.pm 2007-03-01 16:34:33.000000000 +0100 @@ -83,14 +83,6 @@ $this->{rcsFile} = $TWiki::cfg{DataDir}.'/'. $web.$rcsSubDir.'/'.$topic.'.txt,v'; } - - # remove utf8 encodings from filenames - if( $] >= 5.008 ) { - utf8::downgrade($this->{attachment}) if $attachment && utf8::is_utf8($this->{attachment}); - utf8::downgrade($this->{file}) if utf8::is_utf8($this->{file}); - utf8::downgrade($this->{rcsFile}) if utf8::is_utf8($this->{rcsFile}); - } - } return $this; diff -urNw -x .svn -x ldap.cfg -x tdb -x twiki_dav -x '*-my.pm' -x Plugins -x Contrib -x CPAN -x '*-Cache.pm' -x '*-Orig.pm' -x Users -x HFile -x Beautifier -x Output -x '*.swp' -x LocalSite.cfg MAIN.orig/lib/TWiki/Store.pm MAIN/lib/TWiki/Store.pm --- MAIN.orig/lib/TWiki/Store.pm 2007-02-28 15:15:25.000000000 +0100 +++ MAIN/lib/TWiki/Store.pm 2007-02-28 15:10:44.000000000 +0100 @@ -255,6 +255,9 @@ ( $web, $topic ) = $this->{session}->normalizeWebTopicName( $web, $topic ); + # add dependency + $this->{session}->{cache}->addDependency( $web, $topic ) if $TWiki::cfg{Cache}{Enabled}; + my $text; my $handler = $this->_getHandler( $web, $topic ); @@ -344,6 +347,8 @@ $fileAttachment->{movefrom}.' moved to '. $fileAttachment->{movedto}, $user->webDotWikiName() ); } finally { + $this->{session}->{cache}->fireDependency("$oldWeb.$oldTopic"); + $this->{session}->{cache}->fireDependency("$newWeb.$newTopic"); $this->unlockTopic( $user, $oldWeb, $oldTopic ); $this->unlockTopic( $user, $newWeb, $newTopic ); }; @@ -477,7 +482,9 @@ } $handler->moveTopic( $newWeb, $newTopic ); + $this->{session}->{cache}->fireDependency("$newWeb.$newTopic"); } finally { + $this->{session}->{cache}->fireDependency("$oldWeb.$oldTopic"); $this->unlockTopic( $user, $oldWeb, $oldTopic ); }; @@ -893,6 +900,7 @@ $plugins->afterSaveHandler( $text, $topic, $web, $error?$error->{-text}:'', $meta ); } + $this->{session}->{cache}->fireDependency("$web.$topic"); throw $error if $error; } @@ -1037,6 +1045,7 @@ $this->saveTopic( $user, $web, $topic, $text, $meta, {} ); } finally { + $this->{session}->{cache}->fireDependency("$web.$topic"); $this->unlockTopic( $user, $web, $topic ); }; diff -urNw -x .svn -x ldap.cfg -x tdb -x twiki_dav -x '*-my.pm' -x Plugins -x Contrib -x CPAN -x '*-Cache.pm' -x '*-Orig.pm' -x Users -x HFile -x Beautifier -x Output -x '*.swp' -x LocalSite.cfg MAIN.orig/lib/TWiki/UI/View.pm MAIN/lib/TWiki/UI/View.pm --- MAIN.orig/lib/TWiki/UI/View.pm 2007-02-28 15:15:25.000000000 +0100 +++ MAIN/lib/TWiki/UI/View.pm 2007-02-28 15:26:16.000000000 +0100 @@ -80,8 +80,25 @@ TWiki::UI::checkWebExists( $session, $webName, $topicName, 'view' ); - my $skin = $session->getSkin(); + my $refresh = $query->param('refresh') || ''; + if ($refresh eq 'all') { + $session->{cache}->clear; # SMELL: restrict this to admins + } + my $page; + $page = $session->{cache}->getPage(); + if ($page) { + print STDERR "found $webName.$topicName in cache\n" if $TWiki::cfg{Cache}{Debug}; + $session->{cache}->renderDirtyAreas(\$page); + print $page; + if( $TWiki::cfg{Log}{view} ) { + $session->writeLog( 'view', $webName.'.'.$topicName, '(cached)' ); + } + return; + } + + print STDERR "computing page for $webName.$topicName\n" if $TWiki::cfg{Cache}{Debug}; + my $skin = $session->getSkin(); my $rev = $store->cleanUpRevID( $query->param( 'rev' )); my $topicExists = @@ -326,7 +343,6 @@ # SMELL: hack to get around not having a proper topic object model $session->enterContext( 'can_render_meta', $meta ); - my $page; # Legacy: If the _only_ skin is 'text' it is used like this: # http://.../view/Codev/MyTopic?skin=text&contenttype=text/plain&raw=on # which shows the topic as plain text; useful for those who want diff -urNw -x .svn -x ldap.cfg -x tdb -x twiki_dav -x '*-my.pm' -x Plugins -x Contrib -x CPAN -x '*-Cache.pm' -x '*-Orig.pm' -x Users -x HFile -x Beautifier -x Output -x '*.swp' -x LocalSite.cfg MAIN.orig/lib/TWiki/UI.pm MAIN/lib/TWiki/UI.pm --- MAIN.orig/lib/TWiki/UI.pm 2007-02-28 15:15:25.000000000 +0100 +++ MAIN/lib/TWiki/UI.pm 2007-03-02 18:18:43.000000000 +0100 @@ -56,7 +56,7 @@ sub run { my ( $method, %initialContext ) = @_; - my ( $query, $pathInfo, $user, $url, $topic ); + my ( $query, $user, $url, $topic ); # Use unbuffered IO $| = 1; diff -urNw -x .svn -x ldap.cfg -x tdb -x twiki_dav -x '*-my.pm' -x Plugins -x Contrib -x CPAN -x '*-Cache.pm' -x '*-Orig.pm' -x Users -x HFile -x Beautifier -x Output -x '*.swp' -x LocalSite.cfg MAIN.orig/lib/TWiki.pm MAIN/lib/TWiki.pm --- MAIN.orig/lib/TWiki.pm 2007-02-28 15:15:25.000000000 +0100 +++ MAIN/lib/TWiki.pm 2007-02-28 15:27:57.000000000 +0100 @@ -221,7 +221,8 @@ VAR => \&_VAR, WEBLIST => \&_WEBLIST, WIKINAME => \&_WIKINAME_deprecated, - WIKIUSERNAME => \&_WIKIUSERNAME_deprecated + WIKIUSERNAME => \&_WIKIUSERNAME_deprecated, + DISPLAYDEPENDENCIES => \&_DISPLAYDEPENDENCIES ); $contextFreeSyntax{IF} = 1; @@ -468,6 +469,7 @@ use TWiki::Time; # date/time conversions use TWiki::Users; # user handler use TWiki::I18N; # i18n handler +use TWiki::Cache; # caching services =pod @@ -591,7 +593,14 @@ # can't use simple length() in case we have UNICODE # see perldoc -f length my $len = do { use bytes; length( $text ); }; - $this->writePageHeader( undef, $pageType, $contentType, $len ); + my $header = $this->_getPageHeader( undef, $pageType, $contentType, $len ); + if ($this->inContext('view') && $TWiki::cfg{Cache}{Enabled}) { + $text = $header.$text; + $this->{cache}->cachePage($text); # cache header+text + $this->{cache}->renderDirtyAreas(\$text); + } else { + print $header; + } } print $text; } @@ -609,12 +618,18 @@ Implements the post-Dec2001 release plugin API, which requires the writeHeaderHandler in plugin to return a string of HTTP headers, CR/LF +getHeaderHandler in plugin to return a string of HTTP headers, CR/LF delimited. Filters any illegal headers. Plugin headers will override core settings. =cut sub writePageHeader { + my $this = shift; + print $this->_getPageHeader(@_); +} + +sub _getPageHeader { my( $this, $query, $pageType, $contentType, $contentLength ) = @_; ASSERT($this->isa( 'TWiki')) if DEBUG; @@ -682,7 +697,7 @@ my $hdr = CGI::header( $hopts ); - print $hdr; + return $hdr; # to get it into the cache } =pod @@ -1238,6 +1253,7 @@ # create the various sub-objects $this->{sandbox} = $sharedSandbox; + $this->{cache} = TWiki::Cache::makeTWikiCache( $this ); $this->{plugins} = new TWiki::Plugins( $this ); $this->{net} = new TWiki::Net( $this ); $this->{store} = new TWiki::Store( $this ); @@ -1457,6 +1473,7 @@ $this->{prefs}->finish(); $this->{users}->finish(); $this->{store}->finish(); + $this->{cache}->finish(); %$this = (); } @@ -2261,6 +2278,10 @@ return $text; } + my $dirtyAreas = {}; + $text = $this->{renderer}->takeOutBlocks( $text, 'dirtyarea', + $dirtyAreas) if $TWiki::cfg{Cache}{Enabled}; + my $verbatim = {}; $text = $this->{renderer}->takeOutBlocks( $text, 'verbatim', $verbatim); @@ -2358,6 +2379,8 @@ #$stackTop =~ s/$percent/%/go; $this->{renderer}->putBackBlocks( \$stackTop, $verbatim, 'verbatim' ); + $this->{renderer}->putBackBlocks( \$stackTop, $dirtyAreas, 'dirtyarea' ) + if $TWiki::cfg{Cache}{Enabled}; #print STDERR "FINAL $stackTop\n" if $tell; @@ -2562,12 +2585,18 @@ ASSERT($theTopic) if DEBUG; return $text unless $text; - my $verbatim={}; + + # take out dirty areas + my $dirtyAreas={}; + $text = $this->{renderer}->takeOutBlocks( $text, 'dirtyarea', $dirtyAreas ) + if $TWiki::cfg{Cache}{Enabled}; + # Plugin Hook (for cache Plugins only) $this->{plugins}->beforeCommonTagsHandler( $text, $theTopic, $theWeb ); #use a "global var", so included topics can extract and putback #their verbatim blocks safetly. + my $verbatim={}; $text = $this->{renderer}->takeOutBlocks( $text, 'verbatim', $verbatim); @@ -2606,6 +2635,10 @@ # TWiki Plugin Hook (for cache Plugins only) $this->{plugins}->afterCommonTagsHandler( $text, $theTopic, $theWeb ); + # restore dirty areas + $this->{renderer}->putBackBlocks( \$text, $dirtyAreas, 'dirtyarea', 'dirtyarea' ) + if $TWiki::cfg{Cache}{Enabled}; + return $text; } @@ -2898,6 +2931,11 @@ $text = applyPatternToIncludedText( $text, $pattern ) if( $pattern ); + # take out dirty areas + my $dirtyAreas={}; + $text = $this->{renderer}->takeOutBlocks( $text, 'dirtyarea', $dirtyAreas ) + if $TWiki::cfg{Cache}{Enabled}; + $this->_expandAllTags( \$text, $includedTopic, $includedWeb ); # 4th parameter tells plugin that its called for an included file @@ -2935,6 +2973,10 @@ # handle tags again because of plugin hook $this->_expandAllTags( \$text, $includedTopic, $includedWeb ); + # restore dirty areas + $this->{renderer}->putBackBlocks( \$text, $dirtyAreas, 'dirtyarea', 'dirtyarea' ) + if $TWiki::cfg{Cache}{Enabled}; + # restore the tags delete $this->{includes}->{$key}; %{$this->{SESSION_TAGS}} = %saveTags; @@ -3608,4 +3650,43 @@ return '| *Group* | *Members* |'."\n".join("\n", sort @table); } +sub _DISPLAYDEPENDENCIES { + my ( $this, $params ) = @_; + + my $web = $params->{web} || $this->{webName}; + my $topic = $params->{topic} || $this->{topicName}; + my $header = $params->{header} || ''; + my $footer = $params->{footer} || ''; + my $format = $params->{format} || ' 1 [[$web.$topic]]'; + my $separator = $params->{sep} || $params->{separator} || "\n"; + my $type = $params->{type} || ''; + + ($web, $topic) = $this->normalizeWebTopicName($web, $topic); + + + my $deps; + if ($type =~ /^rev(erse)?$/) { + $deps = $this->{cache}->getRevDependencies("$web.$topic"); + } elsif ($type eq 'web') { + $deps = $this->{cache}->getWebDependencies(); + } else { + $deps = $this->{cache}->getDependencies("$web.$topic"); + } + my @lines; + my $thisWeb; + my $thisTopic; + foreach my $dep (sort @$deps) { + $dep =~ /^(.*)[\.\/](.*?)$/; + $thisWeb = $1; + $thisTopic = $2; + next unless $this->{store}->topicExists($thisWeb, $thisTopic); + my $text = $format; + $text =~ s/\$web/$thisWeb/g; + $text =~ s/\$topic/$thisTopic/g; + push @lines, $text; + } + return '' unless @lines; + return expandStandardEscapes($header.join($separator, @lines).$footer); +} + 1;