view release on metacpan or  search on metacpan

synctree  view on Meta::CPAN

#!/usr/local/bin/perl

use Benchmark;
use ClearCase::Argv 1.34;
use ClearCase::SyncTree 0.28;
use File::Basename;
use File::Find;
use File::Path;
use File::Spec 0.82;
use Cwd;
use Getopt::Long;

use constant MSWIN => $^O =~ /MSWin32|Windows_NT/i ? 1 : 0;

require 5.005 if MSWIN;

my $prog = basename($0, qw(.pl));
my $rc = 0;

sub usage {
    my $msg = shift;
    my $retcode = (defined($msg) && !$msg) ? 0 : 2;
    if ($retcode) {
	select STDERR;
	print "$prog: Error: $msg\n\n" if $msg;
    }
    print <<EOF;
Usage: $prog [flags] -sbase <dir> -dbase <vob-dir> [pname...]
Flags:
   -help		Print this message and exit
   -sbase <dir>		The source base directory
   -dbase <vob-dir>	The destination base directory
   -flist <file>	A file containing a list of src files, or "-" for stdin
   -map			Interpret \@ARGV as a hash mapping src => dest
   -follow		Follow symlinks when traversing <pname> directories
   -force		Continue despite errors
   -stop		Stop at the first error (no cleanup)
   -ignore_co		Allow checkouts to remain, untouched, in the dest
   -overwrite_co	Allow existing checkouts in dest to be overwritten
   -ci			Check in changes (default is to leave co'ed)
   -cr			Check in so as to preserve CR's (slower)
   -vp			Ignore versioned elements in src area
   -ctime		Checked in files get current time (no -ptime)
   -rmname		Remove files from dest area that aren't in src
   -label <lbtype>	Apply the specified label recursively to -dbase
   -lbmods		Apply the -label lbtype only to modified elems
   -c <comment>		Use specified comment for checkins
   -no			Exit after showing a preview
   -yes			Perform all work (except checkin) without prompting
   -nprotect		Turn off "cleartool protect -chmod" phase
   -rellinks            Turn absolute symlinks within sbase into relative ones
   -reuse		Attempt to reuse existing elements of same name
   -summary 		Print a summary of cleartool activities when done
   -verbose <n>		Set to 0 for least verbosity, 2 for most (default=1)
   -Narrow [!]<re>	Limit files found to those which match /re/
   -Version		Print the current $prog version and quit
   -vreuse		Attempt to reuse existing versions of same element
   -/dbg=1		Verbose mode: show cleartool cmds as they run
Notes:
    All flags may be abbreviated to their shortest unique name.
    Run "perldoc synctree" for detailed documentation and examples.
    Or "perldoc ClearCase::SyncTree" for even more documentation.
Examples:
    $prog -sbase /tmp/newcode -dbase /vobs_tps/foo /tmp/newcode
    $prog -sb /tmp/newcode -db /vobs_tps/foo -N '\.java\$' -rm -yes -ci
    $prog -sb /tmp/newcode -db /vobs_tps/foo -N '!\.old\$' -reuse 
EOF
    exit $retcode;
}

my(%opt, %xfer);

{
    my($only, $skip);
    sub wanted {
	my $path = File::Spec->rel2abs($File::Find::name);
	$path =~ s%\\%/%g if MSWIN;
	if (! -d && defined $opt{Narrow}) {
	    $only ||= join('|', grep !/^!/, @{$opt{Narrow}});
	    return if $only && $path !~ /$only/;
	    $skip = join('|', map {(m/^!(.*)/)[0]} grep /^!/, @{$opt{Narrow}});
	    # Filename patterns should be case insensitive on Windows.
	    $skip = "(?i:$skip)" if MSWIN;
	    return if $skip && $path =~ /$skip/;
	}
	if (-f $_ || -l $_) {
	    if (-r _) {
		# Skip versioned elements if requested.
		return if $opt{vp} && (-e "$_@@/main/0" || -e "$_/@@/main/0");
		# Passed all tests, put it on the list.
		$xfer{$path} = $path;
	    } else {
		print STDERR "$prog: Error: permission denied: $path\n";
	    }
	} elsif (-d _) {
	    if ($_ eq 'lost+found') {
		$File::Find::prune = 1;
		return;
	    }
	    # Keep directories in the list only if they're empty.
	    opendir(DIR, $_) || warn "$prog: Error: $_: $!";
	    my @entries = readdir DIR;
	    closedir(DIR);
	    $xfer{$path} = $path if @entries == 2;
	} elsif (! -e _) {
	    die "$prog: Error: no such file or directory: $path\n";
	} else {
	    print STDERR "$prog: Error: unsupported file type: $path\n";
	}
    }