view release on metacpan or  search on metacpan

lib/Bio/MAGETAB/Util/Reader/Tabfile.pm  view on Meta::CPAN

sub _get_filepath {

    my ( $self, $dir ) = @_;

    my $uri = $self->get_uri();

    # Assume file as default URI scheme.
    my $path;
    if ( ! $uri->scheme() || $uri->scheme() eq 'file' ) {

	$uri->scheme('file');

	# URI::File specific, this avoids quoting e.g. spaces in filenames.
	my $uri_path = $uri->file();

	if ( $dir ) {
	    $path = File::Spec->file_name_is_absolute( $uri_path )
		  ? $uri_path
		  : File::Spec->catfile( $dir, $uri_path );
	}
	else {
	    $path = File::Spec->rel2abs( $uri_path );
	}
    }
    # Add the common network URI schemes.
    elsif ( $uri->scheme() eq 'http' || $uri->scheme() eq 'ftp' ) {
	$path = $self->_cache_network_file( $uri, $dir );
    }
    else {
	croak(sprintf(
	    "ERROR: Unsupported URI scheme: %s\n", $uri->scheme(),
	));
    }

    return $path;
}

sub _cache_filehandle {

    my ( $self ) = @_;

    my $fh;
    unless ( $fh = $self->get_filehandle ) {
        my $path = $self->_get_filepath();
        open( $fh, '<', $path )
            or croak(qq{Error: Unable to open file "$path": $!});
        $self->set_filehandle( $fh );
    }

    return $fh;
}
        

sub _cache_network_file {

    my ( $self, $uri, $dir ) = @_;

    require LWP::UserAgent;

    # N.B. we don't handle URI fragments, just the path.
    my ( $basename ) = ( $uri->path() =~ m!/([^/]+) \z!xms );

    my $target;
    if ( $dir ) {
	$target = File::Spec->catfile( $dir, $basename );
    }
    else {
	$target = $basename;
    }

    # Only download the file once.
    unless ( -f $target ) {

	printf STDOUT (
	    qq{Downloading network file "%s"...\n},
	    $uri->as_string(),
	);

	# Download the $uri->as_string()
	my $ua = LWP::UserAgent->new();

	my $response = $ua->get(
	    $uri->as_string(),
	    ':content_file' => $target,
	);

	unless ( $response->is_success() ) {
	    croak(sprintf(
		qq{Error downloading network file "%s" : %s\n},
		$uri->as_string(),
		$response->status_line(),
	    ));
	}
    }

    return $target;
}

sub _check_linebreaks {

    # Checks for Mac, Unix or Dos line endings by reading the whole
    # file in chunks, and regexp matching the various linebreak types.
    # Returns the appropriate linebreak for acceptable line breaks
    # (N.B. line breaks *must* be unanimous), undef for not.

    my ( $self ) = @_;

    my $path = $self->_get_filepath();

    my $bytelength = -s $path;

    my $fh = $self->_cache_filehandle();

    # Count all the line endings. This can get memory intensive
    # (implicit list generation, can be over 1,000,000 entries for
    # Affy CEL). We read the file in defined chunks to address this.
    my ( $unix_count, $mac_count, $dos_count );
    my $chunk_size          = 3_000_000;    # ~10 chunks to a big CEL file.
    my $previous_final_char = q{};
    for ( my $offset = 0; $offset < $bytelength; $offset += $chunk_size ) {