package Maasha::BioRun;


# Copyright (C) 2007-2009 Martin A. Hansen.

# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation; either version 2
# of the License, or (at your option) any later version.

# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.

# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.

# http://www.gnu.org/copyleft/gpl.html


# >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> DESCRIPTION <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<


# Routines that contains Biopieces which are run.


# >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<


use strict;
use Data::Dumper;
use Getopt::Long qw( :config bundling );
use Time::HiRes qw( gettimeofday );
use Storable qw( dclone );
use Maasha::Biopieces;
use Maasha::Config;
use Maasha::Common;
use Maasha::Filesys;
use Maasha::Fasta;
use Maasha::EMBL;
use Maasha::Seq;
use Maasha::Calc;
use Maasha::UCSC;
use Maasha::UCSC::BED;
use Maasha::UCSC::Wiggle;
use Maasha::NCBI;
use Maasha::GFF;
use Maasha::TwoBit;
use Maasha::Solid;
use Maasha::Solexa;
use Maasha::SQL;
use Maasha::Gwiki;

use vars qw( @ISA @EXPORT_OK );

require Exporter;

@ISA = qw( Exporter );

use constant {
    SEQ_NAME => 0,
    SEQ      => 1,
};


# >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> GLOBALS <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<


my ( $script, $BP_TMP );

$script = Maasha::Common::get_scriptname();
$BP_TMP = Maasha::Common::get_tmpdir();


# >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> RUN SCRIPT <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<


run_script( $script );


# >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> SUBROUTINES <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<


sub run_script
{
    # Martin A. Hansen, August 2007.

    # Run a specific script.

    my ( $script,   # script name
       ) = @_;

    # Returns nothing.

    my ( $t0, $t1, $options, $in, $out );

    Maasha::Biopieces::log_biopiece();

    $t0 = gettimeofday();

    $options = get_options( $script );

    $options->{ "SCRIPT" } = $script;

    $script = "print_usage" if ( -t STDIN and keys %{ $options } <= 1 or $options->{ 'help' } );

    $in  = Maasha::Biopieces::read_stream( $options->{ "stream_in" } );
    $out = Maasha::Biopieces::write_stream( $options->{ "stream_out" } );

    if    ( $script eq "print_usage" )              { script_print_usage(               $in, $out, $options ) }
    elsif ( $script eq "complexity_seq" )           { script_complexity_seq(            $in, $out, $options ) }

    close $in if defined $in;
    close $out;

    $t1 = gettimeofday();

    print STDERR "Program: $script" . ( " " x ( 25 - length( $script ) ) ) . sprintf( "Run time: %.4f\n", ( $t1 - $t0 ) ) if $options->{ 'verbose' };
}


sub get_options
{
    # Martin A. Hansen, February 2008.

    # Gets options from commandline and checks these vigerously.

    my ( $script,     # name of script
       ) = @_;

    # Returns hash

    my ( %options, @options, $opt, @genomes, $real );

    if ( $script eq "print_usage" )
    {
        @options = qw(
            data_in|i=s
        );
    }

    push @options, qw(
        stream_in|I=s
        stream_out|O=s
        verbose|v
        help|?
    );

#    print STDERR Dumper( \@options );
    
    GetOptions(
        \%options,
        @options,
    );

#    print STDERR Dumper( \%options );

    if ( -t STDIN && scalar( keys %options ) == 0 or $options{ "help" } ) {
        return wantarray ? %options : \%options;
    }

    $options{ "cols" }      = [ split ",", $options{ "cols" } ]      if defined $options{ "cols" };
    $options{ "keys" }      = [ split ",", $options{ "keys" } ]      if defined $options{ "keys" };
    $options{ "no_keys" }   = [ split ",", $options{ "no_keys" } ]   if defined $options{ "no_keys" };
    $options{ "save_keys" } = [ split ",", $options{ "save_keys" } ] if defined $options{ "save_keys" };
    $options{ "quals" }     = [ split ",", $options{ "quals" } ]     if defined $options{ "quals" };
    $options{ "feats" }     = [ split ",", $options{ "feats" } ]     if defined $options{ "feats" };
    $options{ "frames" }    = [ split ",", $options{ "frames" } ]    if defined $options{ "frames" };
    $options{ "samples" }   = [ split ",", $options{ "samples" } ]   if defined $options{ "samples" };
    $options{ "tables" }    = [ split ",", $options{ "tables" } ]    if defined $options{ "tables" };
    $options{ "tracks" }    = [ split ",", $options{ "tracks" } ]    if defined $options{ "tracks" };
    
    # ---- check arguments ----

    if ( $options{ 'data_in' } )
    {
        $options{ "files" } = Maasha::Biopieces::getopt_files( $options{ 'data_in' } );

        Maasha::Common::error( qq(Argument to --data_in must be a valid file or fileglob expression) ) if scalar @{ $options{ "files" } } == 0;
    }

    map { Maasha::Common::error( qq(Argument to --cols must be a whole numbers - not "$_") ) if $_ !~ /^\d+$/ } @{ $options{ "cols" } } if $options{ "cols" };

    # print STDERR Dumper( \%options );

    $real = "beg|end|word_size|wrap|len|prefix_length|mismatches|offset|num|skip|cpus|window_size|step_size";

    foreach $opt ( keys %options )
    {
        if ( $opt =~ /stream_in|pattern_in|exact_in/ and not -f $options{ $opt } )
        {
            Maasha::Common::error( qq(Argument to --$opt must be a valid file or fileglob expression - not "$options{ $opt }") );
        }
        elsif ( $opt =~ /$real/ and $options{ $opt } !~ /^\d+$/ )
        {
            Maasha::Common::error( qq(Argument to --$opt must be a whole number - not "$options{ $opt }") );
        }
        elsif ( $opt =~ /max_hits|max_hits|max_misses|dist|edit_dist|flank|gap|hamming_dist|priority/ and $options{ $opt } !~ /^-?\d+$/ )
        {
            Maasha::Common::error( qq(Argument to --$opt must be an integer - not "$options{ $opt }") );
        }
        elsif ( $opt =~ /identity|threshold/ and $options{ $opt } !~ /^-?(?:\d+(?:\.\d*)?|\.\d+)$/ )
        {
            Maasha::Common::error( qq(Argument to --$opt must be a decimal number - not "$options{ $opt }") );
        }
        elsif ( $opt =~ /e_val/ and $options{ $opt } !~ /^([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/ )
        {
            Maasha::Common::error( qq(Argument to --$opt must be a float - not "$options{ $opt }") );
        }
        elsif ( $opt =~ /strand/ and $options{ $opt } !~ /^(\+|-)$/ )
        {
            Maasha::Common::error( qq(Argument to --$opt must be "+" or "-" - not "$options{ $opt }") );
        }
        elsif ( $opt eq "genome" )
        {
            @genomes = Maasha::Common::ls_dirs( "$ENV{ 'BP_DATA' }/genomes" );
            map { $_ =~ s/.*\/(.+)$/$1/ } @genomes;

            if ( not grep { $_ =~ /^$options{ $opt }$/ } @genomes ) {
                Maasha::Common::error( qq(Genome $options{ $opt } not found in "$ENV{ 'BP_DATA' }/genomes/") );
            }
        }
        elsif ( $opt eq "terminal" and not $options{ $opt } =~ /^(svg|post|dumb|x11)/ )
        {
            Maasha::Common::error( qq(Bad --$opt argument "$options{ $opt }") );
        }
        elsif ( $opt eq "table" and $options{ $opt } =~ /(-|\.)/ )
        {
            Maasha::Common::error( qq(Character '$1' is not allowed in table name: $options{ $opt }) );
        }
        elsif ( $opt eq "merge" and $options{ $opt } !~ /^(AandB|AorB|BorA|AnotB|BnotA)$/ )
        {
            Maasha::Common::error( qq(Argument to --$opt must be AandB, AorB, BorA, AnotB, or BnotA - not "$options{ $opt }") );
        }
    }


    return wantarray ? %options : \%options;
}


# >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> SCRIPTS  <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<


sub script_print_usage
{
    # Martin A. Hansen, January 2008.

    # Retrieves usage information from file and
    # prints this nicely formatted.

    my ( $in,        # handle to in stream
         $out,       # handle to out stream
         $options,   # options hash
       ) = @_;

    # Returns nothing.

    my ( $file, $wiki, $lines );

    if ( $options->{ 'data_in' } ) {
        $file = $options->{ 'data_in' };
    } else {
        $file = join "", $ENV{ 'BP_DIR' }, "/bp_usage/", $options->{ 'SCRIPT' }, ".wiki";
    }

    $wiki = Maasha::Gwiki::gwiki_read( $file );

    ( $wiki->[ 2 ], $wiki->[ 3 ], $wiki->[ 0 ], $wiki->[ 1 ] ) = ( $wiki->[ 0 ], $wiki->[ 1 ], $wiki->[ 2 ], $wiki->[ 3 ] );

    if ( not $options->{ "help" } ) {
        @{ $wiki } = grep { $_->[ 0 ]->{ 'SECTION' } =~ /Biopiece|summary|Usage|Options|Help/ } @{ $wiki };
    }

    $lines = Maasha::Gwiki::gwiki2ascii( $wiki );

    print STDERR "$_\n" foreach @{ $lines };

    exit;
}


sub script_complexity_seq
{
    # Martin A. Hansen, May 2008.

    # Generates an index calculated as the most common di-residue over
    # the sequence length for all sequences in stream.

    my ( $in,     # handle to in stream
         $out,    # handle to out stream
       ) = @_;

    # Returns nothing.

    my ( $record, $index );

    while ( $record = Maasha::Biopieces::get_record( $in ) ) 
    {
        $record->{ "SEQ_COMPLEXITY" } = sprintf( "%.2f", Maasha::Seq::seq_complexity( $record->{ "SEQ" } ) ) if $record->{ "SEQ" };

        Maasha::Biopieces::put_record( $record, $out );
    }
}


# >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

1;

__END__

