view release on metacpan or  search on metacpan

lib/Bio/DB/BigWigSet.pm  view on Meta::CPAN

    if (my $old = $self->{attributes}{$path}) {
	%$attributes = (%$old,%$attributes);  # merge
    }
    $self->{bigwigs}{$path}  ||= undef;
    $self->{attributes}{$path} = $attributes;
}

=item @paths = $bws->bigwigs

Returns the path to all the BigWig files in the collection.

=cut

sub bigwigs {
    my $self = shift;
    return keys %{$self->{bigwigs}};
}

=item $bigwig = $bws->get_bigwig($path)

If the BigWig file is part of the set, opens and returns it.

=back

=cut

sub get_bigwig {
    my $self = shift;
    my $path = shift;
    return unless exists $self->{bigwigs}{$path};
    my $bw = $self->{bigwigs}{$path} ||=
	Bio::DB::BigWig->new(-bigwig => $path,
			     -fasta  => $self->dna_accessor||undef) 
	or die "Could not open bigwig file $path: $!";
    return $bw;
}

sub read_index {
    my $self = shift;
    my ($file,$base) = @_;
    $base ||= dirname($file);
    my $f;

    if ($file =~ /^(ftp|http):/i) {
	my $ua = LWP::UserAgent->new;
	my $r  = $ua->get($file);
	die "Couldn't read $file: ",$r->status_line unless $r->is_success;
	eval "require IO::String; 1" 
	    or die "IO::String module is required for remote directories"
	    unless IO::String->can('new');
	$f = IO::String->new($r->decoded_content);
    }
    else {
	$f = IO::File->new($file) or die "$file: $!";
    }
    my ($current_path,%wigs);

    while (<$f>) {
	chomp;
	s/\s+$//;   # strip whitespace at ends of lines
	# strip right-column comments unless they look like colors or html fragments
	s/\s*\#.*$// unless /\#[0-9a-f]{6,8}\s*$/i || /\w+\#\w+/ || /\w+\"*\s*\#\d+$/;   
	if (/^\[([^\]]+)\]/) {  # beginning of a configuration section
	    my $wigname = $1;
	    $current_path    = $wigname =~ m!^(/|http:|ftp:)! ? $wigname
		                                              : "$base/$wigname";
	}

	elsif ($current_path && /^([\w: -]+?)\s*=\s*(.*)/) {  # key value pair
	    my $tag = lc $1;
	    my $value = defined $2 ? $2 : '';
	    $wigs{$current_path}{$tag}=$value;
	}
    }

    for my $path (keys %wigs) {
	my $attributes = $wigs{$path};
	$self->set_bigwig_attributes($path,$attributes);
    }
}

sub segment {
    my $self = shift;
    my ($seqid,$start,$end) = @_;

    if ($_[0] =~ /^-/) {
	my %args = @_;
	$seqid = $args{-seq_id} || $args{-name};
	$start = $args{-start};
	$end   = $args{-stop}    || $args{-end};
    } else {
	($seqid,$start,$end) = @_;
    }

    my ($one_bigwig) = keys %{$self->{bigwigs}};
    my $bw           = $self->get_bigwig($one_bigwig);

    my $size = $bw->length($seqid) or return;

    $start ||= 1;
    $end   ||= $bw->length($seqid);

    return unless $start >= 1 && $start < $size;
    return unless $end   >= 1 && $end   < $size;

    return Bio::DB::BigWigSet::Segment->new(-bws   => $self,
					    -seq_id=> $seqid,
					    -start => $start,
					    -end   => $end);
}

sub metadata {
    my $self = shift;

    my $att = $self->{attributes};

    # obscure file names
    my @indices = sort {
		      $att->{$a}{display_name} cmp $att->{$b}{display_name}
		  } keys %$att;
    my @values  = @{$att}{@indices};