Mercurial > repos > mahtabm > ensembl

comparison variant_effect_predictor/Bio/Root/IOManager.pm @ 0:1f6dce3d34e0

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Uploaded
author mahtabm
date Thu, 11 Apr 2013 02:01:53 -0400
parents
children
comparison
equal deleted inserted replaced
-1:000000000000 0:1f6dce3d34e0
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