version 1.3, 2005/05/02 22:46:48 |
version 1.13, 2009/12/16 20:11:13 |
|
|
# $Id$ |
# $RedRiver: Cached.pm,v 1.12 2006/05/15 18:47:04 andrew Exp $ |
use strict; |
use strict; |
|
|
package BT::OBTMetaInfo; |
package BT::MetaInfo::Cached; |
|
|
require 5.6.0; |
require 5.0060; |
use vars qw( $VERSION @ISA ); |
use vars qw( $VERSION @ISA ); |
|
|
use Digest::SHA1 qw(sha1); |
use Cache::FileCache; |
use Fcntl ':flock'; # import LOCK_* constants |
use File::Basename; |
|
use Digest::MD5; |
|
|
use BT::MetaInfo; |
use BT::MetaInfo; |
use base 'BT::MetaInfo'; |
use base 'BT::MetaInfo'; |
|
|
use OpenBSDTorrents; |
|
|
|
use Data::Dumper; |
|
|
|
$VERSION = do { my @r = (q$Id$ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; |
$VERSION = do { my @r = (q$Id$ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; |
|
|
sub new |
sub new |
{ |
{ |
my $classname = shift; |
my $class = shift; |
return $classname->SUPER::new(@_); |
my $file = shift; |
} |
my $cache_settings = shift; |
|
|
|
if (ref $file eq 'HASH') { |
|
$cache_settings = $file; |
|
$file = undef; |
|
} |
|
|
sub info_hash_cached |
$cache_settings->{namespace} ||= 'BT::MetaInfo::Cached'; |
{ |
$cache_settings->{default_expires_in} ||= 7 * 24 * 60 * 60; |
my $self = shift; |
$cache_settings->{auto_purge_interval} ||= 1 * 1 * 10 * 60; |
my $torrent = shift; |
|
|
|
return $self->SUPER::info_hash unless $torrent; |
my $cache = new Cache::FileCache( $cache_settings ); |
|
|
my $meta_file = $torrent; |
my $obj = (defined($file)) ? _load($file, $cache) : {}; |
$meta_file =~ s/\.torrent$/.$OBT->{META_EXT}/; |
|
|
|
my $hash = undef; |
bless($obj, $class); |
|
|
if (-e $meta_file) { |
$obj->{cache} = $cache; |
#print "Reading meta file: $meta_file\n"; |
|
open my $meta, $meta_file or die "Couldn't open $meta_file: $!"; |
|
flock($meta, LOCK_SH); |
|
binmode $meta; |
|
|
|
$hash = do { local $/; <$meta> }; |
return $obj; |
|
} |
|
|
flock($meta, LOCK_UN); |
sub _load { |
close $meta; |
my $file = shift; |
} else { |
my $cache = shift; |
$hash = $self->SUPER::info_hash; |
|
#print "Writing meta file: $meta_file\n"; |
|
open my $meta, '>', $meta_file |
|
or die "Couldn't open $meta_file: $!"; |
|
flock($meta, LOCK_EX); |
|
binmode $meta; |
|
|
|
print $meta $hash; |
my $basename = basename($file); |
|
|
|
my $info = $cache->get( $basename ); |
|
|
flock($meta, LOCK_UN); |
my $md5; |
close $meta; |
if (defined $info && $info->{'md5'}) { |
|
my $old_md5 = delete $info->{'md5'}; |
|
my $cur_md5 = _MD5_file($file); |
|
if ($old_md5 ne $cur_md5) { |
|
$cache->remove( $basename ); |
|
$info = undef; |
|
} |
|
$md5 = $cur_md5; |
|
} |
|
|
|
unless (defined $info) { |
|
$info = BT::MetaInfo::_load($file); |
|
$info->{'md5'} = $md5; |
|
$cache->set( $basename, $info ); |
|
delete $info->{'md5'}; |
} |
} |
#my $text_hash = unpack("H*", $hash); |
|
#print "INFO_HASH: $text_hash\n"; |
return $info; |
|
|
return $hash; |
|
} |
} |
|
|
1 |
|
|
sub save |
|
{ |
|
my $self = shift; |
|
my $file = shift; |
|
my $basename = basename($file); |
|
|
|
my $cache = delete $self->{'cache'}; |
|
|
|
if ( $self->SUPER::save($file, @_) ) { |
|
my %info_hash = %$self; # unbless |
|
|
|
$info_hash{'md5'} = _MD5_file($file); |
|
$cache->set($basename, \%info_hash) |
|
} |
|
|
|
$self->{'cache'} = $cache; |
|
|
|
return 1; |
|
} |
|
|
|
sub _MD5_file |
|
{ |
|
my $file = shift; |
|
|
|
my $ctx = Digest::MD5->new; |
|
open my $fh, $file or die "Couldn't open FILE '$file': $!"; |
|
binmode $fh; |
|
$ctx->addfile($fh); |
|
close $fh; |
|
|
|
return $ctx->hexdigest; |
|
} |