view release on metacpan or  search on metacpan

bin/psync  view on Meta::CPAN

	    }
	}elsif (S_ISREG($mode)){ # -f
	    $opt_v and do_log("+f $spath");
	    $opt_a or copy ($spath, $dpath)
		or $Debug ?
		warn "$spath -> $dpath : ", &MacOSX::File::strerr :
		warn "$spath -> $dpath : $MacOSX::File::CopyErr" ;
	    copyattrib($spath, $dpath, $mode, $uid, $gid, $atime, $mtime);
	}elsif (S_ISLNK($mode)){ # -l
	    $opt_v and do_log("+l $spath");
	    my $slink = readlink($spath);
	    if ($slink ne readlink($dpath)){
		unlink $dpath && symlink(readlink($spath), $dpath);
	    }
	}
    }
}

$opt_v and do_log("fixing directory attributes ...");
# sort must be this order for depth-first traversal
for my $k (sort {$b cmp $a} keys %Action){
    $Action{$k} >  0 or next;
    my ($size, $mtime)		      = unpack("N2", $Signature{$k});
    my ($mode, $uid,  $gid,  $atime)  = unpack("N4", $Attribs{$k});
    S_ISDIR($mode) or next;  # -d
    my $spath = $Root{$k} . $k; $spath =~ s,^/+,/,o;
    my $dpath = $Dst . $k;

    unless ($opt_n){
	copyattrib($spath, $dpath, $mode, $uid, $gid, $atime, $mtime);
	$opt_v and do_log(sprintf "0%04o,%s,%s $dpath", ($mode & 07777),
			  (getpwuid($uid))[0],(getgrgid($gid))[0] );
    }
}

if ($opt_r >= 2){
    # these are to make DB operation fast enough
    my $hashinfo = DB_File::HASHINFO->new;
    $hashinfo->{nelem} = scalar keys %Action;
    $hashinfo->{bsize} = 1024; # MAXPATHLEN
    $hashinfo->{cachesize} = 4 * 1024 * 1024;
    tie (my %db, 'DB_File', $Psync_DB,	O_CREAT|O_RDWR, 0640, $hashinfo)
	or die "$Psync_DB : $!";
    $opt_v and do_log("Using $Dst/$Psync_DB to store extra attributes.");
    my $count;
    while ( my ($k, $v) = each %Action){
	if ($v >= 0){
	    $db{$k} = $Attribs{$k};
	    $count++ % 10000 == 0 and do_log("$count items stored.");
	}
    }
    untie %db;
    move $Psync_DB, "$Dst/$Psync_DB" or die "Can't move $Psync_DB";
}

sub copyattrib{
    my ($spath, $dpath, $mode, $uid, $gid, $atime, $mtime) = @_;
    my $finfo = getfinfo($spath);
    unless ($opt_r > 1){
	chmod $mode & 07777, $dpath;
	chown $uid,   $gid,  $dpath;
    }
    $finfo and $finfo->set($dpath);
    utime $atime, $mtime,  $dpath;
}

exit;
sub do_log{
    print shift, "\n";
}

sub sig2txt{
    return sprintf("0x%08x,0x%08x",unpack("N2",shift));
}

sub addsig{
    my ($path, $mode,$uid,$gid,$size,$atime,$mtime, $action) = @_;
    my $sig  = pack("N2", (S_ISREG($mode) ? $size : 0), $mtime);
    tied %Attribs or $Attribs{$path} = pack("N4", $mode, $uid, $gid, $atime);
    if ($opt_v > 3 and $action > 0){
	do_log qq(was: ) . sig2txt($Signature{$path});
	do_log qq(now: ) . sig2txt($sig);
    }
    if ($Signature{$path} eq $sig){
	$opt_f or $action = 0;	   # same file
    }else{
	$Signature{$path} =  $sig; # different
    }
    $Action{$path} = $action;
    $opt_v > 2 and
	do_log(join("," => $Action{$path},
		    sprintf("0x%08x,0x%08x,0x%08x",
			    unpack("N2",$Signature{$path})),
		    $path));
}

# File::Find is too general purpose thus slow.
# we implement our own traversal routine

sub scantree {
    my ($root, $path, $action) = @_;
    if ($opt_v){
	$ScanCount % 8192 == 0 and  printf "\n%10d:", $ScanCount;
	$ScanCount % 128  == 0 and  print  ".";
	$ScanCount++;
    }
    if ($path =~ $IgnorePat){
	addsig($path, 0, 0, 0, 0, 0, 0, $Del_Ignored);
	return;
    }
    $action > 0 and $Root{$path} = $root;
    my $fpath = $root . $path;
    my ($dev, $mode, $nlink, $uid, $gid, $size, $atime, $mtime) =
	(lstat($fpath))[0,2,3,4,5,7,8,9] or warn "can't stat $fpath";

    addsig($path, $mode, $uid, $gid, $size, $atime, $mtime, $action);

    if (-d _){
	$dev != $Topdev and return;
	opendir my $d, $fpath or warn "$fpath:$!";
	# see ._* is avoided