Catching errors with both mod_cgi & mod_perl - perl

Thanks to everyone in advance.
I've been doing some research on error handling and I don't feel like I'm getting a solid understanding of what I should do.
Preamble: My code is living in Apache and executed in the browser, my goals don't include command line execution.
I'd like to have the behavior of CGI::Carp (fatalsToBrowser) with the ability to capture the output and be able to throw it in my own templated page, email it etc... I did notice that fatalsToBrowser doesn't work with mod_perl. Does anyone know why? How is Apache/mod_perl getting in the way?
First Goal: I'd like to put something together that works if the code is being executed with mod_perl or mod_cgi.
Second Goal: I'd like to have a high-level method(s) that catches all the errors similar to .NET's Application_Error (in global.asax) and PHP's set_exception_handler() and set_error_handler() methods. These allow you to take control when an error is raised, without wrapping code in messy/gross try-catch statements.
Things I've read/reviewed:
1.) OO Exception Handling in Perl, but wasn't what I was looking for. Most of the stuff I want to catch is die()ing. The next link also says that this article is out of date and deprecated.
2.) Perl: $SIG{__DIE__}, eval { } and stack trace, but I didn't get much from this related to my goals.
3.) Practical Mode Perl (O'Reilly), Chapter 21 "Error Handling and Debugging". Thankfully all my perl code uses strict and warnings are enabled, and most important things mentioned in Chapter 6 "Coding with mod_perl in Mind" are already done.
4.) I've dug through the tables of contents in "Learning Perl", "Perl Cookbook", "Programming Perl" and "Higher Order Perl" and didn't see anything that stuck out at me. If you think I missed something there please let me know. :)
I don't remember where (maybe in "Practical mod_perl", but I've read that you should not mess with $SIG{__DIE__}.

Have you read the mod_perl website's bit on Alternative Exception Handling Techniques? It discusses about how you can catch uncaught exceptions though the use of overriding the global die() function instead of using $SIG{__DIE__}. A much cleaner method but not perfect.

What type of errors are you trying to catch? Are custom error pages not sufficient for your purposes?
My CGI scripts are short (OK, this is really bare bones — and untested):
#!/usr/bin/perl
use strict;
use warnings;
use My::App;
use My::ErrorReporter qw( error_to_html );
run();
sub run {
my $app = eval {
My::App->new(
'some_param',
'another_param',
)
};
unless ( $app ) {
print error_to_html( $# );
return;
}
eval {
$app->handle_request;
} and return;
print error_to_html( $# );
return;
}
__END__
Now, fatalsToBrowser is not for your users. That is a development aid for you. The error messages users see should not convey information about the program. So, for example, in a routine that opens and reads a configuration file, you should do something like:
sub read_my_config {
my $self = shift;
open my $config_h, '<', $self->config_file;
unless ( $config_h ) {
# This goes to the Apache error log where you can read it
warn sprintf(
"Cannot open '%s': %s",
$self->config_file, $!
);
# This is for web site visitors to see
die "Cannot open configuration file";
}
# rest of the code
}

Related

How to properly use the try catch in perl that error.pm provides?

I have found that there is the module Error that provides try and catch functionality like in java. But I am confused at how you can print the exception that returns.
I would like to understand how to do the following
try {
// do something that will fail!
} catch (Error e) {
// Print out the exception that occurred
System.out.println(e.getMessage());
}
How do I get the print of the error with the stack trace?
You're probably better off using Try::Tiny which will help you avoid a number of pitfalls with older perls.
use Try::Tiny;
try {
die "foo";
} catch {
warn "caught error: $_";
};
Last I checked, Error was deprecated. But here's how you would do it without that module:
eval {
die "Oops!";
1;
} or do {
my $e = $#;
print("Something went wrong: $e\n");
};
Basically, use eval instead of try, die instead of throw, and look for the exception in $#. The true value at the end of the eval block is part of an idiom to prevent $# from unintentionally changing before it is used again in Perl versions older than 5.14, see P::C::P::ErrorHandling::RequireCheckingReturnValueOfEval for details. For example, this code suffers from this flaw.
# BAD, DO NOT USE WITH PERLS OLDER THAN 5.14
eval {
die "Oops!";
};
if (my $e = $#) {
print("Something went wrong: $e\n");
}
# BAD, DO NOT USE WITH PERLS OLDER THAN 5.14
But note that many Perl operations do not raise exceptions when they fail; they simply return an error code. This behavior can be altered via autodie for builtins and standard modules. If you're using autodie, then the standard way of doing try/catch is this (straight out of the autodie perldoc):
use feature qw(switch);
eval {
use autodie;
open(my $fh, '<', $some_file);
my #records = <$fh>;
# Do things with #records...
close($fh);
};
given ($#) {
when (undef) { say "No error"; }
when ('open') { say "Error from open"; }
when (':io') { say "Non-open, IO error."; }
when (':all') { say "All other autodie errors." }
default { say "Not an autodie error at all." }
}
For getting a stacktrace, look at Carp.
If you want something a bit more powerful than Try::Tiny, you might want to try looking at the TryCatch module in CPAN.
Native try/catch/finally.
Perl now has native support for try/catch/finally. You can use it like this. As of Perl v5.36, It's currently experimental.
use experimental "try";
try { die 42 }
catch ($err) {
print "got $err"
}
Unfortunately TryCatch has been broken with the new version 0.006020 of Devel::Declare and there seems to be no intention of fixing it. The perl core developers team also complained about the funky stuff TryCatch was relying on to make it work.
Instead there is a new implementation called Nice::Try, which is a perfect replacement.
There is no need to have semi colon on the last brace like Try::Tiny.
You can also do exception variable assignment like
try
{
# something
}
catch( $e )
{
# catch this in $e
}
It also works using class exception like
try
{
# something
}
catch( Exception $e )
{
# catch this in $e
}
And it also supports finally. Its features set make it quite unique.
Full disclosure: I have developed this module when TryCatch got broken.
IMHO Syntax::Keyword::Try is a better option than Try::Tiny for most cases.
Try::Tiny is an order of magnitude slower than either eval or Syntax::Keyword::Try. It depends on your application if this is a problem or not. For many applications its not important.
Also if you are a visitor from another language, Try::Tiny has syntax quirks which make it not quite the try/catch you are used to.
As has been said, the old Error module is deprecated, but it has continued to work for me long after. It's been a while since I last checked if its still working. I tried some of the "better" replacements and found them all lacking, so I still use Error.
Here's a sample from some code that's pretty straight forward and prints the error that was caught. This is from an app I wrote that uses Storable to store and retrieve serialized perl objects to an MLDBM backend file.
use Error(':try');
...
try {
$obj = retrieve( $objfile );
} catch Error::Simple with {
my $E = shift;
warn "Caught error $E";
};
This returns a message something like:
Caught error Not a HASH reference at ./json2text.pl line 12.
If you want the full stack trace, you can either run the code under the debugger, or you can read about the stacktrace method on the perldoc for the Error class itself. I never found it necessary to have apps not running under the debugger to print full stack traces, so I don't have any examples of that in my collection to paste a sample from.
I hope this helps. Sometimes you just have to wait for a dinosaur to show up.

Perl module loading - Safeguarding against: perhaps you forgot to load "Bla"?

When you run perl -e "Bla->new", you get this well-known error:
Can't locate object method "new" via package "Bla"
(perhaps you forgot to load "Bla"?)
Happened in a Perl server process the other day due to an oversight of mine. There are multiple scripts, and most of them have the proper use statements in place. But there was one script that was doing Bla->new in sub blub at line 123 but missing a use Bla at the top, and when it was hit by a click without any of the other scripts using Bla having been loaded by the server process before, then bang!
Testing the script in isolation would be the obvious way to safeguard against this particular mistake, but alas the code is dependent upon a humungous environment. Do you know of another way to safeguard against this oversight?
Here's one example how PPI (despite its merits) is limited in its view on Perl:
use strict;
use HTTP::Request::Common;
my $req = GET 'http://www.example.com';
$req->headers->push_header( Bla => time );
my $au=Auweia->new;
__END__
PPI::Token::Symbol '$req'
PPI::Token::Operator '->'
PPI::Token::Word 'headers'
PPI::Token::Operator '->'
PPI::Token::Word 'push_header'
PPI::Token::Symbol '$au'
PPI::Token::Operator '='
PPI::Token::Word 'Auweia'
PPI::Token::Operator '->'
PPI::Token::Word 'new'
Setting the header and assigning the Auweia->new parse the same. So I'm not sure how you can build upon such a shaky foundation. I think the problem is that Auweia could also be a subroutine; perl.exe cannot tell until runtime.
Further Update
Okay, from #Schwern's instructive comments below I learnt that PPI is just a tokenizer, and you can build upon it if you accept its limitations.
Testing is the only answer worth the effort. If the code contains mistakes like forgetting to load a class, it probably contains other mistakes. Whatever the obstacles, make it testable. Otherwise you're patching a sieve.
That said, you have two options. You can use Class::Autouse which will try to load a module if it isn't already loaded. It's handy, but because it affects the entire process it can have unintended effects.
Or you can use PPI to scan your code and find all the class method calls. PPI::Dumper is very handy to understand how PPI sees Perl.
use strict;
use warnings;
use PPI;
use PPI::Dumper;
my $file = shift;
my $doc = PPI::Document->new($file);
# How PPI sees a class method call.
# PPI::Token::Word 'Class'
# PPI::Token::Operator '->'
# PPI::Token::Word 'method'
$doc->find( sub {
my($node, $class) = #_;
# First we want a word
return 0 unless $class->isa("PPI::Token::Word");
# It's not a class, it's actually a method call.
return 0 if $class->method_call;
my $class_name = $class->literal;
# Next to it is a -> operator
my $op = $class->snext_sibling or return 0;
return 0 unless $op->isa("PPI::Token::Operator") and $op->content eq '->';
# And then another word which PPI identifies as a method call.
my $method = $op->snext_sibling or return 0;
return 0 unless $method->isa("PPI::Token::Word") and $method->method_call;
my $method_name = $method->literal;
printf "$class->$method_name seen at %s line %d.\n", $file, $class->line_number;
});
You don't say what server enviroment you're running under, but from what you say it sounds like you could do with preloading all your modules in advance before executing any individual pages. Not only would this prevent the problems you're describing (where every script has to remember to load all the modules it uses) but it would also save you memory.
In pre-forking servers (as is commonly used with mod_perl and Apache) you really want to load as much of your code before your server forks for the first time so that the code is stored once in copy-on-write shared memory rather than mulitple times in each child process when it is loaded on demand.
For information on pre-loading in Apache, see the section of Practical mod_perl

Is there a tool for extracting all variable, module, and function names from a Perl module file?

My apologies if this is a duplicate; I may not know the proper terms to search for.
I am tasked with analyzing a Perl module file (.pm) that is a fragment of a larger application. Is there a tool, app, or script that will simply go through the code and pull out all the variable names, module names, and function calls? Even better would be something that would identify whether it was declared within this file or is something external.
Does such a tool exist? I only get the one file, so this isn't something I can execute -- just some basic static analysis I guess.
Check out the new, but well recommended Class::Sniff.
From the docs:
use Class::Sniff;
my $sniff = Class::Sniff->new({class => 'Some::class'});
my $num_methods = $sniff->methods;
my $num_classes = $sniff->classes;
my #methods = $sniff->methods;
my #classes = $sniff->classes;
{
my $graph = $sniff->graph; # Graph::Easy
my $graphviz = $graph->as_graphviz();
open my $DOT, '|dot -Tpng -o graph.png' or die("Cannot open pipe to dot: $!");
print $DOT $graphviz;
}
print $sniff->to_string;
my #unreachable = $sniff->unreachable;
foreach my $method (#unreachable) {
print "$method\n";
}
This will get you most of the way there. Some variables, depending on scope, may not be available.
If I understand correctly, you are looking for a tool to go through Perl source code. I am going to suggest PPI.
Here is an example cobbled up from the docs:
#!/usr/bin/perl
use strict;
use warnings;
use PPI::Document;
use HTML::Template;
my $Module = PPI::Document->new( $INC{'HTML/Template.pm'} );
my $sub_nodes = $Module->find(
sub { $_[1]->isa('PPI::Statement::Sub') and $_[1]->name }
);
my #sub_names = map { $_->name } #$sub_nodes;
use Data::Dumper;
print Dumper \#sub_names;
Note that, this will output:
...
'new',
'new',
'new',
'output',
'new',
'new',
'new',
'new',
'new',
...
because multiple classes are defined in HTML/Template.pm. Clearly, a less naive approach would work with the PDOM tree in a hierarchical way.
Another CPAN tools available is Class::Inspector
use Class::Inspector;
# Is a class installed and/or loaded
Class::Inspector->installed( 'Foo::Class' );
Class::Inspector->loaded( 'Foo::Class' );
# Filename related information
Class::Inspector->filename( 'Foo::Class' );
Class::Inspector->resolved_filename( 'Foo::Class' );
# Get subroutine related information
Class::Inspector->functions( 'Foo::Class' );
Class::Inspector->function_refs( 'Foo::Class' );
Class::Inspector->function_exists( 'Foo::Class', 'bar' );
Class::Inspector->methods( 'Foo::Class', 'full', 'public' );
# Find all loaded subclasses or something
Class::Inspector->subclasses( 'Foo::Class' );
This will give you similar results to Class::Sniff; you may still have to do some processing on your own.
There are better answers to this question, but they aren't getting posted, so I'll claim the fastest gun in the West and go ahead and post a 'quick-fix'.
Such a tool exists, in fact, and is built into Perl. You can access the symbol table for any namespace by using a special hash variable. To access the main namespace (the default one):
for(keys %main::) { # alternatively %::
print "$_\n";
}
If your package is named My/Package.pm, and is thus in the namespace My::Package, you would change %main:: to %My::Package:: to achieve the same effect. See the perldoc perlmod entry on symbol tables - they explain it, and they list a few alternatives that may be better, or at least get you started on finding the right module for the job (that's the Perl motto - There's More Than One Module To Do It).
If you want to do it without executing any code that you are analyzing, it's fairly easy to do this with PPI. Check out my Module::Use::Extract; it's a short bit of code shows you how to extract any sort of element you want from PPI's PerlDOM.
If you want to do it with code that you have already compiled, the other suggestions in the answers are better.
I found a pretty good answer to what I was looking for in this column by Randal Schwartz. He demonstrated using the B::Xref module to extract exactly the information I was looking for. Just replacing the evaluated one-liner he used with the module's filename worked like a champ, and apparently B::Xref comes with ActiveState Perl, so I didn't need any additional modules.
perl -MO=Xref module.pm

How can I override Perl's open() function but use the same filehandle for testing?

I am currently adding some unit tests to some legacy code and I find myself with the need to override an open function. The live code looks something like this.
if ( !open( F, $filetoopen) ){
# do stuff with <F>
}
What I want to do is make sure that "F" contains a file handle that I have provided from my tests rather than what it thinks its opening.
I have the following code in my .t file...
BEGIN {
*CORE::GLOBAL::open = sub { open(F,$testfiletoopen); };
};
... it does work and the code in test finishes up reading from my test file. However it will only continue to work as long as I use the same filehandle name "F" as the code in test.
If there a way to make this test code less fragile so that if the filehandle name is changed in the live code the test won't fail?
Thanks
Why don't you simply use the parameters your live code provides to open?
BEGIN {
*CORE::GLOBAL::open = sub { open $_[0], $newfilename };
};
Keep in mind that this will break horribly as soon as you use the three-argument-form of open. If anything, this question offers yet more prove that the three-argument version is superior.

How can I fix the "Couldn't create file parser context for file ..." bug with Perl libxml on Debian?

When I try to read an XML file with XML::Simple, sometimes I get this error message:
Couldn't create file parser context for file ...
After some googling, it seems to be a problem with libxml-libxml-perl and is supposed to be fixed in the version I use (1.59-2).
Any ideas?
Edit: (code)
sub Read
{
my ($file, $no_option) = #_;
my %XML_INPUT_OPTIONS = ( KeyAttr => [], ForceArray => 1 );
if ((defined $file) && (-f $file))
{
my #stats = stat($file);
if ((defined $XML_CACHE{$file})
&& ($stats[9] == $XML_CACHE{$file}{modif_time}))
{
return ($XML_CACHE{$file}{xml});
}
else
{
my $xml = eval { XMLin($file,
(defined $no_option ? () : %XML_INPUT_OPTIONS)) };
AAT::Syslog("AAT::XML", "XML_READ_ERROR", $#) if ($#);
$XML_CACHE{$file}{modif_time} = $stats[9];
$XML_CACHE{$file}{xml} = $xml;
return ($xml);
}
}
return (undef);
}
And yes, I should & will use XML::Simple cache feature...
Does the error continue "No such file or directory at..."? If so, then I think that the problem is that (for whatever reason) when you get to that point in the script, whatever you are passing to XML::Simple has no xml file in it. Long story short, the script you are using may be passing a bad variable (blank? empty?) to XML::Simple at which point the module chokes. To debug, add a check on whatever you hand to XML::Simple before you pass it along. (See the next paragraph for a concrete example explaining why I think this may be your problem.)
A few months ago, I had a similar problem with Weather::Google. In a nutshell, the weather module was trying to get data from Google via LWP::Simple without a user agent. Google began (apparently) to reject requests without a user agent. I had to backtrack through the modules because the error appeared to come from XML::Simple. In fact, it was caused by what was done in LWP::Simple and Weather::Google. Or rather, the error was a result of Weather::Google not checking the data that was in an object created via LWP::Simple. In a case like this, it can be hard at first to see what's going wrong and where.