view release on metacpan or  search on metacpan

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

=head2 rmtree

 Title   : rmtree
 Usage   : Bio::Root::IO->rmtree($dirname );
 Function: Remove a full directory tree

           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 "