Return to Cached.pm CVS log

Up to [local] / openbsd / OpenBSDTorrents / lib / BT / MetaInfo

Annotation of openbsd/OpenBSDTorrents/lib/BT/MetaInfo/Cached.pm, Revision 1.10

1.10    ! andrew      1: # $Id: Cached.pm,v 1.9 2005/05/06 18:30:25 andrew Exp andrew $
1.2       andrew      2: use strict;
                      3:
1.5       andrew      4: package BT::MetaInfo::Cached;
1.1       andrew      5:
                      6: require 5.6.0;
1.2       andrew      7: use vars qw( $VERSION @ISA );
1.1       andrew      8:
1.5       andrew      9: use Cache::FileCache;
                     10: use File::Basename;
                     11:
1.1       andrew     12: use BT::MetaInfo;
1.3       andrew     13: use base 'BT::MetaInfo';
1.1       andrew     14:
1.10    ! andrew     15: $VERSION = do { my @r = (q$Id: Cached.pm,v 1.9 2005/05/06 18:30:25 andrew Exp andrew $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r };
1.3       andrew     16:
1.1       andrew     17: sub new
                     18: {
1.4       andrew     19:        my $class = shift;
                     20:         my $file  = shift;
1.5       andrew     21:        my $cache_settings = shift;
1.9       andrew     22:
                     23:        if (ref $file eq 'HASH') {
                     24:                $cache_settings = $file;
                     25:                $file = undef;
                     26:        }
1.4       andrew     27:
1.10    ! andrew     28:        $cache_settings->{namespace}           ||= 'BT::MetaInfo::Cached';
        !            29:        $cache_settings->{default_expires_in}  ||=  7 * 24 * 60 * 60;
        !            30:        $cache_settings->{auto_purge_interval} ||=  1 *  1 * 10 * 60;
1.5       andrew     31:
                     32:        my $cache = new Cache::FileCache( $cache_settings );
                     33:
1.8       andrew     34:        my $obj = (defined($file)) ? _load($file, $cache) : {};
1.5       andrew     35:
1.8       andrew     36:        bless($obj, $class);
                     37:
1.5       andrew     38:        $obj->{cache} = $cache;
                     39:
1.8       andrew     40:         return $obj;
                     41: }
1.5       andrew     42:
1.4       andrew     43: sub _load {
                     44:        my $file = shift;
1.5       andrew     45:        my $cache = shift;
                     46:
                     47:        my $basename = basename($file);
1.4       andrew     48:
1.5       andrew     49:        my $info = $cache->get( $basename );
1.1       andrew     50:
1.5       andrew     51:        unless (defined $info) {
1.4       andrew     52:                $info = BT::MetaInfo::_load($file);
1.5       andrew     53:                $cache->set( $basename, $info );
1.4       andrew     54:        }
                     55:        return $info;
                     56: }
1.3       andrew     57:
1.1       andrew     58:
1.6       andrew     59: sub save
                     60: {
1.8       andrew     61:        my $self = shift;
                     62:        my $file = shift;
1.6       andrew     63:        my $basename = basename($file);
                     64:
1.8       andrew     65:        my $cache = delete $self->{cache};
1.6       andrew     66:
1.8       andrew     67:        if ( $self->SUPER::save($file, @_) ) {
                     68:                my %info_hash = %$self; # unbless
                     69:                $cache->set($basename, \%info_hash)
                     70:        }
                     71:
                     72:        $self->{cache} = $cache;
1.6       andrew     73: }