$SIG{ 'TERM' } = \&sig_handler;
+sub status_set
+{
+ my ( $time_stamp, $script, $user, $pid, $file, $fh );
+
+ $time_stamp = Maasha::Common::time_stamp();
+ $user = Maasha::Common::get_user();
+ $script = Maasha::Common::get_scriptname();
+ $pid = Maasha::Common::get_processid();
+
+ $file = "$ENV{ 'BP_TMP' }/" . join( ".", $user, $script, $pid ) . ".status";
+ $fh = Maasha::Filesys::file_write_open( $file );
+
+ print $fh join( ";", $time_stamp, join( " ", @ARGV ) ) . "\n";
+
+ close $fh;
+}
+
+
+sub status_log
+{
+ # Martin A. Hansen, June 2009.
+
+ # Retrieves initial status information written with status_set and uses this
+ # to write a status entry to the log file.
+
+ my ( $status, # status - OPTIONAL
+ ) = @_;
+
+ # Returns nothing.
+
+ my ( $time0, $time1, $script, $user, $pid, $file, $fh, $elap, $fh_global, $fh_local, $line, $args, $tmp_dir );
+
+ $status ||= "OK";
+
+ $time1 = Maasha::Common::time_stamp();
+ $user = Maasha::Common::get_user();
+ $script = Maasha::Common::get_scriptname();
+ $pid = Maasha::Common::get_processid();
+
+ $file = "$ENV{ 'BP_TMP' }/" . join( ".", $user, $script, $pid ) . ".status";
+
+ return if not -f $file;
+
+ $fh = Maasha::Filesys::file_read_open( $file );
+ $line = <$fh>;
+ chomp $line;
+ close $fh;
+
+ unlink $file;
+
+ ( $time0, $args, $tmp_dir ) = split /;/, $line;
+
+ Maasha::Filesys::dir_remove( $tmp_dir ) if defined $tmp_dir;
+
+ $elap = Maasha::Common::time_stamp_diff( $time0, $time1 );
+
+ $fh_global = Maasha::Filesys::file_append_open( "$ENV{ 'BP_LOG' }/biopieces.log" );
+ $fh_local = Maasha::Filesys::file_append_open( "$ENV{ 'HOME' }/.biopieces.log" );
+
+ 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";
+
+ $fh_global->autoflush( 1 );
+ $fh_local->autoflush( 1 );
+
+ close $fh_global;
+ close $fh_local;
+}
+
+
sub log_biopiece
{
# Martin A. Hansen, January 2008.
{
# 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
) = @_;
# ---- 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 },
- { long => 'verbose', short => 'v', type => 'flag', mandatory => 'no', default => undef, allowed => undef, disallowed => undef },
+ { 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 },
+ { long => 'verbose', short => 'v', type => 'flag', mandatory => 'no', default => undef, allowed => undef, disallowed => undef },
);
check_duplicates_args( $arg_list );
# 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 not ( exists $options{ 'stream_in' } or exists $options{ 'data_in' } or not -t STDIN ) )
- if ( exists $options->{ 'help' } or ( scalar keys %{ $options } == 0 or exists $options->{ 'data_in' } or not -t STDIN ) )
+ if ( $help or -t STDIN )
{
- $wiki = $ENV{ 'BP_DIR' } . "/bp_usage/$script.wiki";
-
- if ( exists $options->{ 'help' } ) {
- `print_wiki --data_in=$wiki --help`;
- } elsif ( $script =~ /^(list_biopieces|list_genomes)$/ ) {
- return;
- } else {
- `print_wiki --data_in=$wiki`;
+ if ( not ( exists $options{ 'stream_in' } or $options{ 'data_in' } ) )
+ {
+ if ( scalar keys %options == 0 )
+ {
+ $wiki = $ENV{ 'BP_DIR' } . "/bp_usage/$script.wiki";
+
+ if ( $help ) {
+ `print_wiki --data_in=$wiki --help`;
+ } elsif ( $script =~ /^(list_biopieces|list_genomes|list_mysql_databases|biostat)$/ ) {
+ return;
+ } else {
+ `print_wiki --data_in=$wiki`;
+ }
+
+ exit;
+ }
}
-
- exit;
}
}
}
}
-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
sleep 1;
-# if ( -d $BP_TMP )
+ if ( $sig =~ /MAASHA_ERROR/ )
{
- 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();
+ print STDERR "\nProgram '$script' had an error" . " - Please wait for temporary data to be removed\n";
+ status_log( "ERROR" );
}
+ 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" );
+ }
+ elsif ( $sig eq "TERM" )
+ {
+ print STDERR "\nProgram '$script' terminated (someone used kill?)" . " - Please wait for temporary data to be removed\n";
+ status_log( "TERMINATED" );
+ }
+ else
+ {
+ print STDERR "\nProgram '$script' died->$sig" . " - Please wait for temporary data to be removed\n";
+ status_log( "DIED" );
+ }
+
+ clean_tmp();
exit( 0 );
}
}
-sub run_time
+sub get_tmpdir
{
- # Martin A. Hansen, May 2009.
-
- # Returns a precision timestamp for calculating
- # run time.
+ # Martin A. Hansen, April 2008.
- return Maasha::Common::get_time_hires();
-}
+ # Create a temporary directory based on
+ # $ENV{ 'BP_TMP' } and sessionid. The directory
+ # name is written to the status file.
+ # Returns a path.
-sub run_time_print
-{
- # Martin A. Hansen, May 2009
+ my ( $user, $sid, $pid, $script, $path, $file, $fh, $line );
- # Print the run time to STDERR for the current script if
- # the verbose switch is set in the option hash.
+ Maasha::Common::error( qq(no BP_TMP set in %ENV) ) if not -d $ENV{ 'BP_TMP' };
- my ( $t0, # run time begin
- $t1, # run time end
- $options, # options hash
- ) = @_;
+ $user = Maasha::Common::get_user();
+ $sid = Maasha::Common::get_sessionid();
+ $pid = Maasha::Common::get_processid();
+ $script = Maasha::Common::get_scriptname();
- # Returns nothing
+ $path = "$ENV{ 'BP_TMP' }/" . join( "_", $user, $sid, $pid, "bp_tmp" );
+ $file = "$ENV{ 'BP_TMP' }/" . join( ".", $user, $script, $pid ) . ".status";
+
+ $fh = Maasha::Filesys::file_read_open( $file );
+ $line = <$fh>;
+ chomp $line;
+ close $fh;
- my $script = Maasha::Common::get_scriptname();
+ $fh = Maasha::Filesys::file_write_open( $file );
+ print $fh "$line;$path\n";
+ close $fh;
- print STDERR "Program: $script" . ( " " x ( 25 - length( $script ) ) ) . sprintf( "Run time: %.4f\n", ( $t1 - $t0 ) ) if $options->{ 'verbose' };
+ Maasha::Filesys::dir_create( $path );
+ return $path;
}
-sub get_tmpdir
+sub biopiecesrc
{
- # Martin A. Hansen, April 2008.
+ # Martin A. Hansen, July 2009.
- # Create a temporary directory based on
- # $ENV{ 'BP_TMP' } and sessionid.
+ # Read Biopiece configuration info from .biopiecesrc.
+ # and returns the value of a given key.
- # this thing is a really bad solution and needs to be removed.
+ my ( $key, # configuration key
+ ) = @_;
- # Returns a path.
+ # Returns a string.
- my ( $user, $sid, $pid, $path );
+ my ( $file, $fh, $record );
- Maasha::Common::error( qq(no BP_TMP set in %ENV) ) if not -d $ENV{ 'BP_TMP' };
+ $file = "$ENV{ 'HOME' }/.biopiecesrc";
- $user = Maasha::Common::get_user();
- $sid = Maasha::Common::get_sessionid();
- $pid = Maasha::Common::get_processid();
+ return undef if not -f $file;
- $path = "$ENV{ 'BP_TMP' }/" . join( "_", $user, $sid, $pid, "bp_tmp" );
-
- Maasha::Filesys::dir_create( $path );
+ $fh = Maasha::Filesys::file_read_open( $file );
+ $record = get_record( $fh );
+ close $fh;
- return $path;
+ if ( exists $record->{ $key } ) {
+ return $record->{ $key };
+ } else {
+ return undef;
+ }
}
projects / biopieces.git / blobdiff