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:
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)
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;