use Bio::Tools::RestrictionEnzyme;

  ## Create a new object by name.

  $re1 = Bio::Tools::RestrictionEnzyme->new(-NAME =>'EcoRI');

  ## Create a new object using special syntax
  ## which specifies the enzyme name, recognition site, and cut position.
  ## Used for enzymes not known to this module.

  $re2 = Bio::Tools::RestrictionEnzyme->new(-NAME =>'EcoRV--GAT^ATC', 
                                            -MAKE =>'custom');

  ## Get a list of the resulting fragments when a sequence is cut with
  ## the given enzyme. The method expects a Bio::Seq object.

  @fragments = $re2->cut_seq($seqobj);

  ## Get a list of names of all available restriction enzymes 
  ## known to this module.

  @all = $re->available_list();

  ## Get the names of restriction enzymes that have 6 bp 
  ## recognition sequences.

  @sixcutters = $re->available_list(6);

    $re_n  = Bio::Tools::RestrictionEnzyme->new(-name=>'N--NNNNN',
                                                -make=>'custom');

     -name => 'N--NNNNNNNNNN'

#---------------
    my($class, @args) = @_;
    my $self = $class->SUPER::new(@args);
    $self->warn("Use of Bio::Tools::RestrictionEnzyme is deprecated".
                   "Use Bio::Restriction classes instead");
    my ($name,$make) = $self->_rearrange([qw(NAME MAKE)],@args);

    $name && $self->name($name);
    my %data;
    if(defined $make && $make eq 'custom') {
	%data = $self->_make_custom($name); 
    } else {
	%data = $self->_make_standard($name);
    }
    $self->{'_seq'} = new Bio::PrimarySeq(%data, 
				   -VERBOSE =>$self->verbose,
 				   -alphabet => 'dna',
				   );
    return $self;

#------------------
    my($self, $name) = @_;

    $name =~ s/^\s+|\s+$//g;
 
    $self->is_available($name) || 
	$self->throw("Unavailable or undefined enzyme: $name (Note: CASE SENSITIVE)\n" .
		     "Currently available enzymes:\n @RE_available\n");

    my @data = split( ' ', $RE{$name});
    my (%dat);
    $dat{-SEQ} = $data[0];
    $dat{-NAME} = $dat{-ID}= $name;    
    $self->{'_cuts_after'} = $data[1];

    return %dat;

#-----------------
    my($self, $name) = @_;

    $name =~ s/\s+//g;
    my @parts  = split '--', $name;
    my (%dat);
    $dat{-NAME} = $dat{-ID} = $parts[0];
    $self->name($parts[0]);  ## Reset name

    $parts[1] || return $self->throw("Undefined recognition site for $parts[0].",
				      "Use this syntax: EcoRV--GAT^ATC");
    ## Determine the cuts_after point.
    my $cut_index = index $parts[1], '^';
    if( $cut_index <0) { $cut_index = 0;
			 $self->warn("Unknown cut position for $parts[0]. Assuming position 0\n" . 
				     "Use carat to specify cut position (e.g., G^AATTC)"); }
    $self->{'_cuts_after'} =  $cut_index;

    ## Save the recognition sequence after removing the '^'
    $parts[1] =~ s/\^//g;
    $dat{-SEQ} = $parts[1];
    return %dat;

 #---------------
    my $self = shift; 
    if(@_) { my $num = shift;
	     if($num == 0 and $num ne '0') {
		 $self->throw("The cuts_after position be an integer ($num)");
	     }
	     $self->{'_cuts_after'} = $num;
	 }
    $self->{'_cuts_after'};

#---------
    my $self = shift;
    my $seq = $self->seq;
    my $cuts_after = $self->cuts_after;
    if($cuts_after > 0) {
	if( $cuts_after >= $seq->length) {
	    return $seq->seq.'^';
	} else { 
	    return $seq->subseq(1, $self->cuts_after).'^'.$seq->subseq($self->cuts_after+1, $seq->length); 
	}
    } else {
        return $seq->seq;
    }

  my $self = shift; $self->{'_seq'};

  my $self = shift; $self->{'_seq'}->seq;

  my $self = shift; $self->{'_seq'}->revcom->seq();

#-------------
    my( $self, $seqObj) = @_;
    if( !ref($seqObj) || 
	! $seqObj->isa('Bio::PrimarySeqI') ) {
	$self->throw( "Can't cut sequence. Missing or invalid object".
		      "seqObj: $seqObj");
    }

    my $cuts_after = $self->{'_cuts_after'};
    my ($site_3prime_seq, $site_5prime_seq);
    my $reSeq = $self->seq;
    if($cuts_after == 0) {
	$site_3prime_seq = '';
	$site_5prime_seq = $reSeq->seq();
    } elsif($cuts_after == $reSeq->length) {
	$site_3prime_seq = $reSeq->seq();
	$site_5prime_seq = '';
    } else {
	$site_3prime_seq = $reSeq->subseq(1, $self->{'_cuts_after'});
	$site_5prime_seq = $reSeq->subseq($self->{'_cuts_after'}+1, $reSeq->length);
    }

    $self->debug("3' site: $site_3prime_seq\n5' site: $site_5prime_seq\n");

    my(@re_frags);
    my $seq = uc $self->_expanded_string;

    if(!$self->palindromic and $self->name ne 'N') {
	my $revseq = $self->_expanded_string( $reSeq->revcom->seq() );
	$seq .= '|'.uc($revseq);
    }
    $self->debug(__PACKAGE__, ": site seq: $seq\n");
    $self->debug(__PACKAGE__, ": splitting ", $reSeq->seq, "\n");
    @re_frags = split(/$seq/i, $seqObj->seq);

    $self->debug(__PACKAGE__, ": cut_seq, ", scalar(@re_frags), " fragments.\n");

    ## Re-attach the split recognition site back to the frags
    ## since perl zapped them in the split() call.
    my($i);
    my $numFrags = scalar @re_frags;
    for($i=0; $i<$numFrags; $i++) {
        $i < $#re_frags  and $re_frags[$i] = $re_frags[$i].$site_3prime_seq;
        $i > 0           and $re_frags[$i] = $site_5prime_seq.$re_frags[$i];
    }
    @re_frags;

#-----------------
    my($self, $seqobj) = @_;

    my $site = $self->_expanded_string;
    my $seq = $seqobj->seq;
    study($seq);
    my @locations;
    while( $seq =~ /($site)/ig ) {
        # $` is preceding string before pattern so length returns position
	push @locations, length($`); 	
    }
    return\@ locations;

    my ($self, $str) = @_;
    
    $str ||= $self->string;

    if( $self->name ne 'N' ) {
        $str =~ s/N|X/\./g;
        $str =~ s/R/\[AG\]/g;
        $str =~ s/Y/\[CT\]/g;
        $str =~ s/S/\[GC\]/g;
        $str =~ s/W/\[AT\]/g;
        $str =~ s/M/\[AC\]/g;
        $str =~ s/K/\[TG\]/g;
        $str =~ s/B/\[CGT\]/g;
        $str =~ s/D/\[AGT\]/g;
        $str =~ s/H/\[ACT\]/g;
        $str =~ s/V/\[ACG\]/g;
    }
    return $str;

#-----------------
    my($self, $seqObj) = @_;

    my $site = $self->_expanded_string;
    my $seq = $seqObj->seq;

    $seq =~ s|$site|<b>$site</b>|g;
    return $seq;

#----------------
    my $self = shift;
    $self->string eq $self->revcom;

#----------------
    my($self,$name) = @_;
    exists $RE{$name};

#--------------
    my($self,$name) = @_;
    $self->warn('available() is deprecated; use is_available() instead');
    $self->is_available($name);

   my ($obj,$value) = @_;
   if( defined $value) {
      $obj->{'name'} = $value;
    }
    return $obj->{'name'};

#-------------------
    my($self,$size) = @_;
    $size ||= 'all';

    $size eq 'all' and return @RE_available;

    my(@data, @names);
    foreach (@RE_available) {
	@data = split /\s/, $RE{$_};
	if(length $data[0] == $size) {
	    push @names, $_;
	}
    }
    @names;

  bioperl-l@bioperl.org                  - General discussion
  http://bioperl.org/wiki/Mailing_lists  - About the mailing lists

  http://bugzilla.open-bio.org/