Bio/Restriction/IO/itype2.pm

   1 # BioPerl module for Bio::Restriction::IO::itype2
   2 #
   3 # Please direct questions and support issues to <bioperl-l@bioperl.org>
   4 #
   5 # Cared for by Rob Edwards <redwards@utmem.edu>
   6 #
   7 # Copyright Rob Edwards
   8 #
   9 # You may distribute this module under the same terms as perl itself
  10 #
  11
  12 # POD documentation - main docs before the code
  13
  14 =head1 NAME
  15
  16 Bio::Restriction::IO::itype2 - itype2 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 tab delimited, entry per line format which is fast to process.
  25
  26 =head1 FEEDBACK
  27
  28 =head2 Mailing Lists
  29
  30 User feedback is an integral part of the evolution of this and other
  31 Bioperl modules. Send your comments and suggestions preferably to the
  32 Bioperl mailing lists Your participation is much appreciated.
  33
  34   bioperl-l@bioperl.org                  - General discussion
  35   http://bioperl.org/wiki/Mailing_lists  - About the mailing lists
  36
  37 =head2 Support
  38
  39 Please direct usage questions or support issues to the mailing list:
  40
  41 I<bioperl-l@bioperl.org>
  42
  43 rather than to the module maintainer directly. Many experienced and
  44 reponsive experts will be able look at the problem and quickly
  45 address it. Please include a thorough description of the problem
  46 with code and data examples if at all possible.
  47
  48 =head2 Reporting Bugs
  49
  50 Report bugs to the Bioperl bug tracking system to help us keep track
  51 the bugs and their resolution.  Bug reports can be submitted via the
  52 web:
  53
  54   https://github.com/bioperl/bioperl-live/issues
  55
  56 =head1 AUTHOR
  57
  58 Rob Edwards, redwards@utmem.edu
  59
  60 =head1 CONTRIBUTORS
  61
  62 Heikki Lehvaslaiho, heikki-at-bioperl-dot-org
  63 Mark A. Jensen, maj-at-fortinbras-dot-us
  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::itype2;
  75
  76 use strict;
  77
  78 use Bio::Restriction::Enzyme;
  79 use Bio::Restriction::EnzymeCollection;
  80
  81 use Data::Dumper;
  82
  83 use base qw(Bio::Restriction::IO::base);
  84
  85 =head2 read
  86
  87  Title   : read
  88  Usage   : $renzs = $stream->read
  89  Function: reads all the restrction enzymes from the stream
  90  Returns : a Bio::Restriction::IO object
  91  Args    : none
  92
  93 Internally creates a hash of enzyme information which is passed on to
  94 L<Bio::Restriction::Enzyme::new>.
  95
  96 =cut
  97
  98 sub read {
  99     my $self = shift;
 100
 101     my $renzs = Bio::Restriction::EnzymeCollection->new(-empty => 1);
 102
 103     # read until start of data
 104     while (defined( my $line = $self->_readline()) ) {
 105         next if $line =~ /^[ R]/;
 106         $self->_pushback($line);
 107         last;
 108     }
 109
 110     # enzyme name [tab] prototype [tab] recognition sequence with
 111     # cleavage site [tab] methylation site and type [tab] commercial
 112     # source [tab] references
 113
 114     while (defined(my $line = $self->_readline()) ) {
 115         $self->debug($line);
 116         chomp $line;
 117
 118         my ($name, $prototype, $site, $meth, $vendor, $refs) = split /\t/, $line;
 119         # we need mininum name and site
 120         unless ($site) {
 121             $self->warn("Can not parse line with name [$name]") if $self->verbose > 0;
 122             next;
 123         }
 124         next unless $name;
 125
 126 #         # four cut enzymes are not in this format
 127 #         my $precut;
 128 #         if ($site =~ m/^\((\d+\/\d+)\)[ATGCN]+/) {
 129 #             $precut=$1;
 130 #             $site =~ s/\($precut\)//;
 131 #         }
 132         # -------------- cut ---------------
 133
 134         # this regexp now parses all possible components
 135         # $1 : (s/t) or undef
 136         # $2 : [site]
 137         # $3 : (m/n) or undef /maj
 138
 139         my ($precut, $recog, $postcut) = ( $site =~ m/^(?:\((\w+\/\w+)\))?([\w^]+)(?:\((\w+\/\w+)\))?/ );
 140
 141
 142         my @sequences;
 143         if ($site =~ /\,/) {
 144             @sequences = split( /\,/, $site);
 145             $site=shift @sequences;
 146         }
 147
 148         #
 149         # prototype
 150         #
 151
 152         # presence of a name means the prototype isoschizomer, absence means
 153         # this enzyme is the prototype
 154         my $is_prototype = ($prototype ? 1 : 0);
 155
 156
 157         #
 158         # vendors
 159         #
 160         my @vendors;
 161             @vendors = ( split / */, $vendor) if $vendor;
 162
 163         #
 164         # references
 165         #
 166         my @refs;
 167         @refs = map {split /\n+/} $refs if $refs;
 168
 169         # when enz is constructed, site() will contain original characters,
 170         # but recog() will contain a regexp if required.../maj
 171
 172         my $re = Bio::Restriction::Enzyme->new(
 173             -name          => $name,
 174             -site          => $recog,
 175             -recog         => $recog,
 176             -precut        => $precut,
 177             -postcut       => $postcut,
 178             -is_prototype  => $is_prototype,
 179             -prototype     => $prototype,
 180             -vendors       => [@vendors],
 181             -references    => [@refs],
 182             -xln_sub       => \&_xln_sub
 183             );
 184
 185         #
 186         # methylation
 187         #
 188         # [easier to set here during parsing than in constructor] /maj
 189         my @meths;
 190         if ($meth) {
 191             # this can be either X(Y) or X(Y),X2(Y2)
 192             # where X is the base and y is the type of methylation
 193             if ( $meth =~ /(\S+)\((\d+)\),(\S+)\((\d+)\)/ ) { # two msites per site
 194                 #my ($p1, $m1, $p2, $m2) = ($1, $2, $3, $4);
 195                 $re->methylation_sites($self->_meth($re,$1, $2),
 196                                        $self->_meth($re,$3,$4));
 197             }
 198             elsif ($meth =~ /(\S+)\((\d+)\)/ ) { # one msite per site or more sites
 199                 #print Dumper $meth;
 200                 $re->methylation_sites( $self->_meth($re,$1,$2) );
 201                 @meths = split (/, /, $meth);
 202                 $meth=shift @meths;
 203             } else {
 204                 $self->warn("Unknown methylation format [$meth]") if $self->verbose >0;
 205             }
 206         }
 207
 208         #
 209         # create special types of Enzymes
 210         #
 211         $self->_make_multisites( $re, \@sequences, \@meths) if @sequences;
 212         $renzs->enzymes($re);
 213
 214
 215     }
 216
 217     return $renzs;
 218 }
 219
 220 =head2 _xln_sub
 221
 222  Title   : _xln_sub
 223  Function: Translates withrefm coords to Bio::Restriction coords
 224  Args    : Bio::Restriction::Enzyme object, scalar integer (cut posn)
 225  Note    : Used internally; pass as a coderef to the B:R::Enzyme
 226            constructor
 227
 228 =cut
 229
 230 sub _xln_sub {
 231     my ($z,$c) = @_;
 232     return ($c < 0 ? $c : length($z->string)+$c);
 233 }
 234
 235 =head2 write
 236
 237  Title   : write
 238  Usage   : $stream->write($renzs)
 239  Function: writes restriction enzymes into the stream
 240  Returns : 1 for success and 0 for error
 241  Args    : a Bio::Restriction::Enzyme
 242            or a Bio::Restriction::EnzymeCollection object
 243
 244 =cut
 245
 246 sub write {
 247     my ($self,@h) = @_;
 248     $self->throw_not_implemented;
 249 }
 250
 251 1;