X-Git-Url: https://defaria.com/gitweb/?a=blobdiff_plain;f=lib%2FClearcase.pm;h=e9b58ff7762273a4ff29ad22d94191c4b2ac0b96;hb=0ef66cf800a95592cb108547021905cc0009b913;hp=bb2b7455c0a85909b52545b4db02863e65dcc31b;hpb=81cbd130706633b1c19ff59371c2ef61d80c562b;p=clearscm.git diff --git a/lib/Clearcase.pm b/lib/Clearcase.pm index bb2b745..e9b58ff 100644 --- a/lib/Clearcase.pm +++ b/lib/Clearcase.pm @@ -80,17 +80,17 @@ use IPC::Open3; use OSDep; use Display; -my ($clearpid, $clearin, $clearout, $oldHandler); +my ($clearpid, $clearin, $clearout, $oldHandler, $cleartool); our $VIEW_DRIVE = 'M'; our $VOB_MOUNT = 'vob'; our $WIN_VOB_PREFIX = '\\'; our $SFX = $ENV{CLEARCASE_XN_SFX} ? $ENV{CLEARCASE_XN_SFX} : '@@'; -our $VOBTAG_PREFIX = ($ARCH eq 'windows' or $ARCH eq 'cygwin') +our $VOBTAG_PREFIX = ($ARCHITECTURE eq 'windows' or $ARCHITECTURE eq 'cygwin') ? $WIN_VOB_PREFIX - : "/$VOB_MOUNT/"; -our $VIEWTAG_PREFIX = ($ARCH eq 'windows' or $ARCH eq 'cygwin') + : "/$VOB_MOUNT"; +our $VIEWTAG_PREFIX = ($ARCHITECTURE eq 'windows' or $ARCHITECTURE eq 'cygwin') ? "$VIEW_DRIVE:" : "${SEPARATOR}view"; @@ -112,15 +112,15 @@ our @EXPORT_OK = qw ( BEGIN { # Find executables that we rely on - if ($ARCH eq 'windows' or $ARCH eq 'cygwin') { + if ($ARCHITECTURE eq 'windows' or $ARCHITECTURE eq 'cygwin') { # Should really go to the registry for this... # We can go to the registry pretty easy in Cygwin but I'm not sure how to do # that in plain old Windows. Most people either have Clearcase installed on # the C drive or commonly on the D drive on servers. So we'll look at both. - $CCHOME = 'C:\\Program Files\\Rational\\Clearcase'; + $CCHOME = 'C:\\IBMRational\\RationalSDLC\\Clearcase'; - $CCHOME = 'D:\\Program Files\\Rational\\Clearcase' + $CCHOME = 'D:\\IBMRational\\RationalSDLC\\Clearcase' unless -d $CCHOME; error 'Unable to figure out where Clearcase is installed', 1 @@ -177,7 +177,7 @@ sub _formatOpts { sub _setComment ($) { my ($comment) = @_; - return !$comment ? '-nc' : '-c "' . quotameta $comment . '"'; + return !$comment ? '-nc' : '-c "' . quotemeta $comment . '"'; } # _setComment sub vobname ($) { @@ -238,7 +238,7 @@ The unique part of the vob name if (substr ($tag, 0, 1) eq '\\') { $name = substr $tag, 1; } elsif (substr ($tag, 0, 1) eq '/') { - if ($tag =~ /${Clearcase::VOBTAG_PREFIX}(.+)/) { + if ($tag =~ /${Clearcase::VOBTAG_PREFIX}\/(.+)/) { $name = $1; } # if } # if @@ -578,13 +578,13 @@ Array of output lines from the cleartool command execution. # installed under /opt/rational/clearcase/bin. This is needed in case we wish # to use these Clearcase objects say in a web page where the server is often # run as a plain user who does not have cleartool in their path. - my $cleartool; - - if ($ARCH =~ /Win/ or $ARCH eq 'cygwin') { - $cleartool = 'cleartool'; - } elsif (-x '/opt/rational/clearcase/bin/cleartool') { - $cleartool = '/opt/rational/clearcase/bin/cleartool'; - } # if + unless ($cleartool) { + if ($ARCHITECTURE =~ /Win/ or $ARCHITECTURE eq 'cygwin') { + $cleartool = 'cleartool'; + } elsif (-x '/opt/rational/clearcase/bin/cleartool') { + $cleartool = '/opt/rational/clearcase/bin/cleartool'; + } # if + } # unless # TODO: Need to catch SIGCHILD here in case the user does something like hit # Ctrl-C. Such an action may interrupt the underlying cleartool process and @@ -593,6 +593,7 @@ Array of output lines from the cleartool command execution. if (!$clearpid) { # Simple check to see if we can execute cleartool @output = `$cleartool -ver 2>&1`; + @output = (); return (-1, 'Clearcase not installed') unless $? == 0; @@ -627,12 +628,53 @@ Array of output lines from the cleartool command execution. pop @output if @output and $output[$#output] eq ''; - $self->{status} = $status; - $self->{output} = join "\n", @output; + $self->{lastcmd} = 'cleartool ' . $cmd; + $self->{status} = $status; + $self->{output} = join "\n", @output; return ($status, @output); } # execute +sub lastcmd() { + my ($self) = @_; + +=pod + +=head2 lastcmd() + +Return last command attempted by execute + +Parameters: + +=for html
+ +=over + +=item none + +=back + +=for html
+ +Returns: + +=for html
+ +=over + +=item Last command attempted by execute + +=back + +=for html
+ +=cut + + $self->{lastcmd} ||= ''; + + return $self->{lastcmd}; +} # lastcmd + sub new { my ($class) = @_;