File Coverage

blib/lib/NCBIx/BigFetch.pm

Criterion	Covered	Total	%
statement	124	253	49.0
branch	17	58	29.3
condition	1	6	16.6
subroutine	20	36	55.5
pod	10	15	66.6
total	172	368	46.7

package NCBIx::BigFetch;
use warnings;
use strict;
use Class::Std;
use Class::Std::Utils;
use Carp;
use LWP::Simple;
use YAML qw(DumpFile LoadFile);
use Time::HiRes qw(usleep);

use version; our $VERSION = qv('0.5.6');

our $config_file   = 'efetch_N.yml';
our $esearch_file  = 'esearch_N.txt';
our $data_file     = 'sequences_N_M.txt';
our $sleep_policy  = 2_750_000;

{
	# These properties have defaults but can also be initialized by new()
	my %project_id_of         :ATTR( :get :set );
	my %base_url_of           :ATTR( :get :set );
	my %base_dir_of           :ATTR( :get :set );
	my %db_of                 :ATTR( :get :set );
	my %query_of              :ATTR( :get :set );
	my %index_of              :ATTR( :get :set );
	my %return_max_of         :ATTR( :get :set );
	my %return_type_of        :ATTR( :get :set );
	my %return_mode_of        :ATTR( :get :set );
	my %missing_of            :ATTR( :get :set );

	# These properties are set by the code
	my %start_date_of         :ATTR( :get :set );
	my %start_time_of         :ATTR( :get :set );
	my %querykey_of           :ATTR( :get :set );
	my %webenv_of             :ATTR( :get :set );
	my %count_of              :ATTR( :get :set );

	sub next_index           { my ($self) = @_; my $ident = ident $self; $index_of{$ident} += $return_max_of{$ident}; $self->_save(); }

	sub get_config_filename  { my ($self)  = @_; my $project_id = $self->get_project_id(); $config_file =~ s/N/$project_id/; return $self->get_base_dir() . '/' . $config_file; }
	sub get_esearch_filename { my ($self)  = @_; my $project_id = $self->get_project_id(); $esearch_file =~ s/N/$project_id/; return $self->get_base_dir() . '/' . $esearch_file; }
	sub get_data_filename    { my ($self, $index)  = @_; my $project_id = $self->get_project_id(); $index = defined($index) ? $index : $self->get_index(); my $filename = $data_file; $filename =~ s/N/$project_id/g; $filename =~ s/M/$index/g; return $self->get_base_dir() . '/' . $filename; }

	sub BUILD {
		my ($self, $ident, $arg_ref) = @_;

		# Set environment
		$self->_init( $arg_ref );

		# Check for existing project
		if (-e $self->get_config_filename()) {
			$self->_status("Loading existing project");

			# Get existing config
			$self->_load();
		} else {
			$self->_status("Starting new project");

			# Set start date and time
			$self->_set_date();

			# Submit search and parse results
			$self->_search();

			# Save config
			$self->_save( $arg_ref );
		}

		return;
	}

	sub file_test {
		my ( $self )   = @_;
		my $file_written;

		# Get the file names for the test (/home/username/e* or /root/e*)
		my $config_filename  = $self->get_config_filename();
		my $esearch_filename = $self->get_esearch_filename();

		# Remove exisitng files and count files written
		if (-e $config_filename )  { $file_written++; `rm $config_filename`; }
		if (-e $esearch_filename ) { $file_written++; `rm $esearch_filename`; }

		return $file_written;
	}

	sub results_waiting {
		my ( $self )   = @_;
		if ( $self->get_index() < $self->get_count() ) {
			return 1;
		} else {
			$self->_status("Found " . $self->_commify( scalar(@{ $self->get_missing() }) ) . " missing batches." );
			return 0;
		}
	}

	sub missing_batches {
		my ( $self )   = @_;
		if ( @{ $self->get_missing() } ) { return 1; } else { return 0; }
	}

	sub get_next_batch {
		my ( $self )   = @_;
		my $index      = $self->get_index();

		# Get the batch
		$self->get_batch( $index );

		# Update the index
		$self->next_index();

		return;
	}

	sub get_batch {
		my ( $self, $index )   = @_;
		my $return_max  = $self->get_return_max();
		my $return_type = $self->get_return_type();
		my $return_mode = $self->get_return_mode();

		$self->_status("Starting with index " . $self->_commify( $index ) );

		# Ethics requires we wait sleep_policy microseconds before retrieving
		$self->_sleep();

		# Define a batch through URL
		my $efetch_url  = $self->get_base_url() . 'efetch.fcgi?db=' . $self->get_db();
		   $efetch_url .= '&WebEnv=' . $self->get_webenv() . '&query_key=' . $self->get_querykey() . "&rettype=$return_type&retmode=$return_mode";
		   $efetch_url .= "&retstart=$index&retmax=$return_max";
		   $efetch_url .= '&tool=ncbix_bigfetch&email=[e-mail]';

		# Get the batch using LWP::Simple (get)
		my $results  = get($efetch_url);

		# Check results # TODO: capture expired WebEnv and restart query
		if ( $results =~ m/resource is temporarily unavailable/i ) { $self->note_missing_batch( $index ); }
		if ( $results =~ m/NCBI C\+\+ Exception/i )                { $self->note_missing_batch( $index ); }
		if ( $results eq '' )                                      { $self->note_missing_batch( $index ); }

		# Save the sequences
		$self->_set_file_text( $self->get_data_filename( $index ), $results );

		return;
	}

	sub get_missing_batch {
		my ( $self )   = @_;

		# Get the next missing batch index
		my @missing    = @{ $self->get_missing() };
		my $index      = shift @missing;

		# Update the missing batch list
		$self->set_missing( \@missing );

		# Get the batch
		$self->get_batch( $index );

		return;
	}

	sub note_missing_batch {
		my ( $self, $index )    = @_;
		my @missing;
		my $missing             = $self->get_missing();
		if ( defined $missing ) {
			@missing = @{ $missing };
		} else {
			@missing = ();
		}
		push @missing, $index;
		$self->set_missing( \@missing );
		$self->_save();
	}

	sub get_sequence {
		my ( $self, $id )   = @_;
		my $return_type = $self->get_return_type();
		my $return_mode = $self->get_return_mode();

		$self->_status("Fetching sequence $id");

		# Ethics requires we wait sleep_policy microseconds before retrieving
		$self->_sleep();

		# Define a batch through URL
		my $efetch_url  = $self->get_base_url() . 'efetch.fcgi?db=' . $self->get_db();
		   $efetch_url .= '&id=' . $id . "&rettype=$return_type&retmode=$return_mode";
		   $efetch_url .= '&tool=ncbix_bigfetch&email=[e-mail]';

		# Get the sequence
		my $results  = get($efetch_url);

		# Save the sequences in missing file
		$self->_add_file_text( $self->get_data_filename( 0 ), $results );

		return;
	}

	sub unavailable_ids {
		my ( $self )     = @_;
		my $count        = $self->get_index();
		my $return_max   = $self->get_return_max();
		my $index        = 1;
		my @unavailables = ();

		while ( $index < $count ) {
			$self->_status("Checking " . $self->_commify( $index ) . " through " . $self->_commify( $index + $return_max - 1 ) );

			# Get the sequences
			my $text = $self->_get_file_text( $self->get_data_filename( $index ) );

			while ( $text =~ m/Error:\s(\d+)\sis\snot\savailable\sat\sthis\stime/g ) { push @unavailables, $1; }

			# Update the index
			$index += $return_max;
		}

		$self->_status("Found " . $self->_commify( scalar(@unavailables) ) . " unavailable ids." );

		return \@unavailables;
	}

	sub _init {
		my ( $self, $arg_ref ) = @_;

		my $project_id   = $arg_ref->{project_id}  ? $arg_ref->{project_id}  : "1";
		my $base_url     = $arg_ref->{base_url}    ? $arg_ref->{base_url}    : "http://eutils.ncbi.nlm.nih.gov/entrez/eutils/";
		my $base_dir     = $arg_ref->{base_dir}    ? $arg_ref->{base_dir}    : $self->_get_base_dir();
		my $db           = $arg_ref->{db}          ? $arg_ref->{db}          : "protein";
		my $query        = $arg_ref->{query}       ? $arg_ref->{query}       : "apoptosis";
		my $index        = $arg_ref->{index}       ? $arg_ref->{index}       : "1";
		my $return_max   = $arg_ref->{return_max}  ? $arg_ref->{return_max}  : "500";
		my $return_type  = $arg_ref->{return_type} ? $arg_ref->{return_type} : "fasta";
		my $return_mode  = $arg_ref->{return_mode} ? $arg_ref->{return_mode} : "text";
		my $missing      = $arg_ref->{missing}     ? $arg_ref->{missing}     : [];

		$self->set_project_id( $project_id );
		$self->set_base_url( $base_url );
		$self->set_base_dir( $base_dir );
		$self->set_db( $db );
		$self->set_query( $query );
		$self->set_index( $index );
		$self->set_return_max( $return_max );
		$self->set_return_type( $return_type );
		$self->set_return_mode( $return_mode );
		$self->set_missing( $missing );

		return;
	}

	sub _set_date {
		my ( $self ) = @_;

		my @time  = localtime;
		my $year  = 1900 + $time[5];
		my $month = $time[4] + 1; $month =~ s/^(\d)$/0$1/;
		my $day   = $time[3];     $day   =~ s/^(\d)$/0$1/;
		my $hour  = $time[2];     $hour  =~ s/^(\d)$/0$1/;
		my $min   = $time[1];     $min   =~ s/^(\d)$/0$1/;
		my $sec   = $time[0];     $sec   =~ s/^(\d)$/0$1/;

		$self->set_start_date( "$year-$month-$day" );
		$self->set_start_time( "$hour:$min:$sec" );

		return;
	}

	sub _search {
		#my ( $self, $arg_ref ) = @_;
		my ( $self, $arg_ref ) = @_;

		# Get search result ticket
		my $esearch_url          = $self->get_base_url() . 'esearch.fcgi?db=' . $self->get_db();
		   $esearch_url         .= '&term=' . $self->get_query() . '&usehistory=y';
		   $esearch_url         .= '&tool=ncbix_bigfetch&email=[e-mail]';
		my $esearch_result       = get($esearch_url);

		# Save search result
		$self->_set_file_text( $self->get_esearch_filename(), $esearch_result );

		# Parse the relevant keys
		$esearch_result =~ m/([0-9]*)<\/Count>/g;               $self->set_count( $1 );
		$esearch_result =~ m/([0-9]*)<\/QueryKey>/g;         $self->set_querykey( $1 );
		$esearch_result =~ m/([\.a-zA-Z0-9_@\-]*)<\/WebEnv>/g; $self->set_webenv( $1 );

		return;
	}

	sub _load {
		my ( $self ) = @_;
		my %config = %{ LoadFile( $self->get_config_filename() ) };
		$self->set_project_id( $config{project_id} );
		$self->set_base_url( $config{base_url} );
		$self->set_base_dir( $config{base_dir} );
		$self->set_db( $config{db} );
		$self->set_query( $config{query} );
		$self->set_querykey( $config{querykey} );
		$self->set_webenv( $config{webenv} );
		$self->set_count( $config{count} );
		$self->set_index( $config{index} );
		$self->set_start_date( $config{start_date} );
		$self->set_start_time( $config{start_time} );
		$self->set_return_max( $config{return_max} );
		$self->set_return_type( $config{return_type} );
		$self->set_return_mode( $config{return_mode} );
		$self->set_missing( $config{missing} );
	}

	sub _save {
		my ( $self, $arg_ref ) = @_;
		my $ident    = ident $self;
		my $config;

		if (defined $arg_ref) {
			$config = $arg_ref;
		} else {
			$config = {  project_id   => $project_id_of{$ident},
				     base_url     => $base_url_of{$ident},
				     base_dir     => $base_dir_of{$ident},
				     db           => $db_of{$ident},
				     query        => $query_of{$ident},
				     querykey     => $querykey_of{$ident},
				     webenv       => $webenv_of{$ident},
				     count        => $count_of{$ident},
				     index        => $index_of{$ident},
				     start_date   => $start_date_of{$ident},
				     start_time   => $start_time_of{$ident},
				     return_max   => $return_max_of{$ident},
				     return_type  => $return_type_of{$ident},
				     return_mode  => $return_mode_of{$ident},
				     missing      => $missing_of{$ident} };
		}
		DumpFile( $self->get_config_filename(), $config );
		return;
	}

	sub _get_base_dir {
		my ( $self, $base_dir ) = @_;
		chomp( my $id = `id -nu`);
		if ($id eq 'root') { $base_dir = '/root'; } else { $base_dir = '/home/' . $id; }
		return $base_dir;
	}

	sub _status {
		my ( $self, $msg ) = @_;
		print STDOUT "  STATUS: $msg \n";
		return;
	}

	sub _sleep {
		my ( $self ) = @_;
		usleep($sleep_policy);
		return;
	}

	sub _get_file_text {
		my ( $self, $path_file_name ) = @_;
		my ($text, $line);
		if (-e $path_file_name) {
			open  (my $IN, '<', $path_file_name) || croak( "Cannot open $path_file_name: $!" );
			while ($line = <$IN>) { $text .= $line; }
			close ($IN)                          || croak( "Cannot close $path_file_name: $!" );
		}
		return $text;
	}

	sub _set_file_text {
		my ( $self, $path_file_name, $text ) = @_;
		open  (my $OUT, '>', $path_file_name)        || croak( "Cannot open $path_file_name: $!" );
		print $OUT $text                             || croak( "Cannot write $path_file_name: $!" );
		close ($OUT)                                 || croak( "Cannot close $path_file_name: $!" );
	}

	sub _add_file_text {
		my ( $self, $path_file_name, $text ) = @_;
		open  (my $OUT, '>>', $path_file_name)       || croak( "Cannot open $path_file_name: $!" );
		print $OUT $text                             || croak( "Cannot write $path_file_name: $!" );
		close ($OUT)                                 || croak( "Cannot close $path_file_name: $!" );
	}

	sub _commify { # Perl Cookbook 2.17
		my ( $self, $string ) = @_;
		my $text = reverse $string;
		$text =~ s/(\d\d\d)(?=\d)(?!\d*\.)/$1,/g;
		return scalar reverse $text;
	}

	sub authors { return 'Roger Hall , Michael Bauer , Kamakshi Duvvuru . Copyleft (C) 2009'; }
}

1; # Magic true value required at end of module
__END__