view release on metacpan or  search on metacpan

Bio/Root/IO.pm  view on Meta::CPAN

           If File::Path exists on your system, this routine will merely
           delegate to it. Otherwise it runs a local version of that code.

           You should use this method to remove directories which contain
           files.

           You can call this method both as a class and an instance method.

 Args    : roots - rootdir to delete or reference to list of dirs

           verbose - a boolean value, which if TRUE will cause
                     C<rmtree> to print a message each time it
                     examines a file, giving the name of the file, and
                     indicating whether it's using C<rmdir> or
                     C<unlink> to remove it, or that it's skipping it.
                     (defaults to FALSE)

           safe - a boolean value, which if TRUE will cause C<rmtree>
                  to skip any files to which you do not have delete
                  access (if running under VMS) or write access (if
                  running under another OS).  This will change in the
                  future when a criterion for 'delete permission'
                  under OSs other than VMS is settled.  (defaults to
                  FALSE)
 Returns : number of files successfully deleted

=cut

# taken straight from File::Path VERSION = "1.0403"
sub rmtree {
    my ($self, $roots, $verbose, $safe) = @_;
    if ( $FILEPATHLOADED ) {
        return File::Path::rmtree ($roots, $verbose, $safe);
    }

    my $force_writable = ($^O eq 'os2' || $^O eq 'dos' || $^O eq 'MSWin32' ||
                          $^O eq 'amigaos' || $^O eq 'cygwin');
    my $Is_VMS = $^O eq 'VMS';

    my @files;
    my $count = 0;
    $verbose ||= 0;
    $safe    ||= 0;
    if ( defined($roots) && length($roots) ) {
        $roots = [$roots] unless ref $roots;
    } else {
        $self->warn("No root path(s) specified\n");
        return 0;
    }

    my $root;
    for $root (@{$roots}) {
        $root =~ s#/\z##;
        (undef, undef, my $rp) = lstat $root or next;
        $rp &= 07777;   # don't forget setuid, setgid, sticky bits
        if ( -d _ ) {
            # notabene: 0777 is for making readable in the first place,
            # it's also intended to change it to writable in case we have
            # to recurse in which case we are better than rm -rf for
            # subtrees with strange permissions
            chmod(0777, ($Is_VMS ? VMS::Filespec::fileify($root) : $root))
              or $self->warn("Could not make directory '$root' read+writable: $!")
            unless $safe;
            if (opendir DIR, $root){
                @files = readdir DIR;
                closedir DIR;
            } else {
                $self->warn("Could not read directory '$root': $!");
                @files = ();
            }

            # Deleting large numbers of files from VMS Files-11 filesystems
            # is faster if done in reverse ASCIIbetical order
            @files = reverse @files if $Is_VMS;
            ($root = VMS::Filespec::unixify($root)) =~ s#\.dir\z## if $Is_VMS;
            @files = map("$root/$_", grep $_!~/^\.{1,2}\z/s,@files);
            $count += $self->rmtree([@files],$verbose,$safe);
            if ($safe &&
              ($Is_VMS ? !&VMS::Filespec::candelete($root) : !-w $root)) {
                print "skipped '$root'\n" if $verbose;
                next;
            }
            chmod 0777, $root
              or $self->warn("Could not make directory '$root' writable: $!")
              if $force_writable;
            print "rmdir '$root'\n" if $verbose;
            if (rmdir $root) {
                ++$count;
            }
            else {
                $self->warn("Could not remove directory '$root': $!");
                chmod($rp, ($Is_VMS ? VMS::Filespec::fileify($root) : $root))
                  or $self->warn("and can't restore permissions to "
                                 . sprintf("0%o",$rp) . "\n");
            }
        }
        else {
            if (     $safe
                and ($Is_VMS ? !&VMS::Filespec::candelete($root)
                             : !(-l $root || -w $root))
                ) {
                print "skipped '$root'\n" if $verbose;
                next;
            }
            chmod 0666, $root
              or $self->warn( "Could not make file '$root' writable: $!")
              if $force_writable;
            warn "unlink '$root'\n" if $verbose;
            # delete all versions under VMS
            for (;;) {
                unless (unlink $root) {
                    $self->warn("Could not unlink file '$root': $!");
                    if ($force_writable) {
                        chmod $rp, $root
                          or $self->warn("and can't restore permissions to "
                                         . sprintf("0%o",$rp) . "\n");
                    }
                    last;
                }
                ++$count;
                last unless $Is_VMS && lstat $root;
            }
        }
    }

    return $count;
}


=head2 _flush_on_write

 Title   : _flush_on_write
 Usage   : $io->_flush_on_write($newval)
 Function: Boolean flag to indicate whether to flush
           the filehandle on writing when the end of
           a component is finished (Sequences, Alignments, etc)
 Args    : Optional new value
 Returns : Value of _flush_on_write

=cut

sub _flush_on_write {
    my ($self, $value) = @_;
    if (defined $value) {
        $self->{'_flush_on_write'} = $value;
    }
    return $self->{'_flush_on_write'};
}


=head2 save_tempfiles

 Title   : save_tempfiles
 Usage   : $io->save_tempfiles(1)
 Function: Boolean flag to indicate whether to retain tempfiles/tempdir
 Args    : Value evaluating to TRUE or FALSE
 Returns : Boolean value : 1 = save tempfiles/tempdirs, 0 = remove (default)

=cut

sub save_tempfiles {
    my $self = shift;
    if (@_) {
        my $value = shift;
        $self->{save_tempfiles} = $value ? 1 : 0;
    }
    return $self->{save_tempfiles} || 0;
}


1;