Bio/Restriction/IO/prototype.pm

   1 #
   2 # BioPerl module for Bio::Restriction::IO::prototype
   3 #
   4 # Please direct questions and support issues to <bioperl-l@bioperl.org>
   5 #
   6 # Cared for by Chris Fields
   7 #
   8 # Copyright Chris Fields
   9 #
  10 # You may distribute this module under the same terms as perl itself
  11
  12 # POD documentation - main docs before the code
  13
  14 =head1 NAME
  15
  16 Bio::Restriction::IO::prototype - prototype enzyme set
  17
  18 =head1 SYNOPSIS
  19
  20 Do not use this module directly.  Use it via the Bio::Restriction::IO class.
  21
  22 =head1 DESCRIPTION
  23
  24 This is a parser for the proto/neo file REBASE format, which contains
  25 prototype information as well as (in the neo file) neoschizomer data.
  26
  27 =head1 FEEDBACK
  28
  29 =head2 Mailing Lists
  30
  31 User feedback is an integral part of the evolution of this and other
  32 Bioperl modules. Send your comments and suggestions preferably to the
  33 Bioperl mailing lists Your participation is much appreciated.
  34
  35   bioperl-l@bioperl.org                  - General discussion
  36   http://bioperl.org/wiki/Mailing_lists  - About the mailing lists
  37
  38 =head2 Support
  39
  40 Please direct usage questions or support issues to the mailing list:
  41
  42 I<bioperl-l@bioperl.org>
  43
  44 rather than to the module maintainer directly. Many experienced and
  45 reponsive experts will be able look at the problem and quickly
  46 address it. Please include a thorough description of the problem
  47 with code and data examples if at all possible.
  48
  49 =head2 Reporting Bugs
  50
  51 Report bugs to the Bioperl bug tracking system to help us keep track
  52 the bugs and their resolution.  Bug reports can be submitted via the
  53 web:
  54
  55   https://github.com/bioperl/bioperl-live/issues
  56
  57 =head1 AUTHOR
  58
  59 Rob Edwards, redwards@utmem.edu
  60
  61 =head1 CONTRIBUTORS
  62
  63 Heikki Lehvaslaiho, heikki-at-bioperl-dot-org
  64
  65 =head1 APPENDIX
  66
  67 The rest of the documentation details each of the object
  68 methods. Internal methods are usually preceded with a _
  69
  70 =cut
  71
  72 # Let the code begin...
  73
  74 package Bio::Restriction::IO::prototype;
  75
  76 use vars qw(%WITH_REFM_FIELD);
  77 use strict;
  78
  79 use Bio::Restriction::Enzyme;
  80 use Bio::Restriction::EnzymeCollection;
  81
  82 use Data::Dumper;
  83
  84 use base qw(Bio::Restriction::IO::base);
  85
  86 =head2 read
  87
  88  Title   : read
  89  Usage   : $renzs = $stream->read
  90  Function: reads all the restrction enzymes from the stream
  91  Returns : a Bio::Restriction::Restriction object
  92  Args    : none
  93
  94 =cut
  95
  96 sub read {
  97     my $self = shift;
  98     my $coll = Bio::Restriction::EnzymeCollection->new(-empty => 1);
  99     my ($seentop, $last_type);
 100     while (defined (my $line = $self->_readline)) {
 101         chomp $line;
 102         next unless $line;
 103         if ($line =~ /TYPE\s+(I)+/) {
 104             $last_type = $1;
 105             $seentop ||= 1;
 106             next;
 107         }
 108         next unless $seentop;
 109         my @data = split /\s+/,$line,2;
 110         next if $data[0] =~ /^[-\s]*$/;
 111         # neo
 112         my ($enzyme, $is_neo, $is_proto, $site);
 113         if ($data[0] =~ /^\s+(\S+)\s+(\S+)/) {
 114             ($enzyme, $site, $is_proto, $is_neo) = ($1, $2, 0, 1);
 115         } else {
 116             ($enzyme, $site, $is_proto, $is_neo) = ($data[0], $data[1], 1, 0);
 117         }
 118         $site =~ s/\s+//g;
 119
 120         my $precut;
 121         if ($site =~ m/^\((\d+\/\d+)\)[RYATGCN]+/) {
 122             $precut=$1;
 123             $site =~ s/\($precut\)//;
 124         }
 125
 126         my ($cut, $comp_cut);
 127         ($site, $cut, $comp_cut) = $self->_cuts_from_site($site);
 128
 129         my $re = Bio::Restriction::Enzyme->new(
 130             -type => $last_type,
 131             -site => $site,
 132             -name => $enzyme,
 133             -is_prototype => $is_proto,
 134             -is_neoschizomer => $is_neo);
 135
 136         if ($cut) {
 137             $re->cut($self->_coordinate_shift_to_cut(length($site), $cut));
 138             $re->complementary_cut($self->_coordinate_shift_to_cut(length($site), $comp_cut));
 139         }
 140         $coll->enzymes($re);
 141     }
 142     return $coll->enzymes;
 143 }
 144
 145 =head2 write
 146
 147  Title   : write
 148  Usage   : $stream->write($renzs)
 149  Function: writes restriction enzymes into the stream
 150  Returns : 1 for success and 0 for error
 151  Args    : a Bio::Restriction::Enzyme
 152            or a Bio::Restriction::EnzymeCollection object
 153
 154 =cut
 155
 156 sub write {
 157     my ($self,@h) = @_;
 158     $self->throw_not_implemented;
 159 }
 160
 161 1;