Skip to content

Instantly share code, notes, and snippets.

@jhannah
Created October 31, 2009 14:38
Show Gist options
  • Save jhannah/223096 to your computer and use it in GitHub Desktop.
Save jhannah/223096 to your computer and use it in GitHub Desktop.
# 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;
}
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment