8 use base
qw(Bio::Root::Root);
12 # Use stream I/O in your module
13 $self->{'io'} = Bio::Root::IO->new(-file => "myfile");
14 $self->{'io'}->_print("some stuff");
15 my $line = $self->{'io'}->_readline();
16 $self->{'io'}->_pushback($line);
17 $self->{'io'}->close();
19 # obtain platform-compatible filenames
20 $path = Bio::Root::IO->catfile($dir, $subdir, $filename);
21 # obtain a temporary file (created in $TEMPDIR)
22 ($handle) = $io->tempfile();
26 This module provides methods that will usually be needed for any sort
27 of file- or stream-related input/output, e.g., keeping track of a file
28 handle, transient printing and reading from the file handle, a close
29 method, automatically closing the handle on garbage collection, etc.
31 To use this for your own code you will either want to inherit from
32 this module, or instantiate an object for every file or stream you are
33 dealing with. In the first case this module will most likely not be
34 the first class off which your class inherits; therefore you need to
35 call _initialize_io() with the named parameters in order to set file
36 handle, open file, etc automatically.
38 Most methods start with an underscore, indicating they are private. In
39 OO speak, they are not private but protected, that is, use them in
40 your module code, but a client code of your module will usually not
41 want to call them (except those not starting with an underscore).
43 In addition this module contains a couple of convenience methods for
44 cross-platform safe tempfile creation and similar tasks. There are
45 some CPAN modules related that may not be available on all
46 platforms. At present, File::Spec and File::Temp are attempted. This
47 module defines $PATHSEP, $TEMPDIR, and $ROOTDIR, which will always be set,
48 and $OPENFLAGS, which will be set if either of File::Spec or File::Temp fails.
50 The -noclose boolean (accessed via the noclose method) prevents a
51 filehandle from being closed when the IO object is cleaned up. This
52 is special behavior when a object like a parser might share a
53 filehandle with an object like an indexer where it is not proper to
54 close the filehandle as it will continue to be reused until the end of the
55 stream is reached. In general you won't want to play with this flag.
57 =head1 AUTHOR Hilmar Lapp
61 our ($FILESPECLOADED, $FILETEMPLOADED,
62 $FILEPATHLOADED, $TEMPDIR,
77 # try to load those modules that may cause trouble on some systems
83 print STDERR
"Cannot load File::Path: $@" if( $VERBOSE > 0 );
87 # If on Win32, attempt to find Win32 package
95 # Try to provide a path separator. Why doesn't File::Spec export this,
97 if ($^O
=~ /mswin/i) {
99 } elsif($^O
=~ /macos/i) {
107 $TEMPDIR = File
::Spec
->tmpdir();
108 $ROOTDIR = File
::Spec
->rootdir();
109 require File
::Temp
; # tempfile creation
113 if(! defined($TEMPDIR)) { # File::Spec failed
115 if (defined $ENV{'TEMPDIR'} && -d
$ENV{'TEMPDIR'} ) {
116 $TEMPDIR = $ENV{'TEMPDIR'};
117 } elsif( defined $ENV{'TMPDIR'} && -d
$ENV{'TMPDIR'} ) {
118 $TEMPDIR = $ENV{'TMPDIR'};
120 if($^O
=~ /mswin/i) {
121 $TEMPDIR = 'C:\TEMP' unless $TEMPDIR;
123 } elsif($^O
=~ /macos/i) {
124 $TEMPDIR = "" unless $TEMPDIR; # what is a reasonable default on Macs?
125 $ROOTDIR = ""; # what is reasonable??
127 $TEMPDIR = "/tmp" unless $TEMPDIR;
130 if (!( -d
$TEMPDIR && -w
$TEMPDIR )) {
131 $TEMPDIR = '.'; # last resort
134 # File::Temp failed (alone, or File::Spec already failed)
135 # determine open flags for tempfile creation using Fcntl
136 $OPENFLAGS = O_CREAT
| O_EXCL
| O_RDWR
;
137 for my $oflag (qw
/FOLLOW BINARY LARGEFILE EXLOCK NOINHERIT TEMPORARY/){
138 my ($bit, $func) = (0, "Fcntl::O_" . $oflag);
140 $OPENFLAGS |= $bit if eval { $bit = &$func(); 1 };
143 $ONMAC = "\015" eq "\n";
150 Usage : my $io = Bio::Root::IO->new( -file => 'data.txt' );
151 Function: Create new class instance. It automatically calls C<_initialize_io>.
152 Args : Same named parameters as C<_initialize_io>.
153 Returns : A Bio::Root::IO object
158 my ($caller, @args) = @_;
159 my $self = $caller->SUPER::new
(@args);
160 $self->_initialize_io(@args);
165 =head2 _initialize_io
167 Title : _initialize_io
168 Usage : $io->_initialize_io(@params);
169 Function: Initializes filehandle and other properties from the parameters.
170 Args : The following named parameters are currently recognized:
171 -file name of file to read or write to
172 -fh file handle to read or write to (mutually exclusive
173 with -file and -string)
174 -input name of file, or filehandle (GLOB or IO::Handle object)
176 -string string to read from (will be converted to filehandle)
177 -url name of URL to open
178 -flush boolean flag to autoflush after each write
179 -noclose boolean flag, when set to true will not close a
180 filehandle (must explicitly call close($io->_fh)
181 -retries number of times to try a web fetch before failure
182 -ua_parms when using -url, hashref of key => value parameters
183 to pass to LWP::UserAgent->new(). A useful value might
184 be, for example, {timeout => 60 } (ua defaults to 180s)
190 my($self, @args) = @_;
192 $self->_register_for_cleanup(\
&_io_cleanup
);
194 my ($input, $noclose, $file, $fh, $string,
195 $flush, $url, $retries, $ua_parms) =
196 $self->_rearrange([qw(INPUT NOCLOSE FILE FH STRING FLUSH URL RETRIES UA_PARMS)],
204 require LWP
::UserAgent
;
205 my $ua = LWP
::UserAgent
->new(%$ua_parms);
207 my ($handle, $tempfile) = $self->tempfile();
208 CORE
::close($handle);
210 for (my $try = 1 ; $try <= $retries ; $try++) {
211 $http_result = $ua->get($url, ':content_file' => $tempfile);
212 $self->warn("[$try/$retries] tried to fetch $url, but server ".
213 "threw ". $http_result->code . ". retrying...")
214 if !$http_result->is_success;
215 last if $http_result->is_success;
217 $self->throw("Failed to fetch $url, server threw ".$http_result->code)
218 if !$http_result->is_success;
224 delete $self->{'_readbuffer'};
225 delete $self->{'_filehandle'};
226 $self->noclose( $noclose) if defined $noclose;
227 # determine whether the input is a file(name) or a stream
229 if (ref(\
$input) eq 'SCALAR') {
230 # we assume that a scalar is a filename
231 if ($file && ($file ne $input)) {
232 $self->throw("Input file given twice: '$file' and '$input' disagree");
235 } elsif (ref($input) &&
236 ((ref($input) eq 'GLOB') || $input->isa('IO::Handle'))) {
240 # let's be strict for now
241 $self->throw("Unable to determine type of input $input: ".
242 "not string and not GLOB");
246 if (defined($file) && defined($fh)) {
247 $self->throw("Providing both a file and a filehandle for reading - ".
252 if (defined($file) || defined($fh)) {
253 $self->throw("File or filehandle provided with -string, ".
254 "please unset if you are using -string as a file");
256 open $fh, '<', \
$string or $self->throw("Could not read string: $!");
259 if (defined($file) && ($file ne '')) {
261 ($mode, $file) = $self->cleanfile;
263 my $action = ($mode =~ m/>/) ?
'write' : 'read';
264 $fh = Symbol
::gensym
();
265 open $fh, $mode, $file or $self->throw("Could not $action file '$file': $!");
269 # check filehandle to ensure it's one of:
270 # a GLOB reference, as in: open(my $fh, "myfile");
271 # an IO::Handle or IO::String object
272 # the UNIVERSAL::can added to fix Bug2863
273 unless ( ( ref $fh and ( ref $fh eq 'GLOB' ) )
274 or ( ref $fh and ( UNIVERSAL
::can
( $fh, 'can' ) )
275 and ( $fh->isa('IO::Handle')
276 or $fh->isa('IO::String') ) )
278 $self->throw("Object $fh does not appear to be a file handle");
281 binmode $fh, ':raw:eol(LF-Native)';
283 $self->_fh($fh); # if $fh not provided, defaults to STDIN and STDOUT
286 $self->_flush_on_write(defined $flush ?
$flush : 1);
295 Usage : $io->_fh($newval);
296 Function: Get or set the file handle for the stream encapsulated.
297 Args : Optional filehandle to use
298 Returns : Filehandle for the stream
303 my ($self, $value) = @_;
304 if ( defined $value) {
305 $self->{'_filehandle'} = $value;
307 return $self->{'_filehandle'};
315 $io->mode(-force => 1);
316 Function: Determine if the object was opened for reading or writing
317 Args : -force: Boolean. Once mode() has been called, the mode is cached for
318 further calls to mode(). Use this argument to override this
319 behavior and re-check the object's mode.
320 Returns : Mode of the object:
323 'rw' for readable and writable
324 '?' if mode could not be determined (e.g. for a -url)
329 my ($self, %arg) = @_;
331 # Method 1: IO::Handle::fdopen
332 # my $iotest = new IO::Handle;
333 # $iotest->fdopen( dup(fileno($fh)) , 'r' );
334 # if ($iotest->error == 0) { ... }
335 # It did not actually seem to work under any platform, since there would no
336 # error if the filehandle had been opened writable only. It could not be
337 # hacked around when dealing with unseekable (piped) filehandles.
339 # Method 2: readline, a.k.a. the <> operator
342 # if (defined $line) {
343 # $self->{'_mode'} = 'r';
345 # It did not work well either because <> returns undef, i.e. querying the
346 # mode() after having read an entire file returned 'w'.
348 if ( $arg{-force
} || not exists $self->{'_mode'} ) {
349 # Determine stream mode
353 # Determine read/write status of filehandle
355 if ( defined( read $fh, my $content, 0 ) ) {
356 # Successfully read 0 bytes
359 if ( defined( syswrite $fh, '') ) {
360 # Successfully wrote 0 bytes
365 # Stream does not have a filehandle... cannot determine mode
368 # Save mode for future use
369 $self->{'_mode'} = $mode;
371 return $self->{'_mode'};
378 Usage : $io->file('>'.$file);
379 my $file = $io->file;
380 Function: Get or set the name of the file to read or write.
381 Args : Optional file name (including its mode, e.g. '<' for reading or '>'
383 Returns : A string representing the filename and its mode.
388 my ($self, $value) = @_;
389 if ( defined $value) {
390 $self->{'_file'} = $value;
392 return $self->{'_file'};
399 Usage : my ($mode, $file) = $io->cleanfile;
400 Function: Get the name of the file to read or write, stripped of its mode
401 ('>', '<', '+>', '>>', etc).
403 Returns : In array context, an array of the mode and the clean filename.
409 return ($self->{'_file'} =~ m/^ (\+?[><]{1,2})?\s*(.*) $/x);
416 Usage : $io->format($newval)
417 Function: Get the format of a Bio::Root::IO sequence file or filehandle. Every
418 object inheriting Bio::Root::IO is guaranteed to have a format.
420 Returns : Format of the file or filehandle, e.g. fasta, fastq, genbank, embl.
426 my $format = (split '::', ref($self))[-1];
434 Usage : $io->format($newval)
435 Function: Get the variant of a Bio::Root::IO sequence file or filehandle.
436 The format variant depends on the specific format used. Note that
437 not all formats have variants. Also, the Bio::Root::IO-implementing
438 modules that require access to variants need to define a global hash
439 that has the allowed variants as its keys.
441 Returns : Variant of the file or filehandle, e.g. sanger, solexa or illumina for
442 the fastq format, or undef for formats that do not have variants.
447 my ($self, $variant) = @_;
448 if (defined $variant) {
449 $variant = lc $variant;
450 my $var_name = '%'.ref($self).'::variant';
451 my %ok_variants = eval $var_name; # e.g. %Bio::Assembly::IO::ace::variant
452 if (scalar keys %ok_variants == 0) {
453 $self->throw("Could not validate variant because global variant ".
454 "$var_name was not set or was empty\n");
456 if (not exists $ok_variants{$variant}) {
457 $self->throw("$variant is not a valid variant of the " .
458 $self->format . ' format');
460 $self->{variant
} = $variant;
462 return $self->{variant
};
469 Usage : $io->_print(@lines)
470 Function: Print lines of text to the IO stream object.
471 Args : List of strings to print
472 Returns : True on success, undef on failure
478 my $fh = $self->_fh() || \
*STDOUT
;
479 my $ret = print $fh @_;
487 Usage : $io->_insert($string,1)
488 Function: Insert some text in a file at the given line number (1-based).
489 Args : * string to write in file
490 * line number to insert the string at
496 my ($self, $string, $line_num) = @_;
499 $self->throw("Could not insert text at line $line_num: the minimum ".
500 "line number possible is 1.");
503 my ($mode, $file) = $self->cleanfile;
504 if (not defined $file) {
505 $self->throw('Could not insert a line: IO object was initialized with '.
506 'something else than a file.');
508 # Everything that needs to be written is written before we read it
511 # Edit the file line by line (no slurping)
515 while (-e
"$file.$number.temp") {
518 $temp_file = "$file.$number.temp";
519 copy
($file, $temp_file);
520 open my $fh1, '<', $temp_file or $self->throw("Could not read temporary file '$temp_file': $!");
521 open my $fh2, '>', $file or $self->throw("Could not write file '$file': $!");
522 while (my $line = <$fh1>) {
523 if ($. == $line_num) { # right line for new data
524 print $fh2 $string . $line;
532 unlink $temp_file or $self->throw("Could not delete temporary file '$temp_file': $!");
534 # Line number check (again)
535 if ( $. > 0 && $line_num > $. ) {
536 $self->throw("Could not insert text at line $line_num: there are only ".
537 "$. lines in file '$file'");
539 # Re-open the file in append mode to be ready to add text at the end of it
540 # when the next _print() statement comes
541 open my $new_fh, '>>', $file or $self->throw("Could not append to file '$file': $!");
543 # If file is empty and we're inserting at line 1, simply append text to file
544 if ( $. == 0 && $line_num == 1 ) {
545 $self->_print($string);
554 Usage : local $Bio::Root::IO::HAS_EOL = 1;
555 my $io = Bio::Root::IO->new(-file => 'data.txt');
556 my $line = $io->_readline();
558 Function: Read a line of input and normalize all end of line characters.
560 End of line characters are typically "\n" on Linux platforms, "\r\n"
561 on Windows and "\r" on older Mac OS. By default, the _readline()
562 method uses the value of $/, Perl's input record separator, to
563 detect the end of each line. This means that you will not get the
564 expected lines if your input has Mac-formatted end of line characters.
565 Also, note that the current implementation does not handle pushed
566 back input correctly unless the pushed back input ends with the
567 value of $/. For each line parsed, its line ending, e.g. "\r\n" is
568 converted to "\n", unless you provide the -raw argument.
570 Altogether it is easier to let the PerlIO::eol module automatically
571 detect the proper end of line character and normalize it to "\n". Do
572 so by setting $Bio::Root::IO::HAS_EOL to 1.
574 Args : -raw : Avoid converting end of line characters to "\n" This option
575 has no effect when using $Bio::Root::IO::HAS_EOL = 1.
576 Returns : Line of input, or undef when there is nothing to read anymore
581 my ($self, %param) = @_;
582 my $fh = $self->_fh or return;
585 # if the buffer been filled by _pushback then return the buffer
586 # contents, rather than read from the filehandle
587 if( @
{$self->{'_readbuffer'} || [] } ) {
588 $line = shift @
{$self->{'_readbuffer'}};
593 # Note: In Windows the "-raw" parameter has no effect, because Perl already discards
594 # the '\r' from the line when reading in text mode from the filehandle
595 # ($line = <$fh>), and put it back automatically when printing
596 if( !$HAS_EOL && !$param{-raw
} && (defined $line) ) {
597 # don't strip line endings if -raw or $HAS_EOL is specified
598 $line =~ s/\015\012/\012/g; # Change all CR/LF pairs to LF
599 $line =~ tr/\015/\n/ unless $ONMAC; # Change all single CRs to NEWLINE
608 Usage : $io->_pushback($newvalue)
609 Function: Puts a line previously read with _readline back into a buffer.
610 buffer can hold as many lines as system memory permits.
612 Note that this is only supported for pushing back data ending with
613 the current, localized value of $/. Using this method to push
614 modified data back onto the buffer stack is not supported; see bug
622 # fix for bug 843, this reveals some unsupported behavior
625 # my ($self, $value) = @_;
626 # if (index($value, $/) >= 0) {
627 # push @{$self->{'_readbuffer'}}, $value;
629 # $self->throw("Pushing modifed data back not supported: $value");
634 my ($self, $value) = @_;
635 return unless $value;
636 unshift @
{$self->{'_readbuffer'}}, $value;
645 Function: Closes the file handle associated with this IO instance,
646 excepted if -noclose was specified.
655 # do not close if we explicitly asked not to
656 return if $self->noclose;
658 if( defined( my $fh = $self->{'_filehandle'} )) {
660 return if ref $fh eq 'GLOB' && (
661 \
*STDOUT
== $fh || \
*STDERR
== $fh || \
*STDIN
== $fh
664 # don't close IO::Strings
665 CORE
::close $fh unless ref $fh && $fh->isa('IO::String');
667 $self->{'_filehandle'} = undef;
668 delete $self->{'_readbuffer'};
677 Function: Flushes the filehandle
686 if( !defined $self->{'_filehandle'} ) {
687 $self->throw("Flush failed: no filehandle was active");
690 if( ref($self->{'_filehandle'}) =~ /GLOB/ ) {
691 my $oldh = select($self->{'_filehandle'});
695 $self->{'_filehandle'}->flush();
704 Usage : $io->noclose($newval)
705 Function: Get or set the NOCLOSE flag - setting this to true will prevent a
706 filehandle from being closed when an object is cleaned up or
708 Args : Optional new value (a scalar or undef)
709 Returns : Value of noclose (a scalar)
715 return $self->{'_noclose'} = shift if @_;
716 return $self->{'_noclose'};
727 my $v = $self->verbose;
729 # we are planning to cleanup temp files no matter what
730 if ( exists($self->{'_rootio_tempfiles'})
731 and ref($self->{'_rootio_tempfiles'}) =~ /array/i
732 and not $self->save_tempfiles
735 warn( "going to remove files ",
736 join(",", @
{$self->{'_rootio_tempfiles'}}),
739 unlink (@
{$self->{'_rootio_tempfiles'}} );
741 # cleanup if we are not using File::Temp
742 if ( $self->{'_cleanuptempdir'}
743 and exists($self->{'_rootio_tempdirs'})
744 and ref($self->{'_rootio_tempdirs'}) =~ /array/i
745 and not $self->save_tempfiles
748 warn( "going to remove dirs ",
749 join(",", @
{$self->{'_rootio_tempdirs'}}),
752 $self->rmtree( $self->{'_rootio_tempdirs'});
760 Usage : $exists = $io->exists_exe('clustalw');
761 $exists = Bio::Root::IO->exists_exe('clustalw')
762 $exists = Bio::Root::IO::exists_exe('clustalw')
763 Function: Determines whether the given executable exists either as file
764 or within the path environment. The latter requires File::Spec
766 On Win32-based system, .exe is automatically appended to the program
767 name unless the program name already ends in .exe.
768 Args : Name of the executable
769 Returns : 1 if the given program is callable as an executable, and 0 otherwise
774 my ($self, $exe) = @_;
775 $self->throw("Must pass a defined value to exists_exe") unless defined $exe;
776 $exe = $self if (!(ref($self) || $exe));
777 $exe .= '.exe' if(($^O
=~ /mswin/i) && ($exe !~ /\.(exe|com|bat|cmd)$/i));
778 return $exe if ( -f
$exe && -x
$exe ); # full path and exists
780 # Ewan's comment. I don't think we need this. People should not be
781 # asking for a program with a pathseparator starting it
782 # $exe =~ s/^$PATHSEP//;
784 # Not a full path, or does not exist. Let's see whether it's in the path.
785 if($FILESPECLOADED) {
786 for my $dir (File
::Spec
->path()) {
787 my $f = Bio
::Root
::IO
->catfile($dir, $exe);
788 return $f if( -f
$f && -x
$f );
798 Usage : my ($handle,$tempfile) = $io->tempfile();
799 Function: Create a temporary filename and a handle opened for reading and
801 Caveats: If you do not have File::Temp on your system you should
802 avoid specifying TEMPLATE and SUFFIX.
803 Args : Named parameters compatible with File::Temp: DIR (defaults to
804 $Bio::Root::IO::TEMPDIR), TEMPLATE, SUFFIX.
805 Returns : A 2-element array, consisting of temporary handle and temporary
811 my ($self, @args) = @_;
815 # map between naming with and without dash
816 for my $key (keys(%params)) {
818 my $v = $params{$key};
819 delete $params{$key};
820 $params{uc(substr($key,1))} = $v;
822 # this is to upper case
823 my $v = $params{$key};
824 delete $params{$key};
825 $params{uc($key)} = $v;
828 $params{'DIR'} = $TEMPDIR if(! exists($params{'DIR'}));
829 unless (exists $params{'UNLINK'} &&
830 defined $params{'UNLINK'} &&
831 ! $params{'UNLINK'} ) {
832 $params{'UNLINK'} = 1;
834 $params{'UNLINK'} = 0;
837 if($FILETEMPLOADED) {
838 if(exists($params{'TEMPLATE'})) {
839 my $template = $params{'TEMPLATE'};
840 delete $params{'TEMPLATE'};
841 ($tfh, $file) = File
::Temp
::tempfile
($template, %params);
843 ($tfh, $file) = File
::Temp
::tempfile
(%params);
846 my $dir = $params{'DIR'};
847 $file = $self->catfile(
849 (exists($params{'TEMPLATE'}) ?
850 $params{'TEMPLATE'} :
851 sprintf( "%s.%s.%s", $ENV{USER
} || 'unknown', $$, $TEMPCOUNTER++))
854 # sneakiness for getting around long filenames on Win32?
856 $file = Win32
::GetShortPathName
($file);
859 # Try to make sure this will be marked close-on-exec
860 # XXX: Win32 doesn't respect this, nor the proper fcntl,
861 # but may have O_NOINHERIT. This may or may not be in Fcntl.
863 # Store callers umask
867 # Attempt to open the file
868 if ( sysopen($tfh, $file, $OPENFLAGS, 0600) ) {
872 $self->throw("Could not write temporary file '$file': $!");
876 if( $params{'UNLINK'} ) {
877 push @
{$self->{'_rootio_tempfiles'}}, $file;
880 return wantarray ?
($tfh,$file) : $tfh;
887 Usage : my ($tempdir) = $io->tempdir(CLEANUP=>1);
888 Function: Creates and returns the name of a new temporary directory.
890 Note that you should not use this function for obtaining "the"
891 temp directory. Use $Bio::Root::IO::TEMPDIR for that. Calling this
892 method will in fact create a new directory.
894 Args : args - ( key CLEANUP ) indicates whether or not to cleanup
895 dir on object destruction, other keys as specified by File::Temp
896 Returns : The name of a new temporary directory.
901 my ($self, @args) = @_;
902 if ($FILETEMPLOADED && File
::Temp
->can('tempdir')) {
903 return File
::Temp
::tempdir
(@args);
906 # we have to do this ourselves, not good
907 # we are planning to cleanup temp files no matter what
909 print "cleanup is " . $params{CLEANUP
} . "\n";
910 $self->{'_cleanuptempdir'} = ( defined $params{CLEANUP
} &&
911 $params{CLEANUP
} == 1);
912 my $tdir = $self->catfile( $TEMPDIR,
913 sprintf("dir_%s-%s-%s",
914 $ENV{USER
} || 'unknown',
918 push @
{$self->{'_rootio_tempdirs'}}, $tdir;
926 Usage : $path = Bio::Root::IO->catfile(@dirs, $filename);
927 Function: Constructs a full pathname in a cross-platform safe way.
929 If File::Spec exists on your system, this routine will merely
930 delegate to it. Otherwise it tries to make a good guess.
932 You should use this method whenever you construct a path name
933 from directory and filename. Otherwise you risk cross-platform
934 compatibility of your code.
936 You can call this method both as a class and an instance method.
938 Args : components of the pathname (directories and filename, NOT an
945 my ($self, @args) = @_;
947 return File
::Spec
->catfile(@args) if $FILESPECLOADED;
948 # this is clumsy and not very appealing, but how do we specify the
950 if($args[0] eq '/') {
953 return join($PATHSEP, @args);
960 Usage : Bio::Root::IO->rmtree($dirname );
961 Function: Remove a full directory tree
963 If File::Path exists on your system, this routine will merely
964 delegate to it. Otherwise it runs a local version of that code.
966 You should use this method to remove directories which contain
969 You can call this method both as a class and an instance method.
971 Args : roots - rootdir to delete or reference to list of dirs
973 verbose - a boolean value, which if TRUE will cause
974 C<rmtree> to print a message each time it
975 examines a file, giving the name of the file, and
976 indicating whether it's using C<rmdir> or
977 C<unlink> to remove it, or that it's skipping it.
980 safe - a boolean value, which if TRUE will cause C<rmtree>
981 to skip any files to which you do not have delete
982 access (if running under VMS) or write access (if
983 running under another OS). This will change in the
984 future when a criterion for 'delete permission'
985 under OSs other than VMS is settled. (defaults to
987 Returns : number of files successfully deleted
991 # taken straight from File::Path VERSION = "1.0403"
993 my ($self, $roots, $verbose, $safe) = @_;
994 if ( $FILEPATHLOADED ) {
995 return File
::Path
::rmtree
($roots, $verbose, $safe);
998 my $force_writable = ($^O
eq 'os2' || $^O
eq 'dos' || $^O
eq 'MSWin32' ||
999 $^O
eq 'amigaos' || $^O
eq 'cygwin');
1000 my $Is_VMS = $^O
eq 'VMS';
1006 if ( defined($roots) && length($roots) ) {
1007 $roots = [$roots] unless ref $roots;
1009 $self->warn("No root path(s) specified\n");
1014 for $root (@
{$roots}) {
1016 (undef, undef, my $rp) = lstat $root or next;
1017 $rp &= 07777; # don't forget setuid, setgid, sticky bits
1019 # notabene: 0777 is for making readable in the first place,
1020 # it's also intended to change it to writable in case we have
1021 # to recurse in which case we are better than rm -rf for
1022 # subtrees with strange permissions
1023 chmod(0777, ($Is_VMS ? VMS
::Filespec
::fileify
($root) : $root))
1024 or $self->warn("Could not make directory '$root' read+writable: $!")
1026 if (opendir DIR
, $root){
1027 @files = readdir DIR
;
1030 $self->warn("Could not read directory '$root': $!");
1034 # Deleting large numbers of files from VMS Files-11 filesystems
1035 # is faster if done in reverse ASCIIbetical order
1036 @files = reverse @files if $Is_VMS;
1037 ($root = VMS
::Filespec
::unixify
($root)) =~ s
#\.dir\z## if $Is_VMS;
1038 @files = map("$root/$_", grep $_!~/^\
.{1,2}\z
/s
,@files);
1039 $count += $self->rmtree([@files],$verbose,$safe);
1041 ($Is_VMS ?
!&VMS
::Filespec
::candelete
($root) : !-w
$root)) {
1042 print "skipped '$root'\n" if $verbose;
1046 or $self->warn("Could not make directory '$root' writable: $!")
1048 print "rmdir '$root'\n" if $verbose;
1053 $self->warn("Could not remove directory '$root': $!");
1054 chmod($rp, ($Is_VMS ? VMS
::Filespec
::fileify
($root) : $root))
1055 or $self->warn("and can't restore permissions to "
1056 . sprintf("0%o",$rp) . "\n");
1061 and ($Is_VMS ?
!&VMS
::Filespec
::candelete
($root)
1062 : !(-l
$root || -w
$root))
1064 print "skipped '$root'\n" if $verbose;
1068 or $self->warn( "Could not make file '$root' writable: $!")
1070 warn "unlink '$root'\n" if $verbose;
1071 # delete all versions under VMS
1073 unless (unlink $root) {
1074 $self->warn("Could not unlink file '$root': $!");
1075 if ($force_writable) {
1077 or $self->warn("and can't restore permissions to "
1078 . sprintf("0%o",$rp) . "\n");
1083 last unless $Is_VMS && lstat $root;
1092 =head2 _flush_on_write
1094 Title : _flush_on_write
1095 Usage : $io->_flush_on_write($newval)
1096 Function: Boolean flag to indicate whether to flush
1097 the filehandle on writing when the end of
1098 a component is finished (Sequences, Alignments, etc)
1099 Args : Optional new value
1100 Returns : Value of _flush_on_write
1104 sub _flush_on_write
{
1105 my ($self, $value) = @_;
1106 if (defined $value) {
1107 $self->{'_flush_on_write'} = $value;
1109 return $self->{'_flush_on_write'};
1113 =head2 save_tempfiles
1115 Title : save_tempfiles
1116 Usage : $io->save_tempfiles(1)
1117 Function: Boolean flag to indicate whether to retain tempfiles/tempdir
1118 Args : Value evaluating to TRUE or FALSE
1119 Returns : Boolean value : 1 = save tempfiles/tempdirs, 0 = remove (default)
1123 sub save_tempfiles
{
1127 $self->{save_tempfiles
} = $value ?
1 : 0;
1129 return $self->{save_tempfiles
} || 0;