]> git.donarmstrong.com Git - biopieces.git/blobdiff - code_perl/Maasha/Biopieces.pm
fixed rename bug
[biopieces.git] / code_perl / Maasha / Biopieces.pm
index b57f279213dc98c3c105142e192e889b18b54cec..6c38e430698324319052305b5c1c3afcf5fd84dc 100644 (file)
@@ -51,6 +51,7 @@ use Maasha::NCBI;
 use Maasha::GFF;
 use Maasha::TwoBit;
 use Maasha::Solid;
+use Maasha::Solexa;
 use Maasha::SQL;
 use Maasha::Gwiki;
 
@@ -109,14 +110,8 @@ close $log_local;
 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> RUN SCRIPT <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
 
 
-my $t0 = gettimeofday();
-
 run_script( $script );
 
-my $t1 = gettimeofday();
-
-print STDERR "Program: $script" . ( " " x ( 25 - length( $script ) ) ) . sprintf( "Run time: %.4f\n", ( $t1 - $t0 ) );
-
 
 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> SUBROUTINES <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
 
@@ -157,7 +152,9 @@ sub run_script
 
     # Returns nothing.
 
-    my ( $options, $in, $out );
+    my ( $t0, $t1, $options, $in, $out );
+
+    $t0 = gettimeofday();
 
     $options = get_options( $script );
 
@@ -198,6 +195,7 @@ sub run_script
     elsif ( $script eq "oligo_freq" )               { script_oligo_freq(                $in, $out, $options ) }
     elsif ( $script eq "create_weight_matrix" )     { script_create_weight_matrix(      $in, $out, $options ) }
     elsif ( $script eq "calc_bit_scores" )          { script_calc_bit_scores(           $in, $out, $options ) }
+    elsif ( $script eq "calc_fixedstep" )           { script_calc_fixedstep(            $in, $out, $options ) }
     elsif ( $script eq "reverse_seq" )              { script_reverse_seq(               $in, $out, $options ) }
     elsif ( $script eq "complement_seq" )           { script_complement_seq(            $in, $out, $options ) }
     elsif ( $script eq "remove_indels" )            { script_remove_indels(             $in, $out, $options ) }
@@ -233,9 +231,11 @@ sub run_script
     elsif ( $script eq "write_solid" )              { script_write_solid(               $in, $out, $options ) }
     elsif ( $script eq "head_records" )             { script_head_records(              $in, $out, $options ) }
     elsif ( $script eq "remove_keys" )              { script_remove_keys(               $in, $out, $options ) }
+    elsif ( $script eq "remove_adaptor" )           { script_remove_adaptor(            $in, $out, $options ) }
     elsif ( $script eq "rename_keys" )              { script_rename_keys(               $in, $out, $options ) }
     elsif ( $script eq "uniq_vals" )                { script_uniq_vals(                 $in, $out, $options ) }
     elsif ( $script eq "merge_vals" )               { script_merge_vals(                $in, $out, $options ) }
+    elsif ( $script eq "merge_records" )            { script_merge_records(             $in, $out, $options ) }
     elsif ( $script eq "grab" )                     { script_grab(                      $in, $out, $options ) }
     elsif ( $script eq "compute" )                  { script_compute(                   $in, $out, $options ) }
     elsif ( $script eq "flip_tab" )                 { script_flip_tab(                  $in, $out, $options ) }
@@ -263,6 +263,10 @@ sub run_script
 
     close $in if defined $in;
     close $out;
+
+    $t1 = gettimeofday();
+
+    print STDERR "Program: $script" . ( " " x ( 25 - length( $script ) ) ) . sprintf( "Run time: %.4f\n", ( $t1 - $t0 ) ) if $options->{ 'verbose' };
 }
 
 
@@ -277,7 +281,7 @@ sub get_options
 
     # Returns hash
 
-    my ( %options, @options, $opt, @genomes );
+    my ( %options, @options, $opt, @genomes, $real );
 
     if ( $script eq "print_usage" )
     {
@@ -363,6 +367,7 @@ sub get_options
     {
         @options = qw(
             data_in|i=s
+            samples|s=s
             num|n=s
         );
     }
@@ -386,6 +391,7 @@ sub get_options
         @options = qw(
             data_in|i=s
             num|n=s
+            format|f=s
             quality|q=s
         );
     }
@@ -435,6 +441,13 @@ sub get_options
             percent|p
         );
     }
+    elsif ( $script eq "calc_fixedstep" )
+    {
+        @options = qw(
+            score|S
+            log10|L
+        );
+    }
     elsif ( $script eq "transliterate_seq" )
     {
         @options = qw(
@@ -729,6 +742,15 @@ sub get_options
             save_keys|K=s
         );
     }
+    elsif ( $script eq "remove_adaptor" )
+    {
+        @options = qw(
+            adaptor|a=s
+            mismatches|m=s
+            remove|r=s
+            offset|o=s
+        );
+    }
     elsif ( $script eq "rename_keys" )
     {
         @options = qw(
@@ -749,6 +771,13 @@ sub get_options
             delimit|d=s
         );
     }
+    elsif ( $script eq "merge_records" )
+    {
+        @options = qw(
+            keys|k=s
+            merge|m=s
+        );
+    }
     elsif ( $script eq "grab" )
     {
         @options = qw(
@@ -918,7 +947,6 @@ sub get_options
             priority|p=f
             use_score|u
             visibility|v=s
-            wiggle|w
             color|c=s
             chunk_size|C=s
         );
@@ -952,6 +980,7 @@ sub get_options
     $options{ "feats" }     = [ split ",", $options{ "feats" } ]     if defined $options{ "feats" };
     $options{ "frames" }    = [ split ",", $options{ "frames" } ]    if defined $options{ "frames" };
     $options{ "formats" }   = [ split ",", $options{ "formats" } ]   if defined $options{ "formats" };
+    $options{ "samples" }   = [ split ",", $options{ "samples" } ]   if defined $options{ "samples" };
     
     # ---- check arguments ----
 
@@ -964,7 +993,9 @@ sub get_options
 
     map { Maasha::Common::error( qq(Argument to --cols must be a whole numbers - not "$_") ) if $_ !~ /^\d+$/ } @{ $options{ "cols" } } if $options{ "cols" };
 
-#    print STDERR Dumper( \%options );
+    # print STDERR Dumper( \%options );
+
+    $real = "beg|end|word_size|wrap|chunk_size|tile_size|len|prefix_length|mismatches|offset|num|skip|cpus|window_size|step_size";
 
     foreach $opt ( keys %options )
     {
@@ -972,7 +1003,7 @@ sub get_options
         {
             Maasha::Common::error( qq(Argument to --$opt must be a valid file or fileglob expression - not "$options{ $opt }") );
         }
-        elsif ( $opt =~ /beg|end|word_size|wrap|chunk_size|tile_size|len|prefix_length|num|skip|cpus|window_size|step_size/ and $options{ $opt } !~ /^\d+$/ )
+        elsif ( $opt =~ /$real/ and $options{ $opt } !~ /^\d+$/ )
         {
             Maasha::Common::error( qq(Argument to --$opt must be a whole number - not "$options{ $opt }") );
         }
@@ -1001,13 +1032,25 @@ sub get_options
                 Maasha::Common::error( qq(Genome $options{ $opt } not found in "$ENV{ 'BP_DATA' }/genomes/") );
             }
         }
-        elsif ( $opt eq "terminal" and not $options{ $opt } =~ /^(svg|post|dumb)/ )
+        elsif ( $opt eq "terminal" and not $options{ $opt } =~ /^(svg|post|dumb|x11)/ )
         {
             Maasha::Common::error( qq(Bad --$opt argument "$options{ $opt }") );
         }
-        elsif ( $opt eq "table" and $options{ $opt } =~ /-\./ )
+        elsif ( $opt eq "table" and $options{ $opt } =~ /(-|\.)/ )
+        {
+            Maasha::Common::error( qq(Character '$1' is not allowed in table name: $options{ $opt }) );
+        }
+        elsif ( $opt eq "merge" and $options{ $opt } !~ /^(AandB|AorB|BorA|AnotB|BnotA)$/ )
         {
-            Maasha::Common::error( qq(Character '$options{ $opt }' is not allowed in table names) );
+            Maasha::Common::error( qq(Argument to --$opt must be AandB, AorB, BorA, AnotB, or BnotA - not "$options{ $opt }") );
+        }
+        elsif ( $opt eq "format" and $script eq "read_solexa" and $options{ $opt } !~ /octal|decimal/ )
+        {
+            Maasha::Common::error( qq(Argument to --$opt must be octal or decimal - not "$options{ $opt }") );
+        }
+        elsif ( $opt eq "remove" and $script eq "remove_adaptor" and $options{ $opt } !~ /before|after|skip/ )
+        {
+            Maasha::Common::error( qq(Argument to --$opt must be before, after, or skip - not "$options{ $opt }") );
         }
     }
 
@@ -1310,7 +1353,7 @@ sub script_read_psl
 
     # Returns nothing.
 
-    my ( $record, @files, $file, $entries, $entry, $num );
+    my ( $record, $file, $data_in, $num );
 
     while ( $record = get_record( $in ) ) {
         put_record( $record, $out );
@@ -1320,11 +1363,11 @@ sub script_read_psl
 
     foreach $file ( @{ $options->{ "files" } } )
     {
-        $entries = Maasha::UCSC::psl_get_entries( $file );
+        $data_in = Maasha::Common::read_open( $file );
 
-        foreach $entry ( @{ $entries } )
+        while ( $record = Maasha::UCSC::psl_get_entry( $data_in ) ) 
         {
-            put_record( $entry, $out );
+            put_record( $record, $out );
 
             goto NUM if $options->{ "num" } and $num == $options->{ "num" };
 
@@ -1383,7 +1426,7 @@ sub script_read_fixedstep
 {
     # Martin A. Hansen, Juli 2008.
 
-    # Read fixedStep wiggle format from stream or file.
+    # Read fixedstep wiggle format from stream or file.
 
     my ( $in,        # handle to in stream
          $out,       # handle to out stream
@@ -1410,10 +1453,11 @@ sub script_read_fixedstep
 
             if ( $head =~ /^chrom=([^ ]+) start=(\d+) step=(\d+)$/ )
             {
-                $record->{ "CHR" }     = $1;
-                $record->{ "CHR_BEG" } = $2;
-                $record->{ "STEP" }    = $3;
-                $record->{ "VALS" }    = join ",", @{ $entry };
+                $record->{ "REC_TYPE" } = "fixed_step";
+                $record->{ "CHR" }      = $1;
+                $record->{ "CHR_BEG" }  = $2;
+                $record->{ "STEP" }     = $3;
+                $record->{ "VALS" }     = join ";", @{ $entry };
             }
 
             put_record( $record, $out );
@@ -1718,7 +1762,7 @@ sub script_read_soft
 
     # Returns nothing.
 
-    my ( $data_in, $file, $num, $records, $record, $soft_index, $fh, @platforms, $plat_table, @samples, $sample, $old_end );
+    my ( $data_in, $file, $num, $records, $record, $soft_index, $fh, @platforms, $plat_table, @samples, $sample, $old_end, $skip );
 
     while ( $record = get_record( $in ) ) {
         put_record( $record, $out );
@@ -1728,21 +1772,30 @@ sub script_read_soft
 
     foreach $file ( @{ $options->{ "files" } } )
     {
+        print STDERR "Creating index for file: $file\n" if $options->{ "verbose" };
+
         $soft_index = Maasha::NCBI::soft_index_file( $file );
 
         $fh         = Maasha::Common::read_open( $file );
 
-        @platforms  = grep { $_->[ 0 ] =~ /PLATFORM/ } @{ $soft_index };
+        @platforms  = grep { $_->{ "SECTION" } =~ /PLATFORM/ } @{ $soft_index };
+
+        print STDERR "Getting platform tables for file: $file\n" if $options->{ "verbose" };
 
-        $plat_table = Maasha::NCBI::soft_get_platform( $fh, $platforms[ 0 ]->[ 1 ], $platforms[ -1 ]->[ 2 ] );
+        $plat_table = Maasha::NCBI::soft_get_platform( $fh, $platforms[ 0 ]->{ "LINE_BEG" }, $platforms[ -1 ]->{ "LINE_END" } );
 
-        @samples    = grep { $_->[ 0 ] =~ /SAMPLE/ } @{ $soft_index };
+        @samples    = grep { $_->{ "SECTION" } =~ /SAMPLE/ } @{ $soft_index };
 
-        $old_end    = $platforms[ -1 ]->[ 2 ];
+        $old_end    = $platforms[ -1 ]->{ "LINE_END" };
 
         foreach $sample ( @samples )
         {
-            $records = Maasha::NCBI::soft_get_sample( $fh, $plat_table, $sample->[ 1 ] - $old_end - 1, $sample->[ 2 ] - $old_end - 1 );
+            $skip = 0;
+            $skip = 1 if ( $options->{ "samples" } and grep { $sample->{ "SECTION" } !~ /$_/ } @{ $options->{ "samples" } } );
+
+            print STDERR "Getting samples for dataset: $sample->{ 'SECTION' }\n" if $options->{ "verbose" } and not $skip;
+
+            $records = Maasha::NCBI::soft_get_sample( $fh, $plat_table, $sample->{ "LINE_BEG" } - $old_end - 1, $sample->{ "LINE_END" } - $old_end - 1, $skip );
 
             foreach $record ( @{ $records } )
             {
@@ -1753,7 +1806,7 @@ sub script_read_soft
                 $num++;
             }
 
-            $old_end = $sample->[ 2 ];
+            $old_end = $sample->{ "LINE_END" };
         }
 
         close $fh;
@@ -1874,8 +1927,9 @@ sub script_read_solexa
 
     # Returns nothing.
 
-    my ( $record, $file, $base_name, $data_in, $line, $num, @fields, @seqs, @scores, $i, $seq, $seq_count );
+    my ( $record, $file, $data_in, $entry, $num, @seqs, @scores, $i );
 
+    $options->{ "format" }  ||= "octal";
     $options->{ "quality" } ||= 20;
 
     while ( $record = get_record( $in ) ) {
@@ -1886,35 +1940,33 @@ sub script_read_solexa
 
     foreach $file ( @{ $options->{ "files" } } )
     {
-        $data_in   = Maasha::Common::read_open( $file );
-        $base_name = Maasha::Common::get_basename( $file );
-        $base_name =~ s/\..*//;
-
-        $seq_count = 0;
+        $data_in = Maasha::Common::read_open( $file );
 
-        while ( $line = <$data_in> )
+        if ( $options->{ "format" } eq "octal" )
         {
-            @fields = split /:/, $line;
-            @seqs   = split //, $fields[ 5 ];
-            @scores = split / /, $fields[ -1 ];
+            while ( $entry = Maasha::Solexa::solexa_get_entry_octal( $data_in ) )
+            {
+                $record = Maasha::Solexa::solexa2biopiece( $entry, $options->{ "quality" } );
 
-            for ( $i = 0; $i < @scores; $i++ ) {
-                $seqs[ $i ] = lc $seqs[ $i ] if $scores[ $i ] < $options->{ "quality" };
-            }
+                put_record( $record, $out );
 
-            $seq = join "", @seqs;
+                goto NUM if $options->{ "num" } and $num == $options->{ "num" };
 
-            $record->{ "SEQ_NAME" }     = sprintf( "%s_ID%08d", $base_name, $seq_count );
-            $record->{ "SEQ" }          = $seq;
-            $record->{ "SEQ_LEN" }      = length $seq;
-            $record->{ "SCORE_MEAN" }   = sprintf ( "%.2f", Maasha::Calc::mean( \@scores ) );
+                $num++;
+            }
+        }
+        else
+        {
+            while ( $entry = Maasha::Solexa::solexa_get_entry_decimal( $data_in ) )
+            {
+                $record = Maasha::Solexa::solexa2biopiece( $entry, $options->{ "quality" } );
 
-            put_record( $record, $out );
+                put_record( $record, $out );
 
-            goto NUM if $options->{ "num" } and $num == $options->{ "num" };
+                goto NUM if $options->{ "num" } and $num == $options->{ "num" };
 
-            $seq_count++;
-            $num++;
+                $num++;
+            }
         }
 
         close $data_in;
@@ -2443,6 +2495,116 @@ sub script_calc_bit_scores
 }
 
 
+sub script_calc_fixedstep
+{
+    # Martin A. Hansen, September 2008.
+
+    # Calculates fixedstep entries from data in the stream.
+
+    my ( $in,        # handle to in stream
+         $out,       # handle to out stream
+         $options,   # options hash
+       ) = @_;
+
+    # Returns nothing.
+
+    my ( $record, %fh_hash, $fh_in, $fh_out, $chr, $chr, $beg, $end, $q_id, $block, $entry, $clones, $beg_block, $max, $i );
+
+    while ( $record = get_record( $in ) ) 
+    {
+        $record->{ "CHR" }     = $record->{ "S_ID" }  if not defined $record->{ "CHR" };
+        $record->{ "CHR_BEG" } = $record->{ "S_BEG" } if not defined $record->{ "CHR_BEG" };
+        $record->{ "CHR_END" } = $record->{ "S_END" } if not defined $record->{ "CHR_END" };
+
+        if ( $record->{ "CHR" } and defined $record->{ "CHR_BEG" } and $record->{ "CHR_END" } )
+        {
+            $fh_hash{ $record->{ "CHR" } } = Maasha::Common::write_open( "$BP_TMP/$record->{ 'CHR' }" ) if not exists $fh_hash{ $record->{ "CHR" } };
+
+            $fh_out = $fh_hash{ $record->{ "CHR" } };
+        
+            Maasha::UCSC::bed_put_entry( $record, $fh_out, 5 );
+        }
+    }
+
+    map { close $_ } keys %fh_hash;
+
+    foreach $chr ( sort keys %fh_hash )
+    {
+        Maasha::Common::run( "bedSort", "$BP_TMP/$chr $BP_TMP/$chr" );
+
+        $fh_in = Maasha::Common::read_open( "$BP_TMP/$chr" );
+
+        undef $block;
+
+        while ( $entry = Maasha::UCSC::bed_get_entry( $fh_in, 5 ) )
+        {
+            $chr  = $entry->{ 'CHR' };
+            $beg  = $entry->{ 'CHR_BEG' };
+            $end  = $entry->{ 'CHR_END' };
+            $q_id = $entry->{ 'Q_ID' };
+            
+            if ( $options->{ "score" } ) {
+                $clones = $entry->{ 'SCORE' };
+            } elsif ( $q_id =~ /_(\d+)$/ ) {
+                $clones = $1;
+            } else {
+                $clones = 1;
+            }
+
+            if ( $block )
+            {
+                if ( $beg > $max )
+                {
+                    map { $_ = sprintf( "%.4f", Maasha::Calc::log10( $_ ) ) } @{ $block } if $options->{ "log10" };
+
+                    $record->{ "CHR" }      = $chr;
+                    $record->{ "CHR_BEG" }  = $beg_block;
+                    $record->{ "STEP" }     = 1;
+                    $record->{ "VALS" }     = join ";", @{ $block };
+                    $record->{ "REC_TYPE" } = "fixed_step";
+
+                    put_record( $record, $out );
+
+                    undef $block;
+                }
+                else
+                {
+                    for ( $i = $beg - $beg_block; $i < ( $beg - $beg_block ) + ( $end - $beg ); $i++ ) {
+                        $block->[ $i ] += $clones;
+                    }
+
+                    $max = Maasha::Calc::max( $max, $end );
+                }
+            }
+
+            if ( not $block )
+            {
+                $beg_block = $beg;
+                $max       = $end;
+
+                for ( $i = 0; $i < ( $end - $beg ); $i++ ) {
+                    $block->[ $i ] += $clones;
+                }
+            }
+        }
+
+        close $fh_in;
+
+        map { $_ = sprintf( "%.4f", Maasha::Calc::log10( $_ ) ) } @{ $block } if $options->{ "log10" };
+
+        $record->{ "CHR" }      = $chr;
+        $record->{ "CHR_BEG" }  = $beg_block;
+        $record->{ "STEP" }     = 1;
+        $record->{ "VALS" }     = join ";", @{ $block };
+        $record->{ "REC_TYPE" } = "fixed_step";
+
+        put_record( $record, $out );
+
+        unlink "$BP_TMP/$chr";
+    }
+}
+
+
 sub script_reverse_seq
 {
     # Martin A. Hansen, August 2007.
@@ -2943,7 +3105,7 @@ sub script_get_genome_phastcons
     $phastcons_file  = Maasha::Config::genome_phastcons( $options->{ "genome" } );
     $phastcons_index = Maasha::Config::genome_phastcons_index( $options->{ "genome" } );
 
-    $index           = Maasha::UCSC::phastcons_index_retrieve( $phastcons_index );
+    $index           = Maasha::UCSC::fixedstep_index_retrieve( $phastcons_index );
     $fh_phastcons    = Maasha::Common::read_open( $phastcons_file );
 
     if ( defined $options->{ "chr" } and defined $options->{ "beg" } and ( defined $options->{ "end" } or defined $options->{ "len" } ) )
@@ -2955,7 +3117,7 @@ sub script_get_genome_phastcons
             $options->{ "end" } = $options->{ "beg" } + $options->{ "len" } - 1;
         }
 
-        $scores = Maasha::UCSC::phastcons_index_lookup( $index, $fh_phastcons, $options->{ "chr" }, $options->{ "beg" }, $options->{ "end" }, $options->{ "flank" } );
+        $scores = Maasha::UCSC::fixedstep_index_lookup( $index, $fh_phastcons, $options->{ "chr" }, $options->{ "beg" }, $options->{ "end" }, $options->{ "flank" } );
 
         $record->{ "CHR" }       = $options->{ "chr" };
         $record->{ "CHR_BEG" }   = $options->{ "beg" } - $options->{ "flank" };
@@ -3454,7 +3616,41 @@ sub script_blast_seq
         }
     }
 
-    Maasha::Common::run( "blastall", "-p $options->{ 'program' } -e $options->{ 'e_val' } -a $options->{ 'cpus' } -m 8 -i $tmp_in -d $options->{ 'database' } -F $options->{ 'filter' } -o $tmp_out > /dev/null 2>&1", 1 );
+    if ( $options->{ 'verbose' } )
+    {
+        Maasha::Common::run(
+            "blastall",
+            join( " ",
+                "-p $options->{ 'program' }",
+                "-e $options->{ 'e_val' }",
+                "-a $options->{ 'cpus' }",
+                "-m 8",
+                "-i $tmp_in",
+                "-d $options->{ 'database' }",
+                "-F $options->{ 'filter' }",
+                "-o $tmp_out",
+            ),
+            1
+        );
+    }
+    else
+    {
+        Maasha::Common::run(
+            "blastall",
+            join( " ",
+                "-p $options->{ 'program' }",
+                "-e $options->{ 'e_val' }",
+                "-a $options->{ 'cpus' }",
+                "-m 8",
+                "-i $tmp_in",
+                "-d $options->{ 'database' }",
+                "-F $options->{ 'filter' }",
+                "-o $tmp_out",
+                "> /dev/null 2>&1"
+            ),
+            1
+        );
+    }
 
     unlink $tmp_in;
 
@@ -4138,7 +4334,7 @@ sub script_write_fixedstep
 
             $vals = $record->{ 'VALS' };
 
-            $vals =~ tr/,/\n/;
+            $vals =~ tr/;/\n/;
 
             print $fh "$vals\n";
         }
@@ -4489,6 +4685,70 @@ sub script_remove_keys
 }
 
 
+sub script_remove_adaptor
+{
+    # Martin A. Hansen, August 2008.
+
+    # Find and remove adaptor from sequences in the stream.
+
+    my ( $in,        # handle to in stream
+         $out,       # handle to out stream
+         $options,   # options hash
+       ) = @_;
+
+    # Returns nothing.
+
+    my ( $record, $adaptor, $seq, $adaptor_len, $seq_len, $offset, $max_match, $max_mismatch, $pos );
+
+    $options->{ "remove" } ||= "after";
+
+    $max_mismatch = $options->{ "mismatches" } || 0;
+    $offset       = $options->{ "offset" };
+
+    if ( not defined $offset ) {
+        $offset = 0;
+    } else {
+        $offset--;
+    }
+
+    $adaptor      = uc $options->{ "adaptor" };
+    $adaptor_len  = length $adaptor;
+
+    while ( $record = get_record( $in ) ) 
+    {
+        if ( $record->{ "SEQ" } )
+        {
+            $seq     = uc $record->{ "SEQ" };
+            $seq_len = length $seq;
+
+            $pos = Maasha::Common::index_m( $seq, $adaptor, $seq_len, $adaptor_len, $offset, $max_mismatch );
+
+            $record->{ "ADAPTOR_POS" } = $pos;
+
+            if ( $pos >= 0 and $options->{ "remove" } ne "skip" )
+            {
+                if ( $options->{ "remove" } eq "after" )
+                {
+                    $record->{ "SEQ" }     = substr $record->{ "SEQ" }, 0, $pos;
+                    $record->{ "SEQ_LEN" } = $pos;
+                }
+                else
+                {
+                    $record->{ "SEQ" }     = substr $record->{ "SEQ" }, $pos + $adaptor_len;
+                    $record->{ "SEQ_LEN" } = length $record->{ "SEQ" };
+                }
+            }
+
+            put_record( $record, $out );
+        }
+        else
+        {
+            put_record( $record, $out );
+        }
+    }
+}
+
+
 sub script_rename_keys
 {
     # Martin A. Hansen, August 2007.
@@ -4595,6 +4855,177 @@ sub script_merge_vals
 }
 
 
+sub script_merge_records
+{
+    # Martin A. Hansen, July 2008.
+
+    # Merges records in the stream based on identical values of two given keys.
+
+    my ( $in,        # handle to in stream
+         $out,       # handle to out stream
+         $options,   # options hash
+       ) = @_;
+
+    # Returns nothing.
+
+    my ( $merge, $record, $file1, $file2, $fh1, $fh2, $key1, $key2, @keys1, @keys2, @vals1, @vals2,
+         $num1, $num2, $num, $cmp, $i );
+
+    $merge = $options->{ "merge" } || "AandB";
+
+    $file1 = "$BP_TMP/merge_records1.tmp";
+    $file2 = "$BP_TMP/merge_records2.tmp";
+
+    $fh1   = Maasha::Common::write_open( $file1 );
+    $fh2   = Maasha::Common::write_open( $file2 );
+
+    $key1  = $options->{ "keys" }->[ 0 ];
+    $key2  = $options->{ "keys" }->[ 1 ];
+
+    $num   = $key2 =~ s/n$//;
+    $num1  = 0;
+    $num2  = 0;
+
+    while ( $record = get_record( $in ) ) 
+    {
+        if ( exists $record->{ $key1 } )
+        {
+            @keys1 = $key1;
+            @vals1 = $record->{ $key1 };
+
+            delete $record->{ $key1 };
+
+            map { push @keys1, $_; push @vals1, $record->{ $_ } } keys %{ $record };
+
+            print $fh1 join( "\t", @vals1 ), "\n";
+
+            $num1++;
+        }
+        elsif ( exists $record->{ $key2 } )
+        {
+            @keys2 = $key2;
+            @vals2 = $record->{ $key2 };
+
+            delete $record->{ $key2 };
+
+            map { push @keys2, $_; push @vals2, $record->{ $_ } } keys %{ $record };
+
+            print $fh2 join( "\t", @vals2 ), "\n";
+
+            $num2++;
+        }
+    }
+
+    close $fh1;
+    close $fh2;
+
+    if ( $num )
+    {
+        Maasha::Common::run( "sort", "-k 1,1n $file1 > $file1.sort" ) and rename "$file1.sort", $file1;
+        Maasha::Common::run( "sort", "-k 1,1n $file2 > $file2.sort" ) and rename "$file2.sort", $file2;
+    }
+    else
+    {
+        Maasha::Common::run( "sort", "-k 1,1 $file1 > $file1.sort" ) and rename "$file1.sort", $file1;
+        Maasha::Common::run( "sort", "-k 1,1 $file2 > $file2.sort" ) and rename "$file2.sort", $file2;
+    }
+
+    $fh1 = Maasha::Common::read_open( $file1 );
+    $fh2 = Maasha::Common::read_open( $file2 );
+
+    @vals1 = Maasha::Common::get_fields( $fh1 );
+    @vals2 = Maasha::Common::get_fields( $fh2 );
+
+    while ( $num1 > 0 and $num2 > 0 )
+    {
+        undef $record;
+
+        if ( $num ) {
+            $cmp = $vals1[ 0 ] <=> $vals2[ 0 ];
+        } else {
+            $cmp = $vals1[ 0 ] cmp $vals2[ 0 ];
+        }
+
+        if ( $cmp < 0 )
+        {
+            if ( $merge =~ /^(AorB|AnotB)$/ )
+            {
+                for ( $i = 0; $i < @keys1; $i++ ) {
+                    $record->{ $keys1[ $i ] } = $vals1[ $i ];
+                }
+
+                put_record( $record, $out );
+            }
+
+            @vals1 = Maasha::Common::get_fields( $fh1 );
+            $num1--;
+        }
+        elsif ( $cmp > 0 )
+        {
+            if ( $merge =~ /^(BorA|BnotA)$/ )
+            {
+                for ( $i = 0; $i < @keys2; $i++ ) {
+                    $record->{ $keys2[ $i ] } = $vals2[ $i ];
+                }
+
+                put_record( $record, $out );
+            }
+
+            @vals2 = Maasha::Common::get_fields( $fh2 );
+            $num2--;
+        }
+        else
+        {
+            if ( $merge =~ /^(AandB|AorB|BorA)$/ )
+            {
+                for ( $i = 0; $i < @keys1; $i++ ) {
+                    $record->{ $keys1[ $i ] } = $vals1[ $i ];
+                }
+
+                for ( $i = 1; $i < @keys2; $i++ ) {
+                    $record->{ $keys2[ $i ] } = $vals2[ $i ];
+                }
+            
+                put_record( $record, $out );
+            }
+
+            @vals1 = Maasha::Common::get_fields( $fh1 );
+            @vals2 = Maasha::Common::get_fields( $fh2 );
+            $num1--;
+            $num2--;
+        }
+    }
+
+    close $fh1;
+    close $fh2;
+
+    unlink $file1;
+    unlink $file2;
+
+    if ( $num1 > 0 and $merge =~ /^(AorB|AnotB)$/ )
+    {
+        undef $record;
+
+        for ( $i = 0; $i < @keys1; $i++ ) {
+            $record->{ $keys1[ $i ] } = $vals1[ $i ];
+        }
+
+        put_record( $record, $out );
+    }
+
+    if ( $num2 > 0 and $merge =~ /^(BorA|BnotA)$/ )
+    {
+        undef $record;
+
+        for ( $i = 0; $i < @keys2; $i++ ) {
+            $record->{ $keys2[ $i ] } = $vals2[ $i ];
+        }
+
+        put_record( $record, $out );
+    }
+}
+
+
 sub script_grab
 {
     # Martin A. Hansen, August 2007.
@@ -4943,7 +5374,7 @@ sub script_count_records
         }
     }
 
-    $result = { "count_records" => $count };
+    $result = { "RECORDS_COUNT" => $count };
 
     $fh = write_stream( $options->{ "data_out" } );
 
@@ -5090,6 +5521,7 @@ sub script_count_vals
 
     $fh_out   = Maasha::Common::write_open( $tmp_file );
 
+    $cache    = 0;
     $num      = 0;
 
     while ( $record = get_record( $in ) ) 
@@ -5116,7 +5548,7 @@ sub script_count_vals
 
     if ( $cache )
     {
-        $num      = 0;
+        $num   = 0;
 
         $fh_in = Maasha::Common::read_open( $tmp_file );
 
@@ -5165,7 +5597,7 @@ sub script_plot_histogram
 
     while ( $record = get_record( $in ) ) 
     {
-        $data_hash{ $record->{ $options->{ "key" } } }++ if $record->{ $options->{ "key" } };
+        $data_hash{ $record->{ $options->{ "key" } } }++ if defined $record->{ $options->{ "key" } };
 
         put_record( $record, $out ) if not $options->{ "no_stream" };
     }
@@ -5205,7 +5637,7 @@ sub script_plot_lendist
 
     while ( $record = get_record( $in ) ) 
     {
-        $data_hash{ $record->{ $options->{ "key" } } }++ if $record->{ $options->{ "key" } };
+        $data_hash{ $record->{ $options->{ "key" } } }++ if defined $record->{ $options->{ "key" } };
 
         put_record( $record, $out ) if not $options->{ "no_stream" };
     }
@@ -5612,6 +6044,8 @@ sub script_upload_to_ucsc
 
     # Calculate the mean of values of given keys.
 
+    # This routine has developed into the most ugly hack. Do something!
+
     my ( $in,        # handle to in stream
          $out,       # handle to out stream
          $options,   # options hash
@@ -5619,8 +6053,7 @@ sub script_upload_to_ucsc
 
     # Returns nothing.
 
-    my ( $record, $file, $wib_file, $wig_file, $wib_dir, $fh_in, $fh_out, $i, $first, $format, $args, $type, $columns, $append, %fh_hash,
-         $chr, $beg, $end, $block, $line, $max, $beg_block, $entry, $q_id, $clones );
+    my ( $record, $file, $wib_file, $wig_file, $wib_dir, $fh_out, $i, $first, $format, $type, $columns, $append, $vals );
 
     $options->{ "short_label" } ||= $options->{ 'table' };
     $options->{ "long_label" }  ||= $options->{ 'table' };
@@ -5638,201 +6071,109 @@ sub script_upload_to_ucsc
 
     $i = 0;
 
-    if ( $options->{ 'wiggle' } )
+    $fh_out = Maasha::Common::write_open( $file );
+
+    while ( $record = get_record( $in ) ) 
     {
-        $options->{ "visibility" } = "full";
+        put_record( $record, $out ) if not $options->{ "no_stream" };
 
-        while ( $record = get_record( $in ) )
+        if ( $record->{ "REC_TYPE" } eq "fixed_step" )
         {
-            put_record( $record, $out ) if not $options->{ "no_stream" };
+            $vals = $record->{ "VALS" };
+            $vals =~ tr/;/\n/;
 
-            $record->{ "CHR" }     = $record->{ "S_ID" }  if not defined $record->{ "CHR" };
-            $record->{ "CHR_BEG" } = $record->{ "S_BEG" } if not defined $record->{ "CHR_BEG" };
-            $record->{ "CHR_END" } = $record->{ "S_END" } if not defined $record->{ "CHR_END" };
-
-            $fh_hash{ $record->{ "CHR" } } = Maasha::Common::write_open( "$BP_TMP/$record->{ 'CHR' }" ) if not exists $fh_hash{ $record->{ "CHR" } };
+            print $fh_out "fixedStep chrom=$record->{ 'CHR' } start=$record->{ 'CHR_BEG' } step=$record->{ 'STEP' }\n";
+            print $fh_out "$vals\n";
 
-            $fh_out = $fh_hash{ $record->{ "CHR" } };
-            
-            Maasha::UCSC::bed_put_entry( $record, $fh_out, 5 );
+            $format = "WIGGLE" if not $format;
         }
-
-        map { close $_ } keys %fh_hash;
-
-        $fh_out = Maasha::Common::write_open( $file );
-
-        foreach $chr ( sort keys %fh_hash )
+        elsif ( $record->{ "REC_TYPE" } eq "PSL" )
         {
-            Maasha::Common::run( "bedSort", "$BP_TMP/$chr $BP_TMP/$chr" );
-
-            $fh_in = Maasha::Common::read_open( "$BP_TMP/$chr" );
-
-            undef $block;
-
-            while ( $entry = Maasha::UCSC::bed_get_entry( $fh_in, 5 ) )
-            {
-                $chr  = $entry->{ 'CHR' };
-                $beg  = $entry->{ 'CHR_BEG' };
-                $end  = $entry->{ 'CHR_END' };
-                $q_id = $entry->{ 'Q_ID' };
-                
-                if ( $q_id =~ /_(\d+)$/ ) {
-                    $clones = $1;
-                } else {
-                    $clones = 1;
-                }
-
-                if ( $block )
-                {
-                    if ( $beg > $max )
-                    {
-                        Maasha::UCSC::fixedstep_put_entry( $chr, $beg_block, $block, $fh_out );
-                        undef $block;
-                    }
-                    else
-                    {
-                        for ( $i = $beg - $beg_block; $i < ( $beg - $beg_block ) + ( $end - $beg ); $i++ ) {
-                            $block->[ $i ] += $clones;
-                        }
-
-                        $max = Maasha::Calc::max( $max, $end );
-                    }
-                }
-
-                if ( not $block )
-                {
-                    $beg_block = $beg;
-                    $max       = $end;
-
-                    for ( $i = 0; $i < ( $end - $beg ); $i++ ) {
-                        $block->[ $i ] += $clones;
-                    }
-                }
-            }
-
-            close $fh_in;
-
-            Maasha::UCSC::fixedstep_put_entry( $chr, $beg_block, $block, $fh_out );
+            Maasha::UCSC::psl_put_header( $fh_out ) if $first;
+            Maasha::UCSC::psl_put_entry( $record, $fh_out );
+            
+            $first = 0;
 
-            unlink "$BP_TMP/$chr";
+            $format = "PSL" if not $format;
         }
+        elsif ( $record->{ "REC_TYPE" } eq "BED" and $record->{ "SEC_STRUCT" } )
+        {
+            # chrom chromStart  chromEnd    name    score   strand  size    secStr  conf 
 
-        close $fh_out;
-
-        $wig_file = "$options->{ 'table' }.wig";
-        $wib_file = "$options->{ 'table' }.wib";
-
-        $wib_dir  = "$ENV{ 'HOME' }/ucsc/wib";
-
-        Maasha::Common::dir_create_if_not_exists( $wib_dir );
-
-        # Maasha::Common::run( "wigEncode", "$file $wig_file $wib_file > /dev/null 2>&1" );
-
-        `cd $BP_TMP && wigEncode $file $wig_file $wib_file > /dev/null 2>&1`;
-        Maasha::Common::run( "mv", "$BP_TMP/$wib_file $wib_dir" );
-
-        unlink $file;
-
-        $file = $wig_file;
+            print $fh_out join ( "\t",
+                $record->{ "CHR" },
+                $record->{ "CHR_BEG" },
+                $record->{ "CHR_END" } + 1,
+                $record->{ "Q_ID" },
+                $record->{ "SCORE" },
+                $record->{ "STRAND" },
+                $record->{ "SIZE" },
+                $record->{ "SEC_STRUCT" },
+                $record->{ "CONF" },
+            ), "\n";
 
-        $format = "WIGGLE";
-    }
-    else
-    {
-        $fh_out = Maasha::Common::write_open( $file );
-    
-        while ( $record = get_record( $in ) ) 
+            $format  = "BED_SS" if not $format;
+        }
+        elsif ( $record->{ "REC_TYPE" } eq "BED" )
         {
-            put_record( $record, $out ) if not $options->{ "no_stream" };
+            Maasha::UCSC::bed_put_entry( $record, $fh_out, $record->{ "BED_COLS" } );
 
-            if ( $record->{ "REC_TYPE" } eq "PSL" )
-            {
-                Maasha::UCSC::psl_put_header( $fh_out ) if $first;
-                Maasha::UCSC::psl_put_entry( $record, $fh_out );
-                
-                $first = 0;
+            $format  = "BED"                   if not $format;
+            $columns = $record->{ "BED_COLS" } if not $columns;
+        }
+        elsif ( $record->{ "REC_TYPE" } eq "PATSCAN" and $record->{ "CHR" } )
+        {
+            Maasha::UCSC::bed_put_entry( $record, $fh_out, 6 );
 
-                $format = "PSL" if not $format;
-            }
-            elsif ( $record->{ "REC_TYPE" } eq "BED" and $record->{ "SEC_STRUCT" } )
-            {
-                # chrom chromStart  chromEnd    name    score   strand  size    secStr  conf 
-
-                print $fh_out join ( "\t",
-                    $record->{ "CHR" },
-                    $record->{ "CHR_BEG" },
-                    $record->{ "CHR_END" } + 1,
-                    $record->{ "Q_ID" },
-                    $record->{ "SCORE" },
-                    $record->{ "STRAND" },
-                    $record->{ "SIZE" },
-                    $record->{ "SEC_STRUCT" },
-                    $record->{ "CONF" },
-                ), "\n";
-
-                $format  = "BED_SS" if not $format;
-            }
-            elsif ( $record->{ "REC_TYPE" } eq "BED" )
-            {
-                Maasha::UCSC::bed_put_entry( $record, $fh_out, $record->{ "BED_COLS" } );
+            $format  = "BED" if not $format;
+            $columns = 6     if not $columns;
+        }
+        elsif ( $record->{ "REC_TYPE" } eq "BLAST" and $record->{ "S_ID" } =~ /^chr/ )
+        {
+            $record->{ "CHR" }     = $record->{ "S_ID" };
+            $record->{ "CHR_BEG" } = $record->{ "S_BEG" };
+            $record->{ "CHR_END" } = $record->{ "S_END" };
+            $record->{ "SCORE" }   = $record->{ "BIT_SCORE" } * 1000;
 
-                $format  = "BED"                   if not $format;
-                $columns = $record->{ "BED_COLS" } if not $columns;
-            }
-            elsif ( $record->{ "REC_TYPE" } eq "PATSCAN" and $record->{ "CHR" } )
-            {
-                Maasha::UCSC::bed_put_entry( $record, $fh_out, 6 );
+            $format  = "BED" if not $format;
+            $columns = 6     if not $columns;
 
-                $format  = "BED" if not $format;
-                $columns = 6     if not $columns;
-            }
-            elsif ( $record->{ "REC_TYPE" } eq "BLAST" and $record->{ "S_ID" } =~ /^chr/ )
-            {
-                $record->{ "CHR" }     = $record->{ "S_ID" };
-                $record->{ "CHR_BEG" } = $record->{ "S_BEG" };
-                $record->{ "CHR_END" } = $record->{ "S_END" };
-                $record->{ "SCORE" }   = $record->{ "BIT_SCORE" } * 1000;
+            Maasha::UCSC::bed_put_entry( $record, $fh_out );
+        }
+        elsif ( $record->{ "REC_TYPE" } eq "VMATCH" and $record->{ "S_ID" } =~ /^chr/i )
+        {
+            $record->{ "CHR" }     = $record->{ "S_ID" };
+            $record->{ "CHR_BEG" } = $record->{ "S_BEG" };
+            $record->{ "CHR_END" } = $record->{ "S_END" };
+            $record->{ "SCORE" }   = $record->{ "SCORE" } || 999;
+            $record->{ "SCORE" }   = int( $record->{ "SCORE" } );
 
-                $format  = "BED" if not $format;
-                $columns = 6     if not $columns;
+            $format  = "BED" if not $format;
+            $columns = 6     if not $columns;
 
-                Maasha::UCSC::bed_put_entry( $record, $fh_out );
-            }
-            elsif ( $record->{ "REC_TYPE" } eq "VMATCH" and $record->{ "S_ID" } =~ /^chr/i )
-            {
-                $record->{ "CHR" }     = $record->{ "S_ID" };
-                $record->{ "CHR_BEG" } = $record->{ "S_BEG" };
-                $record->{ "CHR_END" } = $record->{ "S_END" };
-                $record->{ "SCORE" }   = $record->{ "SCORE" } || 999;
-                $record->{ "SCORE" }   = int( $record->{ "SCORE" } );
+            Maasha::UCSC::bed_put_entry( $record, $fh_out, 6 );
+        }
 
-                $format  = "BED" if not $format;
-                $columns = 6     if not $columns;
+        if ( $i == $options->{ "chunk_size" } )
+        {
+            close $fh_out;
 
-                Maasha::UCSC::bed_put_entry( $record, $fh_out, 6 );
+            if ( $format eq "BED" ) {
+                Maasha::UCSC::bed_upload_to_ucsc( $BP_TMP, $file, $options, $append );
+            } elsif ( $format eq "PSL" ) {
+                Maasha::UCSC::psl_upload_to_ucsc( $file, $options, $append ); 
             }
 
-            if ( $i == $options->{ "chunk_size" } )
-            {
-                close $fh_out;
-
-                if ( $format eq "BED" ) {
-                    Maasha::UCSC::bed_upload_to_ucsc( $BP_TMP, $file, $options, $append );
-                } elsif ( $format eq "PSL" ) {
-                    Maasha::UCSC::psl_upload_to_ucsc( $file, $options, $append ); 
-                }
-
-                unlink $file;
-
-                $first = 1;
+            unlink $file;
 
-                $append = 1;
+            $first = 1;
 
-                $fh_out = Maasha::Common::write_open( $file );
-            }
+            $append = 1;
 
-            $i++;
+            $fh_out = Maasha::Common::write_open( $file );
         }
+
+        $i++;
     }
 
     close $fh_out;
@@ -5861,6 +6202,27 @@ sub script_upload_to_ucsc
         }
         elsif ( $format eq "WIGGLE" )
         {
+            $options->{ "visibility" } = "full";
+
+            $wig_file = "$options->{ 'table' }.wig";
+            $wib_file = "$options->{ 'table' }.wib";
+
+            $wib_dir  = "$ENV{ 'HOME' }/ucsc/wib";
+
+            Maasha::Common::dir_create_if_not_exists( $wib_dir );
+
+            if ( $options->{ 'verbose' } ) {
+                `cd $BP_TMP && wigEncode $file $wig_file $wib_file`;
+            } else {
+                `cd $BP_TMP && wigEncode $file $wig_file $wib_file > /dev/null 2>&1`;
+            }
+
+            Maasha::Common::run( "mv", "$BP_TMP/$wib_file $wib_dir" );
+
+            unlink $file;
+
+            $file = $wig_file;
+
             $type = "wig 0";
 
             Maasha::UCSC::wiggle_upload_to_ucsc( $BP_TMP, $wib_dir, $file, $options );
@@ -6090,7 +6452,7 @@ sub clean_tmp
 {
     # Martin A. Hansen, July 2008.
 
-    # Cleans out any unused temporary files and direcotries in BP_TMP.
+    # Cleans out any unused temporary files and directories in BP_TMP.
 
     # Returns nothing.
 
@@ -6120,7 +6482,7 @@ sub clean_tmp
                 elsif ( $pid == $curr_pid )
                 {
                     # print STDERR "Removing current dir: $dir\n";
-                    Maasha::Common::dir_remove( $dir );
+                    Maasha::Common::dir_remove( $dir );
                 }
             }
         }