| 1 |
=head1 NAME
|
| 2 |
|
| 3 |
Yuki::YukiWikiCache --- SuikaWiki: Cache database
|
| 4 |
|
| 5 |
=head1 METHODS
|
| 6 |
|
| 7 |
=over 4
|
| 8 |
|
| 9 |
=cut
|
| 10 |
|
| 11 |
package Yuki::YukiWikiCache;
|
| 12 |
use strict;
|
| 13 |
our $VERSION = do { my @r = (q$Revision: 1.1 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r };
|
| 14 |
|
| 15 |
=item $database = tie (%database, 'Yuki::YukiWikiCache', -file => $filename, %option)
|
| 16 |
|
| 17 |
Tie the hash %database with the file $filename.
|
| 18 |
|
| 19 |
Options:
|
| 20 |
|
| 21 |
=over 4
|
| 22 |
|
| 23 |
=item -expires => seconds (default: 24*60*60)
|
| 24 |
|
| 25 |
How long the data is fresh.
|
| 26 |
|
| 27 |
=item -file => filename (required)
|
| 28 |
|
| 29 |
Name of the file the hash is associated with.
|
| 30 |
|
| 31 |
=item -now => un*xtime (default: CORE::time ())
|
| 32 |
|
| 33 |
What time is it NOW.
|
| 34 |
|
| 35 |
=item -removes => seconds (default: 7*24*60*60)
|
| 36 |
|
| 37 |
How long the data should be kept.
|
| 38 |
|
| 39 |
=back
|
| 40 |
|
| 41 |
=cut
|
| 42 |
|
| 43 |
sub TIEHASH {
|
| 44 |
my ($class, %option) = @_;
|
| 45 |
my $self = bless {option => \%option}, $class;
|
| 46 |
$self->{option}->{-expires} ||= 86400;
|
| 47 |
$self->{option}->{-removes} ||= 604800;
|
| 48 |
if (-e $self->{option}->{-file}) {
|
| 49 |
my $decode = sub {my $s = shift; $s =~ s/%([0-9A-F]{2})/chr hex $1/ge; $s};
|
| 50 |
my $now = $self->{option}->{-now} || time;
|
| 51 |
open DB, $self->{option}->{-file} or die "TIEHASH: $self->{option}->{-file}: $!";
|
| 52 |
binmode DB;
|
| 53 |
local $/ = undef;
|
| 54 |
my $val = <DB>;
|
| 55 |
close DB;
|
| 56 |
if ($val =~ s!^\#\?SuikaWikiCache/0.9[^\x02]*\x02!!s) {
|
| 57 |
$self->{value} = {map {($_->[0]=>[$_->[1],$_->[2]])} grep {($_->[2]+$self->{option}->{-removes})>$now} map {my @s = split /\x1F/, $_, 3; [&$decode($s[0]) => &$decode($s[1]), $s[2]]} split /\x1E/, $val};
|
| 58 |
} else {
|
| 59 |
$self->{value} = {};
|
| 60 |
}
|
| 61 |
} else {
|
| 62 |
$self->{value} = {};
|
| 63 |
}
|
| 64 |
$self;
|
| 65 |
}
|
| 66 |
|
| 67 |
=item untie (%database)
|
| 68 |
|
| 69 |
Close the database. You SHOULD call this before your script exits,
|
| 70 |
to be sure the data saved.
|
| 71 |
|
| 72 |
=cut
|
| 73 |
|
| 74 |
sub UNTIE {
|
| 75 |
my $self = shift;
|
| 76 |
my $escape = sub {my $s = $_[0]; $s =~ s/([\x00-\x1F%])/sprintf '%%%02X', ord $1/ge; $s};
|
| 77 |
open DB, "> ".$self->{option}->{-file} or die "UNTIE: $self->{option}->{-file}: $!";
|
| 78 |
binmode DB;
|
| 79 |
print DB "#?SuikaWikiCache/0.9\n\x02".join "\x1E", map {&$escape($_)."\x1F".&$escape($self->{value}->{$_}->[0])."\x1F".$self->{value}->{$_}->[1]} grep {defined $self->{value}->{$_}} keys %{$self->{value}};
|
| 80 |
close DB;
|
| 81 |
}
|
| 82 |
|
| 83 |
sub DESTROY {
|
| 84 |
shift->UNTIE;
|
| 85 |
}
|
| 86 |
|
| 87 |
=item $database{keyname} = keyvalue
|
| 88 |
|
| 89 |
Set the value of the key.
|
| 90 |
|
| 91 |
=cut
|
| 92 |
|
| 93 |
sub STORE { $_[0]->{value}->{$_[1]} = [$_[2], $_[0]->{option}->{-now} || time] }
|
| 94 |
|
| 95 |
=item keyvalue = $database{keyname}
|
| 96 |
|
| 97 |
Get the value of the key.
|
| 98 |
|
| 99 |
=cut
|
| 100 |
|
| 101 |
sub FETCH { (($_[0]->{value}->{$_[1]}->[1] + $_[0]->{option}->{-expires}) > ($_[0]->{option}->{-now} || time)) ? $_[0]->{value}->{$_[1]}->[0] : undef }
|
| 102 |
|
| 103 |
=item delete $database{keyname}
|
| 104 |
|
| 105 |
Delete the key.
|
| 106 |
|
| 107 |
=cut
|
| 108 |
|
| 109 |
sub DELETE { delete $_[0]->{value}->{$_[1]} }
|
| 110 |
|
| 111 |
=item exists $database{keyname}
|
| 112 |
|
| 113 |
Test whether the key is exists or not.
|
| 114 |
|
| 115 |
=cut
|
| 116 |
|
| 117 |
sub EXISTS { exists $_[0]->{value}->{$_[1]} }
|
| 118 |
|
| 119 |
=item keys %database ; vals %database
|
| 120 |
|
| 121 |
Return keys or values of the database.
|
| 122 |
|
| 123 |
=cut
|
| 124 |
|
| 125 |
sub FIRSTKEY {
|
| 126 |
my $self = shift;
|
| 127 |
$self->{-keys} = [keys %{$self->{value}}];
|
| 128 |
shift @{$self->{-keys}};
|
| 129 |
}
|
| 130 |
sub NEXTKEY { shift @{$_[0]->{-keys}||[]} }
|
| 131 |
|
| 132 |
=item %database = ();
|
| 133 |
|
| 134 |
Clear the database. All keys and values are removed.
|
| 135 |
|
| 136 |
=cut
|
| 137 |
|
| 138 |
sub CLEAR { $_[0]->{value} = {} }
|
| 139 |
|
| 140 |
# size: Not implemented
|
| 141 |
|
| 142 |
=item $database->list_all
|
| 143 |
|
| 144 |
Same as keys %database.
|
| 145 |
|
| 146 |
=cut
|
| 147 |
|
| 148 |
sub list_all ($) { keys %{$_[0]->{value}} }
|
| 149 |
|
| 150 |
# rename: Not implemented
|
| 151 |
|
| 152 |
=item $database->sort_by_mtime
|
| 153 |
|
| 154 |
Same as keys %database, but sorting by the timestamp.
|
| 155 |
|
| 156 |
=cut
|
| 157 |
|
| 158 |
sub sort_by_mtime ($) { sort {$_[0]->{value}->{$a}->[1] <=> $_[0]->{value}->{$b}->[1]} keys %{$_[0]->{value}} }
|
| 159 |
|
| 160 |
# sort_by_size: Not implemented
|
| 161 |
# clean, archive: Likewise
|
| 162 |
|
| 163 |
=item $database->recent_changes ($n)
|
| 164 |
|
| 165 |
Same as $database->sort_by_mtime, but only latest (or earliest) $n items are returned.
|
| 166 |
|
| 167 |
=cut
|
| 168 |
|
| 169 |
sub recent_changes{
|
| 170 |
my $self = shift or die qq(recent_changes : usage error.);
|
| 171 |
my($n,$m) = @_;
|
| 172 |
my @key = $self->sort_by_mtime();
|
| 173 |
if($m){
|
| 174 |
return @key[$n..$m];
|
| 175 |
}elsif($n == 0){
|
| 176 |
return @key;
|
| 177 |
}elsif($n < 0){
|
| 178 |
$n = -$n - 1;
|
| 179 |
@key = reverse @key;
|
| 180 |
}else{
|
| 181 |
--$n;
|
| 182 |
}
|
| 183 |
return @key[0..$n];
|
| 184 |
}
|
| 185 |
|
| 186 |
# bkup_next, diff, tracerse_diff, stat, mtime, localtime, info, headline: Not implemented
|
| 187 |
|
| 188 |
=back
|
| 189 |
|
| 190 |
The interface of this module is almost compatible with Yuki::YukiWikiDB2's.
|
| 191 |
|
| 192 |
=head1 LICENSE
|
| 193 |
|
| 194 |
Copyright 2003 Wakaba <w@suika.fam.cx>
|
| 195 |
|
| 196 |
This program is free software; you can redistribute it and/or
|
| 197 |
modify it under the same terms as Perl itself.
|
| 198 |
|
| 199 |
=cut
|
| 200 |
|
| 201 |
1; # $Date: 2003/01/26 02:32:31 $
|
Parent Directory
| 
Revision Log