Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations Chriss Miller on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Code Review - Win32::Carp

Status
Not open for further replies.

Kirsle

Programmer
Joined
Jan 21, 2006
Messages
1,179
Location
US
The other day I started writing this module called Win32::Carp. Its purpose is to redirect warnings and fatal errors to Win32 MsgBoxes.

Here's the test script I have for it:
Code:
use Win32::Carp qw(warnings fatals immediateWarnings);

print "Testing Win32-Carp\n\n";

warn "a pre sleep warning";

warn "another warning";

immediateWarnings(0);

warn "a third warning";

immediateWarnings(1);

warn "a last warning";

warn "one more";
warn "two more";

immediateWarnings(0);

warn "3 more";
warn "4 more";
warn "5 more";
warn "6 more";

die "unexpected error?";

The main use of this module is for "invisible" Perl applications, i.e. ones that don't display a console window and don't use any GUI windows (I have a few of these, for an example, one is an SMTP server, the only way I know it's running is because it has a system tray icon). So this module can pop up fatal errors when such a program crashes, because otherwise I have no way of knowing.

I plan to upload this to CPAN but I want a second pair of eyes to review it and see if they can offer any improvements or spot errors I missed.

Here's the code (minus pod documentation)
Code:
package Win32::Carp;

require 5.000;
use Exporter;
use File::Spec;
use Win32;

BEGIN {
	require Carp;
	*CORE::GLOBAL::die = \&Win32::Carp::die;
}

@ISA = qw(Exporter);
@EXPORT = qw();
@EXPORT_OK = qw(fatals warnings immediateWarnings);

our $DIE = 0;
our $WARN = 0;
our $WAIT = 1;
our @WARNINGS = ();

sub import {
	my $pkg = shift;
	my (%routines);

	grep ($routines{$_}++, @_, @EXPORT);
	$DIE  = 1 if exists $routines{fatals};
	$WARN = 1 if exists $routines{warnings};
	$WAIT = 0 if exists $routines{immediateWarnings};

	my ($oldlevel) = $Exporter::ExportLevel;
	$Exporter::ExportLevel = 1;
	Exporter::import ($pkg, keys %routines);
	$Exporter::ExportLevel = $oldlevel;

	$main::SIG{__DIE__} = \&Win32::Carp::die if exists $routines{fatals};
	$main::SIG{__WARN__} = \&Win32::Carp::warn if exists $routines{warnings};
}

sub realwarn {
	CORE::warn (@_);
}
sub realdie {
	CORE::die (@_);
}

sub warnings {
	if (@_) {
		$WARN = shift;

		if ($WARN) {
			$main::SIG{__WARN__} = \&Win32::Carp::warn;
		}
		else {
			$main::SIG{__WARN__} = \&Win32::Carp::realwarn;
		}
	}
	return $WARN;
}

sub fatals {
	if (@_) {
		$DIE = shift;

		if ($DIE) {
			$main::SIG{__DIE__} = \&Win32::Carp::die;
		}
		else {
			$main::SIG{__DIE__} = \&Win32::Carp::realdie;
		}
	}
	return $DIE;
}

sub immediateWarnings {
	if (@_) {
		$WAIT = shift;
		if ($WAIT) {
			$WAIT = 0;
		}
		else {
			$WAIT = 1;
		}
	}

	if ($WAIT) {
		return 0;
	}
	else {
		return 1;
	}
}

sub id {
	my $level = shift;
	my ($pack,$file,$line,$sub) = caller($level);
	my ($dev,$dirs,$id) = File::Spec->splitpath ($file);
	return ($file,$line,$id);
}

sub warn {
	my (@text) = @_;

	if ($WAIT) {
		push (@WARNINGS, @text);
	}
	else {
		my $title = $0 || 'Win32::Carp';

		foreach (@text) {
			Win32::MsgBox ($_, MB_ICONEXCLAMATION | 0, $title);
		}
	}
}

sub warnmultiple {
	my (@text) = @_;

	my $title = $0 || 'Win32::Carp';

	Win32::MsgBox (join("\n",@text), MB_ICONEXCLAMATION | 0, $title);
}

sub die {
	my (@text) = @_;

	my $title = $0 || 'Win32::Carp';

	foreach (@text) {
		Win32::MsgBox ($_, MB_ICONSTOP | 0, $title);
	}
}

sub END {
	print "DESTROYED! @WARNINGS\n";
	if (@WARNINGS) {
		$WAIT = 0;

		while (@WARNINGS) {
			my @error = ();
			push (@error, shift(@WARNINGS)) if (@WARNINGS);
			push (@error, shift(@WARNINGS)) if (@WARNINGS);
			push (@error, shift(@WARNINGS)) if (@WARNINGS);
			push (@error, shift(@WARNINGS)) if (@WARNINGS);
			push (@error, shift(@WARNINGS)) if (@WARNINGS);

			&Win32::Carp::warnmultiple (@error);
		}
	}
}

1;
 
Code:
            push (@error, shift(@WARNINGS)) if (@WARNINGS);
            push (@error, shift(@WARNINGS)) if (@WARNINGS);
            push (@error, shift(@WARNINGS)) if (@WARNINGS);
            push (@error, shift(@WARNINGS)) if (@WARNINGS);
            push (@error, shift(@WARNINGS)) if (@WARNINGS);

What's this doing, a limit of 5 multiple warnings?


Paul
------------------------------------
Spend an hour a week on CPAN, helps cure all known programming ailments ;-)
 
That code is to show a max of 5 warnings at a time per message box. It's in a while(@WARNINGS) loop, and each loop shifts off @WARNINGS five times until there's nothing left. So if there were 50 warnings throughout the whole program, it will show 5 of them per message box in 10 different boxes.

The reason being, if you put way too much into a MsgBox, you wind up with a really large MsgBox that may take up the whole screen and then some, making it not only annoying but sometimes difficult to find the "Ok" button to the average user who doesn't know that hitting enter will hit the Ok button.

Other than that I couldn't come up with an efficient way to show all the warnings while not being overly annoying.
 
Good answer ;-)

Paul
------------------------------------
Spend an hour a week on CPAN, helps cure all known programming ailments ;-)
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top