view release on metacpan or  search on metacpan

Bio/Assembly/IO.pm  view on Meta::CPAN

 Title   : _load_format_module
 Usage   : *INTERNAL Assembly::IO stuff*
 Function: Loads up (like use) a module at run time on demand
 Example :
 Returns :
 Args    :

=cut

sub _load_format_module {
  my ($self,$format) = @_;
  my $module = "Bio::Assembly::IO::" . $format;
  my $ok;

  eval {
      $ok = $self->_load_module($module);
  };
  if ( $@ ) {
    print STDERR <<END;
$self: could not load $format - for more details on supported formats please see the Assembly::IO docs
Exception $@
END
  ;
  }
  return $ok;
}

=head2 _guess_format

 Title   : _guess_format
 Usage   : $obj->_guess_format($filename)
 Function: guess format based on file suffix
 Example :
 Returns : guessed format of filename (lower case)
 Args    :
 Notes   : formats that _filehandle() will guess includes
           ace, phrap and tigr at the moment

=cut

sub _guess_format {
   my $class = shift;
   my $arg   = shift;

   return unless defined($arg);
   return 'ace'    if ($arg =~ /\.ace/i);
   return 'phrap'  if ($arg =~ /\.phrap/i);
   return 'tigr'   if ($arg =~ /\.tigr/i);
   return 'maq'    if ($arg =~ /\.maq/i);
   return 'sam'    if ($arg =~ /\.[bs]am/i);
   return 'bowtie' if ($arg =~ /\.bowtie/i);

}


=head2 _sort

    Title   : _sort
    Usage   : @sorted_values = $ass_io->_sort(@values)
    Function: Sort a list of values naturally if Sort::Naturally is installed
              (nicer), lexically otherwise (not as nice, but safe)
    Returns : array of sorted values
    Args    : array of values to sort

=cut

sub _sort {
    my @arr = @_;
    my @sorted_arr;
    if (eval { require Sort::Naturally }) {
        @sorted_arr = Sort::Naturally::nsort( @arr ); # natural sort (better)
    } else {
        @sorted_arr = sort @arr; # lexical sort (safe)
    }
    return @sorted_arr;
}


sub DESTROY {
    my $self = shift;

    $self->close();
}

# I need some direction on these!! The module works so I haven't fiddled with them!
# Me neither! (rfsouza)

sub TIEHANDLE {
    my ($class,$val) = @_;
    return bless {'seqio' => $val}, $class;
}

sub READLINE {
    my $self = shift;
    return $self->{'seqio'}->next_seq() || undef unless wantarray;
    my (@list, $obj);
    push @list, $obj while $obj = $self->{'seqio'}->next_seq();
    return @list;
}

sub PRINT {
    my $self = shift;
    $self->{'seqio'}->write_seq(@_);
}

1;