ClearCase-Wrapper-MGi

 view release on metacpan or  search on metacpan

MGi.pm  view on Meta::CPAN

  my @opts = (map(("-$_", $mkv->flagCC($_)), @k), '-tmo', $tmo, "-$shdo");
  my ($host, $ogpa, $hpa, $own) = ($2, $1, $3, $4)
    if $lsv =~ m{ \QGlobal path: \E(.*?)\n.*
		  \QServer host: \E(.*?)\n.*
		  \Qaccess path: \E(.*?)\n.*
		  \QView owner: \E(?:.*?/)(.*?)\n
	      }xs;
  if ($mkv->flagCC('stgloc')) {
    push @opts, '-stg', $mkv->flagCC('stgloc');
  } else {
    my $pwnam = (getpwuid($<))[0];
    if ($mkv->flagCC('hpath')) {
      $hpa = $mkv->flagCC('hpath');
    } else {
      my $pdir = dirname($hpa);
      if (basename($pdir) eq $own) {
	$hpa = File::Spec->catdir(dirname($pdir), $pwnam, "$tag.vws");
      } else {
	$hpa = File::Spec->catdir($pdir, "$tag.vws");
      }
    }

extra/FSCbrokerSuDo  view on Meta::CPAN

my $fsc ='/usr/local/bin/fixsrccont';
my $sudo = '/usr/bin/sudo';

my $rc = 0;
my %batch;
for (@ARGV) {
  push @{$batch{$1}}, $2 if /^(\w+?):(.*)$/;
}
for my $owner (keys %batch) {
  my $arg = join '@@', @{$batch{$owner}}; # split on whitespace...
  $rc |= ((getpwuid($<))[0] eq $owner)? system($fsc, $arg)
    : system($sudo, '-u', $owner, $fsc, $arg);
}
exit $rc;

extra/FixSrcCont.pm  view on Meta::CPAN

our $VERSION = '0.01';
require Exporter;
our @ISA = qw(Exporter);
our @EXPORT = qw(add2fix runfix);

my $ct = new ClearCase::Argv({ipc=>1, autochomp=>1});
my $broker = $ENV{FSCBROKER};
my $fxsc = '/usr/local/bin/fixsrccnt';
my (%tofix, %textfile);
my $user = getpwuid($<) or die "Failed to get uid: $!";

sub textfile {
  my ($typ, $ele) = @_;
  return 1 if $typ eq 'text_file';
  my $vob = $ct->des(['-s'], "vob:$ele")->qx;
  return $textfile{$vob}->{$typ} if defined($textfile{$vob}->{$typ});
  my $sup = $typ;
  do {
    return $textfile{$vob}->{$typ} = 1 if $sup eq 'text_file';
    ($sup) = grep s/^\s*supertype: (.*)$/$1/, $ct->des("eltype:$sup\@$vob")->qx;

extra/ForceLock.pm  view on Meta::CPAN

use Net::SSH::Perl;
use ClearCase::VobPathConv;

our $flk = '/usr/bin/locklbtype';
our $view = 'perl_view';
our $exec = '/opt/rational/clearcase/bin/cleartool setview -exec';
sub ssh() {
  my $host = 'my.unix.sshd.host';
  my $ssh = Net::SSH::Perl->new($host);
  my $account = getlogin || getpwuid($<)
    or die "Couldn't get the uid: $!\n";
  $ssh->login($account);
  return $ssh;
}
sub funlocklt($$) {
  my ($lt, $vob) = @_;
  $vob = winpath2ux($vob);
  my($out, $err, $ret) = ssh()->cmd(
    "$exec '$flk --unlock --vob $vob --lbtype $lt' $view");
  print STDERR join("\n", grep(/^cleartool:/, split /\n/, $err), '') if $err;

extra/locklbtypessh  view on Meta::CPAN

		     "lbtype=s" => \@lbtype);
usage if $help or !($res and $vob and @lbtype) or ($unlock and @nusers);
@lbtype = split(/,/, join(',', @lbtype));
map { $_ = untaint($_) } @lbtype;
@nusers = split(/,/, join(',', @nusers));
map { $_ = untaint($_) } @nusers;
$vob = untaintpath($vob);
$vob = $ct->des(['-s'], "vob:$vob")->qx;
die "Couldn't find the vob $vob\n" unless $vob;
$vob = untaintpath($vob);
my $pwnam = (getpwuid($<))[6];
$pwnam =~ s/^ *(.*[^ ]) *$/$1/;
$pwnam = untaintstring($pwnam);
my $account = getlogin || getpwuid($<) or die "Couldn't get the uid: $!\n";
if ($unlock) {
  my @t = localtime;
  my $t = sprintf"%4d%02d%02d.%02d:%02d:%02d",
    (1900+$t[5]),1+$t[4],$t[3],$t[2],$t[1],$t[0];
  my $eaccount = getpwuid($>) or die "Couldn't get the euid: $!\n";
  my $log = "/var/log/lbunlock.log";
  open LOG, ">>", "$log" or die "Failed to open the $log log: $!\n";
  print LOG "$t $account $vob @lbtype\n";
  close LOG;
  @op = ('unlock');
} else {
  @op = ('lock', '-c', "'Locked by: $account \($pwnam\)'");
  push(@op, '-nusers', join(',', @nusers)) if @nusers;
  push @op, '-rep' if $rep;
}

extra/locklbtypesudo  view on Meta::CPAN

		     "lbtype=s" => \@lbtype);
usage if $help or !($res and $vob and @lbtype) or ($unlock and @nusers);
@lbtype = split(/,/, join(',', @lbtype));
map { $_ = untaint($_) } @lbtype;
@nusers = split(/,/, join(',', @nusers));
map { $_ = untaint($_) } @nusers;
$vob = untaintpath($vob);
$vob = $ct->des(['-s'], "vob:$vob")->qx;
die "Couldn't find the vob $vob\n" unless $vob;
$vob = untaintpath($vob);
my $pwnam = (getpwuid($<))[6];
$pwnam =~ s/^ *(.*[^ ]) *$/$1/;
$pwnam = untaintstring($pwnam);
my $account = getlogin || getpwuid($<) or die "Couldn't get the uid: $!\n";
if ($unlock) {
  my @t = localtime;
  my $t = sprintf"%4d%02d%02d.%02d:%02d:%02d",
    (1900+$t[5]),1+$t[4],$t[3],$t[2],$t[1],$t[0];
  my $eaccount = getpwuid($>) or die "Couldn't get the euid: $!\n";
  my $log = "/var/log/lbunlock.log";
  open LOG, ">>", "$log" or die "Failed to open the $log log: $!\n";
  print LOG "$t $account $vob @lbtype\n";
  close LOG;
  @op = ('unlock');
} else {
  @op = ('lock', '-c', "'Locked by: $account \($pwnam\)'");
  push(@op, '-nusers', join(',', @nusers)) if @nusers;
  push @op, '-rep' if $rep;
}
my ($owner) = grep s%^.*/(.*)$%$1%,
  $ct->des([qw(-fmt %[owner]p)], "vob:$vob")->qx;
$owner = untaint($owner);
map { $_ = "lbtype:$_\@$vob" } @lbtype;
foreach my $t (@lbtype) {
  $ct->des(['-s'], $t)->stdout(0)->system
    and die "Label type $t not found in $vob\n";
}
$< = $>;
my $rc |= ((getpwuid($<))[0] eq $owner)? system($binct, @op, @lbtype)
  : system($sudo, '-u', $owner, $binct, @op, @lbtype);
exit $rc;

extra/updtlink  view on Meta::CPAN

}
my $res = GetOptions("help" => \$help, "vob=s" => \$vob,
		     "user=s" => \$user, "lbtype=s" => \@lbtype);
usage if $help or !($res and $vob and $user and @lbtype);
@lbtype = split(/,/, join(',', @lbtype));
usage('2 types expected: ' . join(', ', @lbtype)) unless @lbtype == 2;
usage("Not a vob: $vob") unless $ct->argv(qw(des -s), "vob:$vob")->qx eq $vob;
usage("Unknown account: $user") unless getpwnam($user);
my $vbown = $ct->argv(qw(des -fmt), '%[owner]p', "vob:$vob")->qx;
$vbown =~ s%^.*/(.*)%$1%;
my $account = (getpwuid($<))[0];
usage("Not vob owner ($vbown): $account") unless $account eq $vbown;
map { $_ = "lbtype:$_\@$vob" } @lbtype;
usage if $ct->argv(qw(des -s), @lbtype)->stdout(0)->system;
my ($pair) = grep s/^\s*(.*) -> (lbtype:.*)$/$1,$2/,
  $ct->argv(qw(des -l -ahl), EQHL, $lbtype[0])->stderr(0)->qx;
my ($hlk, $prev) = split(/,/, $pair) if $pair;
$ct->argv('unlock', $lbtype[0])->stderr(0)->system; #Ignore failure: not locked
$ct->argv('mkhlink', EQHL, @lbtype)->system and die;
if ($prev) {
  no warnings 'qw';