#!/usr/local/bin/perl5.6.1 -w
#
#
#$Id: indexclone.pl,v 1.90 2006/11/10 11:44:53 kva Exp $
#
#######################################################################
# 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.                      #
#######################################################################
#
#
###############################################
# The script rewrites the importsizes indexes #
# every monday morning at 4am, set up on a    #
# cron on galyep.  It writes to files to the  #
# directory /nfs/disk54/badger/src/confirm/   #
# confirmstl/SIZE where importsizes uses the  #
# the indexed files.                          #                          
#                                             #
# Author : Karen Ambrose (kva).               #
###############################################

use strict;
use DB_File;
use File::Copy;
use POSIX qw(uname);

##testing purposes
#my $email = 'kva';

##real recipients
my $email = 'kva,usg';

##name and location of file to be generated.
#my $basedir = '/nfs/disk54/badger/src/confirm/confirmstl/SIZE';
#my $newdir = $ENV{HOME}.'/src/confirmstl/TESTSIZE/';
#my $basedir = '$ENV{HOME}/src/confirmstl/SIZE';
my $basedir = "/tmp";
my $newdir = '/nfs/disk54/badger/src/confirm/confirmstl/SIZE/';

my $gscdb = "$basedir/sizesGSC.db";
my $scdb  = "$basedir/sizesSC.db";
my %GSC_INDEX;
my %SC_INDEX;

my $host = (uname)[1];

#List all the directories that
#are to be included in the index.
my $inputs = { 
    "/nfs/GSC/Humanmap_agarose/fpc/Sizes"           => 1,
    "/nfs/GSC/Humanmap_agarose/SCDATA/SCSIZES"      => 1,
    "/nfs/disk59/fpc/MUScdb/Sizes"                  => 1,
    "/nfs/disk59/fpc/MOUSEBC/fpc_mousemap/Sizes"    => 1,
    "/nfs/disk59/fpc/MOUSEBC/SCDATA/SCSIZES"        => 1,
    "/nfs/disk59/fpc/CmMUScdb/Sizes"                => 1,
    "/nfs/disk59/fpc/zebrafish/Sizes"               => 1,
    "/nfs/disk59/fpc/Tetradon/Sizes"                => 1,
    "/nfs/disk59/fpc/9GSC/Sizes"                    => 1,
    "/nfs/disk59/fpc/porcine/Sizes"                 => 1,
    "/nfs/disk59/fpc/chr17/Sizes"                   => 1,
    "/nfs/disk59/fpc/gallus/Sizes"                  => 1,
    "/nfs/disk59/fpc/platypus/Sizes"                => 1,
    "/nfs/disk59/fpc/C2MUScdb/Sizes"                => 1,
    "/nfs/disk59/fpc/C11MUScdb/Sizes"               => 1,
    "/nfs/disk59/fpc/wallaby/Sizes"                 => 1,
    "/nfs/disk59/fpc/HSA1_HindIII/Sizes"            => 1,
    "/nfs/disk59/fpc/CXMUScdb/Sizes"                => 1,
    "/nfs/disk59/fpc/medicago/Sizes"                => 1,
    "/nfs/disk59/fpc/MUScdb/C11MUScdb/Sizes"        => 1,
    "/nfs/disk59/fpc/MUScdb/CXMUScdb/Sizes"         => 1,
    "/nfs/disk59/fpc/IDD/Sizes"                     => 1,
    "/nfs/disk59/fpc/tomato/tomatocheck/Sizes"      => 1,
    "/nfs/disk59/fpc/Chr21p/Sizes"                  => 1,
    "/nfs/disk59/fpc/tomato/april2005/Sizes"        => 1,
    "/nfs/disk59/fpc/Gibbon/Sizes"                  => 1,
    "/nfs/disk59/fpc/MUScdb/C4MUScdb/Sizes"         => 1,
    "/nfs/disk59/fpc/MUScdb/C2MUScdb/Sizes"         => 1,
    "/nfs/disk59/fpc/MUP/Sizes"                     => 1,
    "/nfs/disk59/fpc/Chr22agarose/Sizes"            => 1
    };


#special hash of arrays to list specific files
#from the directories listed above.
my %HoA;
%HoA = (
#    whole directory is going to be indexed    "/nfs/disk59/fpc/9GSC/Sizes"  => ["9H_1_62.sizes","SC9BAC250.sizes","9H_2.sizes","9H_6.sizes","9fp231.sizes","ASST_7.1.sizes","ASST_7.sizes","asst_9.sizes","asst_10.sizes","mapfin7.sizes","cos1.sizes"],
        "/nfs/disk59/fpc/chr17/Sizes" => ["chr17.1.sizes"],
        "/nfs/disk59/fpc/C2MUScdb/Sizes" => ["mixfp_3.sizes","MUS_TELOMERE_1.sizes"],
	"/nfs/disk59/fpc/C11MUScdb/Sizes" => ["MUS_FOS_1.sizes","MUS_FOS_2.sizes","MUS_TELOMERE_1.sizes","MUS_MIXFP_7.sizes","CKB15_FOS5.sizes"],
	"/nfs/disk59/fpc/CXMUScdb/Sizes" => ["MUSXFP5.sizes","23.sizes","MUS_TELOMERE_1.sizes","assorted.sizes","MUSFP6.sizes","MUSPK175.sizes"],
        "/nfs/disk59/fpc/MUScdb/C11MUScdb/Sizes" => ["MUS_NODFP_1.sizes","POOLCKB14.sizes","Mus_fos_6.sizes"],
        "/nfs/disk59/fpc/MUScdb/CXMUScdb/Sizes" => ["MUSPK175.sizes","Musfos_14.sizes"],
        "/nfs/disk59/fpc/tomato/tomatocheck/Sizes" => ["TOM_SEQ_1.sizes","A_TOMSEQ3.sizes","A_TOMSEQ4.sizes","A_TOMFP_3.sizes","A_TOMFP_4.sizes"],
        "/nfs/disk59/fpc/tomato/april2005/Sizes" => ["TOMSEQ_2.sizes","a1020C1.sizes","a1114A1.sizes","a1308C1.sizes"],
        "/nfs/disk59/fpc/MUP/Sizes" => ["Mus_mup_1.sizes"]
        );

#####################
# M A I N 
#####################

&mail_user($email, "The cronjob located on $host for the index updates of importsizes has started (using indexclone.pl)" );


eval {

    &rotate_old_databases($gscdb);
    &rotate_old_databases($scdb);
    
    my $files = &read_input_files($inputs,\%HoA);
    
    tie %GSC_INDEX, "DB_File", $gscdb;
    foreach my $file ( @{$files} ) {
        &create_gsc_index($file, \%GSC_INDEX);
    }
    untie %GSC_INDEX;
    
    tie %SC_INDEX, "DB_File", $scdb;
    foreach my $file ( @{$files} ) {
        &create_sc_index($file, \%SC_INDEX);
    }
    untie %SC_INDEX;

    &rotate_old_databases2($scdb,$newdir,'sizesSC.db');
    &rotate_old_databases2($gscdb,$newdir,'sizesGSC.db');

    my $scstart = -s $scdb;
    my $scfinal = $newdir.'sizesSC.db';
    my $scfini = -s $scfinal;
    my $gscstart = -s $gscdb;
    my $gscfinal = $newdir.'sizesGSC.db';
    my $gscfini = -s $gscfinal;

#    print "SC START $scstart, SC FINISH $scfini, GSC START $gscstart, GSC FINISH $gscfini\n";

    if (($scstart ne $scfini) || ($gscstart ne $gscfini)){
        if ($scstart ne $scfini) {
            &mail_user($email, "There may be a problem with regards the copying of the file $scdb (size $scstart) to its new destination $scfinal (size $scfini)." );
        }
        elsif ($gscstart ne $gscfini) {
            &mail_user($email, "There may be a problem with regards the copying of the file $gscdb (size $gscstart) to its new destination $gscfinal (size $gscfini)." );
        }
    } else {
        &mail_user($email, "The cronjob located on $host for the index updates of importsizes has completed" );
    }
    
};

if ( $@ ){
    &mail_user($email, "The cronjob located on $host FAILED : $@ ");
}


###############################
# S U B R O U T I N E S
###############################

sub read_input_files {
        my ($input,$hoa) = @_;
        my @files;
        my %INPUT_HASH = %$input;
        my %SPECIAL_FILES = %$hoa;

        foreach my $basedir ( keys %INPUT_HASH ){
            opendir( DIR, $basedir) or die("Failed to open $basedir: $! \n");
            if (defined $SPECIAL_FILES{$basedir}){
                foreach my $file (@{$SPECIAL_FILES{$basedir}}){
                    my $filename = "$basedir/$file";
                    push @files ,$filename;
                } 
            } else { 
                push @files ,map{ "$basedir/$_" } grep(/^.*\.sizes$/, readdir DIR);
            }
            closedir(DIR);
        }
        
        return \@files;
}


sub create_gsc_index {
        my ( $file, $INDEX ) = @_;
        my %HASHEX = (
                      "N"=>"bA",
                      "M"=>"bK",
                      "A"=>"bM",
                      "B"=>"bN",
                      "F"=>"bB"
                      );

        return if ! -e $file;
        return if -z $file;
        open(F, "$file") or die("Can't open $file: $!\n");

        while (<F>){
                my $newclone;
                next unless /^\s*(\S+)\s+\d+\s+\S+\s*$/;
                my $clone = $1;
                next unless $clone =~ /^2?(N|M|A|B|F)0*(\d+)([A-Z])0*(\d+)[a-z]*$/;

                if ($HASHEX{$1}){
                    $newclone=$HASHEX{$1};
                }
                my $stclone = $newclone.$2.$3.$4;

                if ( !defined $INDEX->{$stclone} ) {
                    $INDEX->{$stclone} ="$file*$clone";
                }else{
                    $INDEX->{$stclone}.="\t$file*$clone";
                }
        }
        close(F) or die("Can't close filehandle on $file: $!\n");
	return 1;
}


sub create_sc_index {
        my ( $file, $INDEX ) = @_;

        return if ! -e $file;
        return if -z $file;
        open(F, "$file") or die("Can't open $file: $!\n");

        while (<F>)      {
                next unless /^\s*(\S+)\s+\d+\s+\S+\s*$/;
                 my $clone = $1;
	#	next unless $clone =~ /^[bdz][A-Z]+\d+[A-Z]+\d+$|[df][A-Z]+\d+[A-Z]+\d+$/;
                next unless $clone =~ /^[bdz][A-Z]+\d+[A-Z]+\d+$|[df][A-Z]+\d+[A-Z]+\d+$|\d+\w+\d+$|\w+\d+\w+$|\w+$|\d+$/;                
                
                my $ID_CLONE = $clone;
                if ($ID_CLONE=~ /^zC0+?\S+/){
                    $ID_CLONE=~ s/0+(?=[1-9])//;
                }
                
                if (!defined $INDEX->{$ID_CLONE}) {
                    $INDEX->{$ID_CLONE}  = "$file*$clone";
                } else {
                    $INDEX->{$ID_CLONE} .= "\t$file*$clone";
                }
                
            }
        close(F) or die("Can't close filehandle on $file: $!\n");
	return 1;
    }

sub mail_user {
    my ($user, $message ) = @_;
        open(MAIL, "|/usr/lib/sendmail $user") or die("Failed to open sendmail $!");
        print MAIL <<END_OF_MAIL;
From: cron\@sanger.ac.uk
To: $user\@sanger.ac.uk
Return-Path: $user\@sanger.ac.uk
Subject: Weekly Fingerprint Index Update  

        $message

END_OF_MAIL
        close(MAIL);
}


sub rotate_old_databases {
        my ($db) = @_;
        my $orig = "$db";

        if ( -e $orig ) {
                unlink($orig) or die("Can't delete $orig: $!\n");
        }
        return 1;
}

sub rotate_old_databases2 {
    my ($db,$ndr,$ext) = @_;

    my $orig = "$ndr"."$ext";
    my $backup = "$ndr"."$ext".".old";
    
    if ( -e $backup ) {
#        print "BACKUP :- $backup\n";
        unlink($backup) or die("Can't delete $backup: $!\n");
    }
    
    if ( -e $orig ) {
#        print "ORIGINAL :- $orig\n";
        move($orig,$backup) or die("Can't move $orig to $backup: $!\n");
    }
    
    if (-e $db) {
#        print "DB :- $db\n";
        copy($db,$orig) or die("Can't copy $db to $orig: $!\n");
    }
    return 1;
}














