Copyright 2022 - Custom text here

dsync.pl

#!/usr/bin/perl
#***************************************************************************
#
# dsync.pl
#
# Compare directories and synchronize content
#
# Release: 0.3
# Create: 01.09.1999
# Update: 31.07.2004
# (C) Marcel Mueller 1999-2004
#
#***************************************************************************


use strict;
use locale;

# global vars
my $subdir = 0; # include subdirectories
my $debug = 0; # debug mode
my $mout = 1; # output: 0=none, 1=machine readable, 2=verbose
my $fcomp = 0; # compare file content
my $sync = 0; # syncronisation mode, 0=none, 1=source2->source1, 2=source1->source2, 3=bidirectional
my $nodel = 1; # no delete
my $move = 0; # move files from update dir
my $thres = 0; # time compare threshold
my $updfile; # name of update directory file
my $volfile; # name of volume info file
my $numvol; # number of volumes
my $volno; # volume no
my $sayeq = 0; # report identical files also
my $casesens = 0; # case sensitive
my $ignoredowngrade = 0;# ignore downgrades in case of unidirectioal synchronisation

my @source; # source paths [root, pattern]
my @xcl; # exclude masks


############################################################################
# helper functions
############################################################################

# return smallest argument
# min() = undef
sub min(@)
{ my $r = shift;
foreach (@_)
{ $r = $_ if $_ < $r;
}
return $r;
}

# die with error warning
sub Error($$)
{ print STDERR "$_[1]\n";
exit $_[0];
}

# print warning
sub Warning($)
{ print STDERR "$_[0]\n" if $_[0];
return $_[0];
}


# local CRC32 implementation to avoid dependencies on nonstandard modules
# and because module installation often fails under OS/2.
#
my $CRC32_Polynomial = 0xEDB88320;

my @CRC32_Table;
for my $i (0..255)
{ my $crc = $i;
for (0..7)
{ if ($crc & 1)
{ $crc = ($crc >> 1) ^ $CRC32_Polynomial;
} else
{ $crc >>= 1;
}
}
push @CRC32_Table, $crc;
}

sub CRC32($)
{ my $crc = 0xFFFFFFFF;
map
{ my $tabptr = ($crc & 0xFF) ^ $_;
$crc >>= 8;
$crc ^= $CRC32_Table[$tabptr];
} unpack 'C*', $_[0];
return $crc ^ 0xFFFFFFFF;
}

my $dlerr;
sub DaylightErr()
{ ++$dlerr == 2 and
Warning "Warning: several time stamps differ exactly by a few hole hours.\n"
. " Maybe there is a problem with the time zone or with daylight saving.";
}

sub mylc($)
{ return $casesens ? $_[0] : lc $_[0];
}

# extract drive and path from filename
sub DirSpec($)
{ return ($_[0] =~ /(.*)\//)[0];
}

# convert file mask 2 regex
sub ToRegEx($)
{ $_ = $_[0];
s/\\/\//g; # well windows ...
$_ = quotemeta;
s/\\\*/.*/g;
s/\\\?/./g;
return "^$_\$";
}


############################################################################
#
# hash distribution map functions
#
############################################################################

my $mmscale = 2**32;
my $mmparts = 1;
my @mmap = ([0,2**32,0]);

# view statistics
sub mmanalysis()
{ my @size;
my @frags;
foreach (@mmap)
{ $size[$_->[2]] += $_->[1];
++$frags[$_->[2]];
}
print "Part.\tSize\tFragments\n";
print "$_\t$size[$_]\t$frags[$_]\n" for (0..$mmparts-1);
print "========================\n";
my $frags;
$frags += $_ foreach @frags;
print "$mmparts\t$mmscale\t$frags\n\n";
}

# dump map table
sub mmdump()
{ print "Parts:\t$mmparts\n";
print "Divisor:\t$mmscale\n";
print "Offset\tLength\tPart\n";
print join("\t", @$_), "\n" foreach @mmap;
}

# increment number of parts
sub mmincrease()
{ ++$mmparts;
# sort fragments by part ...
my @bypart = map [], (0..$mmparts-2);
push @{$bypart[$_->[2]]}, $_ foreach @mmap;
# ... and size
@$_ = sort { $a->[1] <=> $b->[1] || $a->[0] <=> $b->[0] } @$_ foreach @bypart;
# calculate goal and padding
my $pad = $mmscale % $mmparts; # all part no >= $mmparts - $pad
my $goal = ($mmscale - $pad) / $mmparts;
# generate newpart out of the others
my $part;
foreach (@bypart)
{ # calculate current size of part
my $sum;
$sum += $_->[1] foreach @$_;
my $diff = $sum - $goal - ($part >= $mmparts - $pad);
#print "D: $part $diff\n";
while ($_->[0]->[1] <= $diff)
{ $diff -= $_->[0]->[1];
$_->[0]->[2] = $mmparts-1;
shift @$_;
}
if ($diff) # split next fragment
{ push @{$_->[0]}, $diff; # tag only
}
} continue
{ ++$part;
}
# now split tagged fragments
my $i;
while ($i < @mmap)
{ if (@{$mmap[$i]} > 3)
{ local $_ = $mmap[$i];
if ($i && $mmap[$i-1]->[2] == $mmparts -1)
{ # cut and merge at front
$mmap[$i-1]->[1] += $_->[3];
$mmap[$i] = [$_->[0] + $_->[3], $_->[1] - $_->[3], $_->[2]];
++$i;
} else
{ # cut at back
splice @mmap, $i, 1, [$_->[0], $_->[1] - $_->[3], $_->[2]], [$_->[0] + $_->[1] - $_->[3], $_->[3], $mmparts-1];
$i += 2;
}
} elsif ($i && $mmap[$i-1]->[2] == $mmap[$i]->[2])
{ # merge
$mmap[$i-1]->[1] += $mmap[$i]->[1];
splice @mmap, $i, 1;
} else
{ ++$i;
}
}
}

# lookup part number by hash
sub mmlook($)
{ my $l = 0;
my $r = $#mmap;
while ($l < $r)
{ my $m = ($l+$r+1) >> 1;
#print "S: $l $r $m $mmap[$m]->[0]\t$_[0]\n";
if ($_[0] < $mmap[$m]->[0])
{ $r = $m-1;
} else
{ $l = $m;
}
}
#printf "F: %08x %08x %08x\n", $mmap[$l]->[0], $_[0], $mmap[$l]->[0]+$mmap[$l]->[1];
return $mmap[$l]->[2];
}


############################################################################
#
# file functions, platform dependant
#
############################################################################

# escape and quote filenames
#sub escfile($)
#{ $_ = $_[0];
# s/^\/cygdrive\/(.+?)\//$1:\//;# cygwin special
# s/\//\\/g; # windows special
# s/%/%%/g; # cmd.exe special
# print "esc: \"$_\"\n";
# return "\"$_\"";
#}

# create directory if neccessary
# CheckDir(dir, source)
# This function calls itself recursively.
sub CheckDir($$);
sub CheckDir($$)
{ my ($dir, $src) = @_;
$dir or return;
return if exists ${$$src[3]}{$dir};
undef ${$$src[3]}{$dir}; # now it is checked
if ($$src[2])
{ # ftp
return if $$src[2]->ls($dir);
print("MKDIR-FTP: $$src[0]/$dir\n"), return if $debug;
$$src[2]->mkdir($dir, 1) or return "FTP mkdir of $dir failed: $@.";
return;
}
return if -d "$$src[0]/$dir";
# directory does not exist
CheckDir DirSpec $dir, $src;
print("MKDIR: $$src[0]/$dir\n"), return if $debug;
mkdir "$$src[0]/$dir" and return;
return "Create directory $$src[0]/$dir failed.";
}

# remove directory if empty
# CheckDirRM(dir, source)
sub CheckDirRM($$)
{ my ($dir, $src) = @_;
while ($dir)
{ if ($$src[2])
{ # ftp
$$src[2]->rmdir($dir) or last;
} else
{ rmdir "$$src[0]/$dir" or last;
}
$dir = DirSpec $dir;
}
return;
}

# remove file
# DeleteFile(file, source)
# removes file source/file and remove the directory if empty
sub DeleteFile($$)
{ my ($file, $src) = @_;
if ($$src[2])
{ # FTP
print("DEL-FTP: $file\n"), return if $debug;
$$src[2]->delete($file) or return "FTP delete failed: @$.";
} else
{ print("DEL: $$src[0]/$file\n"), return if $debug;
unlink "$$src[0]/$file" or return "Removal of $$src[0]/$file failed.";
}
CheckDirRM DirSpec $file, $src;
return;
}

# copy file
# CopyFile(file, source, destination)
# copies source/file to destination/file
# If the destination directory does not exist it is created.
sub CopyFile($$$)
{ my ($file, $src, $dst) = @_;
my $dir = DirSpec $file;
#print "XXX:$file $dir $$src[0] $$dst[0]\n";
CheckDir $dir, $dst;
# multiple dispatch:
if ($$src[2])
{ # FTP source
print("FTP-GET: $$src[0]/$file > $$dst[0]/$file\n"), return if $debug;
$$src[2]->get($file, "$$dst[0]/$file") or return "FTP get of $file failed ($@).";
return;
} elsif ($$dst[2])
{ # ftp destination
print("FTP-PUT: $$dst[0]/$file > $$dst[0]/$file\n"), return if $debug;
$$dst[2]->put("$$src[0]/$file", $file) or return "FTP put of $file to $$dst[0] failed ($@).";
return;
}
print("COPY: $$src[0]/$file $$dst[0]/$dir\n"), return if $debug;
use File::Copy;
unlink "$$dst[0]/$file"; # We have to remove the old file first, becaus File::Copy::copy does not like overwrites.
copy("$$src[0]/$file", "$$dst[0]/$file") or return "Copy of $$src[0]/$file to $$dst[0]/$file failed ($!).";
return;
}

# move file
# CopyFile(file, source, destination)
# moves source/file to destination/file
# If the destination directory does not exist it is created.
sub MoveFile($$$)
{ my ($file, $src, $dst) = @_;
if ($$src[2] || $$dst[2])
{ # FTP trasnsfer: emulate via copy/delete
return CopyFile($file, $src, $dst) or DeleteFile($file, $src);
}
my $dir = DirSpec $file;
CheckDir $dir, $dst;
print("MOVE: $$src[0]/$file $$dst[0]/$dir\n"), return if $debug;
use File::Copy;
move("$$src[0]/$file", "$$dst[0]/$file") or return "Move of $$src[0]/$file to $$dst[0]/$file failed ($!).";
CheckDirRM $dir, $src;
return;
}

############################################################################
# main functions
############################################################################

# handle difference
# DoItem(operation, filename [, additional info])
# operation:
# '*O' file in tree 1 newer"
# 'O*' file in tree 2 newer"
# '*-' file in tree 2 not found"
# '-*' file in tree 1 not found"
# '>>' file in tree 1 is longer with same time stamp"
# '<<' file in tree 2 is longer with same time stamp"
# '<>' files have different content with same time stamp"
# 'EE' error during compare"
# '==' files are identical (as far as checked)
# filename:
# filename including relative path to root
# additional info:
# in case of an error (operation = 'EE') this is written to the screen
sub DoItem($$;$)
{ my ($op, $file, $info) = @_;
# generate output
if ($mout == 1)
{ print "$op $file\n" unless ($op eq '==' && !$sayeq) || ($ignoredowngrade && (($op eq '*O' && $sync == 1) || ($op eq 'O*' && $sync == 2)));
} elsif ($mout == 2)
{ $_ = $op;
print /O\*/ && "File $file in $source[0][0] is older than in $source[1][0].\n" ||
/\*O/ && "File $file in $source[0][0] is newer than in $source[1][0].\n" ||
/-\*/ && "File $file is not found in $source[0][0].\n" ||
/\*-/ && "File $file is not found in $source[1][0].\n" ||
/>>/ && "File $file in $source[0][0] is bigger.\n" ||
/<</ && "File $file in $source[0][0] is smaller.\n" ||
/<>/ && "File $file has different content.\n" ||
/EE/ && "Error $info during compare of $file.\n" ||
/==/ && ($sayeq ? "File $file is identical in both trees.\n" : "") ||
"$op $file\n";
}

$sync or return;
# synchronize
if ($op =~ /\*$/)
{ if ($sync != 2)
{ Warning CopyFile $file, $source[1], $source[0];
} elsif ($op eq 'O*')
{ Warning "Cannot handle downgrade of file $file automatically." unless $ignoredowngrade;
} elsif ($op eq '-*' && !$nodel)
{ Warning DeleteFile $file, $source[1];
}
} elsif ($op =~ /^\*/)
{ if ($sync != 1)
{ Warning &{$move && $updfile ? \&MoveFile : \&CopyFile}($file, $source[0], $source[1]);
} elsif ($op eq '*O')
{ Warning "Cannot handle downgrade of file $file automatically." unless $ignoredowngrade;
} elsif ($op eq '*-' && !$nodel && \$updfile)
{ Warning DeleteFile $file, $source[0];
}
} elsif ($op eq '==')
{ DeleteFile $file, $source[0] if $sync != 2 && !$nodel && $updfile && $move;
} else
{ Warning "Synchronize failed ($op): $file.";
}
return;
}

# add the content of an FTP directory
sub FTPdir($$)
{ my ($src, $path) = @_;
use Net::FTP;
my @dir = $$src[2]->ls or Error 20, "FTP dir failed at $path: $@";
my @files;
foreach (@dir)
{ chomp;
/^\.{1,2}$/ and next;
#print "X:$_";
if ($$src[2]->cwd($_))
{ # dir
print "Enter ftp dir $path$_\n" if $debug;
push @files, FTPdir($src, "$path$_/") if $subdir;
$$src[2]->cdup;
} else
{ # file
#print " - file\n";
next unless /^$$src[1]$/;
push @files, [$$src[2]->mdtm($_), $$src[2]->size($_), "$path$_"];
}
}
return @files;
}

# scan source tree
# ScanTree(destref, filespec)
sub ScanTree($)
{ use File::Find;
my $src = shift;
my @files;
if ($$src[2])
{ # ftp mode
@files = FTPdir $src, "";
} else
{ if ($subdir)
{ # get file tree
my $offset = length($$src[0]) +3;
find({wanted=>sub
{ push @files, [(lstat)[9,7], substr($File::Find::name, $offset)] if /^$$src[1]$/ && -f;
}, no_chdir=>1}, "$$src[0]/."); # /: => OS/2 & Windows special
} else
{ opendir DIRH, $$src[0] or die "Failed to open directory $$src[0]\n";
@files = map /^$$src[1]$/ && -f "$$src[0]/$_" ? [(lstat "$$src[0]/$_")[9,7], $_] : (), readdir DIRH;
closedir DIRH;
} }
return \@files;
}

# check if name is in exclude list
# CheckXcl(name)
sub CheckXcl($)
{ foreach (@xcl)
{ return 1 if $_[0] =~ /$_/;
}
return 0;
}

# fetch next name from list index
# NextName(index)
sub NextName(\@)
{ my $arr = shift;
do
{ shift @$arr;
return undef unless @$arr;
} while CheckXcl mylc $$arr[0][2];
return $$arr[0][2];
}

sub DoFileCompare($$)
{ my ($file0, $file1) = @_;
# compare timestamp
#print "Timed: $thres ".($files0[0][0] - $files1[0][0])." $file0\n" if $debug;
#print "Time: $files0[0][0] - $files1[0][0] $file0\n" if $debug;
my $diff = abs($$file0[0] - $$file1[0]);
if ($diff > $thres)
{ DaylightErr if $diff < 86400 && $diff % 3600 == 0;
print "Time diff: $$file0[2] ".($$file0[0] - $$file1[0])."\n" if $debug;
return $$file0[0] < $$file1[0] ? 'O*' : '*O';
# compare size
}
if ($$file0[1] != $$file1[1])
{ return $$file0[1] < $$file1[1] ? '<<' : '>>';
}
if ($fcomp)
{ # compare content
use File::Compare;
my $rc = compare("$source[0][0]/$$file0[2]","$source[1][0]/$$file1[2]");
if ($rc)
{ return $rc == 1 ? '<>' : 'EE';
} }
return '==';
}

sub parsearg($);
sub parsearg($)
{ $_ = shift;
if (/^\@(.*)/)
{ # option file
open OF, $1
or Error 25, "Failed to open indirect file $1.\n";
while (<OF>)
{ chomp;
next if $_ eq '';
parsearg $_;
}
close OF;
return;
} elsif (!/^\/|^-/)
{ # filename
push @source, $_;
return;
}
# option
study;
/^._$/i and $debug = 1, return;
/^.s$/i and $subdir = 1, return;
/^.x(.+)/i and push(@xcl, ToRegEx $1), return;
/^.(?:v0|q)$/i and $mout = 0, return;
/^.v1$/i and $mout = 1, return;
/^.v2?$/i and $mout = 2, return;
/^.f$/i and $fcomp = 1, return;
/^.d$/i and $nodel = 0, return;
/^.m$/i and $move = 0, return;
/^.t$/i and return;
/^.t(\d+)$/i and $thres = $1, return;
/^.y(1|2|3)?$/i and $sync = $1 || 3, return;
/^.u(.*)/i and $updfile = $1, return;
/^.p(\d+)(?::(\d+))/i and $volfile = 'VOLINFO.DIR', $numvol = $1, $volno = $2, return;
/^.z(?:i|0)(.*)/i and $subdir = 1, $mout = 0, $updfile = $1, return;
/^.z(?:p|1)(.*)/i and $subdir = 1, $mout = 0, $updfile = $1, $sync = 1, return;
/^.z(?:u|2)(.*)/i and $subdir = 1, $mout = 0, $updfile = $1, $sync = 2, return;
/^.z(?:a|3)(.*)/i and $subdir = 1, $mout = 0, $updfile = $1, $sync = 3, $move = 1, return;
/^.cs$/i and $casesens = 1, return;
/^.i$/i and $ignoredowngrade = 1, return;
Error 44, "Invalid option $_";
}


############################################################################
# parse command line
############################################################################
parsearg shift @ARGV while (@ARGV);

@source or
print("Compare and/or synchronize files and directories\n"
. "(C) Marcel Mueller 1999-2001\n\n"
. "Usage: dsync filespec1 filespec2 [options]\n\n"
. "compare results:\n"
. " '*O' file in tree 1 newer\n"
. " 'O*' file in tree 2 newer\n"
. " '*-' file in tree 2 not found\n"
. " '-*' file in tree 1 not found\n"
. " '>>' file in tree 1 is longer with same time stamp\n"
. " '<<' file in tree 2 is longer with same time stamp\n"
. " '<>' files have different content with same time stamp\n"
. " 'EE' error during compare\n\n"
. "options:\n"
. " -s include subdirectories\n"
. " -f compare file content\n"
. " -v compare result in text format instead of the default as noted above\n"
. " -q quiet, i.e. no output to stdout\n"
. " -y synchronize files\n"
. " -y1 update only 1st tree\n"
. " -y2 update only 2nd tree\n"
. " -ufile create update file/directory in filespec1 using file as index\n"
. " -pnum:no switch filespec1 in multiple volume mode\n"
. " The number of volumes (num) and the volume number (no) are optional.\n"
. " -zi shortcut for -s -q -u, create initial update file\n"
. " -zp shortcut for -s -q -u -y1, pack update packet\n"
. " -zu shortcut for -s -q -u -y2, unpack update packet\n"
. " -za shortcut for -s -q -u -y -m, fully automaic resync of update packet\n"
. " -d delete files when removed in the other tree\n"
. " -m move files from update directory instead of copying\n"
. " -tthres threshold in seconds for time compares\n"
. " -xpatt exclude files or subfolders that match the pattern\n"
. " -cs compare filenames case-insensitive\n"
. " -i ignore downgrades (see reference)"), exit 20;

Error 49, "Syntax error: more than 2 source paths:\n @source." if @source > 2;


# some more initialisation stuff
map { $_ = mylc $_; } @xcl;

# get root path & filespec
use Cwd;
@source = map
{ s/\\/\//g; # well, windows ...
my ($root, $name, $ftp) = /(.*[\/:])?(.*)$/;
#print "R $root N $name", -d($_), "_\n";
if ($root =~ /^ftp:\/\/(?:(.+?)(?::(.*))?@)?([\w\.-]+)(?::([\w]+))?(.*)/)
{ # FTP tree
my $user = $1 || "anonymous";
my $pwd = $2;
my $host = $3;
my $port = $4 || 21;
my $ftproot = $5;
print "FTP: $user:***\@$host:$ftproot\n" if $debug;
use Net::FTP;
$ftp = Net::FTP->new($host, {Passive=>1, port=>$port}) or Error 20, "FTP connect failed: $@";
print "FTP connected\n" if $debug;
$ftp->login($user, $pwd) or Error 20, "FTP login failed.";
print "FTP logged in\n" if $debug;
$ftp->binary or Error 20, "FTP binary mode failed: $@";
$ftp->cwd($ftproot) or Error 30, "FTP change to directory $ftproot failed: $@";
print "FTP changed root\n" if $debug;
print "attached to FTP server $host$ftproot as $user.\n";
} else
{ if ($name !~ /\*|\?/ && $root !~ /:$/ && -d)
{ $root = $_;
$name = '';
print "$_ seems to be a directory, '/' added.\n" if $debug;
}
if ($root !~ /^\/\//) # not in case of UNC path
{ $root = Cwd::abs_path($root);
$root =~ s/:$/:\//;
-d $root or Error 30, "$root is no valid directory.";
} }
$root =~ s/\/$//;
$name = ToRegEx $name if $name;
[$root, $name, $ftp, {}];
} @source;

# some defaults
$source[1] = [getcwd], $source[1][0] =~ s/\/$// unless $#source;
$source[0][1] or $source[0][1] = '.*';
$source[1][1] or $source[1][1] = $source[0][1];
$updfile = "$source[0][0]/UPDATE.DIR" if defined $updfile && $updfile eq '';
$volfile = "$source[0][0]/$volfile" if defined $volfile;

if ($debug)
{ print "Filespec: root = $$_[0], pattern = $$_[1]\n" foreach (@source);
print "Exclude: $_\n" foreach (@xcl);
}

# some consistency checks
$updfile && $fcomp and Error 34, "-u and -f are mutual exclusive.";
$volfile && $updfile and Error 43, "-u and -p are mutual excusive.";
$sync == 3 && !$nodel and Error 34, "-y and -d are mutual exclusive.";
if ($source[0][2] || $source[0][2])
{ $fcomp and Error 34, "FTP mode does not support file compare.";
$source[0][2] && $source[0][2] && $sync and Error 34, "Syncronize does not support TWO ftp trees.";
if ($sync == 3)
{ print STDERR "Bidirectional synchronisation makes no sense in case of the ftp protocol\n"
. "since ftp does not preserve the file modification time.\n"
. "Do you want to continue anyway [y|N] ?\n";
scalar <STDIN> =~ /^y/i or exit 1;
}
}
$source[0][0] eq $source[1][0] and Error 32, "Cannot compare files to themselves.";
$source[0][1] ne $source[1][1] and Error 32, "Cannot compare directories with different file patterns.";
#$_ = min length $source[0][0], length $source[1][0];
#substr($source[0][0],0,$_) eq substr($source[1][0],0,$_) and Error 32, "Source path $source[0][0] is not independent of source path $source[1][0].";



############################################################################
# go!
############################################################################
# read volume info
if ($volfile)
{ if (!defined $volno || !defined $numvol)
{ if (open I, $volfile)
{ my ($v, $n) = <I> =~ /(\d+):(\d+)/ or Error 24, "The volume info $volfile is invalid. Use -pnum:no to override.";
close I;
$volno = $v unless defined $volno;
$numvol = $n unless defined $numvol;
} else
{ Error 22, "Cannot deduce the volume information from $volfile. Use -pnum:no.";
} }
--$volno; # convert to zero based index
# calculate distribution function
mmincrease for (2..$numvol);
}

# get file lists
my @tree;
my @voldesc;
my $fref;
foreach my $src (@source)
{ #print "_____@$src\n";
if ($updfile && !@tree)
{ $fref = [];
next unless $sync;
# fetch list from update file
if (!open UPDF, $updfile)
{ if ($sync == 3)
{ print STDERR "Could not find index file $updfile.\n"
. "In case of the first call with -za you may want to create an initial one.\n"
. "Create initial index file [y|N] ?\n";
scalar <STDIN> =~ /^y/i and $sync = 0, next;
}
Error 20, "Failed to read update index file $updfile";
}
my @tmp;
$fref = [map
{ chomp;
$voldesc[0] = $1 if /^:(.*)/;
@tmp = /^(\S+)\s+(\S+)\s+(.*)/ and $tmp[2] =~ s/\\/\//g, [@tmp] or ()
} <UPDF>];
close UPDF;
} else
{ $fref = ScanTree $src;
# discard files on other volumes
if ($volfile && @tree)
{ for (my $j = $#$fref; $j >= 0; --$j)
{ my $fname = uc $fref->[$j][2];
my $part = mmlook CRC32 $fname;
if ($part != $volno)
{ print "V: $part $fname\n" if $debug;
splice @$fref, $j, 1;
}
}
}
}
} continue
{ # sort & store files
push @tree, [sort {mylc $a->[2] cmp mylc $b->[2];} @$fref];
#print map "@$_\n", @{$tree[$#tree]};
}
# volume descriptors
if ($updfile)
{ $voldesc[1] = ($source[1][0] =~ /(.*):/ ? "<unimplemented@@@\1> " : '') . $source[1][0];
if ($voldesc[0] && $sync =~ /1|2/ && mylc $voldesc[0] eq mylc $voldesc[1])
{ print STDERR "Update tree is possibly the same then at the last call.\n"
. "You propably want to use /za or /y.\n"
. "Continue anyway [y|N] ?\n";
scalar <STDIN> =~ /^y/i or exit 1;
} }

# compare
my @files0 = (undef, @{$tree[0]});
my @files1 = (undef, @{$tree[1]});
NextName @files0;
NextName @files1;
while (@files0 || @files1)
{ # compare filenames
my $cmp = @files0 && @files1
? mylc $files0[0][2] cmp mylc $files1[0][2]
: !@files0 - !@files1;
#print "$files0[0][2] vs $files1[0][2]: $cmp\n", scalar @files0, scalar @files1;
if ($cmp == 0)
{ # filenames equal
DoItem DoFileCompare($files0[0], $files1[0]), $files0[0][2];
NextName @files0;
NextName @files1;
} elsif ($cmp < 0)
{ DoItem '*-', $files0[0][2];
NextName @files0;
} else # $cmp > 0
{ DoItem '-*', $files1[0][2];
NextName @files1;
} }

# create update file
if (!$debug && $updfile && $sync != 2)
{ $tree[1] = ScanTree $source[1] if $sync == 3; # rescan tree to include recent changes
Error 14, "Update file $updfile already exists. Maybe you forgot -y.\n" if $sync == 0 && -f $updfile;
open UPDF, ">$updfile" or Error 27, "Failed to create update index file $updfile\n";
print UPDF ":$voldesc[1]\n";
foreach(@{$tree[1]})
{ print UPDF "@$_\n";
}
close UPDF;
}

if ($volfile && ($sync & 1) && !$debug)
{ open O, ">$volfile" or Error 21, "Cannot create volume info $volfile.";
print O $volno+1, "/$numvol";
close O;
}

exit 0;
f t g m