binaries/src/jpred/lib/DSSP/SCOP.pm

   1 package DSSP::SCOP;
   2
   3 use strict;
   4 use warnings;
   5 use Carp;
   6 use Scalar::Util qw(looks_like_number);
   7
   8 use base qw(DSSP);
   9 use lib '..';
  10 use Utils qw($split_resid sort_resid);
  11
  12 =head1 NAME
  13
  14 DSSP::SCOP - Module to select DSSP records from SCOP description
  15
  16 =head1 SYNOPSIS
  17
  18   my $dssp = DSSP::SCOP->new(read_file => "foo.dssp");
  19   my @range = $dssp->get_range("A:33-416");
  20
  21 =head1 DESCRIPTION
  22
  23 A module that provides a method of selecting a range of residues from a DSSP file. The description of the range is in the format used by SCOP version 1.65 in the dir.des file.
  24
  25 =head1 METHODS
  26
  27 The module inherits all the methods from the DSSP module.
  28
  29 =head2 $dssp->get_range("A:1-200,B:1-30")
  30
  31 Returns the DSSP::Position objects from within the range given. These are in the same order as they are presented in the DSSP file. They are returned as an array of array's, with each range having it's own array.
  32
  33 =cut
  34
  35 sub get_range {
  36   my ( $self, $defn ) = @_;
  37
  38   $defn =~ / / and croak "get_range('$defn') has a space in it, which isn't allowed";
  39   my @ranges = split /,/, $defn;
  40
  41   my @data;
  42   for (@ranges) {
  43     my @range;
  44
  45     # A:1-200 or A:
  46     if (/:/) {
  47       my ( $chain, $range ) = split /:/, $_;
  48
  49       # A:1-200
  50       if ( $range =~ /([[:alnum:]]+)-([[:alnum:]]+)/ ) {
  51         push @data, [ $self->select_positions( $chain, $1, $2 ) ];
  52       }
  53
  54       # Hmmmmm.
  55       elsif ($range) {
  56         confess "You shouldn't be here";
  57       }
  58
  59       # A:
  60       else {
  61         push @data, [ $self->get_chain_defs($chain) ];
  62       }
  63     } else {
  64
  65       # 297-368
  66       if (/([[:alnum:]]+)-([[:alnum:]]+)/) {
  67         my @chains = $self->chains;
  68         if ( @chains > 1 ) {
  69           die "Don't know which chain to select";
  70         }
  71         my ($chain) = @chains;
  72
  73         push @data, [ $self->select_positions( $chain, $1, $2 ) ];
  74       }
  75
  76       # -
  77       elsif (/^-$/) {
  78         for my $chain ( $self->chains ) {
  79           push @data, [ $self->get_chain_defs($chain) ];
  80         }
  81       }
  82
  83       # Otherwise we don't know what it is
  84       else {
  85         confess "Missed particular '$_'";
  86       }
  87     }
  88   }
  89
  90   return @data;
  91 }
  92
  93 =head2 $self->select_positions($chain, $start, $end);
  94
  95 Passed a chain
  96
  97 # Select those, $chain, $start, $end;
  98
  99 =cut
 100
 101 sub select_positions {
 102   my ( $self, $chain, $start, $end ) = @_;
 103
 104   confess "Not passed all arguments" if grep { not defined } $chain, $start, $end;
 105   confess "Not passed a valid chain" unless grep { $_ eq $chain } $self->chains;
 106
 107   my ( $flag, @positions ) = 0;
 108   my $test = sub {
 109     my ( $off, $start, $end ) = @_;
 110     if ( 3 == grep { looks_like_number $_ } $off, $start, $end ) {
 111       return 1 if $off >= $start and $off <= $end;
 112     } else {
 113       return undef;
 114     }
 115   };
 116
 117   for my $pos ( $self->get_chain_defs($chain) ) {
 118     if ( $pos->break ) {
 119       push @positions, $pos if $flag;
 120       next;
 121     }
 122
 123     my $off = $pos->off;
 124     if (
 125       ( $off eq $start or $test->( $off, $start, $end ) ) .. ( $off eq $end or $test->( $off, $start, $end ) )
 126
 127       # $test($off, $start, $end) $off >= $start and $off <= $end)
 128       #($off eq $start or )
 129       )
 130     {
 131       push @positions, $pos;
 132       $flag = 1;
 133     } else {
 134       $flag = 0;
 135     }
 136   }
 137   return @positions;
 138 }
 139
 140 1;