view release on metacpan or  search on metacpan

Wrapper.pm  view on Meta::CPAN

          Burrow($1, $action);
          next;
      }
      eval $action if $action;
    }
    close($filename);
    return 0;
}

# For standard format error msgs - see code for examples.
sub Msg {
    my $key = shift;
    my $type = {W=>'Warning', E=>'Error'}->{$key} if $key;
    my $msg;
    if ($type) {
      $msg = "$prog: $type: @_";
    } else {
      $msg = "$prog: @_";
    }
    chomp $msg;
    return "$msg\n";
}

# Allows the extension writer to make an assertion. If this assertion
# is untrue, dump the current command's usage msg to stderr and exit.
sub Assert {
    my($assertion, @msg) = @_;
    return if $assertion;
    my $op = "";
    for (my $i=1; ((caller($i))[3]) =~ /ClearCase::Wrapper::/; $i++) { 
        $op = (caller($i))[3];
    }
    $op =~ s%.*:%%;
    no strict 'refs';
    my $str = ${$op} || $op || 'help';

    for (@msg) {
      chomp;
      print STDERR Msg('E', $_);
    }
    _helpmsg(STDERR, 1, "help", $op);
}

# Recursive function to find the n'th predecessor of a given version.
sub Pred {
    my($vers, $count, $ct) = @_;
    if ($count) {
      $ct ||= ClearCase::Argv->new;
      (my $elem = $vers) =~ s/@@.*//;
      chomp(my $pred = $ct->desc([qw(-pred -s)], $vers)->qx);
      return Pred("$elem@\@$pred", $count-1, $ct);
    } else {
      return $vers;
    }
}

# Examines supplied arg vector, returns the explicit or implicit working view.
sub ViewTag {
    my $vtag;
    if (@_) {
      local(@ARGV) = @_;
      GetOptions("tag=s" => \$vtag);
    }
    if (!$vtag) {
      require Cwd;
      my $cwd = Cwd::fastgetcwd;
      if (MSWIN) {
          $cwd =~ s/^[A-Z]://i;
          $cwd =~ s%\\%/%g;
      }
      if ($cwd =~ m%/+view/([^/]+)%) {
          $vtag ||= $1;
      }
    }
    if (!$vtag && $ENV{CLEARCASE_ROOT}) {
      $vtag = (split(m%[/\\]%, $ENV{CLEARCASE_ROOT}))[-1];
    }
    $vtag ||= ClearCase::Argv->pwv(['-s'])->qx;
    chomp $vtag if $vtag;
    undef $vtag if $vtag =~ m%\sNONE\s%;
    return $vtag;
}

# Print out the list of elements derived as 'eligible', whatever
# that means for the current op.
sub _ShowFound {
    my $ok = shift;
    my $n = @_;
    my $msg;
    if ($n == 0) {
      $msg = Msg(undef, "no eligible elements found");
    } elsif ($n == 1) {
      $msg = Msg(undef, "found 1 file: @_");
    } elsif ($n <= 10) {
      $msg = Msg(undef, "found $n files: @_");
    } else {
      $msg = Msg(undef, "found $n files: @_[0..3] ...");
    }
    print STDERR $msg;
    # Ask if it's OK to continue, exit if no. Generally results from -ok flag.
    if ($ok && $n) {
      (my $op = (caller(2))[3]) =~ s%.*:%%;
      require ClearCase::ClearPrompt;
      my $a = ClearCase::ClearPrompt::clearprompt(
                      qw(proceed -def p -type ok -pro), "Continue $op?");
      exit 0 unless $a == 0;
    }
}

# Return the list of checked-out elements according to the
# -dir/-rec/-all/-avobs flags. Passes the supplied args to
# lsco, returns the result. The first parameter is a boolean
# indicating whether to give the user an "ok to proceed?"
# prompt; this function may exit if the answer is no.
sub AutoCheckedOut {
    my $ok = shift;
    return () unless @_;
    my @args = @_;
    my @auto = grep /^-(?:dir|rec|all|avo)/, @args;
    return @args unless @auto;
    die Msg('E', "mutually exclusive flags: @auto") if @auto > 1;