jpred/lib/DSSP.pm

   1 package DSSP;
   2
   3 use strict;
   4 use warnings;
   5 use Carp;
   6 use IO::String;
   7 use UNIVERSAL qw(isa);
   8
   9 use base qw(Root Read);
  10
  11 =head1 DSSP
  12
  13 Object to hold some of the information found in a DSSP file.
  14
  15 =head2 my $dssp = DSSP->new;
  16
  17 Creates new object. Any accessor method is valid to use as an argument in a hash key/value set of pairs.
  18
  19 =head2 $dssp->read($string);
  20
  21 Reads in the DSSP file contained within the $string. Returns true if it there is information in the file, otherwise false.
  22
  23 =cut
  24
  25 sub read {
  26         my ($self, $data) = @_;
  27
  28         defined $data or croak "No filehandle passed\n";
  29         local $/ = "\n";
  30         my $flag = 0; # Test to see if there's any information in the file
  31
  32         while (<$data>) {
  33                 if (/^  #  RESIDUE AA STRUCTURE/) {
  34                         $flag = 1;
  35                         my $chain;
  36
  37                         while (<$data>) {
  38                                 chomp;
  39                                 my $aa_pri = substr($_, 13, 1);
  40
  41                                 # Chain break, has to come here in order to remember what the
  42                                 # chain was
  43                                 if ($aa_pri eq '!') {
  44                                         $self->add_position(
  45                                                 DSSP::Position->new(
  46                                                         chain => $chain,
  47                                                         break => 1
  48                                                 )
  49                                         );
  50                                         next;
  51                                 }
  52
  53                                 # If there isn't a chain break, continue as normal
  54                                 my $aa_sec = substr($_, 16, 1);
  55                                 my $aa_acc = substr($_, 35, 3);
  56                                 $chain = substr($_, 11, 1);
  57
  58                                 # Field is six wide to include alternatives, but I'm ignoring
  59                                 # those
  60                                 my $pos = substr($_, 5, 6);
  61                                 my $seq_pos = substr($_, 0, 5);
  62
  63                                 # Replace empty chain defn with NULL
  64                                 $chain = 'NULL' if $chain eq ' ';
  65
  66                                 # Replace lower case letters (cystine
  67                                 # bridge pairs) with 'c'
  68                                 $aa_pri =~ tr/[a-z]/c/;
  69
  70                                 $aa_sec =~ tr/ /-/;
  71
  72                                 # Remove any padding whitespace
  73                                 for ($aa_pri, $aa_sec, $aa_acc, $chain, $pos, $seq_pos) {
  74                                         s/ //g
  75                                 }
  76
  77                                 $self->add_position(
  78                                         DSSP::Position->new(
  79                                                 chain => $chain,
  80                                                 pri => $aa_pri,
  81                                                 sec => $aa_sec,
  82                                                 acc => $aa_acc,
  83                                                 off => $pos,
  84                                                 seq_off => $seq_pos,
  85                                                 break => undef
  86                                         )
  87                                 );
  88                         }
  89                 }
  90         }
  91         return $flag;
  92 }
  93
  94 =head2 $dssp->add_position($DSSP::Position);
  95
  96 Adds a position object.
  97
  98 =cut
  99
 100 sub add_position {
 101         my ($self, $pos) = @_;
 102
 103         unless (defined $pos and isa $pos, 'DSSP::Position') {
 104                 croak "No object passed"
 105         }
 106
 107         my ($chain, $offset);
 108
 109         defined($chain = $pos->chain) or croak "Chain not set\n";
 110         unless ($pos->break) {
 111                 defined($offset = $pos->off) or croak "Offset not set\n";
 112         }
 113
 114         # Use a stack based system now
 115         push @{ $self->{__PACKAGE__."pos"}{$chain} }, $pos;
 116
 117         # This is for backwards compatibility, shudder, also required changes in
 118         # get_position() and position()
 119         unless ($pos->break) {
 120                 $self->{__PACKAGE__."offset_compat"}{offset}{$chain}{$offset} = \$self->{__PACKAGE__."pos"}{$chain}->[ -1 ];
 121
 122                 if (exists $self->{__PACKAGE__."pos"}{offset}{$chain}{$offset}) {
 123                         my $out = "Overwriting DSSP position $offset in chain $chain";
 124                         $out .= $self->path ? " for file ".$self->path."\n" : "\n";
 125                         warn $out;
 126                 }
 127         }
 128
 129         # Add the chain if not already present
 130         my @chains = grep { defined } $self->chains;
 131         unless (grep { $chain eq $_ } @chains) {
 132                 $self->chains(@chains, $chain);
 133         }
 134 }
 135
 136 =head2 $DSSP::Position = $dssp->get_chain_defs($chain)
 137
 138 New method to replace get_position() and positions(). Returns all of the DSSP::Position objects for a particular chain in the order they are seen in the DSSP file. Then you have to decide what to do with them.
 139
 140 =cut
 141
 142 sub get_chain_defs {
 143         my ($self, $chain) = @_;
 144
 145         croak "Chain not recognised" unless grep { $_ eq $chain } $self->chains;
 146
 147         return @{ $self->{__PACKAGE__."pos"}{$chain} };
 148 }
 149
 150 =head2 $DSSP::Position = $dssp->get_position($chain, $offset)
 151
 152 Depricated! Don't use this methods as it's broken, it's available for backwards compatibility.
 153
 154 Returns the position object for a particular location.
 155
 156 =cut
 157
 158 sub get_position {
 159         my ($self, $chain, $offset) = @_;
 160
 161         unless (defined $chain) { croak "No chain given" }
 162         unless (defined $offset) { croak "No offset given" }
 163
 164         confess("No such chain '$chain'") and return unless exists $self->{__PACKAGE__."pos"}{$chain};
 165
 166         confess("No such offset $offset in chain $chain") and return
 167                 #unless exists $self->{__PACKAGE__."pos"}{$chain};
 168                 unless exists $self->{__PACKAGE__."offset_compat"}{offset}{$chain}{$offset};
 169
 170         return ${ $self->{__PACKAGE__."offset_compat"}{offset}{$chain}{$offset} };
 171 }
 172
 173 =head2 $DSSP::Position = $dssp->positions($chain);
 174
 175 Depricated! Don't use this methods as it's broken, it's available for backwards compatibility.
 176
 177 Returns all the offsets that are available for a particular chain, sorted by offset.
 178
 179 =cut
 180
 181 sub positions {
 182         my ($self, $chain) = @_;
 183
 184         unless (defined $chain) { croak "No chain given" }
 185
 186         croak "No such chain $chain" unless exists $self->{__PACKAGE__."pos"}{$chain};
 187
 188         no warnings;
 189         return
 190                 map { join "", @{$_} }
 191                 sort { $a->[0] <=> $b->[0] || $a->[1] cmp $b->[1] }
 192                 map { [ /^(-?\d+)(\D+)?$/ ] }
 193                 #keys %{$self->{__PACKAGE__."pos"}{$chain}};
 194                 keys %{$self->{__PACKAGE__."offset_compat"}{offset}{$chain}};
 195 }
 196
 197 =head2 @chains = $dssp->chains;
 198
 199 Finds the chains in the structure, or alters them, but don't do that. Returns an empty list if no chains have been found.
 200
 201 =cut
 202
 203 sub chains {
 204         my ($self, @chains) = @_;
 205         if (@chains) { @{$self->{__PACKAGE__."chains"}} = @chains }
 206         elsif ($self->{__PACKAGE__."chains"}) {
 207                 return @{ $self->{__PACKAGE__."chains"} };
 208         }
 209         else {
 210                 return ();
 211         }
 212 }
 213
 214 =head1 DSSP::Position
 215
 216 Object to hold information on each position of a DSSP output.
 217
 218 =head2 my $dssp_pos = DSSP::Position->new;
 219
 220 Create a new object.
 221
 222 =head2 Accessors
 223
 224 =over
 225
 226 =item * chain
 227
 228 Holds the chain ID.
 229
 230 =item * pri
 231
 232 Holds the primary structre.
 233
 234 =item * sec
 235
 236 Holds the secondary structre.
 237
 238 =item * acc
 239
 240 Holds the solvent structre.
 241
 242 =item * off
 243
 244 Holds the position in the PDB structure.
 245
 246 =back
 247
 248 =cut
 249
 250 use Class::Struct "DSSP::Position" => {
 251         chain => '$',
 252         pri => '$',
 253         sec => '$',
 254         acc => '$',
 255         off => '$',
 256         seq_off => '$',
 257         break => '$'
 258 };
 259
 260 1;