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

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