#!/usr/local/bin/perl5.8.0 -w
use strict;

use TraceServer;
use Cwd;

die "Usage mv_awol.pl <plate1.suffix> <plate2.suffix> <...>\n" unless scalar @ARGV >= 1;

# Arg parsing
my (@plate) = ();
foreach (@ARGV) {
    my ($plate,$suf) = split /\./,$_;
    push @plate,($plate,$suf);
}

if(!-e "phd_dir") {
    print "error: no phd_dir, is this a project dir?\n";
    exit(0);
}
if(!-e "awol") {
    mkdir ("awol",0775);
}
if(!-e "awol/Failures") {
    mkdir ("awol/Failures",0775);
}
if(!-e "awol/phd_dir") {
    mkdir ("awol/phd_dir",0775);
}

# Assume project is the directory we are in.
my $this_project = getcwd();
$this_project =~ s:.*/::;

# Make a connection to the trace server DB and find/create the AWOL group
my $ts = TraceServer->new();

# Iterate through the appropriate subdirs.
mv_plate_reads_repos(".");
mv_plate_reads_repos("./Failures");
mv_plate_reads_repos("./phd_dir");

mv_plate_reads_trsrv($ts, $this_project, "PASS", "AWOP");
mv_plate_reads_trsrv($ts, $this_project, "FAIL", "AWOF");

# The guts - moves all sequences matching $plates[] array from $dir to
# the awol dir/group.
sub mv_plate_reads_repos {
    my ($dir) = @_;
    return (0) if(! -e $dir);

    opendir DIR, $dir or die "Can't open $dir directory: $!\n";
    while (defined(my $name = readdir DIR)) {
	my ($i);
	for($i=0;$i<@plate;$i+=2) {
	    if($name =~ /^($plate[$i])[a-p]\d\d?\./
	       && ($name =~ /\.$plate[$i+1]$/
		   || $name =~ /\.$plate[$i+1].phd.1$/
		   || $name =~ /\.$plate[$i+1]SCF$/)) {

		rename("$dir/$name","awol/$dir/$name");
		#print "rename $dir/$name awol/$dir/$name\n";
	    }
	}
    }
    close DIR;
}

# Internal Trace Server version of the above code; moves sequences from
# $proj/PASS & $proj/FAIL groups and moves them into $proj/AWOP & $proj/AWOF.
# the AWOL groups
sub mv_plate_reads_trsrv {
    my ($ts, $gname, $gtype, $awopf) = @_;

    my $group = $ts->get_group($gname, $gtype);
    return unless defined($group);

    my $toplevel = $ts->get_group($gname, "PROJ");
    if (!defined($toplevel)) {
	warn "No $gname PROJ top-level group; aborting";
	return;
    }

    # Create the parent AWOL group if it doesn't exist
    my $pgroup = $ts->get_group($gname, "AWOL");
    if (!defined($pgroup)) {
	$pgroup = $ts->new_group($gname, "AWOL", "", $toplevel);
	$ts->insert_group($pgroup);
    }

    # Create or obtain the AWOP/AWOF group as appropriate
    my $new_group = $ts->get_group($gname, $awopf);
    if (!defined($new_group)) {
	$new_group = $ts->new_group($gname, $awopf, "", $pgroup);
	$ts->insert_group($new_group);
    }


    # Copy all sequences for all readings in the input group to our new
    # AWOP/AWOF group, removing from their original place.
    my $grit = $group->get_iterator();
    while ($_ = $grit->next) {
	my $read = $ts->get_read_by_seq_id($_);
	my $name = $read->get_name();

	for(my $i=0;$i<@plate;$i+=2) {
	    if($name =~ /^($plate[$i])[a-p]\d\d?\./
	       && ($name =~ /\.$plate[$i+1]$/
		   || $name =~ /\.$plate[$i+1].phd.1$/
		   || $name =~ /\.$plate[$i+1]SCF$/)) {

		my $nseqs = $read->get_num_sequences();
		for (my $s = 0; $s < $nseqs; $s++) {
		    my $seq = $read->get_sequence_by_index($s);
		    # print $group->get_name ."/". $group->get_type . " -> "
		    # . $new_group->get_name ."/". $new_group->get_type . "\n";
		    $group->move_sequence($seq, $new_group);
		}
	    }
	}
    }
}
exit(0);

 # $Log: mv_awol.pl,v $
 # Revision 1.4  2006/08/29  09:22:41  jkb
 # Updates for Internal Trace Server.
 #
 # Revision 1.3  2002/11/20 13:48:03  rmd
 # Changed to handle 384 well plates.
 #
 # Revision 1.2  2000/08/29  16:08:40  rmd
 # Fixed nasty bug that caused too many plates to be moved (notably those that
 # had names starting with the plates that were supposed to be moved).
 #
