=head1 NAME

Yuki::YukiWikiCache --- SuikaWiki: Cache database

=head1 METHODS

=over 4

=cut

package Yuki::YukiWikiCache;
use strict;
our $VERSION = do { my @r = (q$Revision: 1.2 $ =~ /\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: 2004/02/01 12:31:51 $