File Coverage

blib/lib/Microarray/GEO/SOFT.pm

Criterion	Covered	Total	%
statement	4	6	66.6
branch			n/a
condition			n/a
subroutine	2	2	100.0
pod			n/a
total	6	8	75.0

package Microarray::GEO::SOFT;

use List::Vectorize qw(!table);

use Microarray::ExprSet;
use File::Basename;
use LWP::UserAgent;
use Time::HiRes qw(usleep gettimeofday);
use Carp;
use Cwd;
use strict;

require Microarray::GEO::SOFT::GPL;
require Microarray::GEO::SOFT::GSM;
require Microarray::GEO::SOFT::GDS;
require Microarray::GEO::SOFT::GSE;

our $VERSION = "0.20";
our $wd = getcwd();

$| = 1;

# download geo files
our $ua;
our $response;
our $download_start_time;
our $fh_out;

1;

sub new {

	my $invocant = shift;
	my $class = ref($invocant) || $invocant;
	my $self = { "file" => "",
	             "tmp_dir" => ".tmp_soft",
				 "verbose" => 1,
				 "sample_value_column" => "VALUE",
	             @_ };
	bless($self, $class);

	opendir DIR, $self->{tmp_dir} and closedir DIR
		or mkdir $self->{tmp_dir};

	return $self;

}

sub _set_to_null_fh {

	my $null = $^O eq "MSWin32" ? "NUL" : "/dev/null";
	open my $fh_out, ">", $null;
	$| = 1;
	select($fh_out);
}

sub _set_to_std_fh {
	$| = 1;
	select(STDOUT);
}

sub _set_fh {
	my $verbose = shift;

	$verbose ? _set_to_std_fh() : _set_to_null_fh();
}

BEGIN {

	no strict 'refs';

	for my $accessor (qw(meta table)) {
		*{$accessor} = sub {
			my $self = shift;
			return defined($self->{$accessor}) ? $self->{$accessor}
			                                   : undef;
		}
	}

	for my $accessor (qw(accession title platform)) {
		*{$accessor} = sub {
			my $self = shift;
			return defined($self->{meta}->{$accessor}) ? $self->{meta}->{$accessor}
			                                           : undef;
		}
	}

	for my $accessor (qw(rownames colnames colnames_explain matrix)) {
		*{$accessor} = sub {
			my $self = shift;
			return defined($self->{table}->{$accessor}) ? $self->{table}->{$accessor}
			                                            : undef;
		}
	}

}

sub soft_dir {

	my $self = shift;
	return $self->{tmp_dir};
}

sub parse {

	my $self = shift;

	_set_fh($self->{verbose});

	# decompress file
	if( -e $self->{file} and (! -T $self->{file}) ) {
		$self->{file} = _decompress($self->{file});
	}

	my $type = _check_type($self->{file});

	my $obj;
	if($type eq "SERIES") {

		$obj = Microarray::GEO::SOFT::GSE->new(file => $self->{file},
		                                       verbose => $self->{verbose},
											   sample_value_column => $self->{sample_value_column},
											   @_);
		$obj->parse;

	}
	elsif($type eq "DATASET") {

		$obj = Microarray::GEO::SOFT::GDS->new(file => $self->{file},
		                                       verbose => $self->{verbose},
											   @_);
		$obj->parse;

	}
	elsif($type eq "PLATFORM") {

		$obj = Microarray::GEO::SOFT::GPL->new(file => $self->{file},
		                                       verbose => $self->{verbose},
											   @_);
		$obj->parse;
	}
	else {

		croak "ERROR: Format not supported. Only GSExxx, GDSxxx and GPLxxx are valid\n";

	}

	_set_to_std_fh();

	return $obj;
}

# determine what type is the input file by reading first few lines
sub _check_type {

	my $file = shift;

	open F, $file or croak "Cannot open $file.\n";

	while(my $line = ) {

		if($line =~/^\^SERIES /) {
			return "SERIES";
		}

		elsif($line =~/^\^DATASET /) {
			return "DATASET";
		}

		elsif($line =~/^\^PLATFORM /) {
			return "PLATFORM";
		}

		elsif($line =~/^\^Annotation/) {
			return "PLATFORM";
		}
	}

	return undef;
}


sub set_meta {

	my $self = shift;
	my $arg = {'accession' => $self->accession,
	           'title'     => $self->title,
			   'platform'  => $self->platform,
			   @_};

	$self->{meta}->{"accession"} = $arg->{'accession'};
	$self->{meta}->{"title"} = $arg->{'title'};
	$self->{meta}->{"platform"} = $arg->{'platform'};

	return $self;
}


sub set_table {

	my $self = shift;
	my $arg = {'rownames'         => $self->rownames,
	           'colnames'         => $self->colnames,
			   'colnames_explain' => $self->colnames_explain,
			   'matrix'           => $self->matrix,
			   @_};

	$self->{table}->{"rownames"} = $arg->{'rownames'};
	$self->{table}->{"colnames"} = $arg->{'colnames'};
	$self->{table}->{"colnames_explain"} = $arg->{'colnames_explain'};
	$self->{table}->{"matrix"} = $arg->{'matrix'};

	return $self;
}

# download data from GEO ftp
# returns a list of filenames (array reference)
# in most circumstance, there is only one file at each series/platform/gds directory
# but still there is probability that multiple files locate in directory (especially for series matrix format)
# we only deal with one file situation
# for multiple files situation, users can downloaded manually
# and initial this object with file argument
sub download {

	my $self = shift;

	my $id = shift;

	_set_fh($self->{verbose});

	my %option = ( "proxy" => "",        # proxy setting, only http, should be like "http://username:password@127.0.0.1:808/"
				   "timeout" => 30,
	               @_ );

	my $remote_file_list;
	my $remote_file_name;
	my $remote_file_size;
	my $local_file;

	#$fh_out = _open_out_handle($self->{verbose});

	$ua = LWP::UserAgent->new;
	$ua->timeout($option{timeout});

	if($option{proxy}) {
		$ua->proxy(["http"], $option{proxy});
	}

	my $url;

	# different geo data type
	my $url_format = { "gse" => "ftp://ftp.ncbi.nih.gov/pub/geo/DATA/SOFT/by_series",
					   "gpl" => "ftp://ftp.ncbi.nih.gov/pub/geo/DATA/annotation/platforms",
					   "gds" => "ftp://ftp.ncbi.nih.gov/pub/geo/DATA/SOFT/GDS" };

	# format url based on different GEO id type
	if($id =~/^gse\d+$/i) {
		$url = "$url_format->{gse}/$id";
	}
	elsif($id =~/^gpl\d+$/i) {
		$url = "$url_format->{gpl}";
	}
	elsif($id =~/^gds\d+$/i) {
		$url = "$url_format->{gds}";
	}
	else {
		croak "ERROR: GEO ID should look like 'GSE123', 'GPL123' and 'GDS123'";
	}

	# if GSE or GPL
	if($id =~/^gse\d+$/i) {

		# first get the file list in the directory
		# because some GSE or GPL term would have more than one file
		print "Reading dir from GEO FTP site:\n";
		print "  $url\n\n";
		$response = $ua->get($url);

		unless($response->is_success) {
			croak $response->status_line;
		}

		my $content = $response->content;
		@$remote_file_list = split "\n", $content;

		print "found ", scalar(@$remote_file_list), " file.\n";

		if(scalar(@$remote_file_list) > 1) {
			croak "ERROR: There are more than one files in the remote directory and this ".
			      "situation has not been supported by ". __PACKAGE__." by this version. ".
				  "But still you can download them by hand.";
		}
		if(! scalar(@$remote_file_list)) {
			croak "Can not find any file.";
		}

		my @tmp = split " ", $remote_file_list->[0];
		$remote_file_name = $tmp[$#tmp];
		$remote_file_size = $tmp[4];
		$local_file = $self->soft_dir."/$tmp[$#tmp]";

		print "remote file is: $remote_file_name\n";
		print "\n";

	}
	elsif($id =~/gpl\d+$/i) {

		print "Validating link from GEO FTP site:\n";
		print "  $url/$id.annot.gz\n";
		$response = $ua->head("$url/$id.annot.gz");

		unless($response->is_success) {
			croak $response->status_line;
		}

		print "found $id.annot.gz on the server.\n\n";
		$remote_file_name = "$id.annot.gz";
		$remote_file_size = $response->header("content-length");
		$local_file = $self->soft_dir."/$id.annot.gz";

	}
	# if GDS
	elsif($id =~/gds\d+$/i) {

		print "Validating link from GEO FTP site:\n";
		print "  $url/$id.soft.gz\n\n";
		$response = $ua->head("$url/$id.soft.gz");

		unless($response->is_success) {
			croak $response->status_line;
		}

		print "found $id.soft.gz on the server.\n\n";
		$remote_file_name = "$id.soft.gz";
		$remote_file_size = $response->header("content-length");
		$local_file = $self->soft_dir."/$id.soft.gz";

	}

	# whether there already has a file with the same name
	while(-e $local_file) {
		my $r = int(rand(100000));
		if($remote_file_name =~/^(.*?)\.(\S+)$/) {
			my $base = $1;
			my $ext = $2;
			$local_file = $self->soft_dir."/$base.$r.$ext";
		}
		else {
			$local_file = $self->soft_dir."/$remote_file_name.$r";
		}
	}

	$url = "$url/$remote_file_name";
	print "downloading $url\n";
	print "file size: $remote_file_size byte.\n";
	print "local file: $wd/$local_file\n\n";

	# begin to download
	# if thread supported, progress would be shown
	$response = undef;

	eval 'require Thread; require threads::shared';

	if($@) {
		_download($url, $local_file);

		unless($response->is_success) {
			croak $response->status_line;
		}

	} else {
		eval q`
		my $response : shared;
		$download_start_time = gettimeofday();
		my $download_start_time : shared;
		my $f1 = Thread->new(\&_download, $url, $local_file);
		my $f2 = Thread->new(\&_progress, $local_file, $remote_file_size);

		$f1->join;
		$f2->join;
		`;
	}

	$self->{file} = $local_file;

	_set_to_std_fh();

	return $self;
}

sub _download {
	my $url = shift;
	my $local_file = shift;

	$response = $ua->get($url, ":content_file" => $local_file);
}

sub _progress {
	my $local_file = shift;
	my $remote_file_size = shift;

	# still connecting
	while(! -e $local_file) {
		#print "$local_file does not exist, sleep $s_sleep_ms ms.\n";
		usleep(500000);

		if($response) {
			print "\n\n";
			last;
		}
	}

	my $recieved_file_size = -s "$local_file";
	my $i = 0;
	my $bar = ["|", "\\", "-", "/"];
	while($recieved_file_size != $remote_file_size) {
		$recieved_file_size = -s "$local_file";
		my $percentage = $recieved_file_size / $remote_file_size;
		$percentage = sprintf("%.1f", $percentage * 100);
		my $speed = $recieved_file_size / (gettimeofday - $download_start_time);
		$speed = sprintf("%.2f", $speed / 1024);  #KB/s
		my $passed_time = (gettimeofday - $download_start_time);
		$passed_time = int($passed_time);
		print "\b" x 100;

		print "[", $bar->[$i % scalar(@$bar)], "]";
		print " Recieving $recieved_file_size byte.\t$percentage\%\t$speed KB/s\t$passed_time"."s";
		$i ++;

		usleep(500000);

		# if download is done
		if($response) {
			last;
		}
	}

	print "\n\n";

}


sub _decompress {

	# 压缩文件
	my $compressed_file = shift;

	my $null = $^O eq "MSWin32" ? "NUL" : "/dev/null";
	eval("system('gzip --version > $null')") == 0
		or croak "ERROR: Cannot find 'gzip'\n";

	# 压缩文件的文件名
	my $basename = basename($compressed_file);

	print "decompress $compressed_file...\n";
	my $command;

	# 获得解压缩文件的文件名
	$command = "gzip -l \"$compressed_file\"";
	my $status = `$command`;

	my @foo = split "\n", $status;
	@foo = split " ", $foo[1];
	my $uncompressed_file = $foo[$#foo];

	# 解压缩
	$command = "gzip -cd \"$compressed_file\" > \"$uncompressed_file\"";

	system($command) == 0
		or croak "ERROR: $!\n";

	# 返回解压后的文件名
	return "$uncompressed_file";
}


__END__