view release on metacpan or  search on metacpan

bin/psync  view on Meta::CPAN

	$k or next; $Action{$k} <  0 or next;
	my $dpath = $Dst . $k;
	$opt_v and do_log("- $dpath");
	unless ($opt_n){
	    -e $dpath or -l $dpath or next;
	    unlink $dpath or rmdir $dpath or warn "$dpath : $!";
	    my $atticf = dirname($dpath) . '/._' . basename($dpath);
	    if (-f $atticf){
		unlink $atticf or warn "$atticf : $!";
	    }
	}
    }
}
$opt_v and do_log("copying items ...");
# sort must be this order for depth-last traversal
for my $k (sort keys %Action){
    my $spath = $Root{$k} . $k; $spath =~ s,^/+,/,o;
    my $dpath = $Dst . $k;
    $Action{$k} == 0 and $opt_v > 1 and do_log("== $spath");
    $Action{$k} >  0 or next;
    unless ($opt_n){
	my ($size, $mtime)		  = unpack("N2", $Signature{$k});
	my ($mode, $uid,  $gid,	 $atime)  = unpack("N4", $Attribs{$k});
	if     (S_ISDIR($mode)){ # -d
	    unless (-d $dpath){
		$opt_v and do_log("+d $spath");
		mkdir $dpath, 0755 or warn "$dpath : $!";
	    }else{
		$opt_v > 1 and do_log("=d $spath");
	    }
	}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",