binaries/src/jpred/lib/BLC.pm

   1 package BLC;
   2
   3 use strict;
   4 use warnings;
   5 use Carp;
   6
   7 use constant {
   8   ID    => 0,
   9   TITLE => 1,
  10   SEQ   => 2
  11 };
  12
  13 =head2 my $blc = new BLC;
  14
  15 =cut
  16
  17 sub new {
  18   my $proto = shift;
  19   my $class = ref($proto) || $proto;
  20   my $self  = {
  21     _itteration     => 0,
  22     _max_itteration => 0,
  23   };
  24   return bless $self, $class;
  25 }
  26
  27 =head2 my $blc->read_file($file)
  28
  29 Read in a BLC file.
  30
  31 =cut
  32
  33 sub read_file {
  34   my @seqs;
  35   my $self = shift;
  36   my ($fn) = @_;
  37
  38   open BLC, $fn or croak "$fn: $!\n";
  39
  40   while (<BLC>) {
  41     chomp;
  42     if (s/^>//) {
  43       s/\s*$//g;
  44       my ( $id, $title ) = split /\s+/, $_, 2;
  45       $title = '' unless $title;
  46       push @seqs, [ $id, $title ];
  47     }
  48
  49     # This regex copes with odd variations in the start of
  50     # the iterations line that marks the start of sequences
  51     if (/^\s*\*\s*[Ii]teration:?\s*(\d+)\s*$/) {
  52
  53       # The start position of the sequences is the same
  54       # as the offset of the asterix from the start of
  55       # the line
  56       my $start = index $_, '*', 0;
  57       my $iter = $1;
  58       croak "Iteration not greater than 0 in BLC file $fn" unless $iter > 0;
  59
  60       while (<BLC>) {
  61         chomp;
  62         last if /^\s{$start}\*\s*$/;
  63         my $line = substr $_, $start, @seqs;
  64
  65         foreach ( 0 .. $#seqs ) {
  66
  67           # Not just $iter, as we need to
  68           # leave room for the title
  69           # and header
  70           $seqs[$_]->[ SEQ + $iter - 1 ] .= substr( $line, $_, 1 );
  71         }
  72       }
  73     }
  74   }
  75   close BLC;
  76   croak "No sequences found in BLC file $fn" unless @seqs;
  77
  78   foreach (@seqs) {
  79     my ( $id, $title, @seqs ) = @{$_};
  80     $title = '' unless defined $title;
  81     $id    = '' unless defined $id;
  82     $self->set_sequence( $id, $title, @seqs );
  83   }
  84 }
  85
  86 =head2 $blc->set_sequence($id, $title, @seq)
  87
  88 Add a BLC file to the object of $id, $title and @sequence, one sequence per iteration.
  89
  90 =cut
  91
  92 sub set_sequence {
  93   my $self = shift;
  94   my ( $id, $title, @data ) = @_;
  95   push @{ $self->{_seqs} }, [ $id, $title, @data ];
  96 }
  97
  98 =head2 $blc->get_sequence($number)
  99
 100 Returns a list of the ($id, $title, @sequences) where each member of @sequences
 101 is from the itterations, from first to final. Defaults to the first sequences.
 102
 103 =cut
 104
 105 sub get_sequence {
 106   my ( $self, $number ) = @_;
 107   if ( defined $number and $number > $self->get_num_seqs ) {
 108     croak "You're trying to retrive a sequence past than the end of the BLC file in get_sequence($number)";
 109   } elsif ( defined $number and $self->get_num_seqs + $number < 0 ) {
 110     croak "You're trying to retrive a sequence before the begining of the BLC file in get_sequence($number)";
 111   }
 112   $number = 0 unless defined $number;
 113
 114   return @{ ${ $self->{_seqs} }[$number] };
 115 }
 116
 117 =head2 $blc->get_num_seqs()
 118
 119 Returns the number of sequences in the BLC file.
 120
 121 =cut
 122
 123 sub get_num_seqs {
 124   my ($self) = @_;
 125   return $#{ $self->{_seqs} };
 126 }
 127
 128 =head2 $blc->get_sequences($iteration)
 129
 130 Returns all of the sequences in a block file for a particular itteration,
 131 in the same order as they occured in the block file. If left undefined,
 132 it will return the sequences from the first itteration.
 133
 134 =cut
 135
 136 sub get_sequences {
 137   my ( $self, $iteration ) = @_;
 138   $iteration = 0 unless $iteration and $iteration > 0;
 139   return map { $_->[ SEQ + $iteration ] } @{ $self->{_seqs} };
 140 }
 141
 142 =head2 $blc->get_seq_ids($number)
 143
 144 Returns the ID for the $number sequence to occur in the file, if left undefined it'll return all of the IDs.
 145
 146 =cut
 147
 148 sub get_seq_ids {
 149   my ( $self, $number ) = @_;
 150   if ( defined $number ) {
 151     return ${ $self->{_seqs}[$number] }[ID];
 152   } else {
 153     return map { $_->[ID] } @{ $self->{_seqs} };
 154   }
 155 }
 156
 157 =head2 $blc->get_seq_titles($number)
 158
 159 Returns the titles for the number sequence to occur in the file, if left undefined it'll return all of the titles.
 160
 161 =cut
 162
 163 sub get_seq_titles {
 164   my ( $self, $number ) = @_;
 165   if ( defined $number ) {
 166     return ${ $self->{_seqs}[$number] }[TITLE];
 167   } else {
 168     return map { $_->[TITLE] } @{ $self->{_seqs} };
 169   }
 170 }
 171
 172 =head2 $blc->print_blc($fh);
 173
 174 This will print the BLC file object to the filehandle if given, otherwise to STDOUT.
 175
 176 =cut
 177
 178 sub print_blc {
 179   my ( $self, $fh ) = @_;
 180
 181   if   ($fh) { *OUT = $fh }
 182   else       { *OUT = *STDOUT }
 183
 184   # Print the IDs
 185   print OUT ">$_\n" foreach $self->get_seq_ids;
 186
 187   # Get the sequences
 188   #my @sequences = $self->get_sequences
 189   my $i = 0;
 190   while (1) {
 191     my @sequences = $self->get_sequences($i);
 192     last unless defined $sequences[0];
 193     print OUT "* iteration " . ( $i + 1 ) . "\n";
 194     foreach my $j ( 0 .. length( $sequences[0] ) - 1 ) {
 195       foreach (@sequences) {
 196         print OUT substr $_, $j, 1;
 197       }
 198       print OUT "\n";
 199     }
 200     print OUT "*\n";
 201     $i++;
 202   }
 203 }
 204
 205 =head2 $blc->print_fasta($fh)
 206
 207 Prints the BLC file out in FASTA format, each sequence is 72 characters wide.
 208
 209 =cut
 210
 211 sub print_fasta {
 212   my ( $self, $fh ) = @_;
 213
 214   if   ($fh) { *OUT = $fh }
 215   else       { *OUT = *STDOUT }
 216
 217   my @ids       = $self->get_seq_ids;
 218   my @sequences = $self->get_sequences;
 219
 220   croak "Different number of sequences and IDs\n" unless @ids == @sequences;
 221   foreach ( 0 .. $#ids ) {
 222     print OUT ">$ids[$_]\n";
 223     $sequences[$_] =~ s/(.{72})/$1\n/g;
 224     print OUT "$sequences[$_]\n";
 225   }
 226 }
 227
 228 =head2 $blc->next_itteration;
 229
 230 =cut
 231
 232 sub next_itteration {
 233   my ($self) = @_;
 234   $self->itteration( $self->itteration + 1 );
 235 }
 236
 237 =head2 $blc->next_itteration;
 238
 239 =cut
 240
 241 sub max_itteration {
 242   my ($self) = @_;
 243   return $self->{_max_itteration};
 244 }
 245
 246 =head2 $blc->itteration($number)
 247
 248 If $number is defined, sets the itteration to $number, otherwise returns the number of itterations.
 249
 250 =cut
 251
 252 sub itteration {
 253   my ( $self, $itteration ) = @_;
 254   if ( defined $itteration ) {
 255     if ( $itteration < 1 ) {
 256       return undef;
 257     }
 258   } else {
 259     return $self->{_itteration};
 260   }
 261 }
 262
 263 1;