package Maasha::Biopieces;


# 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 for manipulation, parsing and emitting of human/machine readable biopieces records.


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


use vars qw( @ISA @EXPORT_OK );

require Exporter;

@ISA = qw( Exporter );

@EXPORT_OK = qw(
    read_stream
    write_stream
    get_record
    put_record
);


# >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> SIGNAL HANDLER <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<


$SIG{ '__DIE__' } = \&sig_handler;
$SIG{ 'INT' }     = \&sig_handler;
$SIG{ 'TERM' }    = \&sig_handler;


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

    # Log messages to logfile.

    # Returns nothing.

    my ( $time_stamp, $user, $script, $fh_global, $fh_local );

    $time_stamp = Maasha::Common::time_stamp();
    $user       = Maasha::Common::get_user();
    $script     = Maasha::Common::get_scriptname();

    $fh_global  = Maasha::Common::append_open( "$ENV{ 'BP_LOG' }/biopieces.log" );
    $fh_local   = Maasha::Common::append_open( "$ENV{ 'HOME' }/.biopieces.log" );

    print $fh_global "$time_stamp\t$user\t$script ", join( " ", @ARGV ), "\n";
    print $fh_local  "$time_stamp\t$user\t$script ", join( " ", @ARGV ), "\n";

    $fh_global->autoflush( 1 );
    $fh_local->autoflush( 1 );

    close $fh_global;
    close $fh_local;
}


sub read_stream
{
    # Martin A. Hansen, July 2007.

    # Opens a stream to STDIN or a file,

    my ( $path,   # path - OPTIONAL
       ) = @_;

    # Returns filehandle.

    my ( $fh );

    if ( not -t STDIN ) {
        $fh = Maasha::Common::read_stdin();
    } elsif ( not $path ) {
#        Maasha::Common::error( qq(no data stream) );
    } else {
        $fh = Maasha::Common::read_open( $path );
    }
    
#    $fh->autoflush(1) if $fh;  # Disable file buffer for debugging.

    return $fh;
}


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

    # Opens a stream to STDOUT or a file.

    my ( $path,   # path          - OPTIONAL
         $gzip,   # compress data - OPTIONAL
       ) = @_;

    # Returns filehandle.

    my ( $fh );

    if ( $path ) {
        $fh = Maasha::Common::write_open( $path, $gzip );
    } else {
        $fh = Maasha::Common::write_stdout();
    }

    return $fh;
}


sub get_record
{
    # Martin A. Hansen, July 2007.

    # Reads one record at a time and converts that record
    # to a Perl data structure (a hash) which is returned.

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

    # Returns a hash. 

    my ( $block, @lines, $line, $key, $value, %record );

    local $/ = "\n---\n";

    $block = <$fh>;

    chomp $block;

    return if not defined $block;

    @lines = split "\n", $block;

    foreach $line ( @lines )
    {
        ( $key, $value ) = split ": ", $line, 2;

        $record{ $key } = $value;
    }

    return wantarray ? %record : \%record;
}


sub put_record
{
    # Martin A. Hansen, July 2007.

    # Given a Perl datastructure (a hash ref) emits this to STDOUT or a filehandle.

    my ( $data,   # data structure
         $fh,     # file handle - OPTIONAL
       ) = @_;

    # Returns nothing.

    if ( scalar keys %{ $data } )
    {
        if ( $fh )
        {
            map { print $fh "$_: $data->{ $_ }\n" } keys %{ $data };
            print $fh "---\n";
        }
        else
        {
            map { print "$_: $data->{ $_ }\n" } keys %{ $data };
            print "---\n";
        }
    }

    undef $data;
}


sub getopt_files
{
    # Martin A. Hansen, November 2007.

    # Extracts files from an explicit GetOpt::Long argument
    # allowing for the use of glob. E.g.
    # --data_in=test.fna
    # --data_in=test.fna,test2.fna
    # --data_in=*.fna
    # --data_in=test.fna,/dir/*.fna

    my ( $option,   # option from GetOpt::Long
       ) = @_;

    # Returns a list.

    my ( $elem, @files );

    foreach $elem ( split ",", $option )
    {
        if ( -f $elem ) {
            push @files, $elem;
        } elsif ( $elem =~ /\*/ ) {
            push @files, glob( $elem );
        }
    }

    return wantarray ? @files : \@files;
}


sub sig_handler
{
    # Martin A. Hansen, April 2008.

    # Removes temporary directory and exits gracefully.
    # This subroutine is meant to be run always as the last
    # thing even if a script is dies or is interrupted
    # or killed. 

    my ( $sig,   # signal from the %SIG
       ) = @_;

    # print STDERR "signal->$sig<-\n";

    chomp $sig;

    sleep 1;

    if ( -d $BP_TMP )
    {
        if ( $sig =~ /MAASHA_ERROR/ ) {
            print STDERR "\nProgram '$script' had an error"                     . "  -  Please wait for temporary data to be removed\n";
        } elsif ( $sig eq "INT" ) {
            print STDERR "\nProgram '$script' interrupted (ctrl-c was pressed)" . "  -  Please wait for temporary data to be removed\n";
        } elsif ( $sig eq "TERM" ) {
            print STDERR "\nProgram '$script' terminated (someone used kill?)"  . "  -  Please wait for temporary data to be removed\n";
        } else {
            print STDERR "\nProgram '$script' died->$sig"                       . "  -  Please wait for temporary data to be removed\n";
        }

        clean_tmp();
    }

    exit( 0 );
}


sub clean_tmp
{
    # Martin A. Hansen, July 2008.

    # Cleans out any unused temporary files and directories in BP_TMP.

    # Returns nothing.

    my ( $tmpdir, @dirs, $curr_pid, $dir, $user, $sid, $pid );

    $tmpdir = $ENV{ 'BP_TMP' } || Maasha::Common::error( 'No BP_TMP variable in environment.' );

    $curr_pid = Maasha::Common::get_processid();

    @dirs = Maasha::Common::ls_dirs( $tmpdir );

    foreach $dir ( @dirs )
    {
        if ( $dir =~ /^$tmpdir\/(.+)_(\d+)_(\d+)_bp_tmp$/ )
        {
            $user = $1;
            $sid  = $2;
            $pid  = $3;

#            next if $user eq "maasha"; # DEBUG

            if ( $user eq Maasha::Common::get_user() )
            {
                if ( not Maasha::Common::process_running( $pid ) )
                {
                    # print STDERR "Removing stale dir: $dir\n";
                    Maasha::Common::dir_remove( $dir );
                }
                elsif ( $pid == $curr_pid )
                {
                    # print STDERR "Removing current dir: $dir\n";
                    Maasha::Common::dir_remove( $dir );
                }
            }
        }
    }
}


END
{
    clean_tmp();
}


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


1;

__END__
