view release on metacpan or  search on metacpan

cleartool.plx  view on Meta::CPAN

#!/usr/local/bin/perl -w

use strict;
use warnings;
use vars qw($prog $dieexit $dieexec $diemexec);

# The bulk of the code comes from ClearCase::Wrapper ...
BEGIN {
    # Helpful when discriminating between Windows and good OSes.
    use constant MSWIN => $^O =~ /MSWin32|Windows_NT/i ? 1 : 0;

    # Derive the name we were run as and make it available globally for msgs.
    $prog = $ENV{CLEARCASE_WRAPPER_PROG} || (split m%[/\\]+%, $0)[-1];
    $dieexit = sub { die @_, "\n" };
    $dieexec = sub { die system(@_), "\n" }; #function
    $diemexec = sub { #method: patch after loading
        my $self = shift;
        die $self->system(@_), "\n";
    };
    *Argv::exit = $dieexit;
    *ClearCase::Argv::exit = $dieexit;

    # The "standard" set of overrides supplied with the package.
    # These are autoloaded and thus fairly cheap to read in
    # even though there's lots of code inside.
    if (!$ENV{CLEARCASE_WRAPPER_NATIVE}) {
        *ClearCase::Wrapper::exit = $dieexit;
	*ClearCase::Wrapper::exec = $dieexec;
        require ClearCase::Wrapper;
        {
            no warnings qw(redefine);
            *Argv::exec = $diemexec;
        }
	if ($@) {
	    (my $msg = $@) =~ s%\s*\(.*%!%;
	    warn "$prog: Warning: $msg";
	}
    }
}

sub one_cmd {
    # If Wrapper.pm defines an AutoLoad-ed subroutine to handle $ARGV[0],
    # call it.
    if (!$ENV{CLEARCASE_WRAPPER_NATIVE} && 
            ClearCase::Wrapper::Extension($ARGV[0])) {
	# This provides support for writing extensions.
#	local $^W = 0;
	require ClearCase::Argv;
        {
            no warnings qw(redefine);
            *Argv::exec = $diemexec;
        }
	ClearCase::Argv->VERSION(1.07);
	ClearCase::Argv->attropts; # this is what parses -/dbg=1 et al
	{
	    # "Import" these interfaces in case they're wanted.
	    # Doubled up to suppress a spurious warning.
	    *ClearCase::Wrapper::ctsystem = \&ClearCase::Argv::ctsystem;
	    *ClearCase::Wrapper::ctsystem = \&ClearCase::Argv::ctsystem;
	    *ClearCase::Wrapper::ctexec = \&ClearCase::Argv::ctexec;
	    *ClearCase::Wrapper::ctexec = \&ClearCase::Argv::ctexec;
	    *ClearCase::Wrapper::ctqx = \&ClearCase::Argv::ctqx;
	    *ClearCase::Wrapper::ctqx = \&ClearCase::Argv::ctqx;
	}
	# Convert "ct <cmd> -h" to "ct help <cmd>" for simplicity.
	@ARGV = ('help', $ARGV[0])
	                   if $ARGV[0] ne 'help' && grep(/^-h(elp)?$/, @ARGV);
	# Call the override subroutine ...
	no strict 'refs';
	my $cmd = "ClearCase::Wrapper::$ARGV[0]";
	my $rc = eval { $cmd->(@ARGV) };
	if ($@) {
	    chomp $@; #One extra newline to avoid dumping the stack