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