File Coverage

Bio/Restriction/IO/base.pm

Criterion	Covered	Total	%
statement	68	105	64.7
branch	11	32	34.3
condition	8	24	33.3
subroutine	12	18	66.6
pod	4	4	100.0
total	103	183	56.2

#
# BioPerl module for Bio::Restriction::IO::base
#
# Please direct questions and support issues to
#
# Cared for by Rob Edwards
#
# Copyright Rob Edwards
#
# You may distribute this module under the same terms as perl itself
#

# POD documentation - main docs before the code

=head1 NAME

Bio::Restriction::IO::base - base enzyme set

=head1 SYNOPSIS

Do not use this module directly.  Use it via the Bio::Restriction::IO class.

=head1 DESCRIPTION


This class defines some base methods for restriction enzyme input and
at the same time gives a base list of common enzymes.

=head1 FEEDBACK

=head2 Mailing Lists

User feedback is an integral part of the evolution of this and other
Bioperl modules. Send your comments and suggestions preferably to the
Bioperl mailing lists Your participation is much appreciated.

  [e-mail]                  - General discussion
  http://bioperl.org/wiki/Mailing_lists  - About the mailing lists

=head2 Support

Please direct usage questions or support issues to the mailing list:

I

rather than to the module maintainer directly. Many experienced and
reponsive experts will be able look at the problem and quickly
address it. Please include a thorough description of the problem
with code and data examples if at all possible.

=head2 Reporting Bugs

Report bugs to the Bioperl bug tracking system to help us keep track
the bugs and their resolution.  Bug reports can be submitted via the
web:

  https://github.com/bioperl/bioperl-live/issues

=head1 AUTHOR

Rob Edwards, [e-mail]

=head1 CONTRIBUTORS

Heikki Lehvaslaiho, heikki-at-bioperl-dot-org
Mark A. Jensen, maj-at-fortinbras-dot-us

=head1 APPENDIX

The rest of the documentation details each of the object
methods. Internal methods are usually preceded with a _

=cut

# Let the code begin...

package Bio::Restriction::IO::base;

use strict;

use Bio::Restriction::Enzyme;
use Bio::Restriction::EnzymeCollection;
use Bio::Restriction::Enzyme::MultiCut;
use Bio::Restriction::Enzyme::MultiSite;

use base qw(Bio::Restriction::IO);

my $offset; # class variable

sub new {
    my($class, @args) = @_;
    $class = ref $class ? ref $class : $class;
    my $self = bless {}, $class;
    $self->_initialize(@args);
    return $self;
}


{

my %FILE_FORMAT = (
            #'itype2'    => 'itype2', # itype2 format doesn't work with 'current'
            #'8'         => 'itype2',
            'withrefm'  => 'withrefm',
            '31'        => 'withrefm',
            #'bairoch'   => 'bairoch', # bairoch format doesn't work with 'current'
            #'19'        => 'bairoch',
            #'macvector' => 'bairoch',
            #'vectorNTI' => 'bairoch',
            'neo'       => 'neos',
            'prototype' => 'proto'
);

sub _initialize {
    my($self,@args) = @_;
    my ($current, $url, $file, $fh, $format, $verbose) =
        $self->_rearrange([qw(CURRENT URL FILE FH FORMAT VERBOSE)],@args);
    $verbose || 0;
    $self->verbose($verbose);
    if ($current && $format) {
        $self->throw("Can't use -current with file, fh, or url set")  if ($url || $file || $fh);
        $self->throw("Format $format not retrievable using 'current'") if (!exists $FILE_FORMAT{$format});
        my $io = $self->new(-url => 'ftp://ftp.neb.com/pub/rebase/VERSION');
        chomp (my $version = $io->_readline);
        push @args, (-url => "ftp://ftp.neb.com/pub/rebase/$FILE_FORMAT{$format}.$version", -retries => 1);
    }

    $self->_companies;
    return unless $self->SUPER::_initialize(@args);
}

}

=head2 read

 Title   : read
 Usage   : $renzs = $stream->read
 Function: reads all the restrction enzymes from the stream
 Returns : a Bio::Restriction::Restriction object
 Args    : none

=cut

sub read {
    my $self = shift;

    my $renzs = Bio::Restriction::EnzymeCollection->new(-empty => 1);
    seek DATA,($offset||=tell DATA), 0;
    while () {
        chomp;
        next if /^\s*$/;
        my ($name, $site, $cut) = split /\s+/;
        my $re = Bio::Restriction::Enzyme->new(-name => $name,
                                              -site => $site,
                                              -cut => $cut);
        $renzs->enzymes($re);
    }
    return $renzs;
}

=head2 _xln_sub

 Title   : _xln_sub
 Function: Translates withrefm coords to Bio::Restriction coords
 Args    : Bio::Restriction::Enzyme object, scalar integer (cut posn)
 Note    : Used internally; pass as a coderef to the B:R::Enzyme
           constructor
 Note    : It is convenient for each format module to have its own
           version of this; not currently demanded by the interface.
=cut

sub _xln_sub { # for base.pm, a no-op
    my ($z,$c) = @_;
    return $c;
}


=head2 write

 Title   : write
 Usage   : $stream->write($renzs)
 Function: writes restriction enzymes into the stream
 Returns : 1 for success and 0 for error
 Args    : a Bio::Restriction::Enzyme
           or a Bio::Restriction::EnzymeCollection object

=cut

sub write {
    my $self = shift;
    foreach (@_) {
        map { printf "%s\t%s\t%s\n", $_->name, $_->string, $_->cut
          } sort {$a->name cmp $b->name} $_->each_enzyme
            if $_->isa('Bio::Restriction::EnzymeCollection');
        printf "%s\t%s\t%s\n", $_->name, $_->string, $_->cut
            if $_->isa('Bio::Restriction::Enzyme');
    }
}

=head2 verify_prototype

 Title     : verify_prototype
 Purpose   : checks enzyme against current prototype list (retrieved remotely)
 Returns   : returns TRUE if enzyme is prototype
 Argument  : Bio::Restriction::EnzymeI
 Comments  : This is an auxiliary method to retrieve and check an enzyme
             as a prototype.  It retrieves the current list, stores it
             as a singleton instance, then uses it to check the prototype
             and modify is_prototype() to true or false.  Use as follows:

             my $col = $io->read;
             for my $enz ($col->each_enzyme) {
                 print $enz->name.":".$enz->site."\n";
                 print "\t".$io->verify_prototype($enz)."\n";
             }

=cut

my $protodb;

sub verify_prototype {
    my ($self, $enz) = @_;
    $self->throw("Must pass a Bio::Restriction::EnzymeI") unless
        $enz && ref $enz && $enz->isa("Bio::Restriction::EnzymeI");
    if (!defined $protodb) {
        my $io = Bio::Restriction::IO->new(-format => 'prototype',
                      -current => 1);
        $protodb = $io->read;
    }
    if ($protodb->get_enzyme($enz->name)) {
        $enz->is_prototype(1);
    } else {
        $enz->is_prototype(0);
    }
    $enz->is_prototype;
}

=head2 Common REBASE parsing methods

The rest of the methods in this file are to be used by other REBASE
parsers. They are not to be used outside subclasses of this base
class. (They are 'protected' in the sense the word is used in Java.)

=cut

=head2 _cuts_from_site

 Title   : _cuts_from_site
 Usage   : ($site, $cut, $comp_cut) = _cuts_from_site('ACGCGT(4/5)');
 Function: Separates cut positions from a single site string.
           Does nothing to site if it does not have the cut string
 Returns : array of site_string, forward_cut_position, reverse_cut_position
 Args    : recognition site string
 Note    : Not used in withrefm refactor/maj

=cut

sub _cuts_from_site {
    my ($self, $site) = @_;
    my ($cut, $comp_cut) = $site =~ /\((-?\d+)\/(-?\d+)\)/;
    $site =~ s/\(.*\)$//;
    return ($site, $cut, $comp_cut);
}


=head2 _meth

 Title   : _meth
 Usage   : ($pos, $meth) = $self->_meth('2(5)');
 Function: Separates methylation position and coce from a string.
           Adjusts the position depending on enzyme site length
           and symmetry
 Returns : array of position and methylation code
 Args    : 1. reference to Enzyme object
           2. methylation description string

=cut

sub _meth {
    my ($self, $re, $meth) = @_;

    $meth =~ /(\S+)\((\d+)\)/;
    my ($pos, $m) = ($1, $2);
    $pos = 0 if $pos eq '?';
    $pos = $re->seq->length + $pos if $pos and ! $re->palindromic;
    return ($pos, $m);

    $self->warn("Unknown methylation format [$meth]") if $self->verbose >0;
}


=head2 _coordinate_shift_to_cut

 Title   : _coordinate_shift_to_cut
 Usage   : $cut = $self->_coordinate_shift_to_cut($oricut, offset);
 Function: Adjust cut position coordinates to start from the
           first nucleotides of site
 Returns : Cut position in correct coordinates
 Args    : 1. Original cut position
           2. Length of the recognition site
 Note    : Not used in withrefm.pm refactor/maj

=cut

sub _coordinate_shift_to_cut {
    my ($self, $cut, $site_length) = @_;
    return $cut + $site_length;
}


=head2 _make_multisites

 Title   : _make_multisites
 Usage   : $self->_make_multisites($first_enzyme, \@sites, \@mets)
 Function: Bless a Bio::Restriction::Enzyme  into
           Bio::Restriction::Enzyme::MultiSite and clone it as many
           times as there are alternative sites.
 Returns : nothing, does in place editing
 Args    : 1. a Bio::Restriction::Enzyme
           2. reference to an array of recognition site strings
           3. reference to an array of methylation code strings, optional

=cut

# removed the enzyme collection from arg list /maj

sub _make_multisites {
    my ($self, $re, $sites, $meths, $xln_sub) = @_;

    bless $re, 'Bio::Restriction::Enzyme::MultiSite';

    my $count = 0;
    while ($count < scalar @{$sites}) {
	# this should probably be refactored to use the constructor
	# too, rather than the clone/accessor method /maj
#        my $re2 = $re->clone;
#	my $re2;

        my $site = @{$sites}[$count];
	my ($precut, $recog, $postcut) = ( $site =~ m/^(?:\((\w+\/\w+)\))?([\w^]+)(?:\((\w+\/\w+)\))?/ );

	# set the site attribute
#	$re2->site($recog);

	# set the recog attribute (which will make the regexp transformation
	# if necessary:
#	$re2->recog($recog);
#	$recog = $re2->string;

# 	no warnings; # avoid 'uninitialized value' warning against $postcut
#         my ($cut, $comp_cut) = ( $postcut =~  /(-?\d+)\/(-?\d+)/ );
# 	use warnings;

	# note the following hard codes the coordinate transformation
	# used for rebase/itype2 : this method will break on the
	# base.pm format.
#         if ($cut) {
#             $re2->cut($cut + length $recog);
#             $re2->complementary_cut($comp_cut + length $recog);
# 	}

	my $re2 = Bio::Restriction::Enzyme::MultiSite->new(
	    -name     => $re->name,
	    -site     => $recog,
	    -recog    => $recog,
	    -precut   => $precut,
	    -postcut  => $postcut,
	    -xln_sub  => $xln_sub
	    );

        if ($meths and @$meths) {
            $re2->purge_methylation_sites;
            $re2->methylation_sites($self->_meth($re2, @{$meths}[$count]));
        }

        $re->others($re2);
        $count++;
    }

    foreach my $enz ($re->others) {
        $enz->others($re, grep {$_ ne $enz} $re->others);
    }

    1;
}

=head2 _make_multicuts

 Title   : _make_multicuts
 Usage   : $self->_make_multicuts($first_enzyme, $precuts)
 Function:

           Bless a Bio::Restriction::Enzyme into
           Bio::Restriction::Enzyme::MultiCut and clone it. The precut
           string is processed to replase the cut sites in the cloned
           object. Both objects refer to each other through others() method.

 Returns : nothing, does in place editing
 Args    : 1. a Bio::Restriction::Enzyme
           2. precut string, e.g. '12/7'


The examples we have of multiply cutting enzymes cut only four
times. This protected method deals only with a string of two
integers separated with a slash, e.g. '12/7'. The numbers represent the positions
BEFORE the start of the recognition site, i.e. negative positions.

=cut

# removed the enzyme collection from arg list /maj

sub _make_multicuts {
    my ($self, $re, $precut) = @_;

    bless $re, 'Bio::Restriction::Enzyme::MultiCut';

    my ($cut, $comp_cut) = $precut =~ /(-?\d+)\/(-?\d+)/;

    my $re2 = $re->clone;

    $re2->cut("-$cut");
    $re2->complementary_cut("-$comp_cut");

    $re->others($re2);

    1;
}

=head2 _companies

 Title     : _companies
 Purpose   : Defines the companies that we know about
 Returns   : A hash
 Argument  : Nothing
 Comments  : An internal method to define the companies that we know about
             REBASE uses a code, and this converts the code to the real name
	     (e.g. A = Amersham Pharmacia Biotech)

=cut

sub _companies {
    # this is just so it is easy to set up the codes that REBASE uses
    my $self=shift;
    my %companies=(
                   'A'=>'Amersham Pharmacia Biotech (1/03)',
                   'C'=>'Minotech Biotechnology (6/01)',
                   'E'=>'Stratagene (1/03)',
                   'F'=>'Fermentas AB (1/03)',
                   'G'=>'Qbiogene (1/03)',
                   'H'=>'American Allied Biochemical, Inc. (10/98)',
                   'I'=>'SibEnzyme Ltd. (1/03)',
                   'J'=>'Nippon Gene Co., Ltd. (6/00)',
                   'K'=>'Takara Shuzo Co. Ltd. (1/03)',
                   'M'=>'Roche Applied Science (1/03)',
                   'N'=>'New England Biolabs (1/03)',
                   'O'=>'Toyobo Biochemicals (11/98)',
                   'P'=>'Megabase Research Products (5/99)',
                   'Q'=>'CHIMERx (1/03)',
                   'R'=>'Promega Corporation (1/03)',
                   'S'=>'Sigma Chemical Corporation (1/03)',
                   'U'=>'Bangalore Genei (1/03)',
                   'V'=>'MRC-Holland (1/03)',
                   'X'=>'EURx Ltd. (1/03)');
    $self->{company}=\%companies;
}

1;

__DATA__