#!/usr/local/bin/perl
# -*-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.                      #
#######################################################################
# 
# $Id: AssemblyDB.pm,v 1.19 1999/12/02 09:26:47 rmd Exp $
# $Log: AssemblyDB.pm,v $
# Revision 1.19  1999/12/02 09:26:47  rmd
# Now use new oracle parallel server
#
# Revision 1.18  1998/07/24 14:33:04  rmd
# Added countReadsForAllPlates and countReadsForPlate
#
# Revision 1.17  1998/07/23  15:26:19  rmd
# Added updateProcessStatus and updateAnalysed.
#
# Revision 1.16  1998/07/10  13:30:35  rmd
# Changed to use new database server for all projects.
#
# Revision 1.15  1998/06/29  13:39:03  rmd
# Bodge to aid transfer to new database server
#
# Revision 1.14  1998/06/25  16:03:35  rmd
# Changes to try and shrink memork used by ADBgetFasta
#
# Revision 1.13  1997/11/13  12:37:53  rmd
# Added getSchemas function
#
# Revision 1.12  1997/10/15  14:12:05  rmd
# Added table extent sizes.
# Fixed bug so that missing plate names are caught properly.
#
# Revision 1.11  1997/10/13  11:29:24  rmd
# Used OS authentication again
#
# Revision 1.10  1997/10/04  16:35:50  rmd
# Changed to work with new database instance.
# Added select on various sequences to roles.
#
# Revision 1.9  1997/07/21  08:28:12  rmd
# Fixed masked "my" variable.
#
# Revision 1.8  1997/07/08  09:14:21  rmd
# Added multiGetReadInfo, multiGetSeqInfo.
# Improved getRawFasta
#
# Revision 1.7  1997/07/03  09:03:04  rmd
# Added SCFDIRS to @aspTables in makeRoles
#
# Revision 1.6  1997/06/25  15:02:33  rmd
# Added functions for getting fasta data & some process stats.
#
# Revision 1.5  1997/06/16  17:19:28  rmd
# Improved error message given when plate not in database
# Changed SCF file lookup so it is faster with small CAF files and full directories.
#
# Revision 1.4  1997/06/10  16:41:11  rmd
# Added environment variable setting code.  This will have to be changed if Oracle moves (Oh, dear.)
# Also added a check to make sure the oracle directory exists.  If it doesn't, the program will fail
# early, rather than when the database is first accessed.
#
# Revision 1.3  1997/06/09  16:33:39  rmd
# glob is weird.
#
# Revision 1.2  1997/06/09  16:28:43  rmd
# Flushed SCF directory cache whenever insertRawCaf is called (otherwise asp doesn't work).
#
# Revision 1.1  1997/06/09  15:43:19  rmd
# Initial revision
#
#
BEGIN {
    # $ENV{ORAHOME} = "/nfs/app/oraclep";
    # $ENV{ORACLE_HOME} = "$ENV{ORAHOME}/product/7.3.2";
    # $ENV{ORACLE_SID} = "path";
    # $ENV{LD_LIBRARY_PATH} = "$ENV{ORACLE_HOME}/bin:$ENV{ORACLE_HOME}/obackup/bin:$ENV{LD_LIBRARY_PATH}";
    # $ENV{PATH} = "$ENV{PATH}:$ENV{ORACLE_HOME}/bin";
    die "Can't locate Oracle directory '$ENV{ORACLE_HOME}'\n" unless (-e $ENV{ORACLE_HOME});
}

package AssemblyDB;

use Carp;
use Oraperl;
use Caftools;
use DirHandle;
use Uncovered;
use Exporter ();

@ISA = qw(Exporter);

use strict;

sub new {
    my $type = shift;
    my %params = @_;
    my $self = {};
    $self->{user} = $params{user};
    $self->{password} = $params{password};
    # $self->{user} = $params{user} ? $params{user} : "OPS\$$ENV{USER}";
    # $self->{password} = $params{password} ? $params{password} : $self->{user};
    unless ($ENV{ORACLE_SID}) { $self->{system_id} = "sids.world"; }

    ####################### Hard-code this for a while
    $self->{system_id} = "cas2";
    ##################################################

    $self->{schema} = $params{schema};
    $self->{lda} = &Oraperl::ora_login($self->{system_id}, $self->{user}, $self->{password});
    $self->{verbose} = $params{verbose};
    die "Couldn't connect user $self->{user} to database $self->{system_id}\nReason: $Oraperl::ora_errstr\n" unless ($self->{lda});
    &Oraperl::ora_autocommit($self->{lda}, 0);

    $self->{templatesByName} = {};
    $self->{plateInfoCache} = {};
    $self->{cloneIdCache} = {};
    $self->{projIdCache} = {};
    $self->{dirSearchList} = {};
    $self->{dirGlobs} = {};
    $self->{dirCache} = {};

    return bless $self, $type;
}

sub DESTROY {
    my $self = shift;
    confess "Wrong type" unless ref($self);
    &Oraperl::ora_close($self->{csr}) if (defined($self->{cda}));
    if (defined($self->{changed})) {
	unless (&Oraperl::ora_rollback($self->{lda})) {
	    die "Couldn't roll back transaction\nReason: $Oraperl::ora_errstr\n";
	}
    }
    &Oraperl::ora_logoff($self->{lda}) if (defined($self->{lda}));
}

sub _makeCursor {
    my $self = shift;
    confess "Wrong type" unless ref($self);
    $self->{changed} = 1;    
    my ($sql, $cache) = @_;
    &Oraperl::ora_close($self->{csr}) if ($self->{csr});
    $self->{csr} = &Oraperl::ora_open($self->{lda}, $sql, $cache);
    croak "Could not open cursor\nReason: $Oraperl::ora_errstr\nSql: $sql\n" unless($self->{csr});
}

sub _killCursor {
    my $self = shift;
    confess "Wrong type" unless ref($self);
    &Oraperl::ora_close($self->{csr}) if ($self->{csr});
    undef $self->{csr};
}

sub _bind {
    my $self = shift;
    confess "Wrong type" unless ref($self);
    confess "Tried to do a bind on an unopened cursor" unless ($self->{csr});
    $self->{changed} = 1;
    #warn "Binding: @_\n";
    &Oraperl::ora_bind($self->{csr}, @_);
    croak "Failed to bind variables to SQL command\nReason: $Oraperl::ora_errstr\nBinding: @_\n" if ($Oraperl::ora_errno);
}

sub _bind_param {
    my ($self, $paramNum, $value, $attrib) = @_;
    confess "Wrong type" unless ref($self);
    confess "Tried to do a bind on an unopened cursor" unless ($self->{csr});
    $self->{changed} = 1;
    $self->{csr}->bind_param($paramNum, $value, $attrib);
    croak "Failed to bind variable to SQL command\nReason: $Oraperl::ora_errstr\n" if ($Oraperl::ora_errno);
}

sub _fetch {
    my $self = shift;
    confess "Wrong type" unless ref($self);
    confess "Tried to do a fetch on an unopened cursor" unless ($self->{csr});
    my $trunc = shift;
    return &Oraperl::ora_fetch($self->{csr});
}

sub _doSql {
    my $self = shift;
    confess "Wrong type" unless ref($self);
    $self->{changed} = 1;
    my ($sql) = @_;
    if (!&Oraperl::ora_do($self->{lda}, $sql)) {
	croak "Sql command failed\nReason: $Oraperl::ora_errstr\nSql: $sql\n";
    }
}

sub _getHash {
    my $self = shift;
    confess "Wrong type" unless ref($self);
    my ($sql, $valNames, $cache) = @_;
    my $hash = {};
    my $key;
    my @values;
    $self->_makeCursor($sql, $cache);
    while (@values = $self->_fetch()) {
	$key = shift(@values);
	$hash->{$key} = {};
	my $name;
	foreach $name (@{$valNames}) {
	    $hash->{$key}->{$name} = shift(@values);
	}
    }
    croak "Error during database fetch\nReason: $Oraperl::ora_errstr\nSql: $sql\n" if ($Oraperl::ora_errno);
    $self->_killCursor();
    return $hash;
}

sub _getArray {
    my $self = shift;
    confess "Wrong type" unless ref($self);
    my ($sql, $valNames, $cache) = @_;
    my $array = [];
    my @values;
    $self->_makeCursor($sql, $cache);
    while (@values = $self->_fetch()) {
	my $name;
	my $arrayEntry = {};
	foreach $name (@{$valNames}) {
	    $arrayEntry->{$name} = shift(@values);
	}
	push(@{$array}, $arrayEntry);
    }
    croak "Error during database fetch\nReason: $Oraperl::ora_errstr\nSql: $sql\n" if ($Oraperl::ora_errno);
    $self->_killCursor();
    return $array;
}

sub _readLong {
    my ($self, $field) = @_;
    my $long = "";
    my $length = 2048;
    my $segLen = $length;
    my $offset = 0;
    $Oraperl::ora_errno = 0;
    while ((!$Oraperl::ora_errno || $Oraperl::ora_errno == 1406) && $segLen >= $length) {
	my $segment = $self->{csr}->blob_read($field, $offset, $length);
	$segLen = length($segment);
	$offset += $segLen;
	$long .= $segment;
    }
    return $long;
}

sub _getLong {
    my ($self, $sql, $field) = @_;
    #$Oraperl::ora_trunc = 1;
    $self->_makeCursor($sql, 1);
    my $long = $self->_readLong($field);
    $self->_killCursor();
    return $long;
}

sub _getSequenceVal {
    my $self = shift;
    confess "Wrong type" unless ref($self);
    my ($sequenceName) = @_;
    $self->_makeCursor("select $self->{schema}.$sequenceName.nextval from dual", 1);
    my ($val) = $self->_fetch();
    croak "Error while fetching sequence number\nReason: $Oraperl::ora_errstr\n" if ($Oraperl::ora_errno);
    $self->_killCursor();
    return $val;
}

sub _multiGetSequenceVal {
    confess "_multiGetSequenceVal must be called in list context" unless (wantarray);
    my $self = shift;
    confess "Wrong type" unless ref($self);
    my ($sequenceName, $numToGet) = @_;
    return unless ($numToGet);
    $self->_makeCursor("select $self->{schema}.$sequenceName.nextval from dual", 1);
    my @values;
    my $val;
    while ($numToGet && (($val) = $self->_fetch())) {
	push(@values, $val);
	$numToGet--;
	$self->_bind();
    }
    croak "Error while fetching sequence number\nReason: $Oraperl::ora_errstr\n" if ($Oraperl::ora_errno);
    $self->_killCursor();
    return @values;
}

sub commit {
    my $self = shift;
    confess "Wrong type" unless ref($self);
    if (!&Oraperl::ora_commit($self->{lda})) {
	croak "Commit changes to database failed\nReason: $Oraperl::ora_errstr\n";
    }
    undef $self->{changed};
}

sub rollback {
    my $self = shift;
    confess "Wrong type" unless ref($self);
    if ($self->{changed}) {
	unless (&Oraperl::ora_rollback($self->{lda})) {
	    croak "Roll back changes in database failed\nReason: $Oraperl::ora_errstr\n";
	}
    }
    undef $self->{changed};
}

sub getSchemas {
    my ($self) = @_;
    confess "Wrong type" unless ref($self);
    my @schemas;
    $self->_makeCursor("select distinct owner from role_tab_privs where table_name = 'READ2SEQ'");
    my $schemaName;
    while (($schemaName) = $self->_fetch()) {
	push(@schemas, $schemaName);
    }
    $self->_killCursor();
    return \@schemas;
}

sub getAllProjects {
    my $self = shift;
    confess "Wrong type" unless ref($self);
    return $self->_getHash("select all projid, projname from $self->{schema}.project", ['projName']);
}

sub getAllClones {
    my $self = shift;
    confess "Wrong type" unless ref($self);
    return $self->_getHash("select all cloneid, clonename, projid from $self->{schema}.clones", ['cloneName', 'projId']);
}

sub getCloneInfo {
    my ($self, $cloneId) = @_;
    confess "Wrong type" unless ref($self);
    return $self->_getHash("select all cloneid, clonename, projid from $self->{schema}.clones where cloneid = $cloneId",
			   ['cloneName', 'projId'], 1)->{$cloneId};
}

sub getAllLigations {
    my $self = shift;
    confess "Wrong type" unless ref($self);
    return $self->_getHash("select all ligid, lignumber, cloneid, insertsizemin, insertsizemax from $self->{schema}.ligation",
			   ['ligNumber', 'cloneId', 'minInsert', 'maxInsert']);
}

sub getLigationInfo {
    my ($self, $ligId) = @_;
    confess "Wrong type" unless ref($self);
    return $self->_getHash("select all ligid, lignumber, cloneid, insertsizemin, insertsizemax from $self->{schema}.ligation where ligid = $ligId",
			   ['ligNumber', 'cloneId', 'minInsert', 'maxInsert'], 1)->{$ligId};
}

sub getAllPlates {
    my $self = shift;
    confess "Wrong type" unless ref($self);
    return $self->_getHash("select all plateid, platename, ligid from $self->{schema}.plates", ['plateName', 'ligId'], 100);
}

sub getPlateInfo {
    my ($self, $plateId) = @_;
    confess "Wrong type" unless ref($self);
    return $self->_getHash("select all plateid, platename, ligid from $self->{schema}.plates where plateId = $plateId",
			   ['plateName', 'ligId'], 1)->{$plateId};
}

sub getAllTemplates {
    my $self = shift;
    confess "Wrong type" unless ref($self);
    return $self->_getHash("select all templateid, name, plateid from $self->{schema}.template", ['templateName', 'plateId'], 100);
}

sub getTemplateInfo {
    my ($self, $templateId) = @_;
    confess "Wrong type" unless ref($self);
    return $self->_getHash("select all templateid, name, plateid from $self->{schema}.template where templateId = $templateId",
			   ['templateName', 'plateId'], 1)->{$templateId};
}

sub getAllReads {
    my $self = shift;
    confess "Wrong type" unless ref($self);
    return $self->_getHash("select all readid, readname, templateid, strand, primer, dye, to_char(asped, 'YYYY-MM-DD'), basecaller, processstatus, scffile, scfdir from $self->{schema}.read",
			   ['readName', 'templateId', 'strand', 'primer', 'dye', 'asped', 'basecaller', 'processStatus', 'scfFile', 'scfDir'], 100);
}

sub getSeqsForRead {
    my ($self, $readId) = @_;
    confess "Wrong type" unless ref($self);
    return $self->_getHash("select all assemblyid, seqid from $self->{schema}.read2seq where readid = $readId", ['seqId']);
}

sub getSeqVecsForSeq {
    my ($self, $seqId) = @_;
    confess "Wrong type" unless ref($self);
    return $self->_getArray("select all begin, end, text from $self->{schema}.seqvec where seqid = $seqId", ['begin', 'end', 'text']);
}

sub getClippingsForSeq {
    my ($self, $seqId) = @_;
    confess "Wrong type" unless ref($self);
    return $self->_getArray("select all type, begin, end, text from $self->{schema}.clipping where seqid = $seqId",
			    ['type', 'begin', 'end', 'text']);
}

sub getTagsForSeq {
    my ($self, $seqId) = @_;
    confess "Wrong type" unless ref($self);
    return $self->_getArray("select all type, begin, end, text from $self->{schema}.tag where seqid = $seqId",
			    ['type', 'begin', 'end', 'text']);
}

sub getCloneVecsForSeq {
    my ($self, $seqId) = @_;
    confess "Wrong type" unless ref($self);
    return $self->_getArray("select all begin, end, text from $self->{schema}.clonevec where seqid = $seqId", ['begin', 'end', 'text']);
}

sub getAlignsForSeq {
    my ($self, $seqId) = @_;
    confess "Wrong type" unless ref($self);
    return $self->_getArray("select all startinseq, endinseq, startinscf, endinscf from $self->{schema}.aligntoscf where seqid = $seqId",
			    ['startInSeq', 'endInSeq', 'startInScf', 'endInScf']);
}

sub getSequenceInfo {
    my ($self, $seqId) = @_;
    confess "Wrong type" unless ref($self);
    my $hash =  $self->_getHash("select all seqid, Length, GC from $self->{schema}.sequence where seqid = $seqId",
				['length', 'GC'], 1)->{$seqId};
    $hash->{DNA} = $self->_getLong("select all dna from $self->{schema}.sequence where seqid = $seqId", 'dna');
    $hash->{qual} = $self->_getLong("select all qual from $self->{schema}.basequality where seqid = $seqId", 'qual');
    return $hash;
}

sub multiGetReadInfo {
    my ($self, $readIds, $opts) = @_;
    confess "Wrong type" unless ref($self);
    my $verbose = $self->{verbose};
    print STDERR "Getting read information from the database\n" if ($verbose);
    $opts = {select => 'names'} unless ($opts);
    my $selector = ($opts->{select} eq 'ids') ? "readid = :1" : "readname = :1";
    $self->_makeCursor("select all readid, readname, templateid, strand, primer, dye, asped, basecaller, processstatus, ".
		       "scffile, scfdir, analysed from $self->{schema}.read where $selector");
    my %reads;
    my ($count, $total) = (0, scalar(@{$readIds}));
    my $readId;
    foreach $readId (@{$readIds}) {
	$count++;
	print STDERR "\rGetting info for read $count of $total  " if ($verbose and ($count & 15) == 0);
	$self->_bind($readId);
	my $h = {};
	($h->{readId}, $h->{readName}, $h->{templateId}, $h->{strand}, $h->{primer}, $h->{dye}, $h->{asped}, $h->{baseCaller},
	 $h->{processStatus}, $h->{scfFile}, $h->{scfDir}, $h->{analysed}) = $self->_fetch();
	$reads{$readId} = $h;
    }
    print STDERR "\rGetting info for read $count of $total\n" if ($verbose);
    $self->_killCursor();
    return \%reads;
}

sub multiGetSeqInfo {
    my ($self, $seqIds, $opts) = @_;
    confess "Wrong type" unless ref($self);
    my $verbose = $self->{verbose};
    $opts = {stats => 1, dna => 1, basequality => 1} unless ($opts);
    print STDERR "Getting sequence information from the database\n" if ($verbose);
    my %seqs;
    my $seqId;
    foreach $seqId (@{$seqIds}) {
	$seqs{$seqId} = {};
    }
    my ($count, $total) = (0, scalar(@{$seqIds}));
    if ($opts->{stats}) {
	$self->_makeCursor("select all Length, GC from $self->{schema}.sequence where seqid = :1", 100);
	foreach $seqId (@{$seqIds}) {
	    $count++;
	    print STDERR "\rGetting info for sequence $count of $total" if ($verbose and ($count & 15) == 0);
	    $self->_bind($seqId);
	    my ($len, $gc) = $self->_fetch();
	    $seqs{$seqId} = {length => $len, GC => $gc};
	}
	print STDERR "\rGetting info for sequence $count of $total\n" if ($verbose);
	$self->_killCursor();
    }
    if ($opts->{dna}) {
	$count = 0;
	$self->_makeCursor("select all dna from $self->{schema}.sequence where seqid = :1", 1);
	foreach $seqId (@{$seqIds}) {
	    $count++;
	    print STDERR "\rGetting dna for sequence $count of $total" if ($verbose and ($count & 15) == 0);
	    $self->_bind($seqId);
	    $seqs{$seqId}->{DNA} = $self->_readLong('dna');
	}
	print STDERR "\rGetting dna for sequence $count of $total\n" if ($verbose);
	$self->_killCursor();
    }
    if ($opts->{basequality}) {
	$count = 0;
	$self->_makeCursor("select all qual from $self->{schema}.basequality where seqid = :1", 1);
	foreach $seqId (@{$seqIds}) {
	    $count++;
	    print STDERR "\rGetting base quality for sequence $count of $total" if ($verbose and ($count & 15) == 0);
	    $self->_bind($seqId);
	    $seqs{$seqId}->{qual} = $self->_readLong('qual');
	}
	print STDERR "\rGetting base quality for sequence $count of $total\n" if ($verbose);
	$self->_killCursor();
    }
    return \%seqs;
}

sub getAllSCFDirs {
    my $self = shift;
    confess "Wrong type" unless ref($self);
    return $self->_getHash("select all scfdirid, scfdir, projid from $self->{schema}.scfdirs", ['SCFDir', 'projId']);
}

sub addProject {
    my $self = shift;
    confess "Wrong type" unless ref($self);
    my ($projName) = @_;
    my $projId = $self->_getSequenceVal("projid");
    $self->_doSql("insert into $self->{schema}.project (projid, projname) values ($projId, '$projName')");
    $self->addAssembly(0, $projId, "R", "Raw reads");  #Add assembly for raw project reads.
    return $projId;
}

sub addClone {
    my $self = shift;
    confess "Wrong type" unless ref($self);
    my ($cloneName, $projId) = @_;
    my $cloneId = $self->_getSequenceVal("cloneid");
    $self->_doSql("insert into $self->{schema}.clones (cloneid, clonename, projid) values ($cloneId, '$cloneName', $projId)");
    return $cloneId;
}

sub addLigation {
    my $self = shift;
    confess "Wrong type" unless ref($self);
    my ($ligNumber, $cloneId, $insertSizeMin, $insertSizeMax) = @_;
    my $ligId = $self->_getSequenceVal("ligid");
    $self->_doSql("insert into $self->{schema}.ligation (ligid, lignumber, cloneid, insertsizemin, insertsizemax) values ($ligId, '$ligNumber', $cloneId, $insertSizeMin, $insertSizeMax)");
    return $ligId;
}

sub addPlate {
    my $self = shift;
    confess "Wrong type" unless ref($self);
    my ($plateName, $ligId) = @_;
    my $plateId = $self->_getSequenceVal("plateid");
    $self->_doSql("insert into $self->{schema}.plates (plateid, platename, ligid) values ($plateId, '$plateName', $ligId)");
    return $plateId;
}

sub addTemplate {
    my $self = shift;
    confess "Wrong type" unless ref($self);
    my ($name, $plateId) = @_;
    my $templId = $self->_getSequenceVal("templateid");
    $self->_doSql("insert into $self->{schema}.template (templateid, name, plateid) values ($templId, '$name', $plateId)");
    return $templId;
}

sub addRead {
    my $self = shift;
    confess "Wrong type" unless ref($self);
    my ($readName, $templateId, $strand, $primer, $dye, $aspedDate, $basecaller, $processStatus, $scfFile, $scfDir) = @_;
    my $readId = $self->_getSequenceVal("readid");
    $self->_doSql("insert into $self->{schema}.read (readid, readname, templateid, strand, primer, dye, asped, basecaller, processstatus, scffile, scfdir, analysed) values ($readId, '$readName', $templateId, '$strand', '$primer', '$dye', to_date('$aspedDate', 'YYYY-MM-DD'), '$basecaller', '$processStatus', '$scfFile', '$scfDir', 0)");
    return $readId;
}

sub addSeq {
    my $self = shift;
    confess "Wrong type" unless ref($self);
    my ($DNA, $length, $GC, $baseQuality) = @_;
    my $seqId = $self->_getSequenceVal("seqid");
    $self->_doSql("insert into $self->{schema}.sequence (seqid, dna, length, gc) values ($seqId, $DNA, $length, $GC)");
    $self->_doSql("insert into $self->{schema}.basequality (seqid, basequality) values ($seqId, $baseQuality)") if ($baseQuality);
    return $seqId;
}

sub addReadSeqJoin {
    my $self = shift;
    confess "Wrong type" unless ref($self);
    my ($readId, $seqId, $assemblyId) = @_;
    $self->_doSql("insert into $self->{schema}.read2seq (readid, seqid, assemblyid) values ($readId, $seqId, $assemblyId)");
}

sub addAssembly {
    my $self = shift;
    confess "Wrong type" unless ref($self);
    my ($number, $projId, $type, $description) = @_;
    my $assemblyId = $self->_getSequenceVal("assemblyid");
    $self->_doSql("insert into $self->{schema}.assembly (assemblyid, assemblynumber, projid, completed, type, description) values ($assemblyId, $number, $projId, SYSDATE, '$type', '$description')");
    return $assemblyId;
}

sub addScreen {
    my $self = shift;
    confess "Wrong type" unless ref($self);
    my ($readId, $against, $score) = @_;
    $self->_doSql("insert into $self->{schema}.screen (readid, against, score) values ($readId, $against, $score)");
}

sub addSeqVec {
    my $self = shift;
    confess "Wrong type" unless ref($self);
    my ($seqId, $begin, $end, $text) = @_;
    $self->_doSql("insert into $self->{schema}.seqvec (seqid, begin, end, text) values ($seqId, $begin, $end, $text)");
}

sub addClipping {
    my $self = shift;
    confess "Wrong type" unless ref($self);
    my ($seqId, $type, $begin, $end, $text) = @_;
    $self->_doSql("insert into $self->{schema}.clipping (seqid, type, begin, end, text) values ($seqId, $type, $begin, $end, $text)");
}

sub addTag {
    my $self = shift;
    confess "Wrong type" unless ref($self);
    my ($seqId, $type, $begin, $end, $text) = @_;
    $self->_doSql("insert into $self->{schema}.tag (seqid, type, begin, end, text) values ($seqId, $type, $begin, $end, $text)");
}

sub addCloneVec {
    my $self = shift;
    confess "Wrong type" unless ref($self);
    my ($seqId, $begin, $end, $text) = @_;
    $self->_doSql("insert into $self->{schema}.clonevec (seqid, begin, end, text) values ($seqId, $begin, $end, $text)");
}

sub addAlignToSCF {
    my $self = shift;
    confess "Wrong type" unless ref($self);
    my ($seqId, $startInSeq, $endInSeq, $startInSCF, $endInSCF) = @_;
    $self->_doSql("insert into $self->{schema}.aligntoscf (seqid, startinseq, endinseq, startinscf, endinscf) values ($seqId, $startInSeq, $endInSeq, $startInSCF, $endInSCF)");
}

sub addSCFDir {
    my $self = shift;
    confess "Wrong type" unless ref($self);
    my ($scfDir, $projId) = @_;
    my $scfDirId = $self->_getSequenceVal("scfdirid");
    $self->_doSql("insert into $self->{schema}.scfdirs (scfdirid, scfdir, projid) values ($scfDirId, '$scfDir', $projId)");
    return $scfDirId;    
}

sub multiAddTemplates {
    my $self = shift;
    confess "Wrong type" unless ref($self);
    my @templateEntries = @_;
    my @templateIds = $self->_multiGetSequenceVal("templateid", scalar(@templateEntries));
    $self->_makeCursor('insert into $self->{schema}.template (templateid, name, ligationid) values (:1, :2, :3)');
    my $currId = 0;
    my $entry;
    foreach $entry (@templateEntries) {
	$self->_bind($templateIds[$currId++], $entry->{name}, $entry->{ligId});
    }
    $self->_killCursor();
    return @templateIds;
}

sub multiAddRawReads {
    my ($self, $readEntries) = @_;
    confess "Wrong type" unless ref($self);
    my $verbose = $self->{verbose};
    my $total = @{$readEntries};
    warn "Getting assembly numbers\n" if ($verbose);
    #$self->_makeCursor("select all assemblyid from $self->{schema}.assembly, $self->{schema}.clones, $self->{schema}.ligation, $self->{schema}.plates, $self->{schema}.template where assembly.assemblynumber = 0 AND assembly.projid = clones.projid AND clones.cloneid = ligation.cloneid AND ligation.ligid = plates.ligid AND plates.plateid = template.plateid AND template.templateid = :1");
    $self->_makeCursor("select all assemblyid from $self->{schema}.assembly where assemblynumber = 0 AND projid = :1");
    my %rawAssemblyIds;
    my $entry;
    foreach $entry (@{$readEntries}) {
	unless ($rawAssemblyIds{$entry->{projId}}) {
	    $self->_bind($entry->{projId});
	    ($rawAssemblyIds{$entry->{projId}}) = $self->_fetch();
	}
	$entry->{assemblyId} = $rawAssemblyIds{$entry->{projId}};
    }
    $self->_killCursor();
    my @readIds = $self->_multiGetSequenceVal("readid", scalar(@{$readEntries}));
    warn "Inserting reads\n" if ($verbose);
    $self->_makeCursor("insert into $self->{schema}.read (readid, readname, templateid, strand, primer, dye, asped, basecaller, processstatus, scffile, scfdir, analysed) values (:1, :2, :3, :4, :5, :6, to_date(:7, 'YYYY-MM-DD'), :8, :9, :10, :11, 0)");
    my $currId = 0;
    foreach $entry (@{$readEntries}) {
	$entry->{readId} = $readIds[$currId++];
	print STDERR "\rAdding data for read $currId of $total" if ($verbose);
	$self->_bind($entry->{readId}, $entry->{readName}, $entry->{templateId}, $entry->{strand}, $entry->{primer}, $entry->{dye}, $entry->{asped}, $entry->{basecaller}, $entry->{processStatus}, $entry->{scfFile}, $entry->{scfDir});
	
    }
    warn "\n" if ($verbose);
    $self->_killCursor();
    my @seqIds = $self->multiAddReadSequences($readEntries);
    return (\@readIds, \@seqIds);
}

sub multiAddReadSequences {
    my ($self, $seqEntries) = @_;
    confess "Wrong type" unless ref($self);
    my $verbose = $self->{verbose};
    my $total = scalar(@{$seqEntries});
    warn "Adding DNA sequences to the database\n" if ($verbose);
    my @seqIds = $self->_multiGetSequenceVal("seqid", scalar(@{$seqEntries}));
    my $maxLen = 0;
    map { $maxLen = ($maxLen < $_->{length})?$_->{length}:$maxLen; } @{$seqEntries};
    $Oraperl::ora_long = $maxLen + 1;
    my $varchar_attrib = { ora_type => 1 };
    my $long_attrib = { ora_type => 8 };
    my $long_raw_attrib = { ora_type => 24 };
    $self->_makeCursor("insert into $self->{schema}.sequence (seqid, dna, length, gc) values (:1, :2, :3, :4)", 1);
    my $currId = 0;
    my $entry;
    foreach $entry (@{$seqEntries}) {
	$entry->{seqId} = $seqIds[$currId++];
	print STDERR "\rAdding DNA sequence $currId of $total" if ($verbose);
	$self->_bind_param(1, $entry->{seqId}, $varchar_attrib);
	$self->_bind_param(2, $entry->{DNA}, $long_attrib);
	$self->_bind_param(3, $entry->{length}, $varchar_attrib);
	$self->_bind_param(4, $entry->{GC}, $varchar_attrib);
	$self->_bind();
    }
    warn "\n" if ($verbose);
    $self->_killCursor();
    $Oraperl::ora_long = 80;
    warn "Adding base quality values to the database\n" if ($verbose);
    $self->_makeCursor("insert into $self->{schema}.basequality (seqid, qual) values (:1, :2)");
    my $count = 0;
    foreach $entry (@{$seqEntries}) {
	$count++;
	print STDERR "\rAdding base quality values for sequence $currId of $total" if ($verbose);
	$self->_bind_param(1, $entry->{seqId}, $varchar_attrib);
	$self->_bind_param(2, $entry->{baseQuality}, $long_raw_attrib);
	$self->_bind();
    }
    warn "\n" if ($verbose);
    $self->_killCursor();
    warn "Linking read and sequence entries in the database\n" if ($verbose);
    $self->_makeCursor("insert into $self->{schema}.read2seq (readid, seqid, assemblyid) values (:1, :2, :3)");
    $count = 0;
    foreach $entry (@{$seqEntries}) {
	$count++;
	print STDERR "\rLinking sequence $count of $total" if ($verbose);
	$self->_bind($entry->{readId}, $entry->{seqId}, $entry->{assemblyId});
    }
    warn "\n" if ($verbose);
    $self->_killCursor();    
    return @seqIds;
}

sub multiAddScreenInfo {
    my ($self, $screenEntries) = @_;
    confess "Wrong type" unless ref($self);
    $self->_makeCursor("insert into $self->{schema}.screen (readid, against, score) values (:1, :2, :3)");
    my $entry;
    my ($count, $total, $verbose) = (0, scalar(@{$screenEntries}), $self->{verbose});
    warn "Adding screening infomation to the database\n" if ($verbose);
    foreach $entry (@{$screenEntries}) {
	$count++;
	print STDERR "\rAdding screen entry $count of $total " if ($verbose);
	$self->_bind($entry->{readId}, $entry->{against}, $entry->{score});
    }
    warn "\n" if ($verbose);
    $self->_killCursor();
}

sub multiAddSeqVecTags {
    my ($self, $seqVecEntries) = @_;
    confess "Wrong type" unless ref($self);
    $self->_makeCursor("insert into $self->{schema}.seqvec (seqid, begin, end, text) values (:1, :2, :3, :4)");
    my ($count, $total, $verbose) = (0, scalar(@{$seqVecEntries}), $self->{verbose});
    warn "Adding sequence vector tags to the database\n" if ($verbose);
    my $entry;
    foreach $entry (@{$seqVecEntries}) {
	$count++;
	print STDERR "\rAdding tag $count of $total " if ($verbose);
	$entry->{text} = " " unless $entry->{text};
	$self->_bind($entry->{seqId}, $entry->{begin}, $entry->{end}, $entry->{text});
    }
    warn "\n" if ($verbose);
    $self->_killCursor();
}

sub multiAddClippingTags {
    my ($self, $clippingEntries) = @_;
    confess "Wrong type" unless ref($self);
    $self->_makeCursor("insert into $self->{schema}.clipping (seqid, type, begin, end, text) values (:1, :2, :3, :4, :5)");
    my ($count, $total, $verbose) = (0, scalar(@{$clippingEntries}), $self->{verbose});
    warn "Adding clipping tags to the database\n" if ($verbose);
    my $entry;
    foreach $entry (@{$clippingEntries}) {
	$count++;
	print STDERR "\rAdding tag $count of $total " if ($verbose);
	$entry->{text} = " " unless $entry->{text};
	$self->_bind($entry->{seqId}, $entry->{type}, $entry->{begin}, $entry->{end}, $entry->{text});
    }
    warn "\n" if ($verbose);
    $self->_killCursor();
}

sub multiAddTags {
    my ($self, $tagEntries) = @_;
    confess "Wrong type" unless ref($self);
    $self->_makeCursor("insert into $self->{schema}.tag (seqid, type, begin, end, text) values (:1, :2, :3, :4, :5)");
    my ($count, $total, $verbose) = (0, scalar(@{$tagEntries}), $self->{verbose});
    warn "Adding tags to the database\n" if ($verbose);
    my $entry;
    foreach $entry (@{$tagEntries}) {
	$count++;
	print STDERR "\rAdding tag $count of $total " if ($verbose);
	$entry->{text} = " " unless $entry->{text};
	$self->_bind($entry->{seqId}, $entry->{type}, $entry->{begin}, $entry->{end}, $entry->{text});
    }
    warn "\n" if ($verbose);
    $self->_killCursor();
}

sub multiAddCloneVecTags {
    my ($self, $cloneVecEntries) = @_;
    confess "Wrong type" unless ref($self);
    $self->_makeCursor("insert into $self->{schema}.clonevec (seqid, begin, end, text) values (:1, :2, :3, :4)");
    my ($count, $total, $verbose) = (0, scalar(@{$cloneVecEntries}), $self->{verbose});
    warn "Adding cloning vector tags to the database\n" if ($verbose);
    my $entry;
    foreach $entry (@{$cloneVecEntries}) {
	$count++;
	print STDERR "\rAdding tag $count of $total " if ($verbose);
	$entry->{text} = " " unless $entry->{text};
	$self->_bind($entry->{seqId}, $entry->{begin}, $entry->{end}, $entry->{text});
    }
    warn "\n" if ($verbose);
    $self->_killCursor();
}

sub multiAddAlignToSCF {
    my ($self, $alignEntries) = @_;
    confess "Wrong type" unless ref($self);
    $self->_makeCursor("insert into $self->{schema}.aligntoscf (seqid, startinseq, endinseq, startinscf, endinscf) values (:1, :2, :3, :4, :5)");
    my ($count, $total, $verbose) = (0, scalar(@{$alignEntries}), $self->{verbose});
    warn "Adding alignment information to the database\n" if ($verbose);
    my $entry;
    foreach $entry (@{$alignEntries}) {
	$count++;
	print STDERR "\rAdding alignment entry $count of $total " if ($verbose);
	$self->_bind($entry->{seqId}, $entry->{startInSeq}, $entry->{endInSeq}, $entry->{startInSCF}, $entry->{endInSCF});
    }
    warn "\n" if ($verbose);
    $self->_killCursor();    
}

sub insertRawCaf {
    my ($self, $caf, $mustHaveBaseQuality, $warnOnError, $reallyInsert) = @_;
    confess "Wrong type" unless ref $self;
    $self->{cacheDirs} = 1 if (scalar(keys %{$caf->{CAF}->{Sequence}}) > 50);
    $self->_clearDirCache();
    warn "Trying to insert raw CAF file into the database\n" if $self->{verbose};
    my $errorCount = $caf->checkForMissingInfo($mustHaveBaseQuality, $warnOnError);
    warn "$errorCount errors so far\n" if ($errorCount);
    $errorCount += $caf->checkRawSequences($warnOnError);
    warn "$errorCount errors so far\n" if ($errorCount);
    my $parsed = $caf->parse();
    $errorCount += $self->_checkParsedCaf($parsed, $warnOnError);
    die "$errorCount errors found in CAF data\n" if $errorCount;
    $self->_augmentParsedCaf($parsed);
    return unless ($reallyInsert);
    $self->_makeNewCafTemplates($parsed);
    my ($readIds, $seqIds) = $self->multiAddRawReads($parsed);
    my (@seqVecs, @clippings, @tags, @cloneVecs, @aligns);
    my $read;
    foreach $read (@{$parsed}) {
	my $seqId = $read->{seqId};
	map { $_->{seqId} = $seqId; push(@seqVecs, $_); } @{$read->{seqVecs}};
	map { $_->{seqId} = $seqId; push(@clippings, $_); } @{$read->{clippings}};
	map { $_->{seqId} = $seqId; push(@tags, $_); } @{$read->{tags}};
	map { $_->{seqId} = $seqId; push(@cloneVecs, $_); } @{$read->{cloneVecs}};
	map { $_->{seqId} = $seqId; push(@aligns, $_); } @{$read->{aligns}};	
    }
    $self->multiAddSeqVecTags(\@seqVecs);
    $self->multiAddClippingTags(\@clippings);
    $self->multiAddTags(\@tags);
    $self->multiAddCloneVecTags(\@cloneVecs);
    $self->multiAddAlignToSCF(\@aligns);
}

sub _makeNewCafTemplates {
    my ($self, $parsed) = @_;
    my $read;
    warn "Adding new templates to the database\n" if ($self->{verbose});
    my $thash = $self->{templatesByName};
    foreach $read (@{$parsed}) {
	unless ($read->{templateId}) {
	    my $tname = $read->{template};
	    $thash->{$tname} = $self->addTemplate($read->{template}, $read->{plateId}) unless $thash->{$tname};
	    $read->{templateId} = $thash->{$tname};
	}
    }
}

sub _augmentParsedCaf {
    my ($self, $parsed) = @_;
    confess "Wrong type" unless ref $self;
    my $verbose = $self->{verbose};
    warn "Getting template / directory information\n" if ($verbose);
    my ($count, $total) = (0, scalar(@{$parsed}));
    my $read;
    foreach $read (@{$parsed}) {
	$count++;
	print STDERR "\rProcessing read $count of $total" if ($verbose);
	my ($plateName) = $read->{template} =~ m/(\S+)[A-Za-z]\d+$/;
	die "Can't get plate name for template '$read->{template}'\n" unless ($plateName);
	unless ($self->{plateInfoCache}->{$plateName}) {
	    my $plateInfo = $self->_getHash("select all platename, plateid, ligid from $self->{schema}.plates where platename = '$plateName'",
					    ['plateId', 'ligId']);
	    die "Plate '$plateName' is not in the database\n" unless ($plateInfo->{$plateName});
	    $self->{plateInfoCache}->{$plateName} = $plateInfo->{$plateName};
	}
	
	$read->{plateId} = $self->{plateInfoCache}->{$plateName}->{plateId};
	my $ligId = $self->{plateInfoCache}->{$plateName}->{ligId};
	$read->{ligId} = $ligId;
	$self->{cloneIdCache}->{$ligId} = $self->getLigationInfo($ligId)->{cloneId} unless $self->{cloneIdCache}->{$ligId};
	my $cloneId = $self->{cloneIdCache}->{$ligId};
	$read->{cloneId} = $cloneId;
	$self->{projIdCache}->{$cloneId} = $self->getCloneInfo($cloneId)->{projId} unless $self->{projIdCache}->{$cloneId};
	$read->{projId} = $self->{projIdCache}->{$cloneId};
	$self->_cafGetTemplateId($read);
	$self->_cafGetScfDir($read);
    }
    print "\n" if ($verbose);
}

sub _cafGetTemplateId {
    my ($self, $read) = @_;
    my $templateName = $read->{template};
    if ($self->{templatesByName}->{$templateName}) {
	$read->{templateId} = $self->{templatesByName}->{$templateName};
	return;
    }
    my $templates = $self->_getHash("select all name, templateid from $self->{schema}.template where plateid = $read->{plateId}",
				    ['templateId'], 100);
    my $name;
    foreach $name (%{$templates}) {
	$self->{templatesByName}->{$name} = $templates->{$name}->{templateId};
    }
    $read->{templateId} = $self->{templatesByName}->{$name};
}

sub _cafGetScfDir {
    my ($self, $read) = @_;
    confess "Wrong type" unless ref $self;
    my $name = $read->{readName}."SCF";
    my $dirSearchList = $self->{dirSearchList}->{$read->{projId}};
    unless ($dirSearchList) {
	$self->{dirSearchList}->{$read->{projId}} = [];
	$dirSearchList = $self->{dirSearchList}->{$read->{projId}};
	my $dirs = $self->_getHash("select all scfdirid, scfdir from $self->{schema}.scfdirs where projid = $read->{projId}", ['SCFdir']);
	my $dirId;
	foreach $dirId (keys %{$dirs}) {
	    push(@{$dirSearchList}, [$dirId, $dirs->{$dirId}->{SCFdir}]);
	}
    }
    my $dc = $self->{dirCache};
    my ($d, $dirId);
    for($d = 0; $d < scalar(@{$dirSearchList}); $d++) {
	my $dirName;
	($dirId, $dirName) = @{$dirSearchList->[$d]};
	if ($self->{cacheDirs}) {
	    unless ($dc->{$dirId}) {
		my $globbed = $self->_globDir($dirName);
		my $DIRHANDLE = new DirHandle($globbed);
		die "Couldn't open directory '$globbed'\n" unless ($DIRHANDLE);
		$dc->{$dirId} = [];
		@{$dc->{$dirId}} = $DIRHANDLE->read();
		$DIRHANDLE->close();
	    }
	    last if (grep($_ eq $name, @{$dc->{$dirId}}));
	} else {
	    $dc->{$dirId} = $self->_globDir($dirName) unless ($dc->{$dirId});
	    last if (-e "$dc->{$dirId}/$name");
	}
    }
    die "Could not find SCF file $name\n" if ($d >= scalar(@{$dirSearchList}));
    unshift(@{$dirSearchList}, splice(@{$dirSearchList}, $d, 1));
    $read->{scfDir} = $dirId;
}

sub _clearDirCache {
    my ($self) = @_;
    confess "Wrong type" unless ref($self);
    $self->{dirCache} = {};
}

sub _globDir {
    my ($self, $dirName) = @_;
    confess "Wrong type" unless ref($self);
    return $self->{dirGlobs}->{$dirName} if ($self->{dirGlobs}->{$dirName});
    my ($globbed) = glob($dirName);
    unless ($globbed) { die "Couldn't glob '$dirName'\n"; }
    ($self->{dirGlobs}->{$dirName}) = $globbed;
    return $globbed;
}

sub _checkParsedCaf {
    my ($self, $parsed, $warnOnError) = @_;
    confess "Wrong type" unless ref $self;
    warn "Checking parsed CAF data\n" if ($self->{verbose});
    my $errCount;
    my $read;
    foreach $read (@{$parsed}) {
	my $readName = $read->{readName};
	unless ($read->{template}) { warn "No template found for $readName\n" if $warnOnError; $errCount++; }
	unless ($read->{strand}) { warn "No strand information found for $readName\n" if $warnOnError; $errCount++; }
	unless ($read->{primer}) { warn "No primer information found for $readName\n" if $warnOnError; $errCount++; }
	unless ($read->{dye}) { warn "No dye information found for $readName\n" if $warnOnError; $errCount++; }
	unless ($read->{asped}) { warn "No asped date found for $readName\n" if $warnOnError; $errCount++; }
	unless ($read->{basecaller}) { warn "No basecaller information found for $readName\n" if $warnOnError; $errCount++; }
	unless ($read->{processStatus}) { warn "No process status information found for $readName\n" if $warnOnError; $errCount++; }
	unless ($read->{scfFile}) { warn "No SCF file found for $readName\n" if $warnOnError; $errCount++; }
	unless ($read->{DNA}) { warn "No DNA found for $readName\n" if $warnOnError; $errCount++; }
	unless ($read->{baseQuality}) { warn "No Basequality info for $readName\n" if $warnOnError; $errCount++; }	
    }
    return $errCount;
}

sub checkIfReadsExist {
    my ($self, $reads) = @_;
    confess "Wrong type" unless ref $self;
    my ($count, $total, $verbose) = (0, scalar(@{$reads}), $self->{verbose});
    warn "Checking if read names are already in the database\n" if ($verbose);
    my @existing;
    $self->_makeCursor("select count(*) from $self->{schema}.read where readname = :1");
    my $readName;
    foreach $readName (@{$reads}) {
	$count++;
	print STDERR "\rChecking read $count of $total" if ($verbose);
	$self->_bind($readName);
	my ($found) = $self->_fetch();
	push(@existing, $readName) if ($found);
    }
    $self->_killCursor();
    warn "\n" if ($verbose);
    return \@existing;
}

sub _makeSelector {
    my ($self, $params) = @_;
    confess "Wrong type" unless ref $self;
    my $selector = undef;
    $selector = "extended_read.projname like '$params->{project}'" if ($params->{project});
    $selector = "extended_read.clonename like '$params->{clone}'" if ($params->{clone});
    $selector = "extended_read.lignumber like '$params->{ligation}'" if ($params->{ligation});
    $selector = "extended_read.platename like '$params->{plate}'" if ($params->{plate});
    $selector = "extended_read.templatename like '$params->{template}'" if ($params->{template});
    $selector = "extended_read.readname like '$params->{read}'" if ($params->{read});
    confess "No selector: should be one of project, clone, ligation, plate, template or read" unless ($selector);
    return $selector;
}

sub getReadNames {
    my ($self, %params) = @_;
    confess "Wrong type" unless ref $self;
    my $schema = $self->{schema};
    my $selector = $self->_makeSelector(\%params);
    warn "Extracting read names for $selector\n" if ($self->{verbose});
    my $readNames = $self->_getHash("select all readname from $schema.extended_read where $selector", [], 100);
    my @reads = keys(%{$readNames});
    return \@reads;
}

sub countReadsForPlate {
    my ($self, $plate, $passed) = @_;
    my $schema = $self->{schema};
    my $passedCondition = ($passed) ? " and read.processstatus = 'PASS'" : "";
    $self->_makeCursor("select count(*) ".
		       "from $schema.plates, $schema.template, $schema.read ".
		       "where template.plateid = plates.plateid ".
		       "and read.templateid = template.templateid ".
		       "and plates.platename = '$plate'".$passedCondition);
    my ($count) = $self->_fetch();
    $self->_killCursor();
    return $count;
}

sub countReadsForAllPlates {
    my ($self) = @_;
    my %counts;
    my $schema = $self->{schema};
    $self->_makeCursor("select all platename, ".
		       "count(decode(processstatus, 'PASS', 'X')) P, ".
		       "count(decode(processstatus, 'PASS', NULL, 'X')) F ".
		       "from $schema.plates, $schema.template, $schema.read ".
		       "where template.plateid = plates.plateid ".
		       "and read.templateid = template.templateid ".
		       "group by platename");
    my ($plate, $passed, $failed);
    while (($plate, $passed, $failed) = $self->_fetch()) {
	$counts{$plate} = [$passed, $failed];
    }
    $self->_killCursor();
    return \%counts;
}

sub getRawStats {
    my ($self, %params) = @_;
    confess "Wrong type" unless ref $self;
    my $schema = $self->{schema};
    my $selector = $self->_makeSelector(\%params);
    warn "Extracting process stats for $selector\n" if ($self->{verbose});
    my $stats = $self->_getArray("select a.passed, b.failed, c.paired from ".
				 "(select count(*) passed from $schema.extended_read where $selector and processstatus = 'PASS') a, ".
				 "(select count(*) failed from $schema.extended_read where $selector and processstatus != 'PASS') b, ".
				 "(select count(*) paired from ".
				 "(select all readid from $schema.read, ".
				 "(select distinct templateid from $schema.extended_read where $selector and strand = 'Forward' ".
				 "and processstatus = 'PASS' intersect ".
				 "select distinct templateid from $schema.extended_read where $selector and strand = 'Reverse' and ".
				 "processstatus = 'PASS') pt where read.templateid = pt.templateid)) c", ['passed', 'failed', 'paired']);
    my ($passed, $failed, $paired) = ($stats->[0]->{passed}, $stats->[0]->{failed}, $stats->[0]->{paired});
    my $lengths = $self->_getHash("select sequence.seqid, sequence.length from $schema.sequence, $schema.ext_read2seq, $schema.extended_read ".
				  "where $selector and extended_read.processstatus = 'PASS' ".
				  "and ext_read2seq.readid = extended_read.readid and ext_read2seq.assemblynumber = 0 ".
				  "and sequence.seqid = ext_read2seq.seqid", ['len'], 100);
    my $seqVecs = $self->_getArray("select seqvec.seqid, seqvec.begin, seqvec.end from $schema.seqvec, $schema.ext_read2seq, $schema.extended_read ".
				  "where $selector and extended_read.processstatus = 'PASS' ".
				  "and ext_read2seq.readid = extended_read.readid and ext_read2seq.assemblynumber = 0 ".
				  "and seqvec.seqid = ext_read2seq.seqid", ['seqid', 'begin', 'end'], 100);
    my $clips = $self->_getArray("select clipping.seqid, clipping.begin, clipping.end from $schema.clipping, $schema.ext_read2seq, ".
				 "$schema.extended_read where $selector and extended_read.processstatus = 'PASS' ".
				 "and ext_read2seq.readid = extended_read.readid and ext_read2seq.assemblynumber = 0 ".
				 "and clipping.seqid = ext_read2seq.seqid and clipping.type = 'QUAL'", ['seqid', 'begin', 'end'], 100);
    my $seqid;
    my @seqIds = keys %{$lengths};
    my ($totalLen, $totClipLen) = (0, 0);
    foreach $seqid (@seqIds) {
	$totalLen += $lengths->{$seqid}->{len};
	$lengths->{$seqid}->{uncovered} = new Uncovered(1, $lengths->{$seqid}->{len});
    }
    my $seqVec;
    foreach $seqVec (@{$seqVecs}) {
	my ($seqid, $begin, $end) = ($seqVec->{seqid}, $seqVec->{begin}, $seqVec->{end});
	my $unc = $lengths->{$seqid}->{uncovered};
	$unc->cover($begin, $end) if ($unc);
    }
    my $clip;
    foreach $clip (@{$clips}) {
	my ($seqid, $begin, $end) = ($clip->{seqid}, $clip->{begin}, $clip->{end});
	my ($unc, $len) = ($lengths->{$seqid}->{uncovered}, $lengths->{$seqid}->{len});
	$unc->cover(1, $begin) if ($unc);
	$unc->cover($end, $len) if ($unc);
    }
    foreach $seqid (@seqIds) {
	my $unc = $lengths->{$seqid}->{uncovered};
	my $reg;
	for ($reg = $unc->getFirstRegion; $reg; $reg = $unc->getNextRegion) {
	    $totClipLen += $reg->[1] - $reg->[0];
	}
    }
    my $count = scalar(@seqIds);
    $count++ unless ($count);
    return ($passed, $failed, $paired, $totalLen / $count, $totClipLen / $count);
}

sub getReadnamesBySeqid {
    my ($self, %params) = @_;
    confess "Wrong type" unless ref $self;
    my $toGet = {dna => $params{dna}, basequality => $params{basequality}};
    unless ($toGet->{dna} or $toGet->{basequality}) {
	$toGet = {dna => 1, basequality => 1};
    }
    my $verbose = $self->{verbose};
    my $schema = $self->{schema};
    my $analysed = "";
    if (exists($params{analysed}) && scalar(@{$params{analysed}}) > 0) {
	$analysed = "and extended_read.analysed in (" .
	    join(",", @{$params{analysed}}) . ") ";
    }
    my $selector = $self->_makeSelector(\%params);
    my $reads = $self->_getHash("select all ext_read2seq.seqid, ".
				"extended_read.readname ".
				"from $schema.extended_read, ".
				"$schema.ext_read2seq ".
				"where $selector ".
				"and extended_read.processstatus = 'PASS' ".
				$analysed .
				"and ext_read2seq.readid =".
				" extended_read.readid ".
				"and ext_read2seq.assemblynumber = 0",
				['readName'], 100);
    return $reads;
}

sub getFastaForSeqids {
    my ($self, $reads, %params) = @_;
    confess "Wrong type" unless ref $self;
    my $toGet = {dna => $params{dna}, basequality => $params{basequality}};
    unless ($toGet->{dna} or $toGet->{basequality}) {
	$toGet = {dna => 1, basequality => 1};
    }
    my $verbose = $self->{verbose};
    my $schema = $self->{schema};
    my $selector = $self->_makeSelector(\%params);
    my $seqid;
    my @seqids = (keys %{$reads});
    my $seqs = $self->multiGetSeqInfo(\@seqids, $toGet);
    foreach $seqid (@seqids) {
	my $read = $reads->{$seqid};
	$read->{DNA} = uc($seqs->{$seqid}->{DNA});
	$read->{qual} = $seqs->{$seqid}->{qual};
    }
    undef $seqs;
    if ($params{qual}) {
	my $clips = $self->_getArray("select clipping.seqid, ".
				     "clipping.begin, ".
				     "clipping.end ".
				     "from $schema.clipping, ".
				     "$schema.ext_read2seq, ".
				     "$schema.extended_read ".
				     "where $selector ".
				     "and extended_read.processstatus".
				     " = 'PASS' ".
				     "and ext_read2seq.readid".
				     " = extended_read.readid ".
				     "and ext_read2seq.assemblynumber = 0 ".
				     "and clipping.seqid".
				     " = ext_read2seq.seqid ".
				     "and clipping.type = 'QUAL'",
				     ['seqid', 'begin', 'end'], 100);
	my $clip;
	foreach $clip (@{$clips}) {
	    my ($seqid, $begin, $end) = ($clip->{seqid},
					 $clip->{begin},
					 $clip->{end});
	    my $read = $reads->{$seqid};
	    my $length = length($read->{DNA});
	    $begin = 1 if ($begin < 1);
	    $end = $length if ($end > $length);
	    if ($params{qual} eq 'lc') {
		substr($read->{DNA}, 0, $begin - 1) = lc(substr($read->{DNA}, 0, $begin - 1));
		substr($read->{DNA}, $end) = lc(substr($read->{DNA}, $end));
	    } elsif ($params{qual} eq 'clip') {
		$read->{unc} = new Uncovered($begin, $end);
	    }
	}
    }
    if ($params{seqvec}) {
	my $seqvecs = $self->_getArray("select seqvec.seqid, ".
				       "seqvec.begin, ".
				       "seqvec.end ".
				       "from $schema.seqvec, ".
				       "$schema.ext_read2seq, ".
				       "$schema.extended_read ".
				       "where $selector ".
				       "and extended_read.processstatus".
				       " = 'PASS' ".
				       "and ext_read2seq.readid".
				       " = extended_read.readid ".
				       "and ext_read2seq.assemblynumber = 0 ".
				       "and seqvec.seqid".
				       " = ext_read2seq.seqid",
				       ['seqid', 'begin', 'end'], 100);
	my $seqvec;
	foreach $seqvec (@{$seqvecs}) {
	    my ($seqid, $begin, $end) = ($seqvec->{seqid},
					 $seqvec->{begin},
					 $seqvec->{end});
	    my $read = $reads->{$seqid};
	    my $length = length($read->{DNA});
	    $begin = 1 if ($begin < 1);
	    $end = $length if ($end > $length);
	    if ($params{seqvec} eq 'X') {
		my $sublen = $end - --$begin;
		substr($read->{DNA}, $begin, $sublen) = "X" x ($sublen);
	    } elsif ($params{seqvec} eq 'clip') {
		unless ($read->{unc}) {
		    $read->{unc} = new Uncovered(1, $length);
		}
		$read->{unc}->cover($begin, $end);
	    }
	}
    }
    if ($params{qual} eq 'clip' or $params{seqvec} eq 'clip') {
	foreach $seqid (@seqids) {
	    my $read = $reads->{$seqid};
	    next unless ($read->{unc});
	    my $unc = $read->{unc}->getFirstRegion();
	    my ($begin, $end) = ($unc->[0], $unc->[1]);
	    my $len = $end - --$begin;
	    $read->{DNA} = substr($read->{DNA}, $begin, $len);
	    $read->{qual} = substr($read->{qual}, $begin, $len);
	}
    }
    my (%DNA, %qual);
    foreach $seqid (@seqids) {
	my $read = $reads->{$seqid};
	$DNA{$read->{readName}} = $read->{DNA};
	$qual{$read->{readName}} = $read->{qual};
	delete $reads->{$seqid};
    }
    return (\%DNA, \%qual);
}

sub getRawFasta {
    my ($self, %params) = @_;
    confess "Wrong type" unless ref $self;
    my $reads = $self->getReadnamesBySeqid(%params);
    my ($dna, $qual) = $self->getFastaForSeqids($reads, %params);
    return ($dna, $qual);
}

sub updateProcessStatus {
    my ($self, $psUpdates) = @_;

    # $psUpdates = { 'Read_name' => 'CONT "Matches Yeast"', ... }
    # Must have granted update on read.processStatus to user.
    # user must have write access to exp. file

    my %expFilePaths;
    my ($read, $newPS);
    my $errors = 0;
    my $schema = $self->{schema};
    $self->_makeCursor("select scfdirs.scfdir ".
		       "from $schema.scfdirs, $schema.read ".
		       "where read.readname = :1 ".
		       "and scfdirs.scfdirid = read.scfdir");
    while (($read, $newPS) = each(%{$psUpdates})) {
	if ($newPS =~ /^(PASS|CONT|CVEC|SVEC|QUAL)(\s+\".+?\")?/) {
	    if ($1 eq 'CONT' && $2 !~ /\"Matches/) {
		print STDERR "Error: Bad PS for $read : $newPS\n";
		$errors++;
	    } elsif ($1 eq 'PASS') {
		print STDERR "Error: Not allowed to unfail read $read\n";
		$errors++;
	    }
	} else {
	    print STDERR "Error: Bad PS for $read : $newPS\n";
	    $errors++;
	}
	$self->_bind($read);
	my ($scfdir) = $self->_fetch();
	if ($scfdir) {
	    $scfdir = $self->_globDir($scfdir);
	    if (!-e "$scfdir/$read") {
		print STDERR "Can't find exp. file $scfdir/$read\n";
		$errors++;
	    } elsif (!-w "$scfdir/$read") {
		print STDERR "Can't write to exp. file $scfdir/$read\n";
		$errors++;
	    } else {
		$expFilePaths{$read} = "$scfdir/$read";
	    }
	} else {
	    print STDERR "Can't find $read in database\n";
	    $errors++;
	}
    }
    $self->_killCursor();
    if ($errors) {
	die "$errors errors trying to update process statuses\n";
    }
    $self->_makeCursor("update $schema.read ".
		       "set processstatus = :1 ".
		       "where readname = :2");
    while (($read, $newPS) = each(%{$psUpdates})) {
	my ($psType, $message) = 
	    $newPS =~ /^(CONT|CVEC|SVEC|QUAL)\s*(\".+?\")?/;
	if ($psType eq 'SVEC') { 
	    $message = ' "Completely sequencing vector"';
	} elsif ($psType eq 'CVEC') { 
	    $message = ' "Completely cloning vector"';
	} elsif ($psType eq 'QUAL') {
	    $message = ' "Trace quality"';
	} else {
	    $message = " $message";
	}
	print STDERR "Changing $expFilePaths{$read} PS to : $psType$message\n";
	$self->_bind("$psType$message", $read);
	my $write = FileHandle->new(">> $expFilePaths{$read}");
	my ($noQuotes) = $message =~ /\"(.*?)\"/;
	print $write "PS   $noQuotes\n";
	close($write);
    }
    $self->_killCursor();
    $self->commit();
}

sub updateAnalysed {
    my ($self, $analysedUpdates) = @_;

    # $analysedUpdates = { 'Read_name' => new_integer_val, ... }
    # Must have granted update on read.analysed to user.

    my $schema = $self->{schema};
    my ($read, $newAnalysed);
    my $errors = 0;
    $self->_makeCursor("select readid from $schema.read ".
		       "where readname = :1");
    while (($read, $newAnalysed) = each(%{$analysedUpdates})) {
	$self->_bind($read);
	unless ($self->_fetch()) {
	    print STDERR "$read not found in database\n";
	    $errors++;
	}
    }
    $self->_killCursor();
    if ($errors) {
	die "$errors reads not found\n";
    }
    $self->_makeCursor("update $schema.read ".
		       "set analysed = :1 ".
		       "where readname = :2");
    while (($read, $newAnalysed) = each(%{$analysedUpdates})) {
	$self->_bind($newAnalysed, $read);
    }
    $self->_killCursor();
}

sub getSchema {
    my ($self) = @_;
    confess "Wrong type" unless ref $self;
    my $cols =  $self->_getArray("select all column_id, table_name, column_name, data_type, data_length, data_precision, data_scale, nullable, default_length, data_default from sys.all_tab_columns where owner = 'MAL4'", ['column_id', 'table_name', 'column_name', 'data_type', 'data_length', 'data_precision', 'data_scale', 'nullable', 'default_length', 'data_default']);
    my $constraints = $self->_getArray("select all constraint_name, constraint_type, table_name, search_condition, r_owner, r_constraint_name, delete_rule, status from sys.all_constraints where owner = 'MAL4'", ['constraint_name', 'constraint_type', 'table_name', 'search_condition', 'r_owner', 'r_constraint_name', 'delete_rule', 'status']);
    my $consCols = $self->_getArray("select all constraint_name, table_name, column_name, position from sys.all_cons_columns where owner = 'MAL4'", ['constraint_name', 'table_name', 'column_name', 'position']);
    my $seqs = $self->_getArray("select all sequence_name, min_value, max_value, increment_by, cycle_flag, order_flag, cache_size from sys.all_sequences where sequence_owner = 'MAL4'", ['sequence_name', 'min_value', 'max_value', 'increment_by', 'cycle_flag', 'order_flag', 'cache_size']);
    my $schema = {};
    my $col;
    foreach $col (@{$cols}) {
	$schema->{$col->{table_name}} = {cons => {}, cols => {}} unless $schema->{$col->{table_name}};
	$schema->{$col->{table_name}}->{cols}->{$col->{column_name}} = $col;
    }
    my $cons;
    foreach $cons (@{$constraints}) {
	$schema->{$cons->{table_name}} = {cons => {}, cols => {}} unless $schema->{$cons->{table_name}};
	$schema->{$cons->{table_name}}->{cons}->{$cons->{constraint_name}} = $cons;
    }
    my $cc;
    foreach $cc (@{$consCols}) {
	$schema->{$cc->{table_name}} = {cons => {}, cols => {}} unless $schema->{$cc->{table_name}};
	$schema->{$cc->{table_name}}->{cons}->{$cc->{constraint_name}} = {} unless $schema->{$cc->{table_name}}->{cons}->{$cc->{constraint_name}};
	my $consEntry = $schema->{$cc->{table_name}}->{cons}->{$cc->{constraint_name}};
	$consEntry->{cons_cols} = [] unless $consEntry->{cons_cols};
	push(@{$consEntry->{cons_cols}}, $cc->{column_name});
    }
    foreach $cons (@{$constraints}) {
	delete $schema->{$cons->{table_name}}->{cons}->{$cons->{constraint_name}} if ($cons->{constraint_type} eq 'C');
    }
    return $schema, $seqs;
}

sub makeSchema {
    my ($self, $newSchema) = @_;
    confess "Wrong type" unless ref $self;

    # Make table to hold project names
    $self->_doSql("CREATE TABLE $newSchema.PROJECT (PROJID NUMBER NOT NULL, PROJNAME VARCHAR2(16) NOT NULL, ".
		  "CONSTRAINT PROJIDPRIMARY PRIMARY KEY (PROJID), ".
		  "CONSTRAINT PROJNAMEUNIQUE UNIQUE (PROJNAME)) STORAGE (INITIAL 10K NEXT 10K)");

    # Make tables for sample tracking information
    $self->_doSql("CREATE TABLE $newSchema.CLONES (CLONEID NUMBER NOT NULL, CLONENAME VARCHAR2(16) NOT NULL, PROJID NUMBER NOT NULL, ".
		  "CONSTRAINT CLONEIDPRIMARY PRIMARY KEY (CLONEID), ".
		  "CONSTRAINT CLONENAMEUNIQUE UNIQUE (CLONENAME), ".
		  "CONSTRAINT CLONEPROJIDFOREIGN FOREIGN KEY (PROJID) REFERENCES $newSchema.PROJECT (PROJID) ON DELETE CASCADE)".
		  " STORAGE (INITIAL 20K NEXT 20K)");

    $self->_doSql("CREATE TABLE $newSchema.LIGATION (CLONEID NUMBER NOT NULL, INSERTSIZEMAX NUMBER NOT NULL, INSERTSIZEMIN NUMBER NOT NULL, ".
		  "LIGID NUMBER NOT NULL, LIGNUMBER VARCHAR2(16) NOT NULL, ".
		  "CONSTRAINT LIGIDPRIMARY PRIMARY KEY (LIGID), ".
		  "CONSTRAINT LIGNUMBERUNIQUE UNIQUE (LIGNUMBER), ".
		  "CONSTRAINT CLONEIDFOREIGN FOREIGN KEY (CLONEID) REFERENCES $newSchema.CLONES (CLONEID) ON DELETE CASCADE)".
		  " STORAGE (INITIAL 20K NEXT 20K)");

    $self->_doSql("CREATE TABLE $newSchema.PLATES (LIGID NUMBER NOT NULL, PLATEID NUMBER NOT NULL, PLATENAME VARCHAR2(32) NOT NULL, ".
		  "CONSTRAINT PLATEIDPRIMARY PRIMARY KEY (PLATEID), ".
		  "CONSTRAINT PLATENAMEUNIQUE UNIQUE (PLATENAME), ".
		  "CONSTRAINT LIGIDFOREIGN FOREIGN KEY (LIGID) REFERENCES $newSchema.LIGATION (LIGID) ON DELETE CASCADE)".
		  " STORAGE (INITIAL 100K NEXT 100K)");

    $self->_doSql("CREATE TABLE $newSchema.TEMPLATE (NAME VARCHAR2(16) NOT NULL, PLATEID NUMBER NOT NULL, TEMPLATEID NUMBER NOT NULL, ".
		  "CONSTRAINT TEMPLATEIDPRIMARY PRIMARY KEY (TEMPLATEID), ".
		  "CONSTRAINT TEMPLATENAMEUNIQUE UNIQUE (NAME), ".
		  "CONSTRAINT PLATEIDFOREIGN FOREIGN KEY (PLATEID) REFERENCES $newSchema.PLATES (PLATEID) ON DELETE CASCADE)".
		  " STORAGE (INITIAL 500K NEXT 500K)");

    # Make table to hold trace file locations
    $self->_doSql("CREATE TABLE $newSchema.SCFDIRS (PROJID NUMBER NOT NULL, SCFDIR VARCHAR2(256) NOT NULL, SCFDIRID NUMBER NOT NULL, ".
		  "CONSTRAINT SCFDIRIDPRIMARY PRIMARY KEY (SCFDIRID), ".
		  "CONSTRAINT UNIQUEDIRS UNIQUE (SCFDIR), ".
		  "CONSTRAINT SCFDIRPROJIDFOREIGN FOREIGN KEY (PROJID) REFERENCES $newSchema.PROJECT (PROJID) ON DELETE CASCADE)".
		  " STORAGE (INITIAL 10K NEXT 10K)");

    # Make table for read information
    $self->_doSql("CREATE TABLE $newSchema.READ (ANALYSED NUMBER NOT NULL, ASPED DATE NOT NULL, BASECALLER VARCHAR2(16) NOT NULL, ".
		  "DYE VARCHAR2(14) NOT NULL, PRIMER VARCHAR2(256) NOT NULL, PROCESSSTATUS VARCHAR2(128) NOT NULL, ".
		  "READID NUMBER NOT NULL, READNAME VARCHAR2(24) NOT NULL, SCFDIR NUMBER NOT NULL, SCFFILE VARCHAR2(32) NOT NULL, ".
		  "STRAND VARCHAR2(8) NOT NULL, TEMPLATEID NUMBER NOT NULL, ".
		  "CONSTRAINT READIDPRIMARY PRIMARY KEY (READID), ".
		  "CONSTRAINT READNAMEUNIQUE UNIQUE (READNAME), ".
		  "CONSTRAINT READTEMPLATEIDFOREIGN FOREIGN KEY (TEMPLATEID) REFERENCES $newSchema.TEMPLATE (TEMPLATEID) ON DELETE CASCADE, ".
		  "CONSTRAINT SCFDIRFOREIGN FOREIGN KEY (SCFDIR) REFERENCES $newSchema.SCFDIRS (SCFDIRID)) STORAGE (INITIAL 5M NEXT 5M)");

    # Make table for read screening information
    $self->_doSql("CREATE TABLE $newSchema.SCREEN (AGAINST VARCHAR2(256) NOT NULL, READID NUMBER NOT NULL, SCORE NUMBER NOT NULL, ".
		  "CONSTRAINT SCREENPRIMARYKEY PRIMARY KEY (READID, AGAINST), ".
		  "CONSTRAINT READIDFOREIGN FOREIGN KEY (READID) REFERENCES $newSchema.READ (READID)) STORAGE (INITIAL 1M NEXT 1M)");

    # Make tables for DNA sequences and base quality scores
    $self->_doSql("CREATE TABLE $newSchema.SEQUENCE (DNA LONG NOT NULL, GC NUMBER NOT NULL, LENGTH NUMBER NOT NULL, SEQID NUMBER NOT NULL, ".
		  "CONSTRAINT SEQIDPRIMARY PRIMARY KEY (SEQID)) STORAGE (INITIAL 10M NEXT 10M)");

    $self->_doSql("CREATE TABLE $newSchema.BASEQUALITY (QUAL LONG RAW NOT NULL, SEQID NUMBER NOT NULL, ".
		  "CONSTRAINT BASEQUALSEQIDPRIMARY PRIMARY KEY (SEQID), ".
		  "CONSTRAINT BASEQUALSEQIDFOREIGN FOREIGN KEY (SEQID) REFERENCES $newSchema.SEQUENCE (SEQID) ON DELETE CASCADE)".
		  " STORAGE (INITIAL 10M NEXT 10M)");

    # Make table to hold alignment information
    $self->_doSql("CREATE TABLE $newSchema.ALIGNTOSCF (ENDINSCF NUMBER NOT NULL, ENDINSEQ NUMBER NOT NULL, SEQID NUMBER NOT NULL, ".
		  "STARTINSCF NUMBER NOT NULL, STARTINSEQ NUMBER NOT NULL, ".
		  "CONSTRAINT ALIGNSCFPRIMARY PRIMARY KEY (SEQID, STARTINSEQ, ENDINSEQ), ".
		  "CONSTRAINT ALIGNSCFUNIQUE UNIQUE (SEQID, STARTINSCF, ENDINSCF), ".
		  "CONSTRAINT ASCFSEQIDFOREIGN FOREIGN KEY (SEQID) REFERENCES $newSchema.SEQUENCE (SEQID) ON DELETE CASCADE)".
		  " STORAGE (INITIAL 1M NEXT 1M)");

    # Make tables for sequence tags
    $self->_doSql("CREATE TABLE $newSchema.CLIPPING (BEGIN NUMBER NOT NULL, END NUMBER NOT NULL, SEQID NUMBER NOT NULL, ".
		  "TEXT VARCHAR2(256) NOT NULL, TYPE VARCHAR2(8) NOT NULL, ".
		  "CONSTRAINT CLIPPINGPRIMARYKEY PRIMARY KEY (SEQID, TYPE, BEGIN, END), ".
		  "CONSTRAINT CLIPPINGSEQIDFOREIGN FOREIGN KEY (SEQID) REFERENCES $newSchema.SEQUENCE (SEQID) ON DELETE CASCADE)".
		  " STORAGE (INITIAL 1M NEXT 1M)");

    $self->_doSql("CREATE TABLE $newSchema.CLONEVEC (BEGIN NUMBER NOT NULL, END NUMBER NOT NULL, SEQID NUMBER NOT NULL, ".
		  "TEXT VARCHAR2(256) NOT NULL, ".
		  "CONSTRAINT CLONEVECPRIMARY PRIMARY KEY (SEQID, BEGIN, END), ".
		  "CONSTRAINT CVSEQIDFOREIGN FOREIGN KEY (SEQID) REFERENCES $newSchema.SEQUENCE (SEQID) ON DELETE CASCADE)".
		  " STORAGE (INITIAL 1M NEXT 1M)");

    $self->_doSql("CREATE TABLE $newSchema.SEQVEC (BEGIN NUMBER NOT NULL, END NUMBER NOT NULL, SEQID NUMBER NOT NULL, ".
		  "TEXT VARCHAR2(256) NOT NULL, ".
		  "CONSTRAINT SEQVECPRIMARY PRIMARY KEY (SEQID, BEGIN, END), ".
		  "CONSTRAINT SVSEQIDFOREIGN FOREIGN KEY (SEQID) REFERENCES $newSchema.SEQUENCE (SEQID) ON DELETE CASCADE)".
		  " STORAGE (INITIAL 1M NEXT 1M)");

    $self->_doSql("CREATE TABLE $newSchema.TAG (BEGIN NUMBER NOT NULL, END NUMBER NOT NULL, SEQID NUMBER NOT NULL, ".
		  "TEXT VARCHAR2(256) NOT NULL, TYPE VARCHAR2(8) NOT NULL, ".
		  "CONSTRAINT TAGPRIMARY PRIMARY KEY (SEQID, TYPE, BEGIN, END), ".
		  "CONSTRAINT TAGSEQIDFOREIGN FOREIGN KEY (SEQID) REFERENCES $newSchema.SEQUENCE (SEQID) ON DELETE CASCADE)".
		  " STORAGE (INITIAL 1M NEXT 1M)");

    # Make tables for assembly information
    $self->_doSql("CREATE TABLE $newSchema.ASSEMBLY (ASSEMBLYID NUMBER NOT NULL, ASSEMBLYNUMBER NUMBER NOT NULL, PROJID NUMBER NOT NULL, ".
		  "COMPLETED DATE NOT NULL, TYPE CHAR(1) NOT NULL, DESCRIPTION VARCHAR2(256) NOT NULL, ".
		  "CONSTRAINT ASSEMBLYIDPRIMARY PRIMARY KEY (ASSEMBLYID), ".
		  "CONSTRAINT ASSEMBLYUNIQUE UNIQUE (ASSEMBLYNUMBER, PROJID), ".
		  "CONSTRAINT ASSEMBLYPROJIDFOREIGN FOREIGN KEY (PROJID) REFERENCES $newSchema.PROJECT (PROJID) ON DELETE CASCADE)".
		  " STORAGE (INITIAL 100K NEXT 100K)");

    $self->_doSql("CREATE TABLE $newSchema.ASSEMBLYFAILURES (ASSEMBLYID NUMBER NOT NULL, SEQID NUMBER NOT NULL, ".
		  "REASON VARCHAR2(256) NOT NULL, ".
		  "CONSTRAINT AFAILPRIMARY PRIMARY KEY (ASSEMBLYID, SEQID), ".
		  "CONSTRAINT AFAILASSEMBLIDFOREIGN FOREIGN KEY (ASSEMBLYID) REFERENCES $newSchema.ASSEMBLY (ASSEMBLYID) ON DELETE CASCADE, ".
		  "CONSTRAINT AFAILSEQIDFOREIGN FOREIGN KEY (SEQID) REFERENCES $newSchema.SEQUENCE (SEQID) ON DELETE CASCADE)");

    $self->_doSql("CREATE TABLE $newSchema.ASSEMBLYNOTES (ASSEMBLYID NUMBER NOT NULL, NOTES LONG NOT NULL, ".
		  "CONSTRAINT ANOTESPRIMARY PRIMARY KEY (ASSEMBLYID), ".
		  "CONSTRAINT ANOTESAIDFOREIGN FOREIGN KEY (ASSEMBLYID) REFERENCES $newSchema.ASSEMBLY (ASSEMBLYID) ON DELETE CASCADE)".
		  " STORAGE (INITIAL 100K NEXT 100K)");

    $self->_doSql("CREATE TABLE $newSchema.ASSEMBLYOPTS (ASSEMBLYID NUMBER NOT NULL, OPTS LONG NOT NULL, ".
		  "CONSTRAINT AOPTSPRIMARY PRIMARY KEY (ASSEMBLYID), ".
		  "CONSTRAINT AOPTSAIDFOREIGN FOREIGN KEY (ASSEMBLYID) REFERENCES $newSchema.ASSEMBLY (ASSEMBLYID) ON DELETE CASCADE)");

    $self->_doSql("CREATE TABLE $newSchema.ASSEMBLYSEQS (ASSEMBLYID NUMBER NOT NULL, SEQID NUMBER NOT NULL, ".
		  "CONSTRAINT ASEQSPRIMARY PRIMARY KEY (ASSEMBLYID, SEQID), ".
		  "CONSTRAINT ASEQSAIDFOREIGN FOREIGN KEY (ASSEMBLYID) REFERENCES $newSchema.ASSEMBLY (ASSEMBLYID) ON DELETE CASCADE, ".
		  "CONSTRAINT ASEQSSEQIDFOREIGN FOREIGN KEY (SEQID) REFERENCES $newSchema.SEQUENCE (SEQID) ON DELETE CASCADE)");

    # Make table for contig groups
    $self->_doSql("CREATE TABLE $newSchema.GROUPS (GROUPID NUMBER NOT NULL, LOCKEDBY VARCHAR2(16) NOT NULL, LOCKEDDATE DATE NOT NULL, ".
		  "CONSTRAINT GROUPIDPRIMARY PRIMARY KEY (GROUPID))");

    # Make table for contigs
    $self->_doSql("CREATE TABLE $newSchema.CONTIGS (ASSEMBLYID NUMBER NOT NULL, CONTIGID NUMBER NOT NULL, CONTIGNAME VARCHAR2(32) NOT NULL, ".
		  "GROUPID NUMBER NOT NULL, SEQID NUMBER NOT NULL, ".
		  "CONSTRAINT CONTIGIDPRIMARY PRIMARY KEY (CONTIGID), ".
		  "CONSTRAINT CONTIGNAMESUNIQUE UNIQUE (ASSEMBLYID, CONTIGNAME), ".
		  "CONSTRAINT GROUPSUNIQUE UNIQUE (GROUPID), ".
		  "CONSTRAINT SEQSUNIQUE UNIQUE (SEQID), ".
		  "CONSTRAINT CONTIGASSEMBLYIDFOREIGN FOREIGN KEY (ASSEMBLYID) REFERENCES $newSchema.ASSEMBLY (ASSEMBLYID) ON DELETE CASCADE, ".
		  "CONSTRAINT CONTIGGROUPIDFOREIGN FOREIGN KEY (GROUPID) REFERENCES $newSchema.GROUPS (GROUPID), ".
		  "CONSTRAINT CONTIGSEQIDFOREIGN FOREIGN KEY (SEQID) REFERENCES $newSchema.SEQUENCE (SEQID) ON DELETE CASCADE)");

    # Make table for contig assembly information
    $self->_doSql("CREATE TABLE $newSchema.ASSEMBLEDFROM (CONTIGID NUMBER NOT NULL, ENDINCONTIG NUMBER NOT NULL, ENDINSEQ NUMBER NOT NULL, ".
		  "SEQID NUMBER NOT NULL, STARTINCONTIG NUMBER NOT NULL, STARTINSEQ NUMBER NOT NULL, ".
		  "CONSTRAINT ASSEMBLEDFROMPRIMARY PRIMARY KEY (CONTIGID, SEQID, STARTINSEQ, ENDINSEQ), ".
		  "CONSTRAINT AFUNIQUE UNIQUE (CONTIGID, SEQID, STARTINCONTIG, ENDINCONTIG), ".
		  "CONSTRAINT AFCONTIGIDFOREIGN FOREIGN KEY (CONTIGID) REFERENCES $newSchema.CONTIGS (CONTIGID) ON DELETE CASCADE, ".
		  "CONSTRAINT AFSEQIDFOREIGN FOREIGN KEY (SEQID) REFERENCES $newSchema.SEQUENCE (SEQID) ON DELETE CASCADE)");

    # Make table linking reads with DNA sequences
    $self->_doSql("CREATE TABLE $newSchema.READ2SEQ (ASSEMBLYID NUMBER NOT NULL, READID NUMBER NOT NULL, SEQID NUMBER NOT NULL, ".
		  "CONSTRAINT READ2SEQPRIMARY PRIMARY KEY (READID, ASSEMBLYID), ".
		  "CONSTRAINT READ2SEQUNIQUE UNIQUE (SEQID), ".
		  "CONSTRAINT R2SASSEMBLYIDFOREIGN FOREIGN KEY (ASSEMBLYID) REFERENCES $newSchema.ASSEMBLY (ASSEMBLYID) ON DELETE CASCADE, ".
		  "CONSTRAINT R2SREADIDFOREIGN FOREIGN KEY (READID) REFERENCES $newSchema.READ (READID) ON DELETE CASCADE, ".
		  "CONSTRAINT R2SSEQIDFOREIGN FOREIGN KEY (SEQID) REFERENCES $newSchema.SEQUENCE (SEQID)) STORAGE (INITIAL 1M NEXT 1M)");

    # Make indicies
    $self->_doSql("CREATE INDEX $newSchema.READ_TEMPL_ID ON $newSchema.READ (TEMPLATEID)");
    $self->_doSql("CREATE INDEX $newSchema.TEMPL_PLATE_ID ON $newSchema.TEMPLATE (PLATEID)");


    # Make views
    $self->_doSql("create view $newSchema.extended_read as select read.*, template.name templatename, plates.plateid, plates.platename, ".
		  "ligation.ligid, ligation.lignumber, clones.cloneid, clones.clonename, project.projid, project.projname ".
		  "from $newSchema.read, $newSchema.template, $newSchema.plates, $newSchema.ligation, $newSchema.clones, $newSchema.project ".
		  "where template.templateid = read.templateid and plates.plateid = template.plateid ".
		  "and ligation.ligid = plates.ligid and clones.cloneid = ligation.cloneid and project.projid = clones.projid");

    $self->_doSql("create view $newSchema.ext_read2seq as select read2seq.*, assembly.assemblynumber, assembly.projid from ".
		  "$newSchema.read2seq, $newSchema.assembly where assembly.assemblyid = read2seq.assemblyid with read only");

    # Make sequences (used to obtain id numbers)
    $self->_doSql("CREATE SEQUENCE $newSchema.ASSEMBLYID");
    $self->_doSql("CREATE SEQUENCE $newSchema.CLONEID");
    $self->_doSql("CREATE SEQUENCE $newSchema.CONTIGID CACHE 20");
    $self->_doSql("CREATE SEQUENCE $newSchema.GROUPID");
    $self->_doSql("CREATE SEQUENCE $newSchema.LIGID");
    $self->_doSql("CREATE SEQUENCE $newSchema.PLATEID");
    $self->_doSql("CREATE SEQUENCE $newSchema.PROJID");
    $self->_doSql("CREATE SEQUENCE $newSchema.READID CACHE 20");
    $self->_doSql("CREATE SEQUENCE $newSchema.SCFDIRID");
    $self->_doSql("CREATE SEQUENCE $newSchema.SEQID CACHE 20");
    $self->_doSql("CREATE SEQUENCE $newSchema.TEMPLATEID CACHE 20");
}

sub makeRoles {
    my ($self, $schema) = @_;
    my @tables = ('ALIGNTOSCF', 'ASSEMBLEDFROM', 'ASSEMBLY', 'ASSEMBLYFAILURES', 'ASSEMBLYNOTES', 'ASSEMBLYOPTS', 'ASSEMBLYSEQS', 
		  'BASEQUALITY', 'CLIPPING', 'CLONES', 'CLONEVEC', 'CONTIGS', 'GROUPS', 'LIGATION', 'PLATES', 'PROJECT', 'READ', 
		  'READ2SEQ', 'SCFDIRS', 'SCREEN', 'SEQUENCE', 'SEQVEC', 'TAG', 'TEMPLATE', 'EXTENDED_READ', 'EXT_READ2SEQ');
    my $viewerRole = "ASSEMBLY_VIEW_$schema";
    $self->_doSql("CREATE ROLE $viewerRole NOT IDENTIFIED");
    my $table;
    foreach $table (@tables) {
	$self->_doSql("GRANT SELECT ON $schema.$table TO $viewerRole");
    }
    my @aspTables = ('TEMPLATE', 'READ', 'SEQUENCE', 'BASEQUALITY', 'SEQVEC', 'CLIPPING', 'TAG', 'CLONEVEC', 'ALIGNTOSCF', 'READ2SEQ',
		     'SCFDIRS');
    my $aspRole = "ASP_$schema";
    $self->_doSql("CREATE ROLE $aspRole NOT IDENTIFIED");
    foreach $table (@aspTables) {
	$self->_doSql("GRANT INSERT ON $schema.$table TO $aspRole");
    }
    $self->_doSql("GRANT SELECT ON $schema.READID TO $aspRole");
    $self->_doSql("GRANT SELECT ON $schema.SCFDIRID TO $aspRole");
    $self->_doSql("GRANT SELECT ON $schema.SEQID TO $aspRole");
    $self->_doSql("GRANT SELECT ON $schema.TEMPLATEID TO $aspRole");
    
    my @projTables = ('PROJECT', 'CLONES', 'SCFDIRS', 'ASSEMBLY');
    my $projRole = "PROJMAN_$schema";
    $self->_doSql("CREATE ROLE $projRole NOT IDENTIFIED");
    foreach $table (@projTables) {
	$self->_doSql("GRANT INSERT ON $schema.$table TO $projRole");
    }
    $self->_doSql("GRANT SELECT ON $schema.ASSEMBLYID TO $projRole");
    $self->_doSql("GRANT SELECT ON $schema.SCFDIRID TO $projRole");
    $self->_doSql("GRANT SELECT ON $schema.CLONEID TO $projRole");
    $self->_doSql("GRANT SELECT ON $schema.PROJID TO $projRole");

    my @subcloneTables = ('CLONES', 'LIGATION');
    my $subcloneRole = "SUBCLONE_$schema";
    $self->_doSql("CREATE ROLE $subcloneRole NOT IDENTIFIED");
    foreach $table (@subcloneTables) {
	$self->_doSql("GRANT INSERT ON $schema.$table TO $subcloneRole");
    }
    $self->_doSql("GRANT SELECT ON $schema.CLONEID TO $subcloneRole");
    $self->_doSql("GRANT SELECT ON $schema.LIGID TO $subcloneRole");

    my $pickerRole = "PICKER_$schema";
    $self->_doSql("CREATE ROLE $pickerRole NOT IDENTIFIED");
    $self->_doSql("GRANT INSERT ON $schema.PLATES TO $pickerRole");
    $self->_doSql("GRANT SELECT ON $schema.PLATEID TO $pickerRole");

    my @assemblerTables = ('SEQUENCE', 'BASEQUALITY', 'SEQVEC', 'CLIPPING', 'TAG', 'CLONEVEC', 'ALIGNTOSCF', 'READ2SEQ', 'SCREEN', 'GROUPS',
			   'CONTIGS', 'ASSEMBLEDFROM', 'ASSEMBLY', 'ASSEMBLYFAILURES', 'ASSEMBLYNOTES', 'ASSEMBLYOPTS', 'ASSEMBLYSEQS');
    my $assemblerRole = "ASSEMBLER_$schema";
    $self->_doSql("CREATE ROLE $assemblerRole NOT IDENTIFIED");
    foreach $table (@assemblerTables) {
	$self->_doSql("GRANT INSERT ON $schema.$table TO $assemblerRole");
    }

    my $editRole = "EDIT_ASSEM_$schema";
    $self->_doSql("CREATE ROLE $editRole NOT IDENTIFIED");
    $self->_doSql("GRANT INSERT ON $schema.GROUPS TO $editRole");
    $self->_doSql("GRANT DELETE ON $schema.GROUPS TO $editRole");
    $self->_doSql("GRANT UPDATE ON $schema.CONTIGS TO $editRole");
}


