Re: [MacPerl] Deleting files & interaction with AppleScript

[Peter Prymmer <pvhp@best.com>]

Chris Nandor wrote:

> You can't unlink a folder.  Use File::Find to iterate through the folder to
> delete the whole thing:
> 
>   # untested and dangerous code
>   use File::Find;
>   finddepth(sub {
>     if    (-f $_) {unlink}
>     elsif (-d $_) {rmdir}
>   }, $folder);

File::Path::rmtree seems to do this trick adequately (I just verified
it worked OK on a Mac too):

 use File::Path;
 rmtree("Mac:Path:To:$folder");  # removes $folder 
                                 # leaves "Mac:Path:To" && contents intact

BTW (changing the topic slightly to X-platform cp -r implementations) 
does anyone see a problem with something like this apart from 
symlinks on UNIX (hence it is cp_r and not cp_R)?  In glancing through
perlport it appears that using '/' as a separator on 
Acorn RISC OS path names is sometimes acceptable, and if need be it
could be changed to use '.' if $^O eq 'riscos'. 

Also noted (on NT :-{ alas) this recommended idiom does not work since
that port has C<symlink()> hardwired into a fatal exception:

    my $symlink_exists = (eval {symlink("","")};, $@ eq '');

hence I have been having a hard time writing a `cp -R` equivalent.
I am not especially attached to the name Copytree - and was thinking 
that perhaps this cp_r sub ought to be stuck in File::Copy.pm itself.
Comments && suggestions would be welcome.


package File::Copytree;

=head1 NAME

File::Copytree - recursively copy directory trees

=head1 SYNOPSIS

C<use File::Copytree;>

C<cp_r('/source/dir','/dest/dir',1);>

=head1 DESCRIPTION

Uses File::Copy::copy and File::Path::mkpath to 
recursively copy the source directory tree to the 
destination tree (equivalent to C<cp -r> under a shell).

Note that no special provision is made for replicating 
the ownership of the file or directory copies. 

Note that on Unix files that links point to wiil be copied
under cp_r(), hence the use of cp_r() may cause the 
destination to occupy a different amount of space than 
the source.

Note that on VMS no special effort is made to purge
the destination tree, hence repeated applications of
cp_r() may occupy a great deal of disk space.

Uses the L<File::Copy> and L<File::Path> modules.

=head1 AUTHOR

Peter Prymmer <F<pvhp@forte.com>> 8-dec-1998

=cut

use Carp;
use File::Copy;
use File::Path;
use Exporter ();
use strict;
use vars qw( $VERSION @ISA @EXPORT );
$VERSION = "0.01";
@ISA = qw( Exporter );
@EXPORT = qw( cp_r );
my $Is_VMS = $^O eq 'VMS';
my $Is_MacOS = $^O eq 'MacOS';
# my $symlink_exists = (eval {symlink("","")};, $@ eq '');

sub cp_r {

    my $src_dir = shift;
    my $dest_dir = shift;
    my $verbose = shift;

    if ($Is_VMS) {
        $src_dir = VMS::Filespec::unixify($src_dir);
        $dest_dir = VMS::Filespec::unixify($dest_dir);
        if (-d $src_dir) {
            $src_dir =~ s#\.dir$##;
            $dest_dir =~ s#\.dir$##;
        }
    }

    my (@src_files,$src_file,$dest_file,$src_path,$dest_path);

    opendir(SRC,$src_dir) or carp "could not open src_dir, $src_dir: $!";
    # doing a readdir() on a UFS always returns at least qw(. ..)
    # Unfortunately, on VMS we get '%RMS-E-FNF, file not found' errors.
    @src_files = readdir(SRC); # or carp "could not read src_dir, $src_dir: $!";
    closedir(SRC);

    my $mode = 0777; # stat($src_dir);
    print "mkpath($dest_dir)\n" if $verbose;
    my @made = mkpath($dest_dir,$verbose,$mode);

    foreach $src_file (@src_files) {
        if ($Is_MacOS) {
            $src_path = "$src_dir:$src_file";
            $dest_path = "$dest_dir:$src_file";
        }
        else {
            $src_path = "$src_dir/$src_file";
            $dest_path = "$dest_dir/$src_file";
        }
        if (! -d $src_path) {
            print "copy($src_path,$dest_path)\n" if $verbose;
            if (!copy($src_path,$dest_path)) {
                carp "problem copying: $!";
            }
        }
        else {
            print "$src_file appears to be a directory.\n" if $verbose;
            cp_r($src_path,$dest_path,$verbose);
        }
    }
} # sub cp_r

1;
__END__

Peter Prymmer



***** Want to unsubscribe from this list?
***** Send mail with body "unsubscribe" to mac-perl-request@iis.ee.ethz.ch