| Bio-Prospect documentation | Contained in the Bio-Prospect distribution. |
Bio::Prospect::Client -- base class for Bio::Prospect::LocalClient and Bio::Prospect::SoapClient. $Id: Client.pm,v 1.16 2003/11/18 19:45:45 rkh Exp $
This is an abstract class and is intended only for subclassing.
Bio::Prospect::Client is the abstract base class for Bio::Prospect::LocalClient and Bio::Prospect::SoapClient. Not intended to be instantiated directly.
Name: new() Purpose: constructor Arguments: 'tempdir' => directory to create temporary files (optional) Returns: Bio::Prospect::Client
Name: _tempfile() Purpose: return the filename of a temporary file Arguments: suffix for filename (optional) Returns: filename
Name: _get_cache_file() Purpose: return the value for a given key in a given cache Arguments: key, cache name Returns: value
Name: _put_cache_file() Purpose: put a filename into a given cache using a given key Arguments: key, cache name, value Returns: value
Bio::Prospect::LocalClient Bio::Prospect::SoapClient
| Bio-Prospect documentation | Contained in the Bio-Prospect distribution. |
package Bio::Prospect::Client; use strict; use warnings; use File::Temp; use vars qw( $VERSION ); $VERSION = sprintf( "%d.%02d", q$Revision: 1.16 $ =~ /(\d+)\.(\d+)/ ); #------------------------------------------------------------------------------- # new() #-------------------------------------------------------------------------------
sub new { my $type = shift; my $self = {}; if (ref $_[0]) { %{$self} = %{$_[0]}; } else { %{$self} = @_; } bless($self,$type); if ( ! defined $self->{'tempdir'} ) { $self->{tempdir} = File::Temp::tempdir( '/tmp/'.__PACKAGE__.'-XXXX', CLEANUP=>!$ENV{DEBUG} ); defined $self->{tempdir} or throw Bio::Prospect::RuntimeError( "couldn't create temporary directory" ); } if ( ! -w $self->{tempdir} ) { throw Bio::Prospect::RuntimeError( "tempdir (" . $self->{tempdir} . ") is not writeable" ); } print(STDERR "tempdir: " . $self->{tempdir} . "\n") if $ENV{'DEBUG'}; if (not defined $self->{cacheLimit}) { $self->{cacheLimit} = 25; } return $self; } #------------------------------------------------------------------------------- # _tempfile() #-------------------------------------------------------------------------------
sub _tempfile { my $self = shift; my $sfx = @_ ? ".$_[0]" : undef; return File::Temp::tempfile( DIR=>$self->{tempdir}, SUFFIX=>$sfx, UNLINK=>0 ); } #------------------------------------------------------------------------------- # _get_cache_file() #-------------------------------------------------------------------------------
sub _get_cache_file { my ($self,$key,$cacheName) = @_; if ( defined $self->{'cache'}{$cacheName}{$key}{'fn'}) { return $self->{'cache'}{$cacheName}{$key}{'fn'}; } else { return; } } #------------------------------------------------------------------------------- # _put_cache_file() #-------------------------------------------------------------------------------
sub _put_cache_file { my ($self,$key,$cacheName,$fn) = @_; if ( !defined $self->{'cache'}{$cacheName} ) { $self->{'cache'}{$cacheName} = {}; } my $cache = $self->{'cache'}{$cacheName}; # cache this result print(STDERR "## caching $fn in '$cacheName' file cache using a key of $key ...\n") if $ENV{DEBUG}; $cache->{$key}{'fn'} = $fn; $cache->{$key}{'timestamp'} = time; # expire oldest if ( defined $cache and ( exists $self->{cacheLimit} ) and ( scalar keys %{$cache} >= $self->{cacheLimit} ) ) { foreach my $key ( sort { $cache->{$a}{'timestamp'} <=> $cache->{$b}{'timestamp'} } keys %{$cache} ) { print STDERR "deleting $key because it is the oldest key: " . $cache->{$key}{'timestamp'} . "\n" if $ENV{DEBUG}; print STDERR "unlinking " . $cache->{$key}{'fn'} . "\n" if $ENV{DEBUG}; unlink $cache->{$key}{'fn'}; delete $cache->{$key}; last; } } return; }
1;