|
0
|
1 #-----------------------------------------------------------------------------
|
|
|
2 # PACKAGE : Bio::Root::IOManager.pm
|
|
|
3 # AUTHOR : Steve Chervitz (sac@bioperl.org)
|
|
|
4 # CREATED : 26 Mar 1997
|
|
|
5 # REVISION: $Id: IOManager.pm,v 1.13 2002/10/22 07:38:37 lapp Exp $
|
|
|
6 # STATUS : Alpha
|
|
|
7 #
|
|
|
8 # For documentation, run this module through pod2html
|
|
|
9 # (preferably from Perl v5.004 or better).
|
|
|
10 #
|
|
|
11 # MODIFICATION NOTES: See bottom of file.
|
|
|
12 #
|
|
|
13 # Copyright (c) 1997-2000 Steve Chervitz. All Rights Reserved.
|
|
|
14 # This module is free software; you can redistribute it and/or
|
|
|
15 # modify it under the same terms as Perl itself.
|
|
|
16 #-----------------------------------------------------------------------------
|
|
|
17
|
|
|
18 package Bio::Root::IOManager;
|
|
|
19
|
|
|
20 use Bio::Root::Global qw(:devel $CGI $TIMEOUT_SECS);
|
|
|
21 use Bio::Root::Object ();
|
|
|
22 use Bio::Root::Utilities qw(:obj);
|
|
|
23 use FileHandle ();
|
|
|
24
|
|
|
25 @ISA = qw(Bio::Root::Object);
|
|
|
26
|
|
|
27 use strict;
|
|
|
28 use vars qw($ID $VERSION $revision);
|
|
|
29 $ID = 'Bio::Root::IOManager';
|
|
|
30 $VERSION = 0.043;
|
|
|
31
|
|
|
32 ## POD Documentation:
|
|
|
33
|
|
|
34 =head1 NAME
|
|
|
35
|
|
|
36 Bio::Root::IOManager - Input and output manager for Perl5 objects.
|
|
|
37
|
|
|
38 =head1 SYNOPSIS
|
|
|
39
|
|
|
40 =head2 Object Creation
|
|
|
41
|
|
|
42 The creation of Bio::Root::IOManager.pm objects is handled by Bio::Root::Object.pm
|
|
|
43 which delegates various I/O tasks to this module.
|
|
|
44
|
|
|
45 use Bio::Root::IOManager;
|
|
|
46
|
|
|
47 $myIO = new Bio::Root::IOManager(-WHERE =>'/usr/tmp/data.out',
|
|
|
48 -PARENT =>$self);
|
|
|
49
|
|
|
50
|
|
|
51 =head1 INSTALLATION
|
|
|
52
|
|
|
53 This module is included with the central Bioperl distribution:
|
|
|
54
|
|
|
55 http://bio.perl.org/Core/Latest
|
|
|
56 ftp://bio.perl.org/pub/DIST
|
|
|
57
|
|
|
58 Follow the installation instructions included in the README file.
|
|
|
59
|
|
|
60
|
|
|
61 =head1 DESCRIPTION
|
|
|
62
|
|
|
63 This module encapsulates the data and methods necessary for regulating
|
|
|
64 input/output (I/O) of data from Perl objects.
|
|
|
65 It is concerned with "where" to get input or send output as opposed to "what" to get.
|
|
|
66 IOManager.pm is intended to consolidate various I/O issues for
|
|
|
67 Perl objects and provide an object-oriented way to do I/O things such as:
|
|
|
68
|
|
|
69 =over 4
|
|
|
70
|
|
|
71 =item * passing filehandles between objects,
|
|
|
72
|
|
|
73 =item * opening and reading input from files or STDIN,
|
|
|
74
|
|
|
75 =item * routine file management (compressing, uncompressing, and deleting).
|
|
|
76
|
|
|
77 =back
|
|
|
78
|
|
|
79 Subclasses of B<Bio::Root::Object.pm> have access to all methods defined in
|
|
|
80 IOManager.pm since B<Bio::Root::Object.pm> employs Bio::Root::IOManager.pm
|
|
|
81 by a delegation mechanism.
|
|
|
82
|
|
|
83 It is not clear yet how much objects really need to do the fancy I/O gymnastics as
|
|
|
84 supported by IOManager. Most of the time, objects simply send output to STDOUT
|
|
|
85 which is managed at the script/program level. The fancy I/O manipulations are
|
|
|
86 considered experimental and have not been adequately tested or utilized.
|
|
|
87 I'm not really satisfied with the current L<display()|display>/L<set_display()|set_display> strategy.
|
|
|
88 The additional functionality is not often utilized in typical
|
|
|
89 applications. Is the extra complexity worth it?
|
|
|
90
|
|
|
91 B<The API for this module is under development.>
|
|
|
92
|
|
|
93
|
|
|
94 =head2 Generic Data Access & Manipulation
|
|
|
95
|
|
|
96 The L<read()|read> method provided permits the following:
|
|
|
97
|
|
|
98 =over 4
|
|
|
99
|
|
|
100 =item * read from a file or STDIN.
|
|
|
101
|
|
|
102 =item * read a single record or a stream containing multiple records.
|
|
|
103
|
|
|
104 =item * specify a record separator.
|
|
|
105
|
|
|
106 =item * store all input data in memory or process the data stream as it is being read.
|
|
|
107
|
|
|
108 =back
|
|
|
109
|
|
|
110 =head1 DEPENDENCIES
|
|
|
111
|
|
|
112 Bio::Root::IOManager.pm inherits from B<Bio::Root::Object.pm> and uses B<FileHandle.pm>.
|
|
|
113 B<Bio::Root::Utilities.pm> is also used for routine file manipulations
|
|
|
114 compression/uncompression/deletion.
|
|
|
115
|
|
|
116 =head1 SEE ALSO
|
|
|
117
|
|
|
118 Bio::Root::Object.pm - Core object
|
|
|
119 Bio::Root::Utilities.pm - Generic utilty object
|
|
|
120 Bio::Root::Global.pm - Manages global variables/constants
|
|
|
121
|
|
|
122 http://bio.perl.org/Projects/modules.html - Online module documentation
|
|
|
123 http://bio.perl.org/ - Bioperl Project Homepage
|
|
|
124
|
|
|
125 FileHandle.pm (included in the Perl distribution or CPAN).
|
|
|
126
|
|
|
127 =head1 TODO
|
|
|
128
|
|
|
129 Experiment with using the newer B<IO.pm> included in the Perl distribution,
|
|
|
130 instead of FileHandle.pm.
|
|
|
131
|
|
|
132 =head1 FEEDBACK
|
|
|
133
|
|
|
134 =head2 Mailing Lists
|
|
|
135
|
|
|
136 User feedback is an integral part of the evolution of this and other Bioperl modules.
|
|
|
137 Send your comments and suggestions preferably to one of the Bioperl mailing lists.
|
|
|
138 Your participation is much appreciated.
|
|
|
139
|
|
|
140 bioperl-l@bioperl.org - General discussion
|
|
|
141 http://bioperl.org/MailList.shtml - About the mailing lists
|
|
|
142
|
|
|
143 =head2 Reporting Bugs
|
|
|
144
|
|
|
145 Report bugs to the Bioperl bug tracking system to help us keep track the bugs and
|
|
|
146 their resolution. Bug reports can be submitted via email or the web:
|
|
|
147
|
|
|
148 bioperl-bugs@bio.perl.org
|
|
|
149 http://bugzilla.bioperl.org/
|
|
|
150
|
|
|
151 =head1 AUTHOR
|
|
|
152
|
|
|
153 Steve Chervitz E<lt>sac@bioperl.orgE<gt>
|
|
|
154
|
|
|
155 See L<the FEEDBACK section | FEEDBACK> for where to send bug reports and comments.
|
|
|
156
|
|
|
157 =head1 VERSION
|
|
|
158
|
|
|
159 Bio::Root::IOManager.pm, 0.043
|
|
|
160
|
|
|
161 =head1 ACKNOWLEDGEMENTS
|
|
|
162
|
|
|
163 This module was developed under the auspices of the Saccharomyces Genome
|
|
|
164 Database:
|
|
|
165 http://genome-www.stanford.edu/Saccharomyces
|
|
|
166
|
|
|
167 =head1 COPYRIGHT
|
|
|
168
|
|
|
169 Copyright (c) 1997-98 Steve Chervitz. All Rights Reserved.
|
|
|
170 This module is free software; you can redistribute it and/or
|
|
|
171 modify it under the same terms as Perl itself.
|
|
|
172
|
|
|
173 =cut
|
|
|
174
|
|
|
175 #
|
|
|
176 ##
|
|
|
177 ###
|
|
|
178 #### END of main POD documentation.
|
|
|
179 ###
|
|
|
180 ##
|
|
|
181 #'
|
|
|
182
|
|
|
183
|
|
|
184 =head1 APPENDIX
|
|
|
185
|
|
|
186 Methods beginning with a leading underscore are considered private
|
|
|
187 and are intended for internal use by this module. They are
|
|
|
188 B<not> considered part of the public interface and are described here
|
|
|
189 for documentation purposes only.
|
|
|
190
|
|
|
191 =cut
|
|
|
192
|
|
|
193
|
|
|
194
|
|
|
195 #####################################################################################
|
|
|
196 ## CONSTRUCTOR ##
|
|
|
197 #####################################################################################
|
|
|
198
|
|
|
199
|
|
|
200 ## Using default constructor and destructor inherited from Bio::Root::Object.pm
|
|
|
201
|
|
|
202 ## Could perhaps set the file data member.
|
|
|
203
|
|
|
204
|
|
|
205 #####################################################################################
|
|
|
206 ## ACCESSORS ##
|
|
|
207 #####################################################################################
|
|
|
208
|
|
|
209
|
|
|
210 =head2 file
|
|
|
211
|
|
|
212 Usage : $object->file([filename]);
|
|
|
213 Purpose : Set/Get name of a file associated with an object.
|
|
|
214 Example : $object->file('/usr/home/me/data.txt');
|
|
|
215 Returns : String (full path name)
|
|
|
216 Argument : String (full path name) OR a FileHandle or TypeGlob reference
|
|
|
217 : (argument only required for setting)
|
|
|
218 Throws : Exception if the file appears to be empty or non-existent
|
|
|
219 Comments : File can be text or binary.
|
|
|
220
|
|
|
221 See Also : L<compress_file()|compress_file>, L<uncompress_file()|uncompress_file>, L<delete_file()|delete_file>
|
|
|
222
|
|
|
223 =cut
|
|
|
224
|
|
|
225 #--------
|
|
|
226 sub file {
|
|
|
227 #--------
|
|
|
228 my $self = shift;
|
|
|
229 if($_[0]) {
|
|
|
230 my $file = $_[0];
|
|
|
231 if(not ref $file and not -s $file) {
|
|
|
232 $self->throw("File is empty or non-existent: $file");
|
|
|
233 }
|
|
|
234 $self->{'_file'} = $file;
|
|
|
235 }
|
|
|
236 $self->{'_file'};
|
|
|
237 }
|
|
|
238
|
|
|
239
|
|
|
240
|
|
|
241 =head2 set_fh
|
|
|
242
|
|
|
243 Usage : $self->set_fh( named_parameters )
|
|
|
244 Purpose : Sets various FileHandle data members ('fh', 'fherr').
|
|
|
245 : Provides a public interface for _open_fh().
|
|
|
246 Returns : n/a
|
|
|
247 Argument : Named parameters: (TAGS CAN BE UPPER OR LOWER CASE)
|
|
|
248 : -PATH => string (filename) or a FileHandle object ref.
|
|
|
249 : -PRE => string, prefix for opening (e.g., '>', '>>').
|
|
|
250 : -POST => string, postfix for opening (e.g., '|'), for commands.
|
|
|
251 : -WHICH => string, 'err' for setting output path for errors.
|
|
|
252 :
|
|
|
253 Throws : Exception propagated from _open_fh()
|
|
|
254 Examples : $self->set_fh(); # Create anonymous FileHandle object
|
|
|
255 : $self->set_fh(-PATH =>'fileName', # Open for writing
|
|
|
256 : -PRE =>'>');
|
|
|
257 : $self->set_fh(-PATH =>'fileName', # Open error log file in append mode.
|
|
|
258 : -PRE =>'>>',
|
|
|
259 : -WHICH =>'err');
|
|
|
260 : $self->set_fh(-PATH =>$obj->fh()); # Copy a file handle from another object.
|
|
|
261 :
|
|
|
262 Comments : set_read() and set_display() provide
|
|
|
263 : interfaces for set_fh().
|
|
|
264 Status : Experimental
|
|
|
265
|
|
|
266 See also : L<set_read()|set_read>, L<set_display()|set_display>.
|
|
|
267
|
|
|
268 =cut
|
|
|
269
|
|
|
270 #-----------
|
|
|
271 sub set_fh {
|
|
|
272 #-----------
|
|
|
273 my( $self, %param) = @_;
|
|
|
274
|
|
|
275 no strict 'subs';
|
|
|
276 my( $path, $prefix, $postfix, $which) =
|
|
|
277 $self->_rearrange([PATH,PRE,POST,WHICH],%param);
|
|
|
278 use strict 'subs';
|
|
|
279 $prefix ||= '';
|
|
|
280 $postfix ||= '';
|
|
|
281 $which ||= '';
|
|
|
282 my $fullpath = "$prefix$path$postfix";
|
|
|
283 my($fh);
|
|
|
284
|
|
|
285 $DEBUG and print STDERR "set_fh($fullpath) for ${\$self->name()}\n";
|
|
|
286
|
|
|
287 if($which eq 'err') {
|
|
|
288 if(ref($path) =~ /FileHandle|GLOB/ ) {
|
|
|
289 $fh = $path;
|
|
|
290 } else {
|
|
|
291 if(defined $self->{'_fherr'}) { $self->_close_fh('err');}
|
|
|
292 if( not $fh = $self->_open_fh("$fullpath")) {
|
|
|
293 $fh = $self->_open_fh("errors.$$");
|
|
|
294 $fh || return;
|
|
|
295 $self->warn("Couldn't set error output to $fullpath",
|
|
|
296 "Set to file errors.$$");
|
|
|
297 }
|
|
|
298 }
|
|
|
299 $self->{'_fherr_name'} = $fullpath;
|
|
|
300 $self->{'_fherr'} = $fh;
|
|
|
301
|
|
|
302 } else {
|
|
|
303 if(ref($path) =~ /FileHandle|GLOB/ ) {
|
|
|
304 $fh = $path;
|
|
|
305 } else {
|
|
|
306 if(defined $self->{'_fh'}) { $self->_close_fh();}
|
|
|
307 if( not $fh = $self->_open_fh("$fullpath")) {
|
|
|
308 $fh = $self->_open_fh("out.$$");
|
|
|
309 $fh || return;
|
|
|
310 $self->warn("Couldn't set output to $fullpath",
|
|
|
311 "Set to file out.$$");
|
|
|
312 }
|
|
|
313 }
|
|
|
314 $self->{'_fh_name'} = $fullpath;
|
|
|
315 $self->{'_fh'} = $fh;
|
|
|
316 $DEBUG && print STDERR "$ID: set fh to: $fh";
|
|
|
317 }
|
|
|
318 }
|
|
|
319
|
|
|
320
|
|
|
321
|
|
|
322 #=head2 _open_fh
|
|
|
323 #
|
|
|
324 # Purpose : Creates a new FileHandle object and returns it.
|
|
|
325 # : This method can be used when you need to
|
|
|
326 # : pass FileHandles between objects.
|
|
|
327 # Returns : The new FileHandle object.
|
|
|
328 # Throws : Exception: if the call to new FileHandle fails.
|
|
|
329 # Examples : $self->_open_fh(); # Create anonymous FileHandle object
|
|
|
330 # : $self->_open_fh('fileName'); # Open for reading
|
|
|
331 # : $self->_open_fh('>fileName'); # Open for writing
|
|
|
332 # Status : Experimental
|
|
|
333 #
|
|
|
334 #See also : L<set_fh()|set_fh>, L<fh()|fh>, L<set_read()|set_read>, L<set_display()|set_display>
|
|
|
335 #
|
|
|
336 #=cut
|
|
|
337
|
|
|
338 #-------------
|
|
|
339 sub _open_fh {
|
|
|
340 #-------------
|
|
|
341 my( $self, $arg) = @_;
|
|
|
342 my( $filehandle);
|
|
|
343
|
|
|
344 $DEBUG and print STDERR "_open_fh() $arg\n";
|
|
|
345
|
|
|
346 $filehandle = new FileHandle $arg;
|
|
|
347
|
|
|
348 # if($arg =~ /STD[IO]/) {
|
|
|
349 # $filehandle = new FileHandle;
|
|
|
350 # $filehandle = *$arg;
|
|
|
351 # } else {
|
|
|
352 # $filehandle = new FileHandle $arg;
|
|
|
353 # }
|
|
|
354
|
|
|
355 (ref $filehandle) || $self->throw("Can't create new FileHandle $arg",
|
|
|
356 "Cause: $!");
|
|
|
357 return $filehandle;
|
|
|
358 }
|
|
|
359
|
|
|
360
|
|
|
361
|
|
|
362 #=head2 _close_fh
|
|
|
363 #
|
|
|
364 # Purpose : Destroy a FileHandle object.
|
|
|
365 # Returns : n/a
|
|
|
366 # Status : Experimental
|
|
|
367 #
|
|
|
368 #See also : L<_open_fh()|_open_fh>, L<set_fh()|set_fh>
|
|
|
369 #
|
|
|
370 #=cut
|
|
|
371
|
|
|
372 #--------------
|
|
|
373 sub _close_fh {
|
|
|
374 #--------------
|
|
|
375 my( $self, $arg) = @_;
|
|
|
376 $arg ||= '';
|
|
|
377 if($arg eq 'err') {
|
|
|
378 close $self->{'_fherr'};
|
|
|
379 undef $self->{'_fherr'};
|
|
|
380 } else {
|
|
|
381 close $self->{'_fh'};
|
|
|
382 undef $self->{'_fh'};
|
|
|
383 }
|
|
|
384 }
|
|
|
385
|
|
|
386
|
|
|
387 =head2 set_display
|
|
|
388
|
|
|
389 Usage : $self->set_display([-WHERE=>'path'],
|
|
|
390 : [-SHOW =>'what is to be displayed'],
|
|
|
391 : [-MODE =>'file open mode'])
|
|
|
392 Purpose : Sets a new FileHandle object for output.
|
|
|
393 : - Sets the objects 'show' data member to 'default' if it is not defined.
|
|
|
394 : - Is a wrapper for setting an object's STDOUT filehandle:
|
|
|
395 : Checks the -WHERE parameter and the status of the object's current
|
|
|
396 : filehandle {'_fh'} and does one of three things:
|
|
|
397 : 1. If $param{-WHERE} is defined and is not 'STDOUT', it is sent to
|
|
|
398 : set_fh() to open a new fh,
|
|
|
399 : 2. else, if 'fh' has already been defined, it is returned,
|
|
|
400 : 3. else, if where equals 'STDOUT', \*STDOUT is returned.
|
|
|
401 : 4. else, \*STDOUT is returned.
|
|
|
402 :
|
|
|
403 : Thus, if an object has already set its 'fh' to some location,
|
|
|
404 : it can still print to 'STDOUT' by explicitly passing -WHERE='STDOUT'
|
|
|
405 : to display().
|
|
|
406 :
|
|
|
407 Arguments : Named parameters: (TAGS CAN BE UPPER OR LOWER CASE).
|
|
|
408 : (all are optional).
|
|
|
409 : -WHERE => full path name of file to write to or 'STDOUT'.
|
|
|
410 : -SHOW => what data is to be displayed. Becomes $self->{'_show'}
|
|
|
411 : Default = 'default'. This results in a call to
|
|
|
412 : _display_stats() method when display() is called
|
|
|
413 : -MODE => mode for opening file. Default is overwrite '>'.
|
|
|
414 :
|
|
|
415 Returns : FileHandle object reference or typglob reference (\*STDOUT).
|
|
|
416 Throws : Exception propagated from set_fh().
|
|
|
417 Example : $self->set_display();
|
|
|
418 : $self->set_display(-WHERE=>'./data.out');
|
|
|
419 : $self->set_display(-WHERE=>$obj->fh());
|
|
|
420 Status : Experimental
|
|
|
421 Comments : I'm not satisfied with the current display()/set_display() strategy.
|
|
|
422
|
|
|
423 See also : L<display()|display>, L<set_fh()|set_fh>
|
|
|
424
|
|
|
425 =cut
|
|
|
426
|
|
|
427 #----------------'
|
|
|
428 sub set_display {
|
|
|
429 #----------------
|
|
|
430 my( $self, @param ) = @_;
|
|
|
431 my ($show, $where, $mode) = $self->_rearrange([qw(SHOW WHERE MODE)], @param);
|
|
|
432
|
|
|
433 ## Default mode: overwrite any existing file.
|
|
|
434 $mode ||= '>';
|
|
|
435 $where ||= 'STDOUT';
|
|
|
436
|
|
|
437 $self->{'_show'} = ($show || 'default');
|
|
|
438
|
|
|
439 $DEBUG and print STDERR "$ID set_display() show: $self->{'_show'}\twhere: -->$where<--\n";
|
|
|
440
|
|
|
441 if( defined $where and $where !~ /STDOUT/) {
|
|
|
442 # print "setting file handle object\n";
|
|
|
443 $self->set_fh(-PATH =>$where,
|
|
|
444 -PRE =>$mode);
|
|
|
445 } elsif( not defined $self->{'_fh'} or $where =~ /STDOUT/) {
|
|
|
446 return \*STDOUT;
|
|
|
447 } else {
|
|
|
448 # print STDERR "filehandle already set for this object: ${\$self->fh('name')}\n";
|
|
|
449 }
|
|
|
450
|
|
|
451 return $self->{'_fh'};
|
|
|
452 }
|
|
|
453
|
|
|
454
|
|
|
455
|
|
|
456 =head2 set_read
|
|
|
457
|
|
|
458 Purpose : Sets a new FileHandle object for input.
|
|
|
459 : Same logic as set_display() but creates filehandle for read only.
|
|
|
460 Returns : The input FileHandle object or \*STDIN.
|
|
|
461 Arguments : Named parameters: (TAGS CAN BE UPPER OR LOWER CASE).
|
|
|
462 : $param{-WHERE} = full path name of file to write to.
|
|
|
463 Access : Public
|
|
|
464 Status : Experimental, Deprecated
|
|
|
465 :
|
|
|
466 WARNING : THIS METHOD HAS NOT BEEN TESTED AND IS LIKELY UNNECESSARY.
|
|
|
467 : USE THE read() METHOD INSTEAD.
|
|
|
468 :
|
|
|
469 : Note also that set_read() uses the same data member as set_display()
|
|
|
470 : so it is currently not possible to simultaneously have
|
|
|
471 : different displaying and reading filehandles. This degree of
|
|
|
472 : I/O control has not been necessary.
|
|
|
473
|
|
|
474 See also : L<read()|read>, L<set_display()|set_display>
|
|
|
475
|
|
|
476 =cut
|
|
|
477
|
|
|
478 #-------------
|
|
|
479 sub set_read {
|
|
|
480 #-------------
|
|
|
481 my( $self, @param ) = @_;
|
|
|
482 my ($where, $mode) = $self->_rearrange([qw(WHERE MODE)], @param);
|
|
|
483
|
|
|
484 ## Default mode: read only.
|
|
|
485 $mode ||= '<';
|
|
|
486 $where ||= 'STDIN';
|
|
|
487
|
|
|
488 if( ref($where) and $where !~ /STDIN/) {
|
|
|
489 # print "setting file handle object\n";
|
|
|
490 $self->set_fh(-PATH =>$where,
|
|
|
491 -PRE =>$mode);
|
|
|
492 } elsif( not defined $self->{'_fh'} or $where =~ /STDIN/) {
|
|
|
493 return \*STDIN;
|
|
|
494 } else {
|
|
|
495 # print STDERR "filehandle already set for this object: ${\$self->fh('name')}\n";
|
|
|
496 }
|
|
|
497
|
|
|
498 return $self->{'_fh'};
|
|
|
499 }
|
|
|
500
|
|
|
501
|
|
|
502
|
|
|
503 =head2 set_display_err
|
|
|
504
|
|
|
505 Purpose : Sets a new FileHandle object for outputing error information.
|
|
|
506 : Same logic as set_display() but creates a filehandle in
|
|
|
507 : append mode.
|
|
|
508 Returns : The output FileHandle object for saving errors or \*STDERR.
|
|
|
509 Status : Experimental
|
|
|
510 WARNING : NOT TESTED
|
|
|
511
|
|
|
512 See also : L<set_display()|set_display>, L<set_read()|set_read>
|
|
|
513
|
|
|
514 =cut
|
|
|
515
|
|
|
516 #--------------------
|
|
|
517 sub set_display_err {
|
|
|
518 #--------------------
|
|
|
519 my( $self, @param ) = @_;
|
|
|
520 my ($where, $mode) = $self->_rearrange([qw(WHERE MODE)], @param);
|
|
|
521
|
|
|
522 ## Default mode: read only.
|
|
|
523 $mode ||= '>>';
|
|
|
524 $where ||= 'STDERR';
|
|
|
525
|
|
|
526 $DEBUG and print STDERR "set_display_err() object: ${\$self->name()}\n";
|
|
|
527
|
|
|
528 if( ref($where) and $where !~ /STDERR/) {
|
|
|
529 # print "setting file handle object\n";
|
|
|
530 $self->set_fh(-PATH =>$where,
|
|
|
531 -PRE =>$mode);
|
|
|
532 } elsif( not defined $self->{'_fherr'} or $where =~ /STDERR/) {
|
|
|
533 return \*STDERR;
|
|
|
534 } else {
|
|
|
535 # print STDERR "filehandle already set for this object: ${\$self->fh('name')}\n";
|
|
|
536 }
|
|
|
537
|
|
|
538 return $self->{'_fherr'};
|
|
|
539 }
|
|
|
540
|
|
|
541
|
|
|
542 #####################################
|
|
|
543 # GET ACCESSORS
|
|
|
544 #####################################
|
|
|
545
|
|
|
546
|
|
|
547 =head2 show
|
|
|
548
|
|
|
549 Usage : $self->show()
|
|
|
550 Purpose : Get the string used to specify what to display
|
|
|
551 : using the display() method.
|
|
|
552 Returns : String or undef if no show data member is defined.
|
|
|
553 Arguments : n/a
|
|
|
554
|
|
|
555 See also : L<set_display()|set_display>
|
|
|
556
|
|
|
557 =cut
|
|
|
558
|
|
|
559 #----------
|
|
|
560 sub show { my $self= shift; $self->{'_show'}; }
|
|
|
561 #----------
|
|
|
562
|
|
|
563
|
|
|
564
|
|
|
565 =head2 fh
|
|
|
566
|
|
|
567 Usage : $object->fh(['name'])
|
|
|
568 Purpose : Accessor for an object's FileHandle object or the argument used
|
|
|
569 : to create that object.
|
|
|
570 Returns : One of the following:
|
|
|
571 : 1. The arguments used when the filehandle was created ('fh_name').
|
|
|
572 : 2. The FileHandle object reference previously assigned to $self->{'_fh'}.
|
|
|
573 : 3. Typeglob reference \*STDIN, \*STDOUT or \*STDERR.
|
|
|
574 Example : $self->fh(); # returns filehandle for the STDIN/STDOUT path.
|
|
|
575 : $self->fh('err'); # returns filehandle for the err file.
|
|
|
576 : $self->fh('name'); # returns fh creation arguments.
|
|
|
577 : $self->fh('errname'); # returns fh creation arguments for the err file.
|
|
|
578 Status : Experimental
|
|
|
579
|
|
|
580 See also : L<set_display()|set_display>, L<set_read()|set_read>, L<set_fh()|set_fh>, L<set_display_err()|set_display_err>
|
|
|
581
|
|
|
582 =cut
|
|
|
583
|
|
|
584 #--------'
|
|
|
585 sub fh {
|
|
|
586 #--------
|
|
|
587 my( $self, $type, $stream) = @_;
|
|
|
588 $stream ||= 'out';
|
|
|
589 $stream = ($stream eq 'in') ? \*STDIN : \*STDOUT;
|
|
|
590
|
|
|
591 ## Problem: Without named parameters, how do you know if
|
|
|
592 ## a single argument is to be assigned to $type or $stream?
|
|
|
593 ## Function prototypes could be used, or separate methods:
|
|
|
594 ## fh_out(), fh_in(), fh_err().
|
|
|
595 $type or return ($self->{'_fh'} || $stream);
|
|
|
596
|
|
|
597 if( $type =~ /name/){
|
|
|
598 if($type =~ /err/ ) { return $self->{'_fherr_name'}; }
|
|
|
599 else { return $self->{'_fh_name'}; }
|
|
|
600
|
|
|
601 } else {
|
|
|
602 if($type =~ /err/ ) { return ($self->{'_fherr'} || \*STDERR); }
|
|
|
603 else { return ($self->{'_fh'} || $stream); }
|
|
|
604 }
|
|
|
605 }
|
|
|
606
|
|
|
607
|
|
|
608 #####################################################################################
|
|
|
609 ## INSTANCE METHODS ##
|
|
|
610 #####################################################################################
|
|
|
611
|
|
|
612
|
|
|
613 ##
|
|
|
614 ## INPUT METHODS:
|
|
|
615 ##
|
|
|
616
|
|
|
617
|
|
|
618 =head2 read
|
|
|
619
|
|
|
620 Usage : $object->read(<named parameters>);
|
|
|
621 Purpose : Read raw textual data from a file or STDIN.
|
|
|
622 : Optionally process each record it as it is read.
|
|
|
623 Example : $data = $object->read(-FILE =>'usr/people/me/data.txt',
|
|
|
624 : -REC_SEP =>"\n:",
|
|
|
625 : -FUNC =>\&process_rec);
|
|
|
626 : $data = $object->read(-FILE =>\*FILEHANDLE);
|
|
|
627 : $data = $object->read(-FILE =>new FileHandle $file, 'r');
|
|
|
628 :
|
|
|
629 Argument : Named parameters: (TAGS CAN BE UPPER OR LOWER CASE)
|
|
|
630 : (all optional)
|
|
|
631 : -FILE => string (full path to file) or a reference
|
|
|
632 : to a FileHandle object or typeglob. This is an
|
|
|
633 : optional parameter (if not defined, STDIN is used).
|
|
|
634 : -REC_SEP => record separator to be used
|
|
|
635 : when reading in raw data. If none is supplied,
|
|
|
636 : the default record separator is used ($/).
|
|
|
637 : $/ is localized to this method but be careful if
|
|
|
638 : you do any additional file reading in functions
|
|
|
639 : called by this method (see the -FUNC parameter).
|
|
|
640 : Such methods will use the value of $/ set
|
|
|
641 : by read() (if a -RE_SEP is supplied).
|
|
|
642 : -FUNC => reference to a function to be called for each
|
|
|
643 : record. The return value of this function is now checked:
|
|
|
644 : if false, the reading is terminated.
|
|
|
645 : Typically -FUNC supplies a closure.
|
|
|
646 : -HANDLE => reference to a FileHandle object or a
|
|
|
647 : typeglob to be use for reading input.
|
|
|
648 : The FileHandle object should be configured to
|
|
|
649 : read from a desired file before calling this
|
|
|
650 : method. If both -handle and -file are defined,
|
|
|
651 : -handle takes precedence.
|
|
|
652 : (The -HANDLE parameter is no longer necessary
|
|
|
653 : since -FILE can now contain a FileHandle ref.)
|
|
|
654 : -WAIT => integer (number of seconds to wait for input
|
|
|
655 : before timing out. Default = 20 seconds).
|
|
|
656 :
|
|
|
657 Returns : string, array, or undef depending on the arguments.
|
|
|
658 : If a function reference is supplied, this function will be
|
|
|
659 : called using the contents of each record as it is read in.
|
|
|
660 : If no function reference is supplied, the data are returned as a
|
|
|
661 : string in scalar context or as a list in array context.
|
|
|
662 : The data are not altered; blank lines are not removed.
|
|
|
663 :
|
|
|
664 Throws : Exception if no input is read from source.
|
|
|
665 : Exception if no input is read within WAIT seconds.
|
|
|
666 : Exception if FUNC is not a function reference.
|
|
|
667 : Propagates any exceptions thrown by create_filehandle()
|
|
|
668 :
|
|
|
669 Comments : Gets the file name from the current file data member.
|
|
|
670 : If no file has been defined, this method will attempt to
|
|
|
671 : read from STDIN.
|
|
|
672 :
|
|
|
673 : COMPRESSED FILES:
|
|
|
674 : read() will attempt to use gzip -cd to read the file
|
|
|
675 : if it appears to be compressed (binary file test).
|
|
|
676 :
|
|
|
677 : If the raw data is to be returned, wantarray is used to
|
|
|
678 : determine how the data are to be returned (list or string).
|
|
|
679 :
|
|
|
680 : Sets the file data member to be the supplied file name.
|
|
|
681 : (if any is supplied).
|
|
|
682
|
|
|
683 : The read() method is a fairly new implementation
|
|
|
684 : and uses a different approach than display().
|
|
|
685 : For example, set_read() is not used.
|
|
|
686
|
|
|
687 Bugs : The following error is generated by Perl's FileHandle.pm module
|
|
|
688 : when using the -w switch. It can be ignored for now:
|
|
|
689 "Close on unopened file <GEN0> at /tools/perl/5.003/lib/FileHandle.pm line 255."
|
|
|
690
|
|
|
691 See Also : L<file()|file>, L<Bio::Root::Utilities::create_filehandle()|Bio::Root::Utilities>
|
|
|
692
|
|
|
693 =cut
|
|
|
694
|
|
|
695 #----------'
|
|
|
696 sub read {
|
|
|
697 #----------
|
|
|
698 my($self, @param) = @_;
|
|
|
699 my( $rec_sep, $func_ref, $wait ) =
|
|
|
700 $self->_rearrange([qw( REC_SEP FUNC WAIT)], @param);
|
|
|
701
|
|
|
702 my $fmt = (wantarray ? 'list' : 'string');
|
|
|
703 $wait ||= $TIMEOUT_SECS; # seconds to wait before timing out.
|
|
|
704
|
|
|
705 my $FH = $Util->create_filehandle( -client => $self, @param);
|
|
|
706
|
|
|
707 # Set the record separator (if necessary) using dynamic scope.
|
|
|
708 my $prev_rec_sep;
|
|
|
709 $prev_rec_sep = $/ if scalar $rec_sep; # save the previous rec_sep
|
|
|
710 local $/ = $rec_sep if scalar $rec_sep;
|
|
|
711
|
|
|
712 # Verify that we have a proper reference to a function.
|
|
|
713 if($func_ref) {
|
|
|
714 if(not ref($func_ref) =~ /CODE/) {
|
|
|
715 $self->throw("Not a function reference: $func_ref, ${\ref $func_ref}");
|
|
|
716 }
|
|
|
717 }
|
|
|
718
|
|
|
719 $DEBUG && printf STDERR "$ID: read(): rec_sep = %s; func = %s\n",$/, ($func_ref?'defined':'none');
|
|
|
720
|
|
|
721 my($data, $lines, $alarm_available);
|
|
|
722
|
|
|
723 $alarm_available = 1;
|
|
|
724
|
|
|
725 eval {
|
|
|
726 alarm(0);
|
|
|
727 };
|
|
|
728 if($@) {
|
|
|
729 # alarm() not available (ActiveState perl for win32 doesn't have it.
|
|
|
730 # See jitterbug PR#98)
|
|
|
731 $alarm_available = 0;
|
|
|
732 }
|
|
|
733
|
|
|
734 $SIG{ALRM} = sub { die "Timed out!"; };
|
|
|
735
|
|
|
736 eval {
|
|
|
737 $alarm_available and alarm($wait);
|
|
|
738
|
|
|
739 READ_LOOP:
|
|
|
740 while(<$FH>) {
|
|
|
741 # Default behavior: read all lines.
|
|
|
742 # If &$func_ref returns false, exit this while loop.
|
|
|
743 # Uncomment to skip lines with only white space or record separators
|
|
|
744 # next if m@^(\s*|$/*)$@;
|
|
|
745
|
|
|
746 $lines++;
|
|
|
747 $alarm_available and alarm(0); # Deactivate the alarm as soon as we start reading.
|
|
|
748 my($result);
|
|
|
749 if($func_ref) {
|
|
|
750 # Need to reset $/ for any called function.
|
|
|
751 local $/ = $prev_rec_sep if defined $prev_rec_sep;
|
|
|
752 $result = &$func_ref($_) or last READ_LOOP;
|
|
|
753 } else {
|
|
|
754 $data .= $_;
|
|
|
755 }
|
|
|
756 }
|
|
|
757 };
|
|
|
758 if($@ =~ /Timed out!/) {
|
|
|
759 $self->throw("Timed out while waiting for input from $self->{'_input_type'}.", "Timeout period = $wait seconds.\nFor a longer time out period, supply a -wait => <seconds> parameter\n".
|
|
|
760 "or edit \$TIMEOUT_SECS in Bio::Root::Global.pm.");
|
|
|
761 } elsif($@ =~ /\S/) {
|
|
|
762 my $err = $@;
|
|
|
763 $self->throw("Unexpected error during read: $err");
|
|
|
764 }
|
|
|
765
|
|
|
766 close ($FH) unless $self->{'_input_type'} eq 'STDIN';
|
|
|
767
|
|
|
768 if($data) {
|
|
|
769 $DEBUG && do{
|
|
|
770 print STDERR "$ID: $lines records read.\nReturning $fmt.\n" };
|
|
|
771
|
|
|
772 return ($fmt eq 'list') ? split("$/", $data) : $data;
|
|
|
773
|
|
|
774 } elsif(not $func_ref) {
|
|
|
775 $self->throw("No data input from $self->{'_input_type'}");
|
|
|
776 }
|
|
|
777 delete $self->{'_input_type'};
|
|
|
778 undef;
|
|
|
779 }
|
|
|
780
|
|
|
781
|
|
|
782 ##
|
|
|
783 ## OUTPUT METHODS:
|
|
|
784 ##
|
|
|
785
|
|
|
786
|
|
|
787 =head2 display
|
|
|
788
|
|
|
789 Usage : $self->set_display(named parameters)
|
|
|
790 Purpose : Provides a default display method which calls set_display()
|
|
|
791 : and also invokes methods to display an object's stats
|
|
|
792 : if necessary ( _print_stats_header() and _displayStats() ).
|
|
|
793 Returns : True (1).
|
|
|
794 Throws : Propagates any exceptions thrown by set_display().
|
|
|
795 Arguments : Named parameters for set_display().
|
|
|
796 Comments : I'm not satisfied with the current display()/set_display() strategy.
|
|
|
797
|
|
|
798 See also : L<set_display()|set_display>
|
|
|
799
|
|
|
800 =cut
|
|
|
801
|
|
|
802 #-------------
|
|
|
803 sub display {
|
|
|
804 #-------------
|
|
|
805 my( $self, %param ) = @_;
|
|
|
806
|
|
|
807 $DEBUG && print STDERR "$ID display for ${\ref($self)}\n";
|
|
|
808
|
|
|
809 my $OUT = $self->set_display(%param);
|
|
|
810 # my $OUT = $self->set_display( %param );
|
|
|
811 # print "$ID: OUT = $OUT";<STDIN>;
|
|
|
812
|
|
|
813 $DEBUG && do{ print STDERR "display(): WHERE = $OUT;\nSHOW = $self->{'_show'}";<STDIN>;};
|
|
|
814
|
|
|
815 if($self->{'_show'} =~ /stats|default/i) {
|
|
|
816 if($param{-HEADER}) {
|
|
|
817 $self->_print_stats_header($OUT);
|
|
|
818 }
|
|
|
819 $self->parent->_display_stats($OUT);
|
|
|
820 }
|
|
|
821 1;
|
|
|
822 }
|
|
|
823
|
|
|
824
|
|
|
825
|
|
|
826 =head2 _print_stats_header
|
|
|
827
|
|
|
828 Usage : n/a; internal method.
|
|
|
829 : $obj->_print_stats_header(filehandle);
|
|
|
830 Purpose : Prints a header containing basic info about the object
|
|
|
831 : such as the class and name of the object followed by a
|
|
|
832 : line of hyphens.
|
|
|
833 Status : Experimental
|
|
|
834
|
|
|
835 =cut
|
|
|
836
|
|
|
837 #------------------------
|
|
|
838 sub _print_stats_header {
|
|
|
839 #------------------------
|
|
|
840 my($self, $OUT) = @_;
|
|
|
841
|
|
|
842 printf $OUT "\nSTATS FOR %s \"%s\"\n",ref($self->parent),$self->parent->name();
|
|
|
843 printf $OUT "%s\n", '-'x60;
|
|
|
844 }
|
|
|
845
|
|
|
846
|
|
|
847
|
|
|
848
|
|
|
849 ##
|
|
|
850 ## FILE MANIPULATION METHODS:
|
|
|
851 ##
|
|
|
852
|
|
|
853
|
|
|
854
|
|
|
855 =head2 file_date
|
|
|
856
|
|
|
857 Usage : $object->file_date( %named_parameters);
|
|
|
858 Purpose : Get the last modified date of a file.
|
|
|
859 Example : $object->file_date();
|
|
|
860 : $object->file_date(-FMT =>'yyyy-mmm-dd',
|
|
|
861 -FILE =>'/usr/people/me/data.txt');
|
|
|
862 : $object->file_date(-FMT =>'yyyy-mmm-dd');
|
|
|
863 Returns : String (date)
|
|
|
864 Argument : Named parameters: (TAGS CAN BE UPPER OR LOWER CASE)
|
|
|
865 : -FILE => string (filename full path)
|
|
|
866 : -FMT => string (format for the returned date string)
|
|
|
867 :
|
|
|
868 Throws : Exception if no file is specified or the file is non-existent
|
|
|
869 : (Propagated from Utilities::file_date())
|
|
|
870 Comments : File can be text or binary.
|
|
|
871
|
|
|
872 See Also : L<file()|file>, L<Bio::Root::Utilities::file_date()|Bio::Root::Utilities>
|
|
|
873
|
|
|
874 =cut
|
|
|
875
|
|
|
876 #---------------
|
|
|
877 sub file_date {
|
|
|
878 #---------------
|
|
|
879 my ($self, @param) = @_;
|
|
|
880 my ($file, $fmt) = $self->_rearrange([qw(FILE FMT)], @param);
|
|
|
881
|
|
|
882 if(not $file ||= $self->{'_file'}) {
|
|
|
883 $self->throw("Can't get file date: no file specified");
|
|
|
884 }
|
|
|
885 $fmt ||= '';
|
|
|
886 $Util->file_date($file, $fmt);
|
|
|
887 }
|
|
|
888
|
|
|
889
|
|
|
890
|
|
|
891 =head2 compress_file
|
|
|
892
|
|
|
893 Usage : $object->compress_file([filename]);
|
|
|
894 Purpose : Compresses a file if not already compressed.
|
|
|
895 : Compresses to a temorary file if user is not owner of supplied file.
|
|
|
896 Example : $object->file('/usr/home/me/data.txt');
|
|
|
897 : $object->compress_file();
|
|
|
898 Argument : String (full path name) (optional).
|
|
|
899 : If no argument is provided, the file data member is used.
|
|
|
900 Returns : String (compressed file name, full path).
|
|
|
901 : Sets the file data member to the compressed name
|
|
|
902 : when not operating on a file supplied as an argument.
|
|
|
903 : Returns false (undef) if the file is already compressed
|
|
|
904 : (binary test).
|
|
|
905 Throws : Exception if no file is specified.
|
|
|
906 : Propagates any exception thrown by Bio::Root::Utilities::compress()
|
|
|
907 : if the file cannot be compressed().
|
|
|
908 : Tests if file is already compressed to avoid trivial error due to
|
|
|
909 : the file already being compressed.
|
|
|
910 :
|
|
|
911 Comments : Relies on the compress() method of Bio::Root::Utilities.pm
|
|
|
912 : to implement the file compression functionality.
|
|
|
913 : (Currently, Bio::Root::Utilities::compress() uses gzip.)
|
|
|
914 :
|
|
|
915 : If the user is not the owner of the file, the file is
|
|
|
916 : compressed to a tmp file.
|
|
|
917 :
|
|
|
918 : All file compressing/uncompressing requests should go through
|
|
|
919 : compress_file()/uncompress_file(). This serves to confine the
|
|
|
920 : dependency between IOManager.pm module and Utilities.pm
|
|
|
921 : which helps maintainability.
|
|
|
922 :
|
|
|
923 Bugs : Only compresses text files. This obviates a dependency on
|
|
|
924 : particular file suffixes but is not good if you
|
|
|
925 : want to compress a binary file.
|
|
|
926 :
|
|
|
927 : May not be taint-safe.
|
|
|
928
|
|
|
929 See Also : L<uncompress_file()|uncompress_file>, L<file()|file>, L<Bio::Root::Utilities::compress()|Bio::Root::Utilities>
|
|
|
930
|
|
|
931 =cut
|
|
|
932
|
|
|
933 #-----------------
|
|
|
934 sub compress_file {
|
|
|
935 #-----------------
|
|
|
936 my ($self, $file) = @_;
|
|
|
937 my $myfile = 0;
|
|
|
938
|
|
|
939 if(!$file) {
|
|
|
940 $file = $self->{'_file'};
|
|
|
941 $myfile = 1;
|
|
|
942 }
|
|
|
943
|
|
|
944 $file or $self->throw("Can't compress data file: no file specified");
|
|
|
945
|
|
|
946 #printf STDERR "$ID: Compressing data file for %s\n $file\n",$self->name();
|
|
|
947
|
|
|
948 my ($newfile);
|
|
|
949 if (-T $file) {
|
|
|
950 $newfile = -o $file ? $Util->compress($file) : $Util->compress($file, 1);
|
|
|
951 # set the current file to the new name.
|
|
|
952 $self->file($newfile) if $myfile;
|
|
|
953 }
|
|
|
954 $newfile;
|
|
|
955 }
|
|
|
956
|
|
|
957
|
|
|
958
|
|
|
959 =head2 uncompress_file
|
|
|
960
|
|
|
961 Usage : $object->uncompress_file([filename]);
|
|
|
962 Purpose : Uncompresses the file containing the raw report.
|
|
|
963 : Uncompresses to a temorary file if user is not owner of supplied file.
|
|
|
964 Example : $object->file('/usr/home/me/data.txt.gz');
|
|
|
965 : $object->uncompress_file();
|
|
|
966 Argument : String (full path name) (optional).
|
|
|
967 : If no argument is provided, the file data member is used.
|
|
|
968 Returns : String (uncompressed file name, full path).
|
|
|
969 : Sets the file data member to the uncompressed name
|
|
|
970 : when not operating on a file supplied as an argument.
|
|
|
971 : Returns false (undef) if the file is already uncompressed.
|
|
|
972 :
|
|
|
973 Throws : Exception if no file is specified.
|
|
|
974 : Propagates any exception thrown by Bio::Root::Utilities::compress()
|
|
|
975 : if the file cannot be uncompressed().
|
|
|
976 : Tests if file is already uncompressed to avoid trivial error due to
|
|
|
977 : the file already being uncompressed.
|
|
|
978 Comments : See comments for compress_file(). They apply here as well.
|
|
|
979 :
|
|
|
980 Bugs : Considers all binary files to be compressed. This obviates
|
|
|
981 : a dependency on particular file suffixes.
|
|
|
982 : May not be taint safe.
|
|
|
983
|
|
|
984 See Also : L<compress_file()|compress_file>, L<file()|file>, L<Bio::Root::Utilities::uncompress()|Bio::Root::Utilities>
|
|
|
985
|
|
|
986 =cut
|
|
|
987
|
|
|
988 #--------------------
|
|
|
989 sub uncompress_file {
|
|
|
990 #--------------------
|
|
|
991 my ($self, $file) = @_;
|
|
|
992 my $myfile = 0;
|
|
|
993
|
|
|
994 if(!$file) {
|
|
|
995 $file = $self->{'_file'};
|
|
|
996 $myfile = 1;
|
|
|
997 }
|
|
|
998
|
|
|
999 $file or $self->throw("Can't compress file: no file specified");
|
|
|
1000
|
|
|
1001 #printf STDERR "$ID: Uncompressing data file for %s\n $file",$self->name();
|
|
|
1002
|
|
|
1003 my ($newfile);
|
|
|
1004 if (-B $file) {
|
|
|
1005 $newfile = -o $file ? $Util->uncompress($file) : $Util->uncompress($file, 1);
|
|
|
1006 # set the current file to the new name & return it.
|
|
|
1007 $self->file($newfile) if $myfile;
|
|
|
1008 }
|
|
|
1009 $newfile;
|
|
|
1010 }
|
|
|
1011
|
|
|
1012
|
|
|
1013 =head2 delete_file
|
|
|
1014
|
|
|
1015 Usage : $object->delete_file([filename]);
|
|
|
1016 Purpose : Delete a file.
|
|
|
1017 Example : $object->delete_file('/usr/people/me/data.txt');
|
|
|
1018 Returns : String (name of file which was deleted) if successful,
|
|
|
1019 : undef if file does not exist.
|
|
|
1020 : Sets the file data member to undef
|
|
|
1021 : when not operating on a file supplied as an argument.
|
|
|
1022 Argument : String (full path name) (optional).
|
|
|
1023 : If no argument is provided, the file data member is used.
|
|
|
1024 Throws : Exception if the user is not the owner of the file.
|
|
|
1025 : Propagates any exception thrown by Bio::Root::Utilities::delete().
|
|
|
1026 : if the file cannot be deleted.
|
|
|
1027 Comments : Be careful with this method: there is no undelete().
|
|
|
1028 : Relies on the delete() method provided by Bio::Root::Utilities.pm
|
|
|
1029 : to implement the file deletion functionality.
|
|
|
1030 : This method is not taint-safe.
|
|
|
1031 : It is intended for off-line maintenance use only.
|
|
|
1032
|
|
|
1033 See Also : L<file()|file>, L<Bio::Root::Utilities::delete()|Bio::Root::Utilities>
|
|
|
1034
|
|
|
1035 =cut
|
|
|
1036
|
|
|
1037 #-----------------
|
|
|
1038 sub delete_file {
|
|
|
1039 #-----------------
|
|
|
1040 my ($self, $file) = @_;
|
|
|
1041 my $myfile = 0;
|
|
|
1042
|
|
|
1043 if(!$file) {
|
|
|
1044 $file = $self->{'_file'};
|
|
|
1045 $myfile = 1;
|
|
|
1046 }
|
|
|
1047 return undef unless -e $file;
|
|
|
1048
|
|
|
1049 -o $file or
|
|
|
1050 $self->throw("Can't delete file $file: Not owner.");
|
|
|
1051
|
|
|
1052 # $DEBUG and print STDERR "$ID: Deleting data file for ",$self->name();
|
|
|
1053
|
|
|
1054 eval{ $Util->delete($file); };
|
|
|
1055
|
|
|
1056 if(!$@ and $myfile) {
|
|
|
1057 $self->{'_file'} = undef;
|
|
|
1058 }
|
|
|
1059 $file;
|
|
|
1060 }
|
|
|
1061
|
|
|
1062
|
|
|
1063
|
|
|
1064 1;
|
|
|
1065 __END__
|
|
|
1066
|
|
|
1067 #####################################################################################
|
|
|
1068 # END OF CLASS #
|
|
|
1069 #####################################################################################
|
|
|
1070
|
|
|
1071 =head1 FOR DEVELOPERS ONLY
|
|
|
1072
|
|
|
1073 =head2 Data Members
|
|
|
1074
|
|
|
1075 Information about the various data members of this module is provided for those
|
|
|
1076 wishing to modify or understand the code. Two things to bear in mind:
|
|
|
1077
|
|
|
1078 =over 4
|
|
|
1079
|
|
|
1080 =item 1 Do NOT rely on these in any code outside of this module.
|
|
|
1081
|
|
|
1082 All data members are prefixed with an underscore to signify that they are private.
|
|
|
1083 Always use accessor methods. If the accessor doesn't exist or is inadequate,
|
|
|
1084 create or modify an accessor (and let me know, too!).
|
|
|
1085
|
|
|
1086 =item 2 This documentation may be incomplete and out of date.
|
|
|
1087
|
|
|
1088 It is easy for this documentation to become obsolete as this module is still evolving.
|
|
|
1089 Always double check this info and search for members not described here.
|
|
|
1090
|
|
|
1091 =back
|
|
|
1092
|
|
|
1093 An instance of Bio::Root::IOManager.pm is a blessed reference to a hash containing
|
|
|
1094 all or some of the following fields:
|
|
|
1095
|
|
|
1096 FIELD VALUE
|
|
|
1097 ------------------------------------------------------------------------
|
|
|
1098 _show Selects display options.
|
|
|
1099
|
|
|
1100 _fh FileHandle object for redirecting STDIN or STDOUT.
|
|
|
1101
|
|
|
1102 _fherr FileHandle object for error data. Append mode.
|
|
|
1103
|
|
|
1104 _fh_name The arguments used to create fh.
|
|
|
1105
|
|
|
1106 _fherr_name The arguments used to create fherr.
|
|
|
1107
|
|
|
1108 INHERITED DATA MEMBERS
|
|
|
1109
|
|
|
1110 _parent (From Bio::Root::Object.pm> Object reference for the owner of this IOManager.
|
|
|
1111
|
|
|
1112 =cut
|
|
|
1113
|
|
|
1114
|
|
|
1115 MODIFICATION NOTES:
|
|
|
1116 -------------------
|
|
|
1117
|
|
|
1118 17 Feb 1999, sac:
|
|
|
1119 * Using $Global::TIMEOUT_SECS
|
|
|
1120
|
|
|
1121 3 Feb 1999, sac:
|
|
|
1122 * Added timeout support to read().
|
|
|
1123 * Moved the FileHandle creation code out of read() and into
|
|
|
1124 Bio::Root::Utilties since it's of more general use.
|
|
|
1125
|
|
|
1126 24 Nov 1998, sac:
|
|
|
1127 * Modified read(), compress(), and uncompress() to properly
|
|
|
1128 deal with file ownership issues.
|
|
|
1129
|
|
|
1130 19 Aug 1998, sac:
|
|
|
1131 * Fixed bug in display(), which wasn't returning true (1).
|
|
|
1132
|
|
|
1133 0.023, 20 Jul 1998, sac:
|
|
|
1134 * read() can now use a supplied FileHandle or GLOB ref (\*IN).
|
|
|
1135 * A few other touch-ups in read().
|
|
|
1136
|
|
|
1137 0.022, 16 Jun 1998, sac:
|
|
|
1138 * read() now terminates reading when a supplied &$func_ref
|
|
|
1139 returns false.
|
|
|
1140
|
|
|
1141 0.021, May 1998, sac:
|
|
|
1142 * Refined documentation to use 5.004 pod2html.
|
|
|
1143 * Properly using typglob refs as necessary
|
|
|
1144 (e.g., set_display(), set_fh()).
|
|
|
1145
|
|
|
1146 0.031, 2 Sep 1998, sac:
|
|
|
1147 * Doc changes only
|
|
|
1148
|
|
|
1149
|
