view release on metacpan or  search on metacpan

lib/Bio/Graphics/Browser2/DataLoader/archive.pm  view on Meta::CPAN

package Bio::Graphics::Browser2::DataLoader::archive;

# $Id$
use strict;
use base 'Bio::Graphics::Browser2::DataLoader';
use Bio::DB::BigWigSet;
use File::Spec;

sub new {
    my $class = shift;
    my $self  = $class->SUPER::new(@_);
    $self->{default_track_name} = 'track000';
    $self;
}

sub default_track_name {
    my $self = shift;
    return $self->{default_track_name}++;
}

sub load {
    my $self = shift;
    my ($initial_lines,$fh) = @_;
    
    $self->flag_busy(1);
    eval {
	$self->open_conf;
	$self->set_status('starting load');
	
	mkdir $self->sources_path or die $!;
	$self->{archive} = File::Spec->catfile($self->sources_path,$self->track_name);
	my $source_file = IO::File->new($self->{archive},'>');

	warn "sourcefile=$self->{archive}";

	$self->start_load;

	$self->set_status('load data');
	my $bytes_loaded = 0;
	foreach (@$initial_lines) {
	    $source_file->print($_);
	    $bytes_loaded += length $_;
	}

	my $buffer;
	while ((my $bytes = read($fh,$buffer,8192) > 0)) {
	    $source_file->print($buffer);
	    $bytes_loaded += length $ buffer;
	    $self->set_status("loaded $bytes_loaded bytes") if $bytes++ % 10000;
	}
	$source_file->close();
    
	$self->finish_load;
	$self->check_metadata;
	$self->write_conf;
	$self->close_conf;
	$self->set_processing_complete;
    };

    $self->flag_busy(0);
    die $@ if $@;
    return $self->tracks;
}

sub finish_load {
	my $self = shift;
	$self->set_status("extracting files from archive");
	
	my $archive = $self->{archive};
	my $bin = $archive =~ /\.tar$/i ? $self->search_for_binary('tar') :
		$archive =~ /\.zip$/i ? $self->search_for_binary('unzip') :
		'';
	die "unrecognized file type!" unless $bin;
	
	my $command = $archive =~ /\.tar$/i ? "$bin -tf" : "$bin -l";
	my $fh;
	open $fh, "($command $archive && echo 'success') 2>&1 |";
	my @contents = <$fh>;
	close $fh;
	unless ($contents[-1] =~ /success/) {
		die "ARCHIVE LIST ERROR: @contents";
	}
	pop @contents;
	
	my @to_extract;
	while (@contents) {
		my $item = shift @contents;
		next if ($item =~ /^(Archive\:| Length|\-{5,})/); # unzip headers
		$item = (split / {2,}/, $item)[-1]; # split on two or more spaces
		chomp $item;
		my (undef, undef, $file) = File::Spec->splitpath($item);
		if ($file =~ /^meta/i) {
			push @to_extract, [$item, $file];
		}
		elsif ($file =~ /^\./) {
			next; # skip .files if present
		}
		elsif ($file =~ /\.bw$/i) {
			push @to_extract, [$item, $file];
		}
	}
	die "no recognizable files in archive to extract" unless @to_extract;
	
	# we are trying to be safe here and extract just the file contents
	# without directory paths to avoid ill- or mis-intentioned stray files
	my $path = $self->sources_path;
	my $count;
	$command = $archive =~ /\.tar$/i ? "$bin -x -O -f" : "$bin -p";
	foreach (@to_extract) {
		my $target = File::Spec->catfile($path, $_->[1]);
		# extract file from tar archive and redirect to file in our path
		open my $in, "$command $archive \"$_->[0]\" |" or 
			die "unable to open achive for extraction";
		open my $out, '>', $target or die "unable to open target file";
		while (<$in>) {print $out $_}
		close $in;
		close $out;
		$count++ if -e $target && -s _ ;
	}
	die "not all files could be extracted\n" unless $count == scalar(@to_extract);