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