added write_fixedstep

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

diff --git a/bp_bin/write_fixedstep b/bp_bin/write_fixedstep
new file mode 100755 (executable)
index 0000000..4cd1d44
--- /dev/null
+++ b/bp_bin/write_fixedstep
@@ -0,0 +1,6 @@
+#!/usr/bin/env perl
+
+use warnings;
+use strict;
+
+use Maasha::Biopieces;

diff --git a/code_perl/Maasha/Biopieces.pm b/code_perl/Maasha/Biopieces.pm
index aac2215d36cee9882e470fb0321da83bc3d197b4..9d01329365a2d003c9d290a6f5cc733f7f0965a0 100644 (file)
--- a/code_perl/Maasha/Biopieces.pm
+++ b/code_perl/Maasha/Biopieces.pm
@@ -221,6 +221,7 @@ sub run_script
     elsif ( $script eq "write_tab" )                { script_write_tab(                 $in, $out, $options ) }
     elsif ( $script eq "write_bed" )                { script_write_bed(                 $in, $out, $options ) }
     elsif ( $script eq "write_psl" )                { script_write_psl(                 $in, $out, $options ) }
+    elsif ( $script eq "write_fixedstep" )          { script_write_fixedstep(           $in, $out, $options ) }
     elsif ( $script eq "write_2bit" )               { script_write_2bit(                $in, $out, $options ) }
     elsif ( $script eq "write_solid" )              { script_write_solid(               $in, $out, $options ) }
     elsif ( $script eq "head_records" )             { script_head_records(              $in, $out, $options ) }
@@ -646,6 +647,14 @@ sub get_options
             compress|Z
         );
     }
+    elsif ( $script eq "write_fixedstep" )
+    {
+        @options = qw(
+            no_stream|x
+            data_out|o=s
+            compress|Z
+        );
+    }
     elsif ( $script eq "write_2bit" )
     {
         @options = qw(
@@ -3869,8 +3878,6 @@ sub script_write_bed
 
     # Write BED format for the UCSC genome browser using records in stream.
 
-    # Crude - needs lots of work!
-
     my ( $in,        # handle to in stream
          $out,       # handle to out stream
          $options,   # options hash
@@ -3972,6 +3979,43 @@ sub script_write_psl
 }
 
 
+sub script_write_fixedstep
+{
+    # Martin A. Hansen, Juli 2008.
+
+    # Write fixedStep entries from recrods in the stream.
+
+    my ( $in,        # handle to in stream
+         $out,       # handle to out stream
+         $options,   # options hash
+       ) = @_;
+
+    # Returns nothing.
+
+    my ( $fh, $record, $vals );
+
+    $fh = write_stream( $options->{ "data_out" }, $options->{ "compress" } );
+
+    while ( $record = get_record( $in ) ) 
+    {
+        if ( $record->{ "CHR" } and $record->{ "CHR_BEG" } and $record->{ "STEP" } and $record->{ "VALS" } )
+        {
+            print $fh "fixedStep chrom=$record->{ 'CHR' } start=$record->{ 'CHR_BEG' } step=$record->{ 'STEP' }\n";
+
+            $vals = $record->{ 'VALS' };
+
+            $vals =~ tr/,/\n/;
+
+            print $fh "$vals\n";
+        }
+
+        put_record( $record, $out ) if not $options->{ "no_stream" };
+    }
+
+    close $fh;
+}
+
+
 sub script_write_2bit
 {
     # Martin A. Hansen, March 2008.