view release on metacpan or  search on metacpan

examples/README  view on Meta::CPAN

- simplest: The simplest use of ClearCase::Argv I could think up.

- simple: A longer script with a bunch of simple, standalone, code
nuggets.

- CCreport: A "real" application which generates a textual report on
changes made across some time slice in some set of vobs by some set of
users, etc., all configurable.

- tarvob: Another real tool though much less ambitious. This is a
standard vob-backup script implemented with ClearCase::Argv. Locks
vobs, tars, unlocks, etc. Don't use this with production vobs without
careful testing and full understanding of what it does.

- fix_eltype: A real script that brings element types into line with
what "cleartool file" thinks they should be.

- mkattr: An example of how to set string-valued attributes which
tends to be the toughest quoting job. All these examples work on both
Unix and Windows.

examples/tarvob  view on Meta::CPAN

use ClearCase::Argv;

Argv->stdout(0);	# suppress stdout by default
Argv->attropts;		# parse @ARGV for -/flags

# Must specify cleartool location since we'll be running as root.
ClearCase::Argv->cleartool('/usr/atria/bin/cleartool');

use Getopt::Long;
use vars qw(%opt);
GetOptions(\%opt, qw(backupdir=s comment=s rgy z));

chomp(@ARGV = grep !/tmp$/,
    ClearCase::Argv->new(qw(lsvob -s))->noexec(0)->stdout(1)->qx) if !@ARGV;

my $rc = 0;

my $lock = ClearCase::Argv->new('lock');
$lock->opts('-c', $opt{comment}) if $opt{comment};
my $unlock = ClearCase::Argv->new('unlock');
my $tar = Argv->new;

my @backups;

Argv->dbglevel(1);

my $lsvob = ClearCase::Argv->new(
	    {stdout=>1, noexec=>0, dbglevel=>0, autochomp=>1}, 'lsvob', []);

for my $tag (@ARGV) {
    my $pass = 0;
    my $stg = $lsvob->args($tag)->noexec(0)->dbglevel(0)->autochomp(1)->qx;
    $stg =~ s%^\S*\s+\S+\s+(\S+)/[^/]+\.vbs\s+.*%$1%;
    if (!chdir($stg)) {
	warn "$stg: $!";
	next;
    } else {
	warn "\n= ", scalar(localtime), "\n+ cd $stg\n";
    }
    my $d = $opt{backupdir} || $stg;
    (my $v = $tag) =~ s%^\W+%%;
    next if $lock->args("vob:$tag")->system;
    unlink("$d/$v.tar") if !$tar->noexec;
    my $cmd = "gtar -cf $d/$v.tar $v.vbs $v.vbs/d/ddft/* $v.vbs/s/sdft/*";
    $pass++ if $tar->args($cmd)->stdout(1)->system;
    $pass++ if $unlock->args("vob:$tag")->system;
    $rc += $pass;
    next if $pass;
    push(@backups, "$v.tar");
    unlink("$d/$v.tar.gz") if !$tar->noexec;
}
warn "\n= ", scalar(localtime), "\n";

if ($opt{rgy}) {
    my $r = ($opt{backupdir} || '/var/tmp') . 'config.tar.gz';
    my $d = '/var/adm/rational/clearcase';
    $rc++ if Argv->new(qw(gtar -cf), $r, $d)->system;
}

if ($opt{z} && @backups) {
    if ($opt{backupdir}) {
	die "$opt{backupdir}: $!" if !chdir($opt{backupdir});
	warn "\n+ cd $opt{backupdir}\n";
    }
    $rc++ if Argv->new(qw(gzip --force), @backups)->system;
    warn "\n= ", scalar(localtime), "\n";
}

exit $rc;