view release on metacpan or  search on metacpan

DSB.pm  view on Meta::CPAN

    my @net_use = grep /\s[A-Z]:\s/i, Argv->new(qw(net use))->qx;
    my $drive = $opt{drive} || (map {/(\w:)/ && uc($1)}
				grep /\s+\\\\view\\$vtag\b/,
				grep !/unavailable/i, @net_use)[0];
    my $mounted = 0;
    my $pers = $opt{persistent} ? '/persistent:yes' : '/persistent:no';
    if (!$drive) {
	ClearCase::Argv->startview($vtag)->autofail(1)->system
						    if ! -d "//view/$vtag";
	$mounted = 1;
	my %taken = map { /\s([A-Z]:)\s/i; $1 => 1 } @net_use;
	for (reverse 'G'..'Z') {
	    next if $_ eq 'X';	# X: is reserved (for CDROM?) on Citrix
	    $drive = $_ . ':';
	    if (!$taken{$drive}) {
		local $| = 1;
		print "Connecting $drive to \\\\view\\$vtag ... "
							    if !$opt{'exec'};
		my $netuse = Argv->new(qw(net use),
					    $drive, "\\\\view\\$vtag", $pers);
		$netuse->stdout(0) if $opt{'exec'};
		last if !$netuse->system;
	    }
	}
    } elsif ($opt{drive}) {
	$drive .= ':' if $drive !~ /:$/;
	$drive = uc($drive);
	if (! -d $drive) {
	    $mounted = 1;
	    local $| = 1;
	    print "Connecting $drive to \\\\view\\$vtag ... ";
	    Argv->new(qw(net use), $drive, "\\\\view\\$vtag", $pers)->system;
	    exit $?>>8 if $?;
	}
    }
    chdir "$drive/" || die Msg('E', "chdir $drive $!");
    $ENV{CLEARCASE_ROOT} = "\\\\view\\$vtag";
    $ENV{CLEARCASE_VIEWDRIVE} = $ENV{VD} = $drive;
    my $sv = Argv->new($child);
    $sv->prog(qw(start /wait), $sv->prog) if $opt{window};
    if ($mounted && !$opt{persistent}) {
	my $rc = $sv->system;
	my $netuse = Argv->new(qw(net use), $drive, '/delete');
	$netuse->stdout(0) if $opt{'exec'};
	$netuse->system;
	exit $rc;
    } else {
	$sv->exec;
    }
}

=item * UPDATE

Adds a B<-quiet> option to strip out all those annoying
C<Processing dir ...> and C<End dir ...> messages so you can see what
files actually changed. It also suppresses logging by redirecting the
log file to /dev/null.

=cut

sub update {
    my %opt;
    GetOptions(\%opt, qw(quiet));
    return 0 if !$opt{quiet};
    if (!grep m%^-log%, @ARGV) {
	splice(@ARGV, 1, 0, '-log', MSWIN ? 'NUL' : '/dev/null');
    }
    my $ct = ClearCase::Argv->find_cleartool;
    open(CMD, "$ct @ARGV |") || exit(2);
    while(<CMD>) {
	next if m%^(?:Processing|End)\s%;
	next if m%^[.]+$%;
	next if m%, copied 0 %;
	print;
    }
    exit(close(CMD));
}

=item * WINKIN

The B<-tag> flag allows you specify a local file path plus another view;
the named DO in the named view will be winked into the current view, e.g.:

    <cmd-context> winkin -tag otherview /vobs_myvob/dir1/dir2/file

The B<-vp> flag, when used with B<-tag>, causes the "remote" file to be
converted into a DO if required before winkin is attempted. See the
B<winkout> extension for details. I<Note: this feature depends on
C<setview> and thus will not work on Windows where setview has been
removed. However, it would be possible to re-code it to use the setview
emulation provided in this same package if you really want the
feature on Windows.>

=cut

sub winkin {
    my %opt;
    local $Getopt::Long::autoabbrev = 0; # so -rm and -r/ecurse don't collide
    GetOptions(\%opt, qw(rm tag=s vp));
    return 0 if !$opt{tag};
    my $wk = ClearCase::Argv->new(@ARGV);
    $wk->parse(qw(print|noverwrite|siblings|adirs|recurse|ci out|select=s));
    $wk->quote;
    my @files = $wk->args;
    unlink @files if $opt{rm};
    if ($opt{vp}) {
	my @winkout = ($^X, '-S', $0, 'winkout', '-pro');
	ClearCase::Argv->new(qw(setview -exe), "@winkout @files",
					    $opt{tag})->autofail(1)->system;
    }
    my $rc = 0;
    for my $file (@files) {
	if ($wk->flag('recurse') || $wk->flag('out')) {
	    $wk->args;
	} else {
	    $wk->args('-out', $file);
	}
	$rc ||= $wk->args($wk->args, "/view/$opt{tag}$file")->system;
    }
    exit $rc;
}