# -*-Perl-*- 
#######################################################################
# This software has been created by Genome Research Limited (GRL).    # 
# GRL hereby grants permission to use, copy, modify and distribute    # 
# this software and its documentation for non-commercial purposes     # 
# without fee at the user's own risk on the basis set out below.      #
# GRL neither undertakes nor accepts any duty whether contractual or  # 
# otherwise in connection with the software, its use or the use of    # 
# any derivative, and makes no representations or warranties, express #
# or implied, concerning the software, its suitability, fitness for   #
# a particular purpose or non-infringement.                           #
# In no event shall the authors of the software or GRL be responsible # 
# or liable for any loss or damage whatsoever arising in any way      # 
# directly or indirectly out of the use of this software or its       # 
# derivatives, even if advised of the possibility of such damage.     #
# Our software can be freely distributed under the conditions set out # 
# above, and must contain this copyright notice.                      #
#######################################################################
# 
# Universal package for read name decoding. 
# One read per package object. -- DMH
#

package ReadTypes;
use strict;
use Carp;


############################################################
#
# Construct...
#
############################################################

sub new { 

    my ($this, $read)=@_;

    my $self={};

    bless $self, $this;
    $self->examineRead($read) if $read;
   
    return $self;

}


#########################################################
#
# Examine read name
# 
# 
# Normal case is to have read sequenced from a subclone
# plate which follows naming conventions. E.g:
# 
#    zz52a1.s1t
# 
# Where:
# 
#       zz52  plate name.
#          a  row 
#          1  column
#          .  between this and the end of the string
#             is the suffix.
# 
# Allow also for reads coming straight from non-subclones
# where the read name could be:
# 
#    dJ463A9.1.pcr
# or
#    dJ463A9.2.f1
# 
# Where one cannot determine row or column, take everything
# before the `.' as the "plate" name.
#
#########################################################

sub examineRead {

    my ($this, $read)=@_;
    confess 'Wrong type' unless ref $this;

    # Sanity check that we were not given a null string..
    # 
    if ( ! defined($read) || $read eq '') {
	return 1;
    }

    %$this = ();
    
    $this->{'name'} = $read;

    ############################################################
    # Determine TEMPLATE and SUFFIX
    ############################################################

    if ($read =~ /\./) {
	($this->{'template'},$this->{'suffix'}) = ($`, $');
    }else {
	($this->{'template'},$this->{'suffix'}) = ($read,"");
    }

    ############################################################
    # Decode TEMPLATE into PLATE ROW COLUMN
    ############################################################
    if ( $this->{'template'} =~ /^(\S+)(([a-p])(\d{1,2}))$/ ) {

	$this->{'template-convention'} = "plate-well";
	$this->{'plate'} =$1;
	$this->{'well'} =$2;
	$this->{'row'} =$3;
	$this->{'column'} =$4;

    } else {
	$this->{'template-convention'} = "unknown";
    }

    ############################################################
    # Decode SUFFIX
    ############################################################
    
    if ( $this->{'suffix'} =~ /^([wfpqrs]\d[tdpebcmfnk])(.*)$/ ) {
	$this->{'convention'} = "sanger98";
	$this->{'suffix-convention'} = "sanger98";
	$this->{'seqchem'} = $1;
	($this->{'iteration'},$this->{'other'}) = $2 =~ /^([a-z])?(.*)$/;
	$this->{'strands'}   = $this->{'seqchem'} =~ /^[pqf]/ ? 2 : 1;
	$this->{'primer'}    = $this->{'seqchem'} =~ /^.1/ ? "universal" : "custom";
	$this->{'direction'} = $this->{'seqchem'} =~ /^[sp]/ ? "forward" : "reverse";
	$this->{'dye'}       = $this->{'seqchem'} =~ /^..[tdcfnk]/ ? "terminator" : "primer";
	$this->{'good'}      = 1;
    } elsif ( $this->{'suffix'} =~ /^([srpqf][1-9](?:ll|lt|t|t|l)?)(.*)$/ ) {
	$this->{'convention'} = "sanger-old";
	$this->{'suffix-convention'} = "sanger-old";
	$this->{'seqchem'} = $1;
	($this->{'iteration'},$this->{'other'}) = $2 =~ /^(.)(.*)$/;
	$this->{'strands'}   = $this->{'seqchem'} =~ /^[pqf]/ ? 2 : 1;
	$this->{'primer'}    = $this->{'seqchem'} =~ /^.1/ ? "universal" : "custom";
	$this->{'direction'} = $this->{'seqchem'} =~ /^[sp]/ ? "forward" : "reverse";
	$this->{'dye'}       = $this->{'seqchem'} =~ /^..(t|tl|lt)/ ? "terminator" : "primer";
	$this->{'gel'}       = $this->{'seqchem'} =~ /^..(ll|tl|lt|l)/ ? "long" : "standard";
	$this->{'good'}      = 1;
    } elsif ( $this->{'suffix'} =~ /^(sp6|t3|t7)/) {
	$this->{'convention'} = "est";
	$this->{'suffix-convention'} = "est";
	$this->{'primer'} = "universal";
	$this->{'primername'} = $1;
	$this->{'direction'} = ($this->{'suffix'} =~ /^t7/) ? "reverse" : "forward";
	$this->{'other'} = $';
	$this->{'good'}      = 1;
    } else {
	$this->{'good'}      = 0;
	$this->{'unknown'} = "est";
    }


    $this;

}


####################################################
# showInfo 
# 
# Print info to STDOUT
#
####################################################

sub showInfo {

    my $this=shift;
    confess 'Wrong type' unless ref $this;

    foreach (keys(%{$this})) {
	if (defined $this->{$_}) {
	    print "$_: $this->{$_}\n";
	}
    }

}



####################################################
# getItemInfo
# 
# Get specific value
#
####################################################



sub getItemInfo {

    my ($this, $item) = @_;
    confess 'Wrong type' unless ref $this;

    if (defined($this->{$item})) {
	return $this->{$item};
    }

    return 'unknown';
}


sub get {

    my ($this, $item) = @_;
    confess 'Wrong type' unless ref $this;

    return $this->{$item};
}

############################################################
#
############################################################
sub isGood {
    my ($this) = @_;
    confess 'Wrong type' unless ref $this;
    return $this->{'good'};
}


1;



__END__

=head1 NAME

ReadTypes.pm - Perl Object for parsing read names in standard Sanger Format

=head1 DESCRIPTION

B<ReadTypes.pm> analyses a reading name that conforms to an accepted
Sanger Centre read name convention, and decomposes it into the read
attributes upon which the name is based.

=head2 AUTHOR

B<Simon Dear> Email sd@sanger.ac.uk

=head1 CLASS METHODS

=over 5

=item C<new>

Creates a new ReadTypes object. Optionally, the read name to be
analysed can be passed as the sole argument.

=item C<examineRead>

You can specify a new read name to analyse. The result of the previous
analysis (either by use of this or the new() method) are
lost. Components of the read name are queried through the get() and
getItemInfo() method. Returns the object.

=item C<get>

Returns the value of the read name component. See the
section on Instance variables.

=item C<getItemInfo>

Returns the value of the read name component, or the string 'unknown'
if the value was not able to be determined from the name.

=back

=head1 INSTANCE VARIABLES

When a read name is analysed, any of the following instance variables
may be set.

=over 5

=item C<name>

The name of the read, as passed to new() or to examineRead().
At the Sanger Centre, the naming convention is:

    name ::= template . suffix

Note that template should should never contain a "." character.

=item C<template>

The name of the DNA template from which the read was obtained.
At the Sanger Centre, the naming convention is

    template ::= plate well

=item C<plate>

The name of the microtitre plate containing the template.

=item C<well>

The well location in the microtitre plate that contains the template.

    well ::= row column

=item C<row>

The row letter, in the range a to h, corresponding to the well.

=item C<column>

The column number, in the range 1 to 12, corresponding to the well.

=item C<suffix>

The suffix part of the read name. This holds information about the
location of the sequence data with respect to the template (strand and
primer), and the sequencing chemistry and gel run conditions used.

    suffix = seqchem iteration other

=item C<seqchem>

The sequencing chemistry part of the suffix. This conforms to local
naming conventions, which are decomposed in dye, primer, direction,
gel and strands.

=item C<iteration>

The iteration is a letter a through z, indicating the number of
sequencing tries or retries.

=item C<other>

Any text can follow after iteration.

=item C<dye>

The broad catagorisation between dyet-terminator and -primer
chemistry.

One of {primer, terminator}.

=item C<primer>

Whether a universal (standard reagent) or custom (designer) primer was
used for the sequencing run.

One of {universal, custom}.

=item C<direction>

The strand that was sequenced, relative to some arbitrary end of the
template. 

One of {forward, reverse}.

=item C<gel>

The length of gel (well-to-read) or runtime (in hours.)

One of {standard, long}.

=item C<strands>

Whether the template was single or double stranded.

One of [1,2].

=item C<good>

A boolean value, indicating that whether or not the read name
conformed to a recognised convention.

One of [0,1].

=item C<convention>

The naming convention used for the read name.

One of {sanger98, sanger-old, est, pcr, saint-louis}.

This is now obselete and is replaced by template-convention
and suffix-convention.

=item C<template-convention>

The template naming convention used for the read name.

One of {plate-well, unknown}.

=item C<suffix-convention>

The suffix naming convention used for the read name.

One of {sanger98, sanger-old, est, pcr, saint-louis}.

=item C<chemistry>

***NOT IMPLEMENTED YET***

The name of the chemistry used.

One of {ABI-terminator, dRhodamine-terminator, ABI-primer, ET-primer,
BigBye-primer, BigDye-terminator}.

=item C<description>

***NOT IMPLEMENTED YET***

A full textual description of the sequencing chemistry and gel run
conditions used.

=back


=head1 EXAMPLE

Here is a code fragment that shows ReadTypes.pm in use.

    #! /usr/local/bin/perl

    require ReadTypes;

    $rt = ReadTypes->new();

    $rt->examineRead("22a11b1.s1ba.17");
    
    $rt->showInfo();


When executed, this program outputs the following
information:

    direction: forward
    name: 22a11b1.s1ba.17
    dye: primer
    other: .17
    convention: sanger98
    seqchem: s1b
    good: 1
    column: 1
    primer: universal
    iteration: a
    well: b1
    suffix: s1ba.17
    plate: 22a11
    row: b
    template: 22a11b1
    strands: 1

=head1 HISTORY

 # $Id: ReadTypes.pm,v 1.20 2002/04/08 14:18:41 rmd Exp $
 #
 # $Log: ReadTypes.pm,v $
 # Revision 1.20  2002/04/08  14:18:41  rmd
 # Changed to allow plate columns from a to p, for 384 well support.
 #
 # Revision 1.19  2002/01/08  09:18:24  rmd
 # Added ..k suffix for Big Dye vIII.
 # Moved change log to end.
 #
 # Revision 1.18  1999/06/18  08:12:06  rmd
 # Added ..n suffix for MegaBace ET terminators
 #
 # Revision 1.17  1999/06/09 10:39:16  rmd
 # Added ..f for ET terminator chemistry
 #
 # Revision 1.16  1999/01/13 13:25:35  dn1
 # added f** as an option too !
 #
 # Revision 1.15  1999/01/13  13:04:25  as1
 # Added a w suffix
 #
 # Revision 1.14  1998/10/16  10:12:59  as1
 # Added m suffix to support megabase MD machine
 #
 # Revision 1.13  1998/02/09  18:12:23  sd
 # Switch on for Suffix day!
 #
 # Revision 1.12  1998/02/09  12:15:05  sd
 # Added suffix and template-convention.
 #
 # Revision 1.11  1998/02/04  09:20:59  sd
 # est direction set correctly.
 #
 # Revision 1.10  1998/02/03  18:23:20  sd
 # Deep recursion in get.
 # Documentation wrong.
 #
 # Revision 1.9  1998/02/03  16:41:43  sd
 # New version.
 #
 # Revision 1.8  1997/06/09  13:58:56  rmd
 # Modified checkName so it rejects name where length > 16
 # (GAP does not like them).
 #
 # Revision 1.7  1997/05/01  16:41:43  rmd
 # Changed sub new so that new($name) now works.
 # Added 'use strict', plus a few instances of the word 'my' as a consequence.
 # Added checks to make sure object methods are passed an object reference.
 # Added sub 'checkName' to check the read name against the naming convention.
 # If it matches, the attribute 'good' is set to 1.
 # Added sub 'isGood' as a quick way to find out if the read matched, e.g.
 # die 'Bad name' unless ReadTypes->new($name)->isGood();
 #
 # Revision 1.6  1997/04/24  10:59:57  dn1
 # Added copyright
 #
 # Revision 1.5  1997/04/14  15:33:01  sd
 # New suffix for double stranded templates (.[pq]*)
 #
 # Revision 1.4  1996/07/26  14:10:25  sd
 # Added description of read types.
 #
 # Revision 1.3  1996/06/17  16:27:42  dmh
 # Changed naming convention for reads of clones.
 #
 # Revision 1.2  1996/06/17  10:57:09  dmh
 # Added support for samples not from subcloned plate
 # Dual contruction added.
 #
 # Revision 1.1  1996/05/01  10:03:18  badger
 # Initial revision
 #
 #
