Bio-Graphics

 view release on metacpan or  search on metacpan

lib/Bio/Graphics/FeatureFile.pm  view on Meta::CPAN

END
    warn "You need Storable to use new_from_cache(); returning uncached data" unless $has_libs;
    }

    $Storable::Deparse = 1;
    $Storable::Eval    = 1;

    my $file      = $has_libs && $args{-file} or return $self->_new(@_);
    (my $name     = $args{-file}) =~ s!/!_!g;
    my $cachefile = $self->cachefile($name);
    if (-e $cachefile && (stat(_))[9] >= $self->file_mtime($args{-file})) { # cache is valid
#    if (-e $cachefile && -M $cachefile < 0) { # cache is valid
	my $parsed_file = lock_retrieve($cachefile);
	$parsed_file->initialize_code if $parsed_file->safe;
	return $parsed_file;
    } else {
	mkpath(dirname($cachefile));
	my $parsed = $self->_new(@_);
	$parsed->initialize_code();
	eval {lock_store($parsed,$cachefile)};
	warn $@ if $@;

lib/Bio/Graphics/FeatureFile.pm  view on Meta::CPAN

=cut

sub file_mtime {
    my $self = shift;

    my $file  = shift;
    my $mtime = 0;

    for my $f (glob($file)) {
	my $m  = (stat($f))[9] or next;
	$mtime = $m if $mtime < $m;
	open my $fh,'<',$file or next;
	my $cwd = getcwd();
	chdir(dirname($file));

        local $_;
	while (<$fh>) {
	    if (/^\#exec/) {
		return time();  # now!
	    }

lib/Bio/Graphics/FeatureFile.pm  view on Meta::CPAN

	  push @tracks,$panel->add_track($features,@config);
      }
  }
  return wantarray ? (scalar(@tracks),$panel,\@tracks) : scalar @tracks;
}

sub _stat {
  my $self = shift;
  my $file = shift;
  defined fileno($file)  or return;
  my @stat = stat($file) or return;
  if ($self->{stat} && @{$self->{stat}}) { # merge #includes so that mtime etc are max age
      for (8,9,10) {
	  $self->{stat}[$_] = $stat[$_] if $stat[$_] > $self->{stat}[$_];
      }
      $self->{stat}[7] += $stat[7];
  } else {
      $self->{stat} = \@stat;
  }
}

lib/Bio/Graphics/FeatureFile.pm  view on Meta::CPAN

	my $cwd  = getcwd();
	chdir(dirname($f));
	$self->parse_fh($fh);
	chdir($cwd);
    }
}

sub parse_fh {
    my $self = shift;
    my $fh   = shift;
    $self->_stat($fh);
    local $/ = "\n";
    local $_;
    while (<$fh>) {
	chomp;
	$self->parse_line($_) || last;
    }
}

sub parse_text {
  my $self = shift;

lib/Bio/Graphics/FeatureFile.pm  view on Meta::CPAN

=over 4

=item $mtime = $features-E<gt>mtime

=item $atime = $features-E<gt>atime

=item $ctime = $features-E<gt>ctime

=item $size = $features-E<gt>size

Returns stat() information about the data file, for featurefile
objects created using the -file option.  Size is in bytes.  mtime,
atime, and ctime are in seconds since the epoch.

=back

=cut

sub mtime {
  my $self = shift;
  my $d = $self->{m_time} || $self->{stat}->[9];

lib/Bio/Graphics/Wiggle.pm  view on Meta::CPAN

sub new_fh {
    my $self = shift;
    my ($path,$mode) = @_;
    return $path ? IO::File->new($path,$mode)
                 : IO::File->new_tmpfile;
}

sub end {
  my $self = shift;
  unless (defined $self->{end}) {
      my $size     = (stat($self->fh))[7];
      my $data_len = $size - HEADER_LEN();
      return unless $data_len>0;   # undef end
      $self->{end} = ($self->start-1) + $data_len * $self->step;
  }
  return $self->{end};
}

sub DESTROY { shift->write }

sub erase {

lib/Bio/Graphics/Wiggle/Loader.pm  view on Meta::CPAN

sub minmax {
  my $self   = shift;
  my ($infh,$bedline) = @_;
  local $_;

  my $transform  = $self->get_transform;

  my $seqids = ($self->current_track->{seqids} ||= {});
  my $chrom  = $self->{track_options}{chrom};

  if ($self->allow_sampling && (my $size = stat($infh)->size) > BIG_FILE) {
      warn "Wiggle file is very large; resorting to genome-wide sample statistics for $chrom.\n";
      $self->{FILEWIDE_STATS} ||= $self->sample_file($infh,BIG_FILE_SAMPLES);
      for (keys %{$self->{FILEWIDE_STATS}}) {
	$seqids->{$chrom}{$_} = $self->{FILEWIDE_STATS}{$_};
      }
      return;
  }

  my %stats;
  if ($bedline) {  # left-over BED line

lib/Bio/Graphics/Wiggle/Loader.pm  view on Meta::CPAN

sub sample_file {
    my $self = shift;

    my ($fh,$samples) = @_;

    my $transform  = $self->get_transform;

    my $stats = Statistics::Descriptive::Sparse->new();

    my $size = stat($fh)->size;
    my $count=0;
    while ($count < $samples) {
	seek($fh,int(rand $size),0) or die;
	scalar <$fh>; # toss first line
	my $line = <$fh>; # next full line
	$line or next;
	my @tokens = split /\s+/,$line;
	my $value  = $tokens[-1];
	next unless $value =~ /^[\d\seE.+-]+$/; # non-numeric
	$value = $transform->($self,$value) if $transform;