lib/Yuki/YukiWikiCache.pm

=head1 NAME

Yuki::YukiWikiCache --- SuikaWiki: Cache database

=head1 METHODS

=over 4

=cut

package Yuki::YukiWikiCache;
use strict;
our $VERSION = do { my @r = (q$Revision: 0.79 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r };

=item $database = tie (%database, 'Yuki::YukiWikiCache', -file => $filename, %option)

Tie the hash %database with the file $filename.

Options:

=over 4

=item -expires => seconds (default: 24*60*60)

How long the data is fresh.

=item -file => filename (required)

Name of the file the hash is associated with.

=item -now => un*xtime (default: CORE::time ())

What time is it NOW.

=item -removes => seconds (default: 7*24*60*60)

How long the data should be kept.

=back

=cut

sub TIEHASH {
  my ($class, %option) = @_;
  my $self = bless {option => \%option}, $class;
  $self->{option}->{-expires} ||= 86400;
  $self->{option}->{-removes} ||= 604800;
  if (-e $self->{option}->{-file}) {
    my $decode = sub {my $s = shift; $s =~ s/%([0-9A-F]{2})/chr hex $1/ge; $s};
    my $now = $self->{option}->{-now} || time;
    open DB, $self->{option}->{-file} or die "TIEHASH: $self->{option}->{-file}: $!";
    binmode DB;
    local $/ = undef;
    my $val = <DB>;
    close DB;
    if ($val =~ s!^\#\?SuikaWikiCache/0.9[^\x02]*\x02!!s) {
      $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};
    } else {
      $self->{value} = {};
    }
  } else {
    $self->{value} = {};
  }
  $self;
}

=item untie (%database)

Close the database.  You SHOULD call this before your script exits,
to be sure the data saved.

=cut

sub UNTIE {
  my $self = shift;
  my $escape = sub {my $s = $_[0]; $s =~ s/([\x00-\x1F%])/sprintf '%%%02X', ord $1/ge; $s};
  open DB, "> ".$self->{option}->{-file} or die "UNTIE: $self->{option}->{-file}: $!";
  binmode DB;
  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}};
  close DB;
}

sub DESTROY {
  shift->UNTIE;
}

=item $database{keyname} = keyvalue

Set the value of the key.

=cut

sub STORE { $_[0]->{value}->{$_[1]} = [$_[2], $_[0]->{option}->{-now} || time] }

=item keyvalue = $database{keyname}

Get the value of the key.

=cut

sub FETCH { (($_[0]->{value}->{$_[1]}->[1] + $_[0]->{option}->{-expires}) > ($_[0]->{option}->{-now} || time)) ? $_[0]->{value}->{$_[1]}->[0] : undef }

=item delete $database{keyname}

Delete the key.

=cut

sub DELETE { delete $_[0]->{value}->{$_[1]} }

=item exists $database{keyname}

Test whether the key is exists or not.

=cut

sub EXISTS { exists $_[0]->{value}->{$_[1]} }

=item keys %database ; vals %database

Return keys or values of the database.

=cut

sub FIRSTKEY {
  my $self = shift;
  $self->{-keys} = [keys %{$self->{value}}];
  shift @{$self->{-keys}};
}
sub NEXTKEY { shift @{$_[0]->{-keys}||[]} }

=item %database = ();

Clear the database.  All keys and values are removed.

=cut

sub CLEAR { $_[0]->{value} = {} }

# size: Not implemented

=item $database->list_all

Same as keys %database.

=cut

sub list_all ($) { keys %{$_[0]->{value}} }

# rename: Not implemented

=item $database->sort_by_mtime

Same as keys %database, but sorting by the timestamp.

=cut

sub sort_by_mtime ($) { sort {$_[0]->{value}->{$a}->[1] <=> $_[0]->{value}->{$b}->[1]} keys %{$_[0]->{value}} }

# sort_by_size: Not implemented
# clean, archive: Likewise

=item $database->recent_changes ($n)

Same as $database->sort_by_mtime, but only latest (or earliest) $n items are returned.

=cut

sub recent_changes{
        my $self        = shift                         or die qq(recent_changes : usage error.);
        my($n,$m)       = @_;
        my @key         = $self->sort_by_mtime();
        if($m){
                return @key[$n..$m];
        }elsif($n == 0){
                return @key;
        }elsif($n < 0){
                $n              = -$n - 1;
                @key    = reverse @key;
        }else{
                --$n;
        }
        return @key[0..$n];
}

# bkup_next, diff, tracerse_diff, stat, mtime, localtime, info, headline: Not implemented

=back

The interface of this module is almost compatible with Yuki::YukiWikiDB2's.

=head1 LICENSE

Copyright 2003 Wakaba <w@suika.fam.cx>

This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.

=cut

1; # $Date: $
1	w	1.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: 0.79 $ =~ /\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: 246060)
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: 72460*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: $