view release on metacpan or  search on metacpan

ClearPrompt.pm  view on Meta::CPAN

    my @args = @_;
    my $data;

    return 0 if $ENV{ATRIA_WEB_GUI};	# must assume "" or 0 if ccweb interface

    local $!;	# don't mess up errno in the caller's world.

    # Play back responses from the StashFile if it exists and other conditions
    # are satisfied. It seems that CC sets the series id to all zeroes
    # after an error condition (??) so we avoid that case explicitly.
    my $lineno = (caller)[2];
    my $subtext = "from $prog:$lineno";
    if ($TriggerSeries && $ENV{CLEARCASE_SERIES_ID} &&
				    $ENV{CLEARCASE_SERIES_ID} !~ /^[0:.]+$/) {
	(my $sid = $ENV{CLEARCASE_SERIES_ID}) =~ s%:+%-%g;
	$StashFile = tempname($prog, "CLEARCASE_SERIES_ID=$sid");
	if (!$ENV{CLEARCASE_BEGIN_SERIES} && -f $StashFile) {
	    do $StashFile;
	    if ($ENV{CLEARCASE_END_SERIES} &&
				    !$ENV{CLEARCASE_CLEARPROMPT_KEEP_CAPTURE}) {
		# We delay the unlink due to weird  Windows locking behavior

ClearPrompt.pm  view on Meta::CPAN

	};
	eval "END { endfunc(); }";
    }
}

# This is a pseudo warn() func which is called via the $SIG{__WARN__} hook.
sub cpwarn {
    my @msg = @_;
    # always show line numbers if this dbg flag set
    if ($ENV{CLEARCASE_CLEARPROMPT_SHOW_LINENO}) {
	my($file, $line) = (caller)[1,2];
	chomp $msg[-1];
	push(@msg, " at $file line $line.\n");
    }
    _automail('WARN', "Warning from $prog", @msg);
    if ($ENV{ATRIA_FORCE_GUI} && $Dialogs{WARN}) {
	clearprompt(qw(proceed -type w -mask p -pref -pro), "WARNING\n\n@msg");
	return undef; 	# to keep clearprompt() in void context
    } else {
	warn @msg;
    }
}

# A pseudo die() which can be made to override the caller's builtin.
sub die {
    my @msg = @_;
    # always show line numbers if this dbg flag set
    if ($ENV{CLEARCASE_CLEARPROMPT_SHOW_LINENO}) {
	my($file, $line) = (caller)[1,2];
	chomp $msg[-1];
	push(@msg, " at $file line $line.\n");
    }
    _automail('DIE', "Error from $prog", @msg);
    if ($ENV{ATRIA_FORCE_GUI} && $Dialogs{DIE}) {
	clearprompt(qw(proceed -type e -mask p -pref -pro), "ERROR\n\n@msg");
	exit $! || $?>>8 || 255;	# suppress the msg to stderr
    } else {
	require Carp;
	CORE::die Carp::shortmess(@_);