view release on metacpan or  search on metacpan

Copy/Copy.pm  view on Meta::CPAN

		 move
		 );

bootstrap MacOSX::File::Copy $VERSION;
use MacOSX::File;

our $MINBUFFERSIZE     = 4096;
our $DEFAULTBUFFERSIZE = $MINBUFFERSIZE * 1024;
our $MAXBUFFERSIZE     = $DEFAULTBUFFERSIZE * 64;

# Preloaded methods go here.

use Errno;
use File::Basename;

=over 4

=item copy($from, $to, [$maxbufsize, $preserve])

copies file from path $from to path $to, just like
File::Copy::copy().  Returns 1 on success and 0 otherwise.  On error
$MacOSX::File::OSErr is set when appropriate.

copy() can optionally take maximum buffer size as an argument.  This
value sets the limit of copy buffer.  If less value is required copy()
automagically allocates smaller amount of memory.  When in doubt just
leave it as default.

The last argument, $preserve tells copy() whether it should preserve
file attributes from the source file like like C</bin/cp -p>.  Default
is 0.

=cut

sub copy($$;$$){
    my ($src, $dst, $mbs, $preserve) = @_;
    $mbs ||= $DEFAULTBUFFERSIZE;
    $mbs < $MINBUFFERSIZE and $mbs = $MINBUFFERSIZE;
    $mbs > $MAXBUFFERSIZE and $mbs = $MAXBUFFERSIZE;
    $preserve ||= 0;

    my ($srcdev, $srcino, $srcmode, $srcuid, $srcgid, $srcatime, $srcmtime)
	= (lstat($src))[0,1,2,4,5,8,9];
    unless(-f _){
	$MacOSX::File::OSErr = -43; # fnfErr;
	$! = &Errno::ENOENT;
	return;
    }
    my ($dstdev, $dstino) = (lstat($dst))[0,1];
    if (-e _){ # target exists
	# before unlinking $dst, we check if $src and $dst are identical
	$srcino == $dstino and $srcdev == $dstdev
	    and carp "$src and $dst are identical";
	unlink $dst or return;
    }
    if (my $err = xs_copy($src, $dst, $mbs, $preserve)){
	return;
    }else{
	if ($preserve){
	    # These are included in FSCatalogInfo
	    # chown $srcuid, $srcgid, $src;
	    # chmod ($srcmode & 07777), $src;
	    # utime $srcatime, $srcmtime, $src;
	}
	return 1;
    }
}

sub attic($){
    my $path = shift;
    return dirname($path) . '/._' . basename($path);
}

sub dev($){
    my $path = shift;
    return (lstat($path))[0];
}

#
# This one is now xs_free because experiments have proven
# that simple rename() works
#

=item move($from, $to)

moves file from path $from to path $to, just like File::Copy::move().
Within same volume it uses rename().  If not it simply copy() then
unlink().  

This subroutine uses no xs.

=back

=cut

sub move($$){
    my ($src, $dst) = @_;
    my $srca = attic($src);
    my $dstdir = dirname($dst);
    my $srcdev = dev($src);
    my $dstdev = dev($dstdir);
    $DEBUG and warn "dev($src) = $srcdev, dev($dstdir) = $dstdev";
    if ($srcdev == $dstdev){
	$DEBUG and warn "Move within same volume";
	rename $src, $dst;
	if (-f $srca){
	    my $dsta = attic($dst);
	    $DEBUG and warn "$srca found. rename this to $dsta";
	    rename $srca, $dsta or return 1;
	}
	return 1;
    }else{
	$DEBUG and warn "Cross-volume move";
	copy($src, $dst) and unlink $src, $srca;
    }
}

# Autoload methods go after =cut, and are processed by the autosplit program.

1;
__END__