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.13

1.13    ! andrew      1: # $RedRiver: Cached.pm,v 1.12 2006/05/15 18:47:04 andrew Exp $
1.2       andrew      2: use strict;
                      3:
1.5       andrew      4: package BT::MetaInfo::Cached;
1.1       andrew      5:
1.13    ! andrew      6: require 5.0060;
1.2       andrew      7: use vars qw( $VERSION @ISA );
1.1       andrew      8:
1.5       andrew      9: use Cache::FileCache;
                     10: use File::Basename;
1.11      andrew     11: use Digest::MD5;
1.5       andrew     12:
1.1       andrew     13: use BT::MetaInfo;
1.3       andrew     14: use base 'BT::MetaInfo';
1.1       andrew     15:
1.13    ! andrew     16: $VERSION = do { my @r = (q$Id: Cached.pm,v 1.12 2006/05/15 18:47:04 andrew Exp $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r };
1.3       andrew     17:
1.1       andrew     18: sub new
                     19: {
1.4       andrew     20:        my $class = shift;
                     21:         my $file  = shift;
1.5       andrew     22:        my $cache_settings = shift;
1.9       andrew     23:
                     24:        if (ref $file eq 'HASH') {
                     25:                $cache_settings = $file;
                     26:                $file = undef;
                     27:        }
1.4       andrew     28:
1.10      andrew     29:        $cache_settings->{namespace}           ||= 'BT::MetaInfo::Cached';
                     30:        $cache_settings->{default_expires_in}  ||=  7 * 24 * 60 * 60;
                     31:        $cache_settings->{auto_purge_interval} ||=  1 *  1 * 10 * 60;
1.5       andrew     32:
                     33:        my $cache = new Cache::FileCache( $cache_settings );
                     34:
1.8       andrew     35:        my $obj = (defined($file)) ? _load($file, $cache) : {};
1.5       andrew     36:
1.8       andrew     37:        bless($obj, $class);
                     38:
1.5       andrew     39:        $obj->{cache} = $cache;
                     40:
1.8       andrew     41:         return $obj;
                     42: }
1.5       andrew     43:
1.4       andrew     44: sub _load {
                     45:        my $file = shift;
1.5       andrew     46:        my $cache = shift;
                     47:
                     48:        my $basename = basename($file);
1.4       andrew     49:
1.5       andrew     50:        my $info = $cache->get( $basename );
1.1       andrew     51:
1.11      andrew     52:        my $md5;
                     53:        if (defined $info && $info->{'md5'}) {
                     54:                my $old_md5 = delete $info->{'md5'};
                     55:                my $cur_md5 = _MD5_file($file);
                     56:                if ($old_md5 ne $cur_md5) {
                     57:                        $cache->remove( $basename );
                     58:                        $info = undef;
                     59:                }
                     60:                $md5 = $cur_md5;
                     61:        }
                     62:
1.5       andrew     63:        unless (defined $info) {
1.4       andrew     64:                $info = BT::MetaInfo::_load($file);
1.11      andrew     65:                $info->{'md5'} = $md5;
1.5       andrew     66:                $cache->set( $basename, $info );
1.11      andrew     67:                delete $info->{'md5'};
1.4       andrew     68:        }
1.11      andrew     69:
1.4       andrew     70:        return $info;
                     71: }
1.3       andrew     72:
1.1       andrew     73:
1.6       andrew     74: sub save
                     75: {
1.8       andrew     76:        my $self = shift;
                     77:        my $file = shift;
1.6       andrew     78:        my $basename = basename($file);
                     79:
1.11      andrew     80:        my $cache   = delete $self->{'cache'};
1.6       andrew     81:
1.8       andrew     82:        if ( $self->SUPER::save($file, @_) ) {
                     83:                my %info_hash = %$self; # unbless
1.11      andrew     84:
                     85:                $info_hash{'md5'} = _MD5_file($file);
1.8       andrew     86:                $cache->set($basename, \%info_hash)
                     87:        }
                     88:
1.11      andrew     89:        $self->{'cache'} = $cache;
                     90:
                     91:        return 1;
                     92: }
                     93:
                     94: sub _MD5_file
                     95: {
                     96:        my $file = shift;
                     97:
                     98:        my $ctx = Digest::MD5->new;
                     99:        open my $fh, $file or die "Couldn't open FILE '$file': $!";
                    100:        binmode $fh;
                    101:        $ctx->addfile($fh);
                    102:        close $fh;
                    103:
                    104:        return $ctx->hexdigest;
1.6       andrew    105: }