view release on metacpan or  search on metacpan

MGi.pm  view on Meta::CPAN

package ClearCase::Wrapper::MGi;

$VERSION = '1.00';

use warnings;
use strict;
use constant CYGWIN => $^O =~ /cygwin/i ? 1 : 0;
use vars qw($CT $EQHL $PRHL $STHL $FCHL %Xfer $Benchstart);
use File::Find;
($EQHL, $PRHL, $STHL, $FCHL) = qw(EqInc PrevInc StBr FullCpy);

# Note: only wrapper supported functionality--possible fallback to cleartool
sub _Wrap {
  local @ARGV = @_;
  ClearCase::Wrapper::Extension($ARGV[0]);
  no strict 'refs';
  my $rc = eval { "ClearCase::Wrapper::$ARGV[0]"->(@ARGV) };
  if ($@) {
    chomp $@;		 #One extra newline to avoid dumping the stack
    if ($@ =~ m%^\d+$%) {
      $rc = $@;
    } elsif ($@) {
      print STDERR "$@\n";
      $rc = 1;
    } else {
      $rc = 0;
    }
  } else {
    $rc = ClearCase::Argv->new(@ARGV)->system unless $rc; # fallback!
  }
  return $rc;			# Completed, successful or not
}
## Internal service routines, undocumented.
sub _Compareincs {
  my ($t1, $t2) = @_;
  my ($p1, $M1, $m1, $s1) = pfxmajminsfx($t1);
  my ($p2, $M2, $m2, $s2) = pfxmajminsfx($t2);
  if (!(defined($p1) and defined($p2) and ($p1 eq $p2) and ($s1 eq $s2))) {
    warn Msg('W', "$t1 and $t2 not comparable\n");
    return 1;
  }
  return ($M1 <=> $M2 or (defined($m1) and defined($m2) and $m1 <=> $m2));
}
sub _Samebranch {		# same branch
  my ($cur, $prd) = @_;
  $cur =~ s:/\d+$:/:; # Treat CHECKEDOUT as other branch
  $prd =~ s:/\d+$:/:;
  return $cur eq $prd;
}
sub _Sosbranch {		# same or sub- branch
  my ($cur, $prd) = @_;
  $cur =~ s:/\d+$:/:;
  $prd =~ s:/\d+$:/:;
  return $cur =~ /^\Q$prd\E/;
}
sub _Printoffspring {
  no warnings 'recursion';
  my ($id, $gen, $opt, $ind, $seen, $out) = @_;
  my $top = $out? 0 : ($out = [], $seen = {}, 1);
  if ($seen->{$id}++) {
    push @{$out}, sprintf("%${ind}s\[alternative: ${id}\]", '')
      unless $opt->{short} or $opt->{fmt};
    return;
  }
  my @p = @{ $gen->{$id}{parents} || [] };
  my @c = @{ $gen->{$id}{children} || [] };
  my $l = $gen->{$id}{labels} || '';
  my ($s, $u) = ([], []);
  push @{$seen->{$_}? $s : $u}, $_ for @p;
  if (@{$u} and !($opt->{short} or $opt->{fmt})) {
    my $pprinted = 0;
    map{$pprinted++ if $gen->{$_}{printed}} @{$s};
    push @{$out}, ' 'x($ind-1) . '[contributor' . (@{$u}>1? 's' : '') . ': '
      . join(' ', @{$u}) . ']' if $pprinted and $ind;