File Coverage

blib/lib/Bio/Tools/Run/Prints.pm
Criterion Covered Total %
statement 47 94 50.0
branch 5 22 22.7
condition n/a
subroutine 13 18 72.2
pod 5 5 100.0
total 70 139 50.3


line stmt bran cond sub pod time code
1             # Copyright Balamurugan Kumarasamy
2             #
3             # You may distribute this module under the same terms as perl itself
4             # POD documentation - main docs before the code
5              
6             =head1 NAME
7              
8             Bio::Tools::Run::Prints
9              
10             =head1 SYNOPSIS
11              
12             Build a Prints factory
13              
14             my @params = ('DB',$dbfile);
15             my $factory = Bio::Tools::Run::Prints->new($params);
16              
17             # Pass the factory a Bio::Seq object
18             # @feats is an array of Bio::SeqFeature::Generic objects
19             my @feats = $factory->run($seq);
20              
21             =head1 DESCRIPTION
22              
23             FingerPRINTScan II is a PRINTS fingerprint identification algorithm.
24             Copyright (C) 1998,1999 Phil Scordis
25              
26             =head1 FEEDBACK
27              
28             =head2 Mailing Lists
29              
30             User feedback is an integral part of the evolution of this and other
31             Bioperl modules. Send your comments and suggestions preferably to one
32             of the Bioperl mailing lists. Your participation is much appreciated.
33              
34             bioperl-l@bioperl.org - General discussion
35             http://bioperl.org/wiki/Mailing_lists - About the mailing lists
36              
37             =head2 Support
38              
39             Please direct usage questions or support issues to the mailing list:
40              
41             I
42              
43             rather than to the module maintainer directly. Many experienced and
44             reponsive experts will be able look at the problem and quickly
45             address it. Please include a thorough description of the problem
46             with code and data examples if at all possible.
47              
48             =head2 Reporting Bugs
49              
50             Report bugs to the Bioperl bug tracking system to help us keep track
51             the bugs and their resolution. Bug reports can be submitted via the
52             web:
53              
54             http://redmine.open-bio.org/projects/bioperl/
55              
56             =head1 AUTHOR - Bala
57              
58             Email savikalpa@fugu-sg.org
59              
60             =head1 APPENDIX
61              
62             The rest of the documentation details each of the object
63             methods. Internal methods are usually preceded with a _
64              
65             =cut
66              
67             package Bio::Tools::Run::Prints;
68              
69 1         62 use vars qw($AUTOLOAD @ISA $PROGRAM $PROGRAMDIR
70             $PROGRAMNAME @PRINTS_PARAMS
71 1     1   98131 %OK_FIELD);
  1         1  
72 1     1   3 use strict;
  1         1  
  1         15  
73 1     1   447 use Bio::SeqIO;
  1         37952  
  1         24  
74 1     1   6 use Bio::Root::IO;
  1         2  
  1         13  
75 1     1   2 use Bio::Root::Root;
  1         2  
  1         12  
76 1     1   374 use Bio::Factory::ApplicationFactoryI;
  1         99  
  1         17  
77 1     1   421 use Bio::Tools::Prints;
  1         42905  
  1         28  
78 1     1   480 use Bio::Tools::Run::WrapperBase;
  1         2  
  1         47  
79              
80             @ISA = qw(Bio::Root::Root Bio::Tools::Run::WrapperBase);
81              
82             BEGIN {
83              
84 1     1   3 @PRINTS_PARAMS=qw(DB PROGRAM VERBOSE);
85 1         2 foreach my $attr ( @PRINTS_PARAMS)
86 3         552 { $OK_FIELD{$attr}++; }
87             }
88              
89             =head2 program_name
90              
91             Title : program_name
92             Usage : $factory>program_name()
93             Function: holds the program name
94             Returns: string
95             Args : None
96              
97             =cut
98              
99             sub program_name {
100 6     6 1 25 return 'FingerPRINTScan';
101             }
102              
103             =head2 program_dir
104              
105             Title : program_dir
106             Usage : $factory->program_dir(@params)
107             Function: returns the program directory, obtained from ENV variable.
108             Returns: string
109             Args :
110              
111             =cut
112              
113             sub program_dir {
114 3 50   3 1 12 return Bio::Root::IO->catfile($ENV{PRINTSDIR}) if $ENV{PRINTSDIR};
115             }
116              
117             sub AUTOLOAD {
118 1     1   2 my $self = shift;
119 1         2 my $attr = $AUTOLOAD;
120 1         4 $attr =~ s/.*:://;
121 1         12 $attr = uc $attr;
122 1 50       4 $self->throw("Unallowed parameter: $attr !") unless $OK_FIELD{$attr};
123 1 50       2 $self->{$attr} = shift if @_;
124 1         3 return $self->{$attr};
125             }
126              
127             =head2 new
128              
129             Title : new
130             Usage : $prints->new(@params)
131             Function: creates a new Prints factory
132             Returns: Bio::Tools::Run::Prints
133             Args :
134              
135             =cut
136              
137             sub new {
138 1     1 1 93 my ($class,@args) = @_;
139 1         10 my $self = $class->SUPER::new(@args);
140 1         37 $self->io->_initialize_io();
141            
142 1         19 my ($attr, $value);
143 1         3 while (@args) {
144 1         2 $attr = shift @args;
145 1         1 $value = shift @args;
146 1 50       5 next if( $attr =~ /^-/ ); # don't want named parameters
147 1 50       3 if ($attr =~/PROGRAM/i) {
148 0         0 $self->executable($value);
149 0         0 next;
150             }
151 1         7 $self->$attr($value);
152             }
153 1         3 return $self;
154             }
155              
156             =head2 predict_protein_features
157              
158             Title : predict_protein_features()
159             Usage : DEPRECATED. Use $obj->run($seqFile) instead.
160             Function: Runs Prints and creates an array of featrues
161             Returns : An array of Bio::SeqFeature::Generic objects
162             Args : A Bio::PrimarySeqI
163              
164             =cut
165              
166             sub predict_protein_features{
167 0     0 1   return shift->run(@_);
168             }
169              
170             =head2 run
171              
172             Title : run
173             Usage : $obj->run($seq)
174             Function: Runs Prints
175             Returns : An array of Bio::SeqFeature::Generic objects
176             Args : A Bio::PrimarySeqI, or a Fasta file name
177              
178             =cut
179              
180             sub run{
181 0     0 1   my ($self,$seq) = @_;
182 0           my @feats;
183              
184 0 0         if (ref($seq) ){# it is an object
185            
186 0 0         if (ref($seq) =~ /GLOB/) {
187 0           $self->throw("cannot use filehandle");
188             }
189            
190 0           my $infile1 = $self->_writeSeqFile($seq);
191            
192 0           $self->_input($infile1);
193            
194 0           @feats = $self->_run();
195 0           unlink $infile1;
196             }
197             else {
198             #The clone object is not a seq object but a file.
199             #Perhaps should check here or before if this file is fasta format...if not die
200             #Here the file does not need to be created or deleted. Its already written and may be used by other runnables.
201              
202 0           $self->_input($seq);
203              
204 0           @feats = $self->_run();
205             }
206            
207 0           return @feats;
208              
209             }
210              
211             =head2 _input
212              
213             Title : _input
214             Usage : obj->_input($seqFile)
215             Function: Internal(not to be used directly)
216             Returns :
217             Args :
218              
219             =cut
220              
221             sub _input() {
222 0     0     my ($self,$infile1) = @_;
223            
224 0 0         if(defined $infile1){
225            
226 0           $self->{'input'}=$infile1;
227             }
228 0           return $self->{'input'};
229              
230             }
231              
232             =head2 _run
233              
234             Title : _run
235             Usage : $obj->_run()
236             Function: Internal(not to be used directly)
237             Returns : An array of Bio::SeqFeature::Generic objects
238             Args :
239              
240             =cut
241              
242             sub _run {
243 0     0     my ($self)= @_;
244 0           my ($tfh,$outfile) = $self->io->tempfile(-dir=>$self->tempdir());
245 0           close($tfh);
246 0           undef $tfh;
247 0           my $str =$self->executable." ".$self->DB." ".$self->_input." -fjR >".$outfile;
248 0           my $status = system($str);
249 0 0         $self->throw( "Prints call ($str) crashed: $? \n") unless $status==0;
250            
251 0           my $filehandle;
252 0 0         if (ref ($outfile) !~ /GLOB/) {
253 0 0         open (PRINTS, "<".$outfile) or $self->throw ("Couldn't open file ".$outfile.": $!\n");
254 0           $filehandle = \*PRINTS;
255             }
256             else {
257 0           $filehandle = $outfile;
258             }
259 0           my $prints_parser = Bio::Tools::Prints->new(-fh=>$filehandle);
260 0           my @prints_feat;
261            
262 0           while(my $prints_feat = $prints_parser->next_result){
263 0           push @prints_feat, $prints_feat;
264             }
265            
266            
267 0           $self->cleanup();
268 0           unlink $outfile;
269 0           return @prints_feat;
270            
271             }
272              
273              
274             =head2 _writeSeqFile
275              
276             Title : _writeSeqFile
277             Usage : obj->_writeSeqFile($seq)
278             Function: Internal(not to be used directly)
279             Returns :
280             Args :
281              
282             =cut
283              
284             sub _writeSeqFile{
285 0     0     my ($self,$seq) = @_;
286 0           my ($tfh,$inputfile) = $self->io->tempfile(-dir=>$self->tempdir());
287 0           my $in = Bio::SeqIO->new(-fh => $tfh , '-format' => 'Fasta');
288 0           $in->write_seq($seq);
289 0           $in->close();
290 0           undef $in;
291 0           close($tfh);
292 0           undef $tfh;
293 0           return $inputfile;
294              
295             }
296             1;