From: martinahansen <martinahansen@74ccb610-7750-0410-82ae-013aeee3265d>
Date: Thu, 24 Jul 2008 06:27:53 +0000 (+0000)
Subject: fixed cleanup of temporary files
X-Git-Url: https://git.donarmstrong.com/?a=commitdiff_plain;h=e6b05f7b2b570605ef14ca2b75ec95bfab7796a7;p=biopieces.git

fixed cleanup of temporary files

git-svn-id: http://biopieces.googlecode.com/svn/trunk@189 74ccb610-7750-0410-82ae-013aeee3265d
---

diff --git a/code_perl/Maasha/Biopieces.pm b/code_perl/Maasha/Biopieces.pm
index 0015388..d2d83ad 100644
--- a/code_perl/Maasha/Biopieces.pm
+++ b/code_perl/Maasha/Biopieces.pm
@@ -161,6 +161,8 @@ sub run_script
 
     $options = get_options( $script );
 
+    $options->{ "SCRIPT" } = $script;
+
     if ( $script ne "list_biopieces" and $script ne "list_genomes" ) {
         $script = "print_usage" if ( -t STDIN and keys %{ $options } <= 1 or $options->{ 'help' } );
     }
@@ -261,9 +263,6 @@ sub run_script
 
     close $in if defined $in;
     close $out;
-
-    # unset status   - missing
-    # write log file - missing
 }
 
 
@@ -932,14 +931,12 @@ sub get_options
     );
 
 #    print STDERR Dumper( \@options );
-
+    
     GetOptions(
         \%options,
         @options,
     );
 
-    $options{ "script" } = $script;
-
 #    print STDERR Dumper( \%options );
 
     if ( -t STDIN && scalar( keys %options ) == 1 or $options{ "help" } ) {
@@ -1057,7 +1054,7 @@ sub script_print_usage
     if ( $options->{ 'data_in' } ) {
         $file = $options->{ 'data_in' };
     } else {
-        $file = join "", $ENV{ 'BP_DIR' }, "/bp_usage/", $options->{ 'script' }, ".wiki";
+        $file = join "", $ENV{ 'BP_DIR' }, "/bp_usage/", $options->{ 'SCRIPT' }, ".wiki";
     }
 
     $wiki = Maasha::Gwiki::gwiki_read( $file );
@@ -1103,6 +1100,7 @@ sub script_list_biopieces
             @{ $wiki } = grep { $_->[ 0 ]->{ 'FORMAT' }  =~ /paragraph/ } @{ $wiki };
 
             $synopsis = $wiki->[ 0 ]->[ 0 ]->{ 'TEXT' };
+            $synopsis =~ s/!(\w)/$1/g;
 
             printf( "%-30s%s\n", $program, $synopsis );
         }
@@ -3606,7 +3604,7 @@ sub script_soap_seq
 
     close $fh_out;
 
-    Maasha::Common::run( "soap", "-r 2 -a $tmp_in -v $options->{ 'mismatches' } -g $options->{ 'gap_size'} -p $options->{ 'cpus' } -d $options->{ 'in_file' } -o $tmp_out > /dev/null 2>&1", 1 );
+    Maasha::Common::run( "soap", "-r 2 -a $tmp_in -v $options->{ 'mismatches' } -g $options->{ 'gap_size' } -p $options->{ 'cpus' } -d $options->{ 'in_file' } -o $tmp_out > /dev/null 2>&1", 1 );
 
     unlink $tmp_in;
 
@@ -3625,7 +3623,7 @@ sub script_soap_seq
         $record->{ "SCORE" }      = $fields[ 3 ];
         $record->{ "STRAND" }     = $fields[ 6 ];
         $record->{ "S_ID" }       = $fields[ 7 ];
-        $record->{ "S_BEG" }      = $fields[ 8 ] - 1; # soap is one based
+        $record->{ "S_BEG" }      = $fields[ 8 ] - 1; # soap is 1-based
         $record->{ "S_END" }      = $fields[ 8 ] + $fields[ 5 ] - 2;
 
         put_record( $record, $out );
@@ -5995,77 +5993,6 @@ sub put_record
 }
 
 
-sub get_status
-{
-    # Martin A. Hansen, July 2008.
-
-    # Gets the first record in the stream, the status record,
-    # which is returned. An error is raised if no status record
-    # was found.
-
-    my ( $fh,   # handle to stream
-       ) = @_;
-    
-    # Returns a hash.
-
-    my ( $record );
-
-    $record = get_record( $fh );
-
-    Maasha::Common::error( "No status record found in stream." ) if not $record->{ "REC_TYPE" } eq "STATUS";
-
-    return wantarray ? %{ $record } : $record;
-}
-
-
-sub put_status
-{
-    # Martin A. Hansen, July 2008.
-
-    # Output the status record to STDOUT.
-
-    # Should it ever go to file?
-
-    my ( $record,   # status record.
-         $fh,       # handle to file or stream - OPTIONAL
-       ) = @_;
-
-    # Returns nothing.
-
-    put_record( $record, $fh );
-}
-
-
-sub check_status
-{
-    # Martin A. Hansen, July 2008.
-
-}
-
-
-sub status_new
-{
-    # Martin A. Hansen, July 2008.
-
-    # Create a new status record which
-    # is returned.
-
-    my ( $fisk
-    
-       );
-
-    my ( $record );
-    return wantarray ? %{ $record } : $record;
-}
-
-
-sub status_update
-{
-    # Martin A. Hansen, July 2008.
-
-}
-
-
 sub getopt_files
 {
     # Martin A. Hansen, November 2007.
@@ -6127,22 +6054,55 @@ sub sig_handler
             print STDERR "\nProgram '$script' died->$sig"                       . "  -  Please wait for temporary data to be removed\n";
         }
 
-        # This is a really bad solution, potentially, anyone can include this module and set
-        # the BP_TMP to point at any dir and thus take out the machine !!!
-
-        Maasha::Common::dir_remove( $BP_TMP );
+        clean_tmp();
     }
 
     exit( 0 );
 }
 
 
-END
+sub clean_tmp
 {
-    # This is a really bad solution, potentially, anyone can include this module and set
-    # the BP_TMP to point at any dir and thus take out the machine !!!
+    # Martin A. Hansen, July 2008.
 
-    Maasha::Common::dir_remove( $BP_TMP );
+    # Cleans out any unused temporary files and direcotries 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 =~ /(.+)_(\d+)_(\d+)_bp_tmp/ )
+        {
+            $user = $1;
+            $sid  = $2;
+            $pid  = $3;
+
+            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();
 }
 
 
diff --git a/code_perl/Maasha/Common.pm b/code_perl/Maasha/Common.pm
index 4da7483..60d9bc5 100644
--- a/code_perl/Maasha/Common.pm
+++ b/code_perl/Maasha/Common.pm
@@ -467,6 +467,30 @@ sub read_args
 }
 
 
+sub get_time
+{
+    # Martin A. Hansen, July 2008.
+
+    # Get current time as a number.
+
+    # Returns a number.
+
+    return time;
+}
+
+
+sub get_processid
+{
+    # Martin A. Hansen, July 2008.
+
+    # Get process id for current process.
+
+    # Returns a number.
+
+    return $$;
+}
+
+
 sub get_sessionid
 {
     # Martin A. Hansen, April 2008.
@@ -475,7 +499,19 @@ sub get_sessionid
 
     # Returns a number
 
-    return time . $$;
+    return get_time . get_processid;
+}
+
+
+sub get_user
+{
+    # Martin A. Hansen, July 2008.
+
+    # Return the user name of the current user.
+
+    # Returns a string.
+
+    return $ENV{ 'USER' };
 }
 
 
@@ -486,18 +522,19 @@ sub get_tmpdir
     # Create a temporary directory based on
     # $ENV{ 'BP_TMP' } and sessionid.
 
+    # this thing is a really bad solution and needs to be removed.
+
     # Returns a path.
 
-    my ( $user, $sid, $path );
+    my ( $user, $sid, $pid, $path );
 
     Maasha::Common::error( qq(no BP_TMP set in %ENV) ) if not -d $ENV{ 'BP_TMP' };
 
-    $user = $ENV{ 'USER' };
-    $user =~ s/\.//g;
-
+    $user = Maasha::Common::get_user();
     $sid  = Maasha::Common::get_sessionid();
+    $pid  = Maasha::Common::get_processid();
 
-    $path = "$ENV{ 'BP_TMP' }/$user\_$sid";
+    $path = "$ENV{ 'BP_TMP' }/" . join( "_", $user, $sid, $pid, "bp_tmp" );
     
     Maasha::Common::dir_create( $path );
 
@@ -655,6 +692,31 @@ sub time_stamp
 }
 
 
+sub process_running
+{
+    # Martin A. Hansen, July 2008.
+
+    # Given a process ID check if it is running
+    # on the system. Return 1 if the process is
+    # running else 0.
+
+    my ( $pid,   # process ID to check.
+       ) = @_;
+
+    # Returns boolean
+
+    my ( @ps_table );
+    
+    @ps_table = run_and_return( "ps", " a" );
+
+    if ( grep /^\s*$pid\s+/, @ps_table ) {
+        return 1;
+    } else {
+        return 0;
+    }
+}
+
+
 sub wrap_line
 {
     # Martin A. Hansen, May 2005
diff --git a/code_perl/Maasha/Match.pm b/code_perl/Maasha/Match.pm
index 5b0bd09..5acbdfe 100644
--- a/code_perl/Maasha/Match.pm
+++ b/code_perl/Maasha/Match.pm
@@ -34,6 +34,7 @@ use Storable qw( dclone );
 use Maasha::Common;
 use Maasha::Fasta;
 use Maasha::Seq;
+use Maasha::Biopieces;
 use vars qw ( @ISA @EXPORT );
 
 use constant {
@@ -146,7 +147,7 @@ sub match_vmatch
 
     # Returns a string.
 
-    my ( $query_file, $result_file, @result_files, $fh_in, $fh_out, $line, @fields, $i, $record, $vmatch_args, @index_names, @seq_names, $count_list );
+    my ( $query_file, $result_file, @result_files, $fh_in, $fh_out, $line, @fields, $i, $record, $vmatch_args, @index_names, @seq_names, $count_list, $entry );
 
     $query_file  = "$tmp_dir/query.seq";
     $result_file = "$tmp_dir/vmatch.out";
@@ -155,13 +156,13 @@ sub match_vmatch
 
     foreach $record ( @{ $records } ) 
     {
-        if ( $record->{ "SEQ_NAME" } and $record->{ "SEQ" } )
+        if ( $entry = record2fasta( $record ) )
         {
-            next if length $record->{ "SEQ" } < 12; # assuming that the index is created for 12 as minimum length
+            next if length $entry->[ SEQ ] < 12; # assuming that the index is created for 12 as minimum length
 
-            push @seq_names, $record->{ "SEQ_NAME" };
+            push @seq_names, $entry->[ SEQ_NAME ];
 
-            Maasha::Fasta::put_entry( [ $record->{ "SEQ_NAME" }, $record->{ "SEQ" } ], $fh_out, 80 );
+            Maasha::Fasta::put_entry( $entry, $fh_out, 100 );
         }
     }
 
diff --git a/code_perl/Maasha/UCSC.pm b/code_perl/Maasha/UCSC.pm
index dfc5255..9964d88 100644
--- a/code_perl/Maasha/UCSC.pm
+++ b/code_perl/Maasha/UCSC.pm
@@ -73,7 +73,7 @@ sub bed_get_entry
 
     $line = <$fh>;
 
-    $line =~ s/(\n|\r)$//g;    # some people have carriage returns in their BED files -> Grrrr
+    $line =~ tr/\n\r//d;    # some people have carriage returns in their BED files -> Grrrr
 
     return if not defined $line;