~ubuntu-branches/ubuntu/raring/bioperl/raring

« back to all changes in this revision

Viewing changes to Bio/Root/IOManager.pm

  • Committer: Bazaar Package Importer
  • Author(s): Charles Plessy
  • Date: 2008-03-18 14:44:57 UTC
  • mfrom: (4 hardy)
  • mto: This revision was merged to the branch mainline in revision 6.
  • Revision ID: james.westby@ubuntu.com-20080318144457-1jjoztrvqwf0gruk
* debian/control:
  - Removed MIA Matt Hope (dopey) from the Uploaders field.
    Thank you for your work, Matt. I hope you are doing well.
  - Downgraded some recommended package to the 'Suggests' priority,
    according to the following discussion on Upstream's mail list.
    http://bioperl.org/pipermail/bioperl-l/2008-March/027379.html
    (Closes: #448890)
* debian/copyright converted to machine-readable format.

Show diffs side-by-side

added added

removed removed

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