Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- # Here's an example of having BioPerl write an alignment into the middle
- # of an HTML stream:
- use strict;
- use IO::Scalar;
- use BIo::AlignIO;
- my $html = "<h1>Blah!</h1>\n";
- my $html_fh = new IO::Scalar \$html;
- my $io = Bio::AlignIO->new(
- -file => ("t/data/testaln.aln"));
- my $aln = $io->next_aln();
- $io = Bio::AlignIO->new(
- '-fh'=> $html_fh,
- '-format' => 'clustalw');
- $io->write_aln($aln);
- $html .= "<h1>All done! woot!</h1>\n";
- print $html;
- # Here's how Bio::AlignIO::clustalw writes $aln objects to files:
- =head2 write_aln
- Title : write_aln
- Usage : $stream->write_aln(@aln)
- Function: writes the clustalw-format object (.aln) into the stream
- Returns : 1 for success and 0 for error
- Args : Bio::Align::AlignI object
- =cut
- sub write_aln {
- my ( $self, @aln ) = @_;
- my ( $count, $length, $seq, @seq, $tempcount, $line_len );
- $line_len = $self->line_length || $LINELENGTH;
- foreach my $aln (@aln) {
- if ( !$aln || !$aln->isa('Bio::Align::AlignI') ) {
- $self->warn(
- "Must provide a Bio::Align::AlignI object when calling write_aln"
- );
- next;
- }
- my $matchline = $aln->match_line;
- if ( $self->force_displayname_flat ) {
- $aln->set_displayname_flat(1);
- }
- $self->_print(
- sprintf( "CLUSTAL W(%s) multiple sequence alignment\n\n\n",
- $CLUSTALPRINTVERSION )
- ) or return;
- $length = $aln->length();
- $count = $tempcount = 0;
- @seq = $aln->each_seq();
- my $max = 22;
- foreach $seq (@seq) {
- $max = length( $aln->displayname( $seq->get_nse() ) )
- if ( length( $aln->displayname( $seq->get_nse() ) ) > $max );
- }
- while ( $count < $length ) {
- my ( $linesubstr, $first ) = ( '', 1 );
- foreach $seq (@seq) {
- #
- # Following lines are to suppress warnings
- # if some sequences in the alignment are much longer than others.
- my ($substring);
- my $seqchars = $seq->seq();
- SWITCH: {
- if ( length($seqchars) >= ( $count + $line_len ) ) {
- $substring = substr( $seqchars, $count, $line_len );
- if ($first) {
- $linesubstr =
- substr( $matchline, $count, $line_len );
- $first = 0;
- }
- last SWITCH;
- }
- elsif ( length($seqchars) >= $count ) {
- $substring = substr( $seqchars, $count );
- if ($first) {
- $linesubstr = substr( $matchline, $count );
- $first = 0;
- }
- last SWITCH;
- }
- $substring = "";
- }
- $self->_print(
- sprintf(
- "%-" . $max . "s %s\n",
- $aln->displayname( $seq->get_nse() ), $substring
- )
- ) or return;
- }
- my $percentages = '';
- if ( $self->percentages ) {
- my ($strcpy) = ($linesubstr);
- my $count = ( $strcpy =~ tr/\*// );
- $percentages =
- sprintf( "\t%d%%", 100 * ( $count / length($linesubstr) ) );
- }
- $self->_print(
- sprintf(
- "%-" . $max . "s %s%s\n",
- '', $linesubstr, $percentages
- )
- );
- $self->_print( sprintf("\n\n") ) or return;
- $count += $line_len;
- }
- }
- $self->flush if $self->_flush_on_write && defined $self->_fh;
- return 1;
- }
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement