1 package Maasha::Patscan;
3 # Copyright (C) 2007 Martin A. Hansen.
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.
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.
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.
19 # http://www.gnu.org/copyleft/gpl.html
22 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> DESCRIPTION <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
25 # This module contains commonly used routines
28 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
36 use vars qw ( @ISA @EXPORT );
38 @ISA = qw( Exporter );
41 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
46 # Martin A. Hansen, August 2007.
48 # Read a list of patterns from file with one pattern
51 my ( $path, # full path to file
56 my ( $fh, $line, @patterns );
58 $fh = Maasha::Common::read_open( $path );
60 while ( $line = <$fh> )
66 push @patterns, $line;
71 return wantarray ? @patterns : \@patterns;
77 # Martin A. Hansen, November 2007.
79 # Splits a string of patterns with out breaking patterns with [,,].
81 my ( $str, # comma separated list of patterns
86 my ( $i, $char, $brackets, @patterns );
90 for ( $i = 0; $i < length $str; $i++ )
92 $char = substr $str, $i, 1;
96 } elsif ( $char eq "]" ) {
98 } elsif ( $char eq "," and $brackets != 0 ) {
99 substr $str, $i, 1, '!';
103 @patterns = split ",", $str;
105 map { s/!/,/g } @patterns;
107 return wantarray ? @patterns : \@patterns;
111 sub parse_scan_result
113 # Martin A. Hansen, January 2007.
115 # Parses scan_for_matches results
117 my ( $entry, # FASTA tuple
118 $pattern, # pattern used in patscan
123 my ( $head, $seq, $beg, $end, $len, $strand, %match );
125 ( $head, $seq ) = @{ $entry };
127 if ( $head =~ /^(.+):\[(\d+),(\d+)\]$/ )
135 ( $beg, $end ) = ( $end, $beg );
144 $len = $end - $beg + 1;
147 "REC_TYPE" => "PATSCAN",
148 "PATTERN" => $pattern,
151 "S_BEG" => $beg - 1, # sfm is 1-based
152 "S_END" => $end - 1, # sfm is 1-based
161 warn qq(WARNING: Could not parse match header->$head<-\n);
164 return wantarray ? %match : \%match;
168 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<