view release on metacpan or  search on metacpan

lib/Bio/App/SELEX/Stockholm.pm  view on Meta::CPAN

    else {
        %args    = @args;
        $maxcols = $args{'MAXCOLS'};
    }
    $maxcols = 80 unless defined $maxcols;    # default 80-column output

    # init output array
    my @out;
    push @out, "# STOCKHOLM 1.0";

    # determine alignment columns, legend columns & effective columns per line
    my $acols   = $self->columns;
    my $lcols   = $self->lcols;
    my $colstep = $maxcols < 1 ? $acols : $maxcols - $lcols - 1;
    $colstep = $maxcols
      if $colstep < 1;    # protect against negative and 0 colstep...

    # GF lines
    # check for gfOrder (insane, fragile Stockholm line ordering strikes again)
    if ( @{ $self->gfOrder } == map { (@$_) } values %{ $self->gf } )
    {                     # gfOrder same number of lines as #=GF block?

lib/Bio/App/SELEX/Stockholm.pm  view on Meta::CPAN

	    : $self->{$sub};
    }

    # croak
    croak "Unsupported method: $sub";
}


# pretty print line(s)
sub prettify {
    my ($self, $lcols, $legend, @data) = @_;
    # This horribly inefficient/redundant series of transformations comes out with something I like (IH, 7/24/07)
    # Trim it down? pah! Like I have nothing better to do
    $legend = sprintf ("% ${lcols}s", $legend);
    $legend =~ s/^(\s+)(\#=\S\S)(\s+\S+)$/$2$1$3/;
    $legend =~ s/^(\s+)(\#=\S\S\s+\S+)(\s+\S+)$/$2$1$3/;
    $legend =~ s/^(\s\s\s\s\s)(\s+)([^\#]\S+)/$1$3$2/;
    return map ("$legend $_", @data);
    # (pukes into cold coffee cup)
}

# legend width (subtract this from maxcols-1 to get number of columns available for sequence display)
sub lcols {
    my ($self) = @_;
    my $lcols = max ($self->maxNameLen,
		     map(length("#=GF $_"), keys(%{$self->gf})),
		     map(length("#=GC $_"), keys(%{$self->gc})));
    while (my ($gr_key, $gr_hash) = each %{$self->gr}) {
	$lcols = max ($lcols, map(length("#=GR $gr_key $_"), keys(%$gr_hash)));
    }
    while (my ($gs_key, $gs_hash) = each %{$self->gs}) {
	$lcols = max ($lcols, map(length("#=GS $gs_key $_"), keys(%$gs_hash)));