]> git.donarmstrong.com Git - biopieces.git/blobdiff - code_perl/Maasha/Biopieces.pm
fixed another annoying bug in clean_tmp()
[biopieces.git] / code_perl / Maasha / Biopieces.pm
index 06d4b3d8a02e9db84e287b9a92dcf71ecb23830e..372c2699551a2ff17756da289dc98e11434b0e79 100644 (file)
@@ -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' } );
     }
@@ -216,6 +218,7 @@ sub run_script
     elsif ( $script eq "create_blast_db" )          { script_create_blast_db(           $in, $out, $options ) }
     elsif ( $script eq "blast_seq" )                { script_blast_seq(                 $in, $out, $options ) }
     elsif ( $script eq "blat_seq" )                 { script_blat_seq(                  $in, $out, $options ) }
+    elsif ( $script eq "soap_seq" )                 { script_soap_seq(                  $in, $out, $options ) }
     elsif ( $script eq "match_seq" )                { script_match_seq(                 $in, $out, $options ) }
     elsif ( $script eq "create_vmatch_index" )      { script_create_vmatch_index(       $in, $out, $options ) }
     elsif ( $script eq "vmatch_seq" )               { script_vmatch_seq(                $in, $out, $options ) }
@@ -260,9 +263,6 @@ sub run_script
 
     close $in if defined $in;
     close $out;
-
-    # unset status   - missing
-    # write log file - missing
 }
 
 
@@ -569,6 +569,17 @@ sub get_options
             ooc|c
         );
     }
+    elsif ( $script eq "soap_seq" )
+    {
+        @options = qw(
+            in_file|i=s
+            genome|g=s
+            seed_size|s=s
+            mismatches|m=s
+            gap_size|G=s
+            cpus|c=s
+        );
+    }
     elsif ( $script eq "match_seq" )
     {
         @options = qw(
@@ -921,17 +932,15 @@ 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" } ) {
+    if ( -t STDIN && scalar( keys %options ) == 0 or $options{ "help" } ) {
         return wantarray ? %options : \%options;
     }
 
@@ -1007,7 +1016,9 @@ sub get_options
     Maasha::Common::error( qq(no --database or --genome specified) )    if $script eq "blast_seq" and not $options{ "genome" } and not $options{ "database" };
     Maasha::Common::error( qq(both --database and --genome specified) ) if $script eq "blast_seq" and $options{ "genome" } and $options{ "database" };
     Maasha::Common::error( qq(no --index_name or --genome specified) )  if $script eq "vmatch_seq" and not $options{ "genome" } and not $options{ "index_name" };
-    Maasha::Common::error( qq(both --index and --genome specified) )    if $script eq "vmatch_seq" and $options{ "genome" } and $options{ "index" };
+    Maasha::Common::error( qq(both --index and --genome specified) )    if $script eq "vmatch_seq" and $options{ "genome" } and $options{ "index_name" };
+    Maasha::Common::error( qq(no --in_file or --genome specified) )     if $script eq "soap_seq" and not $options{ "genome" } and not $options{ "in_file" };
+    Maasha::Common::error( qq(both --in_file and --genome specified) )  if $script eq "soap_seq" and $options{ "genome" } and $options{ "in_file" };
     Maasha::Common::error( qq(no --genome specified) )                  if $script =~ /format_genome|get_genome_seq|get_genome_align|get_genome_phastcons|blat_seq|plot_phastcons_profiles|plot_karyogram/ and not $options{ "genome" };
     Maasha::Common::error( qq(no --key specified) )                     if $script =~ /plot_lendist|plot_histogram/ and not $options{ "key" };
     Maasha::Common::error( qq(no --keys speficied) )                    if $script =~ /sort_records|count_vals|sum_vals|mean_vals|median_vals|length_vals/ and not $options{ "keys" };
@@ -1044,7 +1055,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 );
@@ -1090,6 +1101,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 );
         }
@@ -2024,7 +2036,7 @@ sub script_format_genome
 
     # Returns nothing.
 
-    my ( $dir, $genome, $fasta_dir, $phastcons_dir, $vals, $fh_out, $record, $format, $index );
+    my ( $dir, $genome, $fasta_dir, $phastcons_dir, $vals, $fh_out, $record, $format, $index, $entry );
 
     $dir    = $options->{ 'dir' } || $ENV{ 'BP_DATA' };
     $genome = $options->{ 'genome' };
@@ -2059,9 +2071,9 @@ sub script_format_genome
 
     while ( $record = get_record( $in ) ) 
     {
-        if ( $fh_out and $record->{ "SEQ_NAME" } and $record->{ "SEQ" } )
+        if ( $fh_out and $entry = record2fasta( $record ) )
         {
-            Maasha::Fasta::put_entry( [ $record->{ "SEQ_NAME" }, $record->{ "SEQ" } ], $fh_out, $options->{ "wrap" } );
+            Maasha::Fasta::put_entry( $entry, $fh_out, $options->{ "wrap" } );
         }
         elsif ( $fh_out and $record->{ "CHR" } and $record->{ "CHR_BEG" } and $record->{ "STEP" } and $record->{ "VALS" } )
         {
@@ -3283,8 +3295,6 @@ sub script_patscan_seq
 
             $i++;
         }
-
-#        put_record( $record, $out );
     }
 
     close $fh_out;
@@ -3354,7 +3364,7 @@ sub script_create_blast_db
 
     # Returns nothing.
 
-    my ( $fh, $seq_type, $path, $record );
+    my ( $fh, $seq_type, $path, $record, $entry );
 
     $path = $options->{ "database" };
 
@@ -3364,11 +3374,11 @@ sub script_create_blast_db
     {
         put_record( $record, $out ) if not $options->{ "no_stream" };
 
-        if ( $record->{ "SEQ" } and $record->{ "SEQ_NAME" } )
+        if ( $entry = record2fasta( $record ) )
         {
-            $seq_type = Maasha::Seq::seq_guess_type( $record->{ "SEQ" } ) if not $seq_type;
+            $seq_type = Maasha::Seq::seq_guess_type( $entry->[ SEQ ] ) if not $seq_type;
 
-            Maasha::Fasta::put_entry( [ $record->{ "SEQ_NAME" }, $record->{ "SEQ" } ], $fh );
+            Maasha::Fasta::put_entry( $entry, $fh );
         }
     }
 
@@ -3397,14 +3407,14 @@ sub script_blast_seq
 
     # Returns nothing.
 
-    my ( $genome, $q_type, $s_type, $tmp_in, $tmp_out, $fh_in, $fh_out, $record, $line, @fields );
+    my ( $genome, $q_type, $s_type, $tmp_in, $tmp_out, $fh_in, $fh_out, $record, $line, @fields, $entry );
 
     $options->{ "e_val" }  = 10 if not defined $options->{ "e_val" };
     $options->{ "filter" } = "F";
     $options->{ "filter" } = "T" if $options->{ "filter" };
     $options->{ "cpus" } ||= 1;
 
-    $options->{ "database" } = "$ENV{ 'BP_DATA' }/genomes/$options->{ 'genome' }/blast/$options->{ 'genome' }.fna"if $options->{ 'genome' };
+    $options->{ "database" } = "$ENV{ 'BP_DATA' }/genomes/$options->{ 'genome' }/blast/$options->{ 'genome' }.fna" if $options->{ 'genome' };
 
     $tmp_in  = "$BP_TMP/blast_query.seq";
     $tmp_out = "$BP_TMP/blast.result";
@@ -3413,11 +3423,11 @@ sub script_blast_seq
 
     while ( $record = get_record( $in ) ) 
     {
-        if ( $record->{ "SEQ_NAME" } and $record->{ "SEQ" } )
+        if ( $entry = record2fasta( $record ) )
         {
-            $q_type = Maasha::Seq::seq_guess_type( $record->{ "SEQ" } ) if not $q_type;
+            $q_type = Maasha::Seq::seq_guess_type( $entry->[ SEQ ] ) if not $q_type;
 
-            Maasha::Fasta::put_entry( [ $record->{ "SEQ_NAME" }, $record->{ "SEQ" } ], $fh_out );
+            Maasha::Fasta::put_entry( $entry, $fh_out );
         }
 
         put_record( $record, $out );
@@ -3507,7 +3517,7 @@ sub script_blat_seq
 
     # Returns nothing.
 
-    my ( $blat_args, $genome_file, $query_file, $fh_in, $fh_out, $type, $record, $result_file, $entries );
+    my ( $blat_args, $genome_file, $query_file, $fh_in, $fh_out, $type, $record, $result_file, $entries, $entry );
 
     $genome_file = "$ENV{ 'BP_DATA' }/genomes/$options->{ 'genome' }/fasta/$options->{ 'genome' }.fna";
 
@@ -3530,10 +3540,10 @@ sub script_blat_seq
 
     while ( $record = get_record( $in ) ) 
     {
-        if ( $record->{ "SEQ_NAME" } and $record->{ "SEQ" } )
+        if ( $entry = record2fasta( $record ) )
         {
-            Maasha::Fasta::put_entry( [ $record->{ "SEQ_NAME" }, $record->{ "SEQ" } ], $fh_out, 80 );
-            $type = Maasha::Seq::seq_guess_type( $record->{ "SEQ" } ) if not $type;
+            $type = Maasha::Seq::seq_guess_type( $entry->[ SEQ ] ) if not $type;
+            Maasha::Fasta::put_entry( $entry, $fh_out, 80 );
         }
 
         put_record( $record, $out );
@@ -3558,6 +3568,75 @@ sub script_blat_seq
 }
 
 
+sub script_soap_seq
+{
+    # Martin A. Hansen, July 2008.
+
+    # soap sequences in stream against a given file or genome.
+
+    my ( $in,        # handle to in stream
+         $out,       # handle to out stream
+         $options,   # options hash
+       ) = @_;
+
+    # Returns nothing.
+
+    my ( $genome, $tmp_in, $tmp_out, $fh_in, $fh_out, $record, $line, @fields, $entry );
+
+    $options->{ "seed_size" }  ||= 10;
+    $options->{ "mismatches" } ||= 2;
+    $options->{ "gap_size" }   ||= 0;
+    $options->{ "cpus" }       ||= 1;
+
+    $options->{ "in_file" } = "$ENV{ 'BP_DATA' }/genomes/$options->{ 'genome' }/fasta/$options->{ 'genome' }.fna" if $options->{ 'genome' };
+
+    $tmp_in  = "$BP_TMP/soap_query.seq";
+    $tmp_out = "$BP_TMP/soap.result";
+
+    $fh_out = Maasha::Common::write_open( $tmp_in );
+
+    while ( $record = get_record( $in ) ) 
+    {
+        if ( $entry = record2fasta( $record ) ) {
+            Maasha::Fasta::put_entry( $entry, $fh_out );
+        }
+
+        put_record( $record, $out );
+    }
+
+    close $fh_out;
+
+    Maasha::Common::run( "soap", "-s $options->{ 'seed_size' } -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;
+
+    $fh_out = Maasha::Common::read_open( $tmp_out );
+
+    undef $record;
+
+    while ( $line = <$fh_out> )
+    {
+        chomp $line;
+
+        @fields = split /\t/, $line;
+
+        $record->{ "REC_TYPE" }   = "SOAP";
+        $record->{ "Q_ID" }       = $fields[ 0 ];
+        $record->{ "SCORE" }      = $fields[ 3 ];
+        $record->{ "STRAND" }     = $fields[ 6 ];
+        $record->{ "S_ID" }       = $fields[ 7 ];
+        $record->{ "S_BEG" }      = $fields[ 8 ] - 1; # soap is 1-based
+        $record->{ "S_END" }      = $fields[ 8 ] + $fields[ 5 ] - 2;
+
+        put_record( $record, $out );
+    }
+
+    close $fh_out;
+
+    unlink $tmp_out;
+}
+
+
 sub script_match_seq
 {
     # Martin A. Hansen, August 2007.
@@ -3613,7 +3692,7 @@ sub script_create_vmatch_index
 
     # Returns nothing.
 
-    my ( $record, $file_tmp, $fh_tmp, $type );
+    my ( $record, $file_tmp, $fh_tmp, $type, $entry );
 
     if ( $options->{ "index_name" } )
     {
@@ -3623,11 +3702,11 @@ sub script_create_vmatch_index
 
     while ( $record = get_record( $in ) ) 
     {
-        if ( $options->{ "index_name" } and $record->{ "SEQ_NAME" } and $record->{ "SEQ" } )
+        if ( $options->{ "index_name" } and $entry = record2fasta( $record ) )
         {
-            Maasha::Fasta::put_entry( [ $record->{ "SEQ_NAME" }, $record->{ "SEQ" } ], $fh_tmp );
+            Maasha::Fasta::put_entry( $entry, $fh_tmp );
 
-            $type = Maasha::Seq::seq_guess_type( $record->{ "SEQ" } ) if not $type;
+            $type = Maasha::Seq::seq_guess_type( $entry->[ SEQ ] ) if not defined $type;
         }
 
         put_record( $record, $out ) if not $options->{ "no_stream" };
@@ -3714,14 +3793,14 @@ sub script_write_fasta
 
     # Returns nothing.
 
-    my ( $record, $fh );
+    my ( $record, $fh, $entry );
 
     $fh = write_stream( $options->{ "data_out" }, $options->{ "compress" } );
 
     while ( $record = get_record( $in ) ) 
     {
-        if ( $record->{ "SEQ_NAME" } and $record->{ "SEQ" } ) {
-            Maasha::Fasta::put_entry( [ $record->{ "SEQ_NAME" }, $record->{ "SEQ" } ], $fh, $options->{ "wrap" } );
+        if ( $entry = record2fasta( $record ) ) {
+            Maasha::Fasta::put_entry( $entry, $fh, $options->{ "wrap" } );
         }
 
         put_record( $record, $out ) if not $options->{ "no_stream" };
@@ -3953,6 +4032,17 @@ sub script_write_bed
 
             Maasha::UCSC::bed_put_entry( $new_record, $fh, 6 );
         }
+        elsif ( $record->{ "REC_TYPE" } eq "SOAP" and $record->{ "S_ID" } =~ /^chr/i )    # ---- Hits from Vmatch ----
+        {
+            $new_record->{ "CHR" }     = $record->{ "S_ID" };
+            $new_record->{ "CHR_BEG" } = $record->{ "S_BEG" };
+            $new_record->{ "CHR_END" } = $record->{ "S_END" };
+            $new_record->{ "Q_ID" }    = $record->{ "Q_ID" };
+            $new_record->{ "SCORE" }   = $record->{ "SCORE" } || 999;
+            $new_record->{ "STRAND" }  = $record->{ "STRAND" };
+
+            Maasha::UCSC::bed_put_entry( $new_record, $fh, 6 );
+        }
         elsif ( $record->{ "CHR" } and defined $record->{ "CHR_BEG" } and $record->{ "CHR_END" } )  # ---- Generic data from tables ----
         {
             Maasha::UCSC::bed_put_entry( $record, $fh );
@@ -4050,7 +4140,7 @@ sub script_write_2bit
 
     # Returns nothing.
 
-    my ( $record, $mask, $tmp_file, $fh_tmp, $fh_in, $fh_out );
+    my ( $record, $mask, $tmp_file, $fh_tmp, $fh_in, $fh_out, $entry );
 
     $mask = 1 if not $options->{ "no_mask" };
 
@@ -4061,8 +4151,8 @@ sub script_write_2bit
 
     while ( $record = get_record( $in ) ) 
     {
-        if ( $record->{ "SEQ_NAME" } and $record->{ "SEQ" } ) {
-            Maasha::Fasta::put_entry( [ $record->{ "SEQ_NAME" }, $record->{ "SEQ" } ], $fh_tmp );
+        if ( $entry = record2fasta( $record ) ) {
+            Maasha::Fasta::put_entry( $entry, $fh_tmp );
         }
 
         put_record( $record, $out ) if not $options->{ "no_stream" };
@@ -4094,17 +4184,17 @@ sub script_write_solid
 
     # Returns nothing.
 
-    my ( $record, $fh, $seq_cs );
+    my ( $record, $fh, $entry );
 
     $fh = write_stream( $options->{ "data_out" }, $options->{ "compress" } );
 
     while ( $record = get_record( $in ) ) 
     {
-        if ( $record->{ "SEQ_NAME" } and $record->{ "SEQ" } )
+        if ( $entry = record2fasta( $record ) )
         {
-            $seq_cs = Maasha::Solid::seq2color_space( uc $record->{ "SEQ" } );
+            $entry->[ SEQ ] = Maasha::Solid::seq2color_space( uc $entry->[ SEQ ] );
 
-            Maasha::Fasta::put_entry( [ $record->{ "SEQ_NAME" }, $seq_cs ], $fh, $options->{ "wrap" } );
+            Maasha::Fasta::put_entry( $entry, $fh, $options->{ "wrap" } );
         }
 
         put_record( $record, $out ) if not $options->{ "no_stream" };
@@ -5609,7 +5699,7 @@ sub script_upload_to_ucsc
         $wig_file = "$options->{ 'table' }.wig";
         $wib_file = "$options->{ 'table' }.wib";
 
-        $wib_dir  = "$ENV{ 'BP_DATA' }/genomes/$options->{ 'database' }/wib";
+        $wib_dir  = "$ENV{ 'HOME' }/ucsc/wib";
 
         Maasha::Common::dir_create_if_not_exists( $wib_dir );
 
@@ -5763,6 +5853,32 @@ sub script_upload_to_ucsc
 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
 
 
+sub record2fasta
+{
+    # Martin A. Hansen, July 2008.
+
+    # Given a biopiece record converts it to a FASTA record.
+    # If no generic SEQ or SEQ_NAME is found, the Q_* and S_* are
+    # tried in that order.
+
+    my ( $record,    # record
+       ) = @_;
+
+    # Returns a tuple.
+
+    my ( $seq_name, $seq );
+
+    $seq_name = $record->{ "SEQ_NAME" } || $record->{ "Q_ID" }  || $record->{ "S_ID" };
+    $seq      = $record->{ "SEQ" }      || $record->{ "Q_SEQ" } || $record->{ "S_SEQ" };
+
+    if ( defined $seq_name and defined $seq ) {
+        return wantarray ? ( $seq_name, $seq ) : [ $seq_name, $seq ];
+    } else {
+        return;
+    }
+}
+
+
 sub read_stream
 {
     # Martin A. Hansen, July 2007.
@@ -5821,10 +5937,10 @@ sub get_record
     # Reads one record at a time and converts that record
     # to a Perl data structure (a hash) which is returned.
 
-    my ( $fh,
+    my ( $fh,   # handle to stream
        ) = @_;
 
-    # Returns data structure
+    # Returns a hash
 
     my ( $block, @lines, $line, $key, $value, %record );
 
@@ -5840,7 +5956,7 @@ sub get_record
 
     foreach $line ( @lines )
     {
-        ( $key, $value ) = split ": ", $line;
+        ( $key, $value ) = split ": ", $line, 2;
 
         $record{ $key } = $value;
     }
@@ -5940,69 +6056,63 @@ 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 !!!
-
-    Maasha::Common::dir_remove( $BP_TMP );
-}
-
-
-# >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
-
-1;
-
-__END__
+    # Martin A. Hansen, July 2008.
 
-
-sub script_read_soft
-{
-    # Martin A. Hansen, December 2007.
-
-    # Read soft format.
-    # http://www.ncbi.nlm.nih.gov/geo/info/soft2.html
-
-    my ( $in,        # handle to in stream
-         $out,       # handle to out stream
-         $options,   # options hash
-       ) = @_;
+    # Cleans out any unused temporary files and direcotries in BP_TMP.
 
     # Returns nothing.
 
-    my ( $data_in, $file, $num, $records, $record );
+    my ( $tmpdir, @dirs, $curr_pid, $dir, $user, $sid, $pid );
 
-    while ( $record = get_record( $in ) ) {
-        put_record( $record, $out );
-    }
+    $tmpdir = $ENV{ 'BP_TMP' } || Maasha::Common::error( 'No BP_TMP variable in environment.' );
 
-    $num = 1;
+    $curr_pid = Maasha::Common::get_processid();
 
-    foreach $file ( @{ $options->{ "files" } } )
-    {
-        $records = Maasha::NCBI::soft_parse( $file );
+    @dirs = Maasha::Common::ls_dirs( $tmpdir );
 
-        foreach $record ( @{ $records } )
+    foreach $dir ( @dirs )
+    {
+        if ( $dir =~ /^$tmpdir\/(.+)_(\d+)_(\d+)_bp_tmp$/ )
         {
-            put_record( $record, $out );
+            $user = $1;
+            $sid  = $2;
+            $pid  = $3;
 
-            goto NUM if $options->{ "num" } and $num == $options->{ "num" };
-
-            $num++;
+            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 );
+                }
+            }
         }
     }
+}
 
-    NUM:
 
-    close $data_in if $data_in;
+END
+{
+    clean_tmp();
 }
+
+
+# >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+
+1;
+
+__END__