#!/usr/local/bin/perl -w-- # -*- perl -*-
#
# $Id: sparsecp,v 1.4 1995/03/28 17:20:34 ejb Exp $
# $Source: /home/ejb/scripts/RCS/sparsecp,v $
# $Author: ejb $
#

# This code, from the perl manual page, forces this to be run by perl from 
# perl, sh, or csh.  It must be first.
eval '(exit $?0)' && eval 'exec /usr/local/bin/perl -S $0 ${1+"$@"}'
& eval 'exec /usr/local/bin/perl -S $0 $argv:q'
    if 0;

$whoami = ($0 =~ m,([^/]*)$,) ? $1 : $0;

require 5.000;
use strict 'refs';

&usage if (@ARGV != 2);

($src, $dest) = (@ARGV);

&sparse_copy($src, $dest);

sub sparse_copy {
    local($src, $dest) = @_;
    local($blocksize) = 512;
    local($nulls) = "\000" x $blocksize;
    local(@stat, $i, $buf);
    
    die "$whoami: $dest exists\n" if (-e $dest);
    die "$whoami: $src does not exist\n" if (! -e $src);
    die "$whoami: $src is not a plain file\n" if (! -f $src);

    local(*SRC, *DEST);
    open(SRC, "<$src") || die "$whoami: can't open $src to read: $!\n";
    open(DEST, ">$dest") || die "$whoami: can't open $dest to write: $!\n";

    (@stat = stat(SRC)) || die "$whoami: can't stat $src: $!\n";
    local($mode, $uid, $gid, $size, $atime, $mtime) = @stat[2,4,5,7,8,9];

    # Read all but the last block
    local($blocks) = int(($size - 1) / $blocksize);
    local($so_far) = 0;
    for ($i = 0; $i < $blocks; $i++)
    {
	$buf = &safe_read($src, *SRC, $blocksize);
	
	if ($buf eq $nulls)
	{
	    seek(DEST, $so_far + $blocksize, 0);
	}
	else
	{
	    &safe_write($dest, *DEST, $buf, $blocksize);
	}
	$so_far += $blocksize;
    }
    $buf = &safe_read($src, *SRC, $size - $so_far);
    &safe_write($dest, *DEST, $buf, $size - $so_far);
    
    close(SRC);
    close(DEST) || die "$whoami: failed to close $dest\n";
    
    chown $uid, $gid, $dest;
    utime $atime, $mtime, $dest;
    chmod $mode, $dest;
}

sub safe_read {
    local($name, *FH, $blocksize) = @_;
    local($len, $buf) = (0, "");
    ($len = sysread(FH, $buf, $blocksize)) ||
	die "$whoami: sysread from $name failed\n";
    die "$whoami: read only $len instead of $blocksize bytes\n" .
	"   ($so_far had been read so far)\n" if ($len != $blocksize);
    $buf;
}

sub safe_write {
    local($name, *FH, $buf, $blocksize) = @_;
    local($len);
    ($len = syswrite(FH, $buf, $blocksize)) ||
	die "$whoami: syswrite to $name failed\n";
    die "$whoami: wrote only $blocksize instead of $len bytes\n" .
	"   ($so_far had been written so far)\n" if ($len != $blocksize);
}

sub usage {
    print STDERR "Usage: $whoami src dest\n";
    exit 1;
}