]> git.donarmstrong.com Git - biopieces.git/blobdiff - code_perl/Maasha/Biopieces.pm
fixed missing BP_TMP dir feature
[biopieces.git] / code_perl / Maasha / Biopieces.pm
index 09218a67cdfcfd5acc708585440071affb4ea6e6..434cdad8cf738328478eba8a4d6a3e154a2824a2 100644 (file)
@@ -56,6 +56,9 @@ $SIG{ 'INT' }     = \&sig_handler;
 $SIG{ 'TERM' }    = \&sig_handler;
 
 
+# >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> SUBROUTINES <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+
+
 sub status_set
 {
     my ( $time_stamp, $script, $user, $pid, $file, $fh );
@@ -65,8 +68,9 @@ sub status_set
     $script     = Maasha::Common::get_scriptname();
     $pid        = Maasha::Common::get_processid();
 
-    $file = "$ENV{ 'BP_TMP' }/" . join( ".", $user, $script, $pid ) . ".status";
+    $file = bp_tmp() . "/" . join( ".", $user, $script, $pid ) . ".status";
     $fh   = Maasha::Filesys::file_write_open( $file );
+    flock($fh, 2);
 
     print $fh join( ";", $time_stamp, join( " ", @ARGV ) ) . "\n";
 
@@ -95,11 +99,12 @@ sub status_log
     $script     = Maasha::Common::get_scriptname();
     $pid        = Maasha::Common::get_processid();
 
-    $file = "$ENV{ 'BP_TMP' }/" . join( ".", $user, $script, $pid ) . ".status";
+    $file = bp_tmp() . "/" . join( ".", $user, $script, $pid ) . ".status";
 
     return if not -f $file;
 
     $fh   = Maasha::Filesys::file_read_open( $file );
+    flock($fh, 1);
     $line = <$fh>;
     chomp $line;
     close $fh;
@@ -113,7 +118,9 @@ sub status_log
     $elap = Maasha::Common::time_stamp_diff( $time0, $time1 );
 
     $fh_global = Maasha::Filesys::file_append_open( "$ENV{ 'BP_LOG' }/biopieces.log" );
+    flock($fh_global, 2);
     $fh_local  = Maasha::Filesys::file_append_open( "$ENV{ 'HOME' }/.biopieces.log" );
+    flock($fh_local, 2);
 
     print $fh_global join( "\t", $time0, $time1, $elap, $user, $status, "$script $args" ) . "\n";
     print $fh_local  join( "\t", $time0, $time1, $elap, $user, $status, "$script $args" ) . "\n";
@@ -134,23 +141,20 @@ sub log_biopiece
 
     # Returns nothing.
 
-    my ( $time_stamp, $user, $script, $fh_global, $fh_local );
+    my ( $time_stamp, $user, $script, $fh );
 
     $time_stamp = Maasha::Common::time_stamp();
     $user       = Maasha::Common::get_user();
     $script     = Maasha::Common::get_scriptname();
 
-    $fh_global  = Maasha::Filesys::file_append_open( "$ENV{ 'BP_LOG' }/biopieces.log" );
-    $fh_local   = Maasha::Filesys::file_append_open( "$ENV{ 'HOME' }/.biopieces.log" );
+    $fh = Maasha::Filesys::file_append_open( "$ENV{ 'BP_LOG' }/biopieces.log" );
+    flock($fh, 2);
 
-    print $fh_global "$time_stamp\t$user\t$script ", join( " ", @ARGV ), "\n";
-    print $fh_local  "$time_stamp\t$user\t$script ", join( " ", @ARGV ), "\n";
+    print $fh "$time_stamp\t$user\t$script ", join( " ", @ARGV ), "\n";
 
-    $fh_global->autoflush( 1 );
-    $fh_local->autoflush( 1 );
+    $fh->autoflush( 1 );
 
-    close $fh_global;
-    close $fh_local;
+    close $fh;
 }
 
 
@@ -289,7 +293,12 @@ sub parse_options
 {
     # Martin A. Hansen, May 2009
 
-    # 
+    # Parses and checks options for Biopieces.
+
+    # First the argument list is checked for duplicates and then
+    # options are parsed from ARGV after which it is checked if
+    # the Biopieces usage information should be printed. Finally,
+    # all options from ARGV are checked according to the argument list.
 
     my ( $arg_list,   # data structure with argument description
        ) = @_;
@@ -301,7 +310,6 @@ sub parse_options
     # ---- Adding the mandatory arguments to the arg_list ----
 
     push @{ $arg_list }, (
-    
         { long => 'help',       short => '?', type => 'flag',  mandatory => 'no', default => undef, allowed => undef, disallowed => undef },
         { long => 'stream_in',  short => 'I', type => 'file!', mandatory => 'no', default => undef, allowed => undef, disallowed => undef },
         { long => 'stream_out', short => 'O', type => 'file',  mandatory => 'no', default => undef, allowed => undef, disallowed => undef },
@@ -393,23 +401,27 @@ sub check_print_usage
 
     # Returns nothing.
 
-    my ( $script, $wiki );
+    my ( %options, $help, $script, $wiki );
+
+    %options = %{ $options };
+    $help    = $options{ 'help' };
+    delete $options{ 'help' };
 
     $script = Maasha::Common::get_scriptname();
 
     if ( $script ne 'print_wiki' )
     {
-        if ( exists $options->{ 'help' } or -t STDIN )
+        if ( $help or -t STDIN )
         {
-            if ( not ( exists $options->{ 'stream_in' } or $options->{ 'data_in' } ) )
+            if ( not ( exists $options{ 'stream_in' } or $options{ 'data_in' } ) )
             {
-                if ( scalar keys %{ $options } <= 1 ) 
+                if ( scalar keys %options == 0 ) 
                 {
                     $wiki = $ENV{ 'BP_DIR' } . "/bp_usage/$script.wiki";
                
-                    if ( exists $options->{ 'help' } ) {
+                    if ( $help ) {
                         `print_wiki --data_in=$wiki --help`;
-                    } elsif ( $script =~ /^(list_biopieces|list_genomes)$/ ) {
+                    } elsif ( $script =~ /^(list_biopieces|list_genomes|list_mysql_databases|biostat)$/ ) {
                         return;
                     } else {
                         `print_wiki --data_in=$wiki`;
@@ -683,35 +695,36 @@ sub check_disallowed
 }
 
 
-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;
-}
+# marked for deletion - obsolete?
+#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
@@ -742,7 +755,7 @@ sub sig_handler
     elsif ( $sig eq "INT" )
     {
         print STDERR "\nProgram '$script' interrupted (ctrl-c was pressed)" . "  -  Please wait for temporary data to be removed\n";
-        status_log( "INTERUPTED" );
+        status_log( "INTERRUPTED" );
     }
     elsif ( $sig eq "TERM" )
     {
@@ -771,7 +784,7 @@ sub clean_tmp
 
     my ( $tmpdir, @dirs, $curr_pid, $dir, $user, $sid, $pid );
 
-    $tmpdir = $ENV{ 'BP_TMP' } || Maasha::Common::error( 'No BP_TMP variable in environment.' );
+    $tmpdir = bp_tmp();
 
     $curr_pid = Maasha::Common::get_processid();
 
@@ -805,38 +818,6 @@ sub clean_tmp
 }
 
 
-sub run_time
-{
-    # Martin A. Hansen, May 2009.
-
-    # Returns a precision timestamp for calculating
-    # run time.
-
-    return Maasha::Common::get_time_hires();
-}
-
-
-sub run_time_print
-{
-    # Martin A. Hansen, May 2009
-
-    # Print the run time to STDERR for the current script if
-    # the verbose switch is set in the option hash.
-
-    my ( $t0,       # run time begin
-         $t1,       # run time end
-         $options,  # options hash
-       ) = @_;
-
-    # Returns nothing
-
-    my $script = Maasha::Common::get_scriptname();
-
-    print STDERR "Program: $script" . ( " " x ( 25 - length( $script ) ) ) . sprintf( "Run time: %.4f\n", ( $t1 - $t0 ) ) if $options->{ 'verbose' };
-
-}
-
-
 sub get_tmpdir
 {
     # Martin A. Hansen, April 2008.
@@ -849,22 +830,22 @@ sub get_tmpdir
 
     my ( $user, $sid, $pid, $script, $path, $file, $fh, $line );
 
-    Maasha::Common::error( qq(no BP_TMP set in %ENV) ) if not -d $ENV{ 'BP_TMP' };
-
     $user   = Maasha::Common::get_user();
     $sid    = Maasha::Common::get_sessionid();
     $pid    = Maasha::Common::get_processid();
     $script = Maasha::Common::get_scriptname();
 
-    $path = "$ENV{ 'BP_TMP' }/" . join( "_", $user, $sid, $pid, "bp_tmp" );
-    $file = "$ENV{ 'BP_TMP' }/" . join( ".", $user, $script, $pid ) . ".status";
+    $path = bp_tmp() . "/" . join( "_", $user, $sid, $pid, "bp_tmp" );
+    $file = bp_tmp() . "/" . join( ".", $user, $script, $pid ) . ".status";
     
     $fh   = Maasha::Filesys::file_read_open( $file );
+    flock($fh, 1);
     $line = <$fh>;
     chomp $line;
     close $fh;
 
     $fh   = Maasha::Filesys::file_write_open( $file );
+    flock($fh, 2);
     print $fh "$line;$path\n";
     close $fh;
 
@@ -874,6 +855,57 @@ sub get_tmpdir
 }
 
 
+sub biopiecesrc
+{
+    # Martin A. Hansen, July 2009.
+
+    # Read Biopiece configuration info from .biopiecesrc.
+    # and returns the value of a given key.
+
+    my ( $key,   # configuration key
+       ) = @_;
+
+    # Returns a string.
+
+    my ( $file, $fh, $record );
+
+    $file = "$ENV{ 'HOME' }/.biopiecesrc";
+
+    return undef if not -f $file;
+
+    $fh     = Maasha::Filesys::file_read_open( $file );
+    flock($fh, 1);
+    $record = get_record( $fh );
+    close $fh;
+
+    if ( exists $record->{ $key } ) {
+        return $record->{ $key };
+    } else {
+        return undef;
+    }
+}
+
+sub bp_tmp
+{
+    # Martin A. Hansen, March 2013.
+
+    # Returns the BP_TMP path.
+    # Errs if no BP_TMP in ENV and
+    # creates BP_TMP if it doesn't exists.
+
+    my ( $path );
+
+    Maasha::Common::error( qq(no BP_TMP set in %ENV) ) if not -d $ENV{ 'BP_TMP' };
+
+    $path = $ENV{ 'BP_TMP' };
+
+    unless ( -d $path ) { # No BP_TMP so we create it
+        mkdir $path or die qq(failed to create dir "$path": $!);
+    }   
+
+    return $path;
+}
+
 END
 {
     clean_tmp();