← Back to branch summary

~ubuntu-branches/ubuntu/trusty/bioperl/trusty-proposed

« back to all changes in this revision

Viewing changes to Bio/Restriction/IO/prototype.pm

  • Committer: Bazaar Package Importer
  • Author(s): Charles Plessy
  • Date: 2009-03-10 07:19:11 UTC
  • mfrom: (1.2.3 upstream)
  • Revision ID: james.westby@ubuntu.com-20090310071911-fukqzw54pyb1f0bd
Tags: 1.6.0-2
https://launchpad.net/bugs/324001
* Removed patch system (not used):
  - removed instuctions in debian/rules;
  - removed quilt from Build-Depends in debian/control.
* Re-enabled tests:
  - uncommented test command in debian/rules;
  - uncommented previously missing build-dependencies in debian/control.
  - Re-enabled tests and uncommented build-dependencies accordingly.
* Removed libmodule-build-perl and libtest-harness-perl from
  Build-Depends-Indep (provided by perl-modules).
* Better cleaning of empty directories using find -type d -empty -delete
  instead of rmdir in debian/rules (LP: #324001).

Show diffs side-by-side

added added

removed removed

Lines of Context:
Bio/Restriction/IO/prototype.pm
 
1
# $Id: prototype.pm 14572 2008-02-29 05:52:03Z cjfields $
 
2
#
 
3
# BioPerl module for Bio::Restriction::IO::prototype
 
4
#
 
5
# Cared for by Chris Fields 
 
6
#
 
7
# Copyright Chris Fields
 
8
#
 
9
# You may distribute this module under the same terms as perl itself
 
10
 
 
11
# POD documentation - main docs before the code
 
12
 
 
13
=head1 NAME
 
14
 
 
15
Bio::Restriction::IO::prototype - prototype enzyme set
 
16
 
 
17
=head1 SYNOPSIS
 
18
 
 
19
Do not use this module directly.  Use it via the Bio::Restriction::IO class.
 
20
 
 
21
=head1 DESCRIPTION
 
22
 
 
23
This is a parser for the proto/neo file REBASE format, which contains
 
24
prototype information as well as (in the neo file) neoschizomer data.
 
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 Reporting Bugs
 
38
 
 
39
Report bugs to the Bioperl bug tracking system to help us keep track
 
40
the bugs and their resolution.  Bug reports can be submitted via the
 
41
web:
 
42
 
 
43
  http://bugzilla.open-bio.org/
 
44
 
 
45
=head1 AUTHOR
 
46
 
 
47
Rob Edwards, redwards@utmem.edu
 
48
 
 
49
=head1 CONTRIBUTORS
 
50
 
 
51
Heikki Lehvaslaiho, heikki-at-bioperl-dot-org
 
52
 
 
53
=head1 APPENDIX
 
54
 
 
55
The rest of the documentation details each of the object
 
56
methods. Internal methods are usually preceded with a _
 
57
 
 
58
=cut
 
59
 
 
60
# Let the code begin...
 
61
 
 
62
package Bio::Restriction::IO::prototype;
 
63
 
 
64
use vars qw(%WITH_REFM_FIELD);
 
65
use strict;
 
66
 
 
67
#use Bio::Restriction::IO;
 
68
use Bio::Restriction::Enzyme;
 
69
use Bio::Restriction::EnzymeCollection;
 
70
 
 
71
use Data::Dumper;
 
72
 
 
73
use base qw(Bio::Restriction::IO::base);
 
74
 
 
75
=head2 read
 
76
 
 
77
 Title   : read
 
78
 Usage   : $renzs = $stream->read
 
79
 Function: reads all the restrction enzymes from the stream
 
80
 Returns : a Bio::Restriction::Restriction object
 
81
 Args    : none
 
82
 
 
83
=cut
 
84
 
 
85
sub read {
 
86
    my $self = shift;
 
87
    my $coll = Bio::Restriction::EnzymeCollection->new(-empty => 1);
 
88
    my ($seentop, $last_type);
 
89
    while (defined (my $line = $self->_readline)) {
 
90
        chomp $line;
 
91
        next unless $line;
 
92
        if ($line =~ /TYPE\s+(I)+/) {
 
93
            $last_type = $1;
 
94
            $seentop ||= 1;
 
95
            next;
 
96
        }
 
97
        next unless $seentop;
 
98
        my @data = split /\s+/,$line,2;
 
99
        next if $data[0] =~ /^[-\s]*$/;
 
100
        # neo
 
101
        my ($enzyme, $is_neo, $is_proto, $site);
 
102
        if ($data[0] =~ /^\s+(\S+)\s+(\S+)/) {
 
103
            ($enzyme, $site, $is_proto, $is_neo) = ($1, $2, 0, 1);
 
104
        } else {
 
105
            ($enzyme, $site, $is_proto, $is_neo) = ($data[0], $data[1], 1, 0);
 
106
        }
 
107
        $site =~ s/\s+//g;
 
108
        
 
109
        my $precut;
 
110
        if ($site =~ m/^\((\d+\/\d+)\)[RYATGCN]+/) {
 
111
            $precut=$1;
 
112
            $site =~ s/\($precut\)//;
 
113
        }
 
114
        
 
115
        my ($cut, $comp_cut);
 
116
        ($site, $cut, $comp_cut) = $self->_cuts_from_site($site);
 
117
        
 
118
        my $re = Bio::Restriction::Enzyme->new(
 
119
            -type => $last_type,
 
120
            -site => $site,
 
121
            -name => $enzyme,
 
122
            -is_prototype => $is_proto,
 
123
            -is_neoschizomer => $is_neo);
 
124
        
 
125
        if ($cut) {
 
126
            $re->cut($self->_coordinate_shift_to_cut(length($site), $cut));
 
127
            $re->complementary_cut($self->_coordinate_shift_to_cut(length($site), $comp_cut));
 
128
        }
 
129
        $coll->enzymes($re);
 
130
    }
 
131
    return $coll->enzymes;
 
132
}
 
133
 
 
134
=head2 write
 
135
 
 
136
 Title   : write
 
137
 Usage   : $stream->write($renzs)
 
138
 Function: writes restriction enzymes into the stream
 
139
 Returns : 1 for success and 0 for error
 
140
 Args    : a Bio::Restriction::Enzyme
 
141
           or a Bio::Restriction::EnzymeCollection object
 
142
 
 
143
=cut
 
144
 
 
145
sub write {
 
146
    my ($self,@h) = @_;
 
147
    $self->throw_not_implemented;
 
148
}
 
149
 
 
150
1;