]> git.donarmstrong.com Git - biopieces.git/blob - bp_bin/extract_seq
more KISS
[biopieces.git] / bp_bin / extract_seq
1 #!/usr/bin/env perl
2
3 # Copyright (C) 2007-2009 Martin A. Hansen.
4
5 # This program is free software; you can redistribute it and/or
6 # modify it under the terms of the GNU General Public License
7 # as published by the Free Software Foundation; either version 2
8 # of the License, or (at your option) any later version.
9
10 # This program is distributed in the hope that it will be useful,
11 # but WITHOUT ANY WARRANTY; without even the implied warranty of
12 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
13 # GNU General Public License for more details.
14
15 # You should have received a copy of the GNU General Public License
16 # along with this program; if not, write to the Free Software
17 # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
18
19 # http://www.gnu.org/copyleft/gpl.html
20
21
22 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> DESCRIPTION <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
23
24 # Split the values of a key into new key/value pairs.
25
26 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
27
28
29 use warnings;
30 use strict;
31 use Maasha::Biopieces;
32
33
34 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
35
36
37 my ( $options, $in, $out, $record, $beg, $end, $len );
38
39 $options = Maasha::Biopieces::parse_options(
40     [
41         { long => 'beg', short => 'b', type => 'uint', mandatory => 'no', default => undef, allowed => undef, disallowed => undef },
42         { long => 'end', short => 'e', type => 'uint', mandatory => 'no', default => undef, allowed => undef, disallowed => undef },
43         { long => 'len', short => 'l', type => 'uint', mandatory => 'no', default => undef, allowed => undef, disallowed => 0 },
44     ]   
45 );
46
47 $in  = Maasha::Biopieces::read_stream( $options->{ "stream_in" } );
48 $out = Maasha::Biopieces::write_stream( $options->{ "stream_out" } );
49
50 if ( not defined $options->{ "beg" } or $options->{ "beg" } < 0 ) {
51     $beg = 0;
52 } else {
53     $beg = $options->{ "beg" } - 1;   # correcting for start offset
54 }
55
56 if ( defined $options->{ "end" } and $options->{ "end" } - 1 < $beg ) {
57     $end = $beg - 1;
58 } elsif ( defined $options->{ "end" } ) {
59     $end = $options->{ "end" } - 1;   # correcting for start offset
60 }
61
62 $len = $options->{ "len" };
63
64 #    print "beg->$beg,  end->$end,  len->$len\n";
65
66 while ( $record = Maasha::Biopieces::get_record( $in ) ) 
67 {
68     if ( $record->{ "SEQ" } )
69     {
70         if ( defined $beg and defined $end )
71         {
72             if ( $end - $beg + 1 > length $record->{ "SEQ" } ) {
73                 $record->{ "SEQ" } = substr $record->{ "SEQ" }, $beg;
74             } else {
75                 $record->{ "SEQ" } = substr $record->{ "SEQ" }, $beg, $end - $beg + 1;
76             }
77         }
78         elsif ( defined $beg and defined $len )
79         {
80             if ( $len > length $record->{ "SEQ" } ) {
81                 $record->{ "SEQ" } = substr $record->{ "SEQ" }, $beg;
82             } else {
83                 $record->{ "SEQ" } = substr $record->{ "SEQ" }, $beg, $len;
84             }
85         }
86         elsif ( defined $beg )
87         {
88             $record->{ "SEQ" } = substr $record->{ "SEQ" }, $beg;
89         }
90
91         $record->{ "SEQ_LEN" } = length $record->{ "SEQ" };
92     }
93
94     Maasha::Biopieces::put_record( $record, $out );
95 }
96
97 Maasha::Biopieces::close_stream( $in );
98 Maasha::Biopieces::close_stream( $out );
99
100
101 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
102
103
104 BEGIN
105 {
106     Maasha::Biopieces::status_set();
107 }
108
109
110 END
111 {
112     Maasha::Biopieces::status_log();
113 }
114
115
116 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
117
118
119 __END__