From: martinahansen <martinahansen@74ccb610-7750-0410-82ae-013aeee3265d>
Date: Mon, 14 Jul 2008 05:40:10 +0000 (+0000)
Subject: added write_fixedstep
X-Git-Url: https://git.donarmstrong.com/?a=commitdiff_plain;h=1519c9972a8fc37f0422fd4c31bf002960c62801;p=biopieces.git

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
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 aac2215..9d01329 100644
--- 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.