← Back to branch summary

~ubuntu-branches/ubuntu/raring/bioperl/raring

« back to all changes in this revision

Viewing changes to Bio/Structure/SecStr/DSSP/Res.pm

  • Committer: Bazaar Package Importer
  • Author(s): Charles Plessy
  • Date: 2008-03-18 14:44:57 UTC
  • mfrom: (4 hardy)
  • mto: This revision was merged to the branch mainline in revision 6.
  • Revision ID: james.westby@ubuntu.com-20080318144457-1jjoztrvqwf0gruk
http://bugs.debian.org/448890
* debian/control:
  - Removed MIA Matt Hope (dopey) from the Uploaders field.
    Thank you for your work, Matt. I hope you are doing well.
  - Downgraded some recommended package to the 'Suggests' priority,
    according to the following discussion on Upstream's mail list.
    http://bioperl.org/pipermail/bioperl-l/2008-March/027379.html
    (Closes: #448890)
* debian/copyright converted to machine-readable format.

Show diffs side-by-side

added added

removed removed

Lines of Context:
Bio/Structure/SecStr/DSSP/Res.pm
1
 
# $id $
 
1
# $Header: /home/repository/bioperl/bioperl-live/Bio/Structure/SecStr/DSSP/Res.pm,v 1.10.4.3 2006/10/02 23:10:31 sendu Exp $
2
2
#
3
3
# bioperl module for Bio::Structure::SecStr::DSSP::Res.pm
4
4
#
113
113
Bioperl modules. Send your comments and suggestions preferably to one
114
114
of the Bioperl mailing lists.  Your participation is much appreciated.
115
115
 
116
 
  bioperl-l@bioperl.org          - General discussion
117
 
  http://bio.perl.org/MailList.html             - About the mailing lists
 
116
  bioperl-l@bioperl.org                  - General discussion
 
117
  http://bioperl.org/wiki/Mailing_lists  - About the mailing lists
118
118
 
119
119
=head2 Reporting Bugs
120
120
 
121
121
Report bugs to the Bioperl bug tracking system to help us keep track
122
 
the bugs and their resolution.  Bug reports can be submitted via email
123
 
or the web:
 
122
the bugs and their resolution.  Bug reports can be submitted via the
 
123
web:
124
124
 
125
 
  bioperl-bugs@bio.perl.org
126
 
  http://bugzilla.bioperl.org/
 
125
  http://bugzilla.open-bio.org/
127
126
 
128
127
=head1 AUTHOR - Ed Green
129
128
 
139
138
 
140
139
package Bio::Structure::SecStr::DSSP::Res;
141
140
use strict;
142
 
use vars qw(@ISA);
143
 
use Bio::Root::Root;
144
141
use Bio::Root::IO;
145
142
use Bio::PrimarySeq;
146
143
 
147
 
@ISA = qw(Bio::Root::Root);
 
144
use base qw(Bio::Root::Root);
148
145
 
149
146
# Would be a class variable if Perl had them
150
147
 
399
396
 Title         : resAA
400
397
 Usage         : fetches the 1 char amino acid code, given an id
401
398
 Function      :
402
 
 Example       : $aa = $dssp_obj->aminoAcid( '20:A' ); # pdb id as arg
 
399
 Example       : $aa = $dssp_obj->resAA( '20:A' ); # pdb id as arg
403
400
 Returns       : 1 character scalar string
404
401
 Args          : RESIDUE_ID
405
402
 
842
839
}
843
840
 
844
841
 
 
842
=head2 residues
 
843
 
 
844
    Title : residues
 
845
    Usage : returns array of residue identifiers for all residues in
 
846
    the output file, or in a specific chain
 
847
    Function :
 
848
    Example : @residues_ids = $dssp_obj->residues()
 
849
    Returns : array of residue identifiers
 
850
    Args : if none => returns residue ids of all residues of all
 
851
    chains (in order); if chain id is given, returns just the residue
 
852
    ids of residues in that chain
 
853
 
 
854
 
 
855
=cut
 
856
 
 
857
# Can't use the standard interface for getting the amino acid,
 
858
# pdb_resnum, etc. in this method because we don't *know* the residue
 
859
# indentifiers - we are building a list of them.
 
860
sub residues {
 
861
    my $self  = shift;
 
862
    my $chain = shift;
 
863
    my @residues;
 
864
    my $num_res = $self->_numResLines();
 
865
    my $aa;
 
866
    for ( my $i = 1; $i <= $num_res; $i++ ) {
 
867
        # find what character was in the slot for tha amino acid code,
 
868
        # if it's a '!' we know this is not a *real* amino acid, it's
 
869
        # a chain discontinuity marker 
 
870
        $aa = $self->{ 'Res' }->[ $i ]->{ 'amino_acid' };
 
871
        if ( $aa ne '!' ) {
 
872
            if ( !$chain ||
 
873
                 $chain eq $self->{ 'Res' }->[ $i ]->{ 'pdb_chain' } ) {
 
874
                push( @residues, 
 
875
                      $self->{ 'Res' }->[ $i ]->{ 'pdb_resnum' }.
 
876
                      $self->{ 'Res' }->[ $i ]->{ 'insertionco' }.
 
877
                      ":".
 
878
                      $self->{ 'Res' }->[ $i ]->{ 'pdb_chain' } );
 
879
            }
 
880
        }
 
881
    }
 
882
    return @residues;
 
883
}
 
884
 
 
885
 
845
886
=head2 getSeq
846
887
 
847
888
 Title         : getSeq
892
933
            push( @frags, $pot_chain );
893
934
        }
894
935
    }
895
 
 
 
936
    
896
937
    # if that didn't work, just get the first one
897
938
    if ( !( @frags ) ) {
898
939
        $chain = $contSegs_pnt->[ 0 ]->[ 2 ];
899
940
        foreach $pot_chain ( @{ $contSegs_pnt } ) {
900
941
            if ( $pot_chain->[ 2 ] eq $chain ) {
901
 
                push( @frags, $chain );
 
942
                push( @frags, $pot_chain );
902
943
            }
903
944
        }
904
945
    }
1165
1206
    # Now find the residue which fits this description.  Linear search is
1166
1207
    # probably not the best way to do this, but oh well...
1167
1208
    for ( my $i = 1; $i <= $self->_numResLines(); $i++ ) {
1168
 
        if ( $key_num == $self->{'Res'}->[$i]->{'pdb_resnum'} ) {
1169
 
            if ( $chain_id ) { # if a chain was specified
1170
 
                if ( $chain_id eq $self->{'Res'}->[$i]->{'pdb_chain'} ) {
1171
 
                    # and it's the right one
1172
 
                    if ( $ins_code ) { # if insertion code was specified
1173
 
                        if ( $ins_code eq $self->{'Res'}->[$i]->{'insertionco'} ) {
1174
 
                            # and it's the right one
 
1209
        unless ( ($self->{'Res'}->[$i]->{'term_sig'} eq '*') ||
 
1210
                 ($self->{'Res'}->[$i]->{'amino_acid'} eq '!') ) {
 
1211
            # chain break 'residue', doesn't match anything
 
1212
            if ( $key_num == $self->{'Res'}->[$i]->{'pdb_resnum'} ) {
 
1213
                if ( $chain_id ) { # if a chain was specified
 
1214
                    if ( $chain_id eq $self->{'Res'}->[$i]->{'pdb_chain'} ) {
 
1215
                        # and it's the right one
 
1216
                        if ( $ins_code ) { # if insertion code was specified
 
1217
                            if ( $ins_code eq $self->{'Res'}->[$i]->{'insertionco'} ) {
 
1218
                                # and it's the right one
 
1219
                                return $i;
 
1220
                            }
 
1221
                        }
 
1222
                        else { # no isertion code specified, this is it
1175
1223
                            return $i;
1176
1224
                        }
1177
1225
                    }
1178
 
                    else { # no isertion code specified, this is it
1179
 
                        return $i;
1180
 
                    }
1181
 
                }
1182
 
            }
1183
 
            else { # no chain was specified
1184
 
                return $i;
 
1226
                }
 
1227
                else { # no chain was specified
 
1228
                    return $i;
 
1229
                }
1185
1230
            }
1186
1231
        }
1187
1232
    }
1216
1261
        return;
1217
1262
    }
1218
1263
 
 
1264
    # REFERENCE line (always there)
1219
1265
    $cur = <$file>;
1220
1266
    ( $element ) = ( $cur =~ /^REFERENCE\s+(.+?)\s+\./ );
1221
1267
    $head{ 'REFERENCE' } = $element;
1222
1268
 
1223
1269
    $cur = <$file>;
1224
 
    @elements = split( /\s+/, $cur );
1225
 
    pop( @elements ); # take off that annoying period
1226
 
    $head{ 'PDB' } = pop( @elements );
1227
 
    $head{ 'DATE' } = pop( @elements );
1228
 
    # now, everything else is "header" except for the word
1229
 
    # HEADER
1230
 
    shift( @elements );
1231
 
    $element = shift( @elements );
1232
 
    while ( @elements ) {
1233
 
        $element = $element." ".shift( @elements );
1234
 
    }
1235
 
    $head{ 'HEADER' } = $element;
1236
 
 
1237
 
    $cur = <$file>;
1238
 
    ($element) = ( $cur =~ /^COMPND\s+(.+?)\s+\./ );
1239
 
    $head{ 'COMPND' } = $element;
1240
 
 
1241
 
    $cur = <$file>;
1242
 
    ($element) = ( $cur =~ /^PDBSOURCE\s+(.+?)\s+\./ );
1243
 
    $head{ 'SOURCE' } = $element;
1244
 
 
1245
 
    $cur = <$file>;
1246
 
    ($element) = ( $cur =~ /^AUTHOR\s+(.+?)\s+/ );
1247
 
    $head{ 'AUTHOR' } = $element;
1248
 
        
1249
 
    $cur = <$file>;
 
1270
    # Check for HEADER line (not always there)
 
1271
    if ( $cur =~ /^HEADER\s/ ) {
 
1272
        @elements = split( /\s+/, $cur );
 
1273
        pop( @elements ); # take off that annoying period
 
1274
        $head{ 'PDB' } = pop( @elements );
 
1275
        $head{ 'DATE' } = pop( @elements );
 
1276
        # now, everything else is "header" except for the word
 
1277
        # HEADER
 
1278
        shift( @elements );
 
1279
        $element = shift( @elements );
 
1280
        while ( @elements ) {
 
1281
            $element = $element." ".shift( @elements );
 
1282
        }
 
1283
        $head{ 'HEADER' } = $element;
 
1284
        
 
1285
        $cur = <$file>;
 
1286
    }
 
1287
 
 
1288
    # Check for COMPND line (not always there)
 
1289
    if ( $cur =~ /^COMPND\s/ ) {
 
1290
        ($element) = ( $cur =~ /^COMPND\s+(.+?)\s+\./ );
 
1291
        $head{ 'COMPND' } = $element;
 
1292
        
 
1293
        $cur = <$file>;
 
1294
    }
 
1295
 
 
1296
    # Check for SOURCE or PDBSOURCE line (not always there)
 
1297
    if ( $cur =~ /^PDBSOURCE\s/ ) {
 
1298
        ($element) = ( $cur =~ /^PDBSOURCE\s+(.+?)\s+\./ );
 
1299
        $head{ 'SOURCE' } = $element;
 
1300
        
 
1301
        $cur = <$file>;
 
1302
    }
 
1303
 
 
1304
    elsif ( $cur =~ /^SOURCE\s/ ) {
 
1305
        ($element) = ( $cur =~ /^SOURCE\s+(.+?)\s+\./ );
 
1306
        $head{ 'SOURCE' } = $element;
 
1307
        
 
1308
        $cur = <$file>;
 
1309
    }
 
1310
 
 
1311
    # Check for AUTHOR line (not always there)
 
1312
    if ( $cur =~ /^AUTHOR/ ) {
 
1313
        ($element) = ( $cur =~ /^AUTHOR\s+(.+?)\s+/ );
 
1314
        $head{ 'AUTHOR' } = $element;
 
1315
 
 
1316
        $cur = <$file>;
 
1317
    }
 
1318
 
 
1319
    # A B C D E TOTAL NUMBER OF RESIDUES, NUMBER ... line
1250
1320
    @elements = split( /\s+/, $cur );
1251
1321
    shift( @elements );
1252
1322
    $head{ 'TotNumRes' } = shift( @elements );
1276
1346
        }
1277
1347
    }
1278
1348
 
1279
 
    while ( chomp( $cur = <$file> ) ) {
 
1349
    while ( $cur = <$file> ) {
 
1350
        if ( $cur =~ m/^\s*$/ ) {
 
1351
            next;
 
1352
        }
1280
1353
        $res_num = substr( $cur, 0, 5 );
1281
1354
        $res_num =~ s/\s//g;
1282
1355
        $self->{ 'Res' }->[ $res_num ] = &_parseResLine( $cur );
1315
1388
    return \%elements;
1316
1389
}
1317
1390
 
1318
 
return 1; #just because
 
1391
1;
1319
1392