view release on metacpan or  search on metacpan

DSB.pm  view on Meta::CPAN

#############################################################################
# Usage Message Extensions
#############################################################################
{
   local $^W = 0;
   no strict 'vars';

   # Usage message additions for actual cleartool commands that we extend.
   $catcs	= "\n* [-cmnt|-expand|-sources|-start]";
   $describe	= "\n* [--par/ents <n>]";
   $lock	= "\n* [-allow|-deny login-name[,...]] [-iflocked]";
   $lsregion	= "\n* [-current]";
   $mklabel	= "\n* [-up]";
   $setcs	= "\n* [-clone view-tag] [-expand] [-sync|-needed]";
   $setview	= "\n* [-me] [-drive drive:] [-persistent]";
   $update	= "\n* [-quiet]";
   $winkin	= "\n* [-vp] [-tag view-tag]";

   # Usage messages for pseudo cleartool commands that we implement here.
   # Note: we used to localize $0 but that turns out to trigger a bug
   # in perl 5.6.1.

DSB.pm  view on Meta::CPAN

    Argv->new('diff', @cstmps)->dbglevel(1)->system;
    unlink(@cstmps);
    exit 0;
}

=item * ECLIPSE

New command. B<Eclipse>s an element by copying a view-private version
over it. This is the dynamic-view equivalent of "hijacking" a file in a
snapshot view. Typically of use if you need temporary write access to a
file when the VOB or current branch is locked, or it's checked out
reserved.  B<Eclipsing elements can lead to dangerous confusion - use
with care!>

=cut

sub eclipse {
    require File::Copy;

    Assert(@ARGV > 1);	# die with usage msg if untrue
    shift @ARGV;	# dump the cmd name leaving only the elems to eclipse

DSB.pm  view on Meta::CPAN

    Argv->new(@ARGV, @vers)->dbglevel(1)->exec;
}

=item * LOCK

New B<-allow> and B<-deny> flags. These work like I<-nuser> but operate
incrementally on an existing I<-nuser> list rather than completely
replacing it. When B<-allow> or B<-deny> are used, I<-replace> is
implied.

When B<-iflocked> is used, no lock will be created where one didn't
previously exist; the I<-nusers> list will only be modified for
existing locks.

=cut

sub lock {
    my %opt;
    GetOptions(\%opt, qw(allow=s deny=s iflocked));
    return 0 unless %opt;
    my $lock = ClearCase::Argv->new(@ARGV);
    $lock->parse(qw(c|cfile=s c|cquery|cqeach nusers=s
						    pname=s obsolete replace));
    die Msg('E', "cannot specify -nusers along with -allow or -deny")
					if $lock->flag('nusers');
    die Msg('E', "cannot use -allow or -deny with multiple objects")
					if $lock->args > 1;
    my $lslock = ClearCase::Argv->lslock([qw(-fmt %c)], $lock->args);
    my($currlock) = $lslock->autofail(1)->qx;
    if ($currlock && $currlock =~ m%^Locked except for users:\s+(.*)%) {
	my %nusers = map {$_ => 1} split /\s+/, $1;
	if ($opt{allow}) {
	    for (split /,/, $opt{allow}) { $nusers{$_} = 1 }
	}
	if ($opt{deny}) {
	    for (split /,/, $opt{deny}) { delete $nusers{$_} }
	}
	$lock->opts($lock->opts, '-nusers', join(',', sort keys %nusers))
								    if %nusers;
    } elsif (!$currlock && $opt{iflocked}) {
	exit 0;
    } elsif ($opt{allow}) {
	$lock->opts($lock->opts, '-nusers', $opt{allow});
    }
    $lock->opts($lock->opts, '-replace') unless $lock->flag('replace');
    $lock->exec;
}

=item * LSREGION