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 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
35 use vars qw ( @ISA @EXPORT );
37 @ISA = qw( Exporter );
40 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
45 # Martin A. Hansen, August 2007.
47 # Read a list of patterns from file with one pattern
50 my ( $path, # full path to file
55 my ( $fh, $line, @patterns );
57 $fh = Maasha::Common::read_open( $path );
59 while ( $line = <$fh> )
65 push @patterns, $line;
70 return wantarray ? @patterns : \@patterns;
76 # Martin A. Hansen, November 2007.
78 # Splits a string of patterns with out breaking patterns with [,,].
80 my ( $str, # comma separated list of patterns
85 my ( $i, $char, $brackets, @patterns );
89 for ( $i = 0; $i < length $str; $i++ )
91 $char = substr $str, $i, 1;
95 } elsif ( $char eq "]" ) {
97 } elsif ( $char eq "," and $brackets != 0 ) {
98 substr $str, $i, 1, '!';
102 @patterns = split ",", $str;
104 map { s/!/,/g } @patterns;
106 return wantarray ? @patterns : \@patterns;
110 sub parse_scan_result
112 # Martin A. Hansen, January 2007.
114 # Parses scan_for_matches results
116 my ( $entry, # FASTA tuple
117 $pattern, # pattern used in patscan
122 my ( $head, $seq, $beg, $end, $len, $strand, %match );
124 ( $head, $seq ) = @{ $entry };
126 if ( $head =~ /^(.+):\[(\d+),(\d+)\]$/ )
134 ( $beg, $end ) = ( $end, $beg );
143 $len = $end - $beg + 1;
146 "REC_TYPE" => "PATSCAN",
147 "PATTERN" => $pattern,
150 "S_BEG" => $beg - 1, # sfm is 1-based
151 "S_END" => $end - 1, # sfm is 1-based
160 warn qq(WARNING: Could not parse match header->$head<-\n);
163 return wantarray ? %match : \%match;
167 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<