view release on metacpan or  search on metacpan

SyncTree.pm  view on Meta::CPAN

sub label {
    my $self = shift;
    my $lbtype = shift || $self->lbtype;
    return unless $lbtype;
    my $dbase = $self->dstbase;
    my $ct = $self->clone_ct({autochomp=>0});
    my $ctq = $self->clone_ct({stdout=>0});
    my $ctbool = $self->clone_ct({autofail=>0, stdout=>0, stderr=>0});
    my $dvob = $self->dstvob;
    my $locked;
    if ($ctbool->lstype(['-s'], "lbtype:$lbtype\@$dvob")->system) {
	$ct->mklbtype($self->comment, "lbtype:$lbtype\@$dvob")->system;
    } elsif (!$self->inclb) {
	$locked = $ct->lslock(['-s'], "lbtype:$lbtype\@$dvob")->qx;
	$ct->unlock("lbtype:$lbtype\@$dvob")->system if $locked;
    }
    # Allow for labelling errors, in case of hard links: only the link
    # recorded can be labelled, the other being seen as 'removed'
    if ($self->label_mods || $self->inclb) {
	my @mods = $self->_lsco;
	push @mods, @{$self->{ST_LBL}} if $self->{ST_LBL};
	if (@mods) {
	    $ctbool->mklabel([qw(-nc -rep), $self->inclb], @mods)->system
	                                                      if $self->inclb;
	    $ctbool->mklabel([qw(-nc -rep), $lbtype], @mods)->system;

SyncTree.pm  view on Meta::CPAN

	# Last, label the ancestors of the destination back to the vob tag.
	my($dad, @ancestors);
	my $min = length($self->normalize($dvob));
	for ($dad = dirname($dbase);
			         length($dad) >= $min; $dad = dirname($dad)) {
	    push(@ancestors, $dad);
	}
	$ctq->mklabel([qw(-rep -nc), $lbtype], @ancestors)->system
								if @ancestors;
    }
    $self->clone_ct->lock("lbtype:$lbtype\@$dbase")->system if $locked;
}

sub get_addhash {
    my $self = shift;
    if ($self->{ST_ADD}) {
	return
	    map { $self->{ST_ADD}->{$_}->{src}, $self->{ST_ADD}->{$_}->{dst} }
		keys %{$self->{ST_ADD}};
    } else {
	return ();

synctree  view on Meta::CPAN

# Support incremental label families (ClearCase::Wrapper::MGi)
if ($opt{label}) {
    my $ct = $sync->clone_ct({autofail=>0, stderr=>0});
    my $dvob = $ct->desc(['-s'], "vob:$opt{dbase}")->qx;
    my $lbtype = "lbtype:$opt{label}\@$dvob";
    $sync->lblver($opt{label}) if $opt{vreuse} && $ct->desc(['-s'], $lbtype)->qx;
    my ($inclb) = grep s/-> (lbtype:.*)$/$1/,
                               $ct->desc([qw(-s -ahl EqInc)], $lbtype)->qx;
    if ($inclb) {
        die "$prog: Error: incremental label types must be unlocked\n"
	                       if $ct->lslock(['-s'], $lbtype, $inclb)->qx;
	$inclb =~ s/^lbtype:(.*)@.*$/$1/;
	$sync->inclb($inclb);
    }
}

if ($opt{flist}) {
    #usage("-flist and -map are mutually exclusive") if $opt{map};
    usage("-flist and -Narrow are mutually exclusive") if $opt{Narrow};
    open(FLIST, $opt{flist}) || die "$prog: Error: $opt{flist}: $!";