view release on metacpan or  search on metacpan

cleartool.dbg  view on Meta::CPAN

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

use strict;
use warnings;
use File::Basename;
use File::Spec::Functions qw(catfile);
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";
	}
	my (%pkg, %seen); #seen functions were overridden: skip next cases
	$pkg{$_}++ for values %ClearCase::Wrapper::ExtMap;
	for (reverse sort keys %pkg) {
	    s%::%/%g;
	    my $as = catfile('auto', $_, 'autosplit.ix');
	    my ($fas) = grep /\Q$as\E$/, keys %INC;
	    die "Could not find $as in \%INC" unless $fas;
	    my $dir = dirname($INC{$fas});
	    opendir DIR, $dir or die "Could not open $dir";
	    for (grep /\.al$/, readdir DIR) {
		next if $seen{$_}++;
		my $f = catfile($dir, $_);
		require $f;
	    }
	    closedir DIR;
	}
    }
}

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.
	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;