package Error;

use HTML::Template;
use strict;

sub new {
    my ($class,$file) = @_;
    my $self  = {
        ERRORS => undef,   # this key is a list of hashes
        file   => $file,
    };
    bless $self, $class;
    return $self;
}

sub add_error {

    my ($self,$field,$reason) = @_;
    push @{$self->{ERRORS}}, { 
        FIELD  => $field,
        REASON => $reason,
    };
}

sub generate_errors {
    
    my ($self,$file) = @_;
    return unless &not_empty;
    
    my $template = HTML::Template->new(filename => $self->{file});
    $template->param(
        IS_SINGULAR => (scalar @{$self->{ERRORS}} == 1),
        ERRORS      => $self->{ERRORS},
    );

    @{$self->{ERRORS}} = ();
    return $template->output;
}

sub not_empty {
    my $self = shift;
    return ($self->{ERRORS}) ? (scalar @{$self->{ERRORS}} > 0) : 0;
}

1;
[download]

use Errors;
my $ERROR = Error->new('error.tmpl');

# etc. . . .
 
sub validate_offer_name {

    my $offer_name = strip_spaces($CGI->param('offer_name'));

    unless ($offer_name =~ m/^[A-Za-z]\w*$/) {
        # ERROR - user entered invalid offer name
        $ERROR->add_error('Create New Offer', 'Invalid characters were
+ found');
        go_home();
        return;
    }

    if (&check_existing($DBH,$offer_name)) {
        # ERROR - name already exists
        $ERROR->add_error('Create New Offer', 'That name exists, try a
+gain');
        go_home();
        return;
    }

    # success - valid name that does not exist
    print_create_offer_form($offer_name);
}

sub go_home {

    # if there are no errors, $errors will be undefined
    my $errors = $ERROR->generate_errors;

    my $template = HTML::Template->new(filename => 'home.tmpl');
    $template->param(
        EXISTING_OFFERS     => fetch_all_offers($DBH),
        EXISTING_TRANSPORTS => fetch_all_transports($DBH),
        ERRORS              => $errors,
    );

    print $CGI->header;
    print $template->output;
}
[download]

The following
<TMPL_IF NAME="IS_SINGULAR">
    error was
<TMPL_ELSE>
    errors were
<TMPL_IF>
found:
<TABLE WIDTH="95%">
<TMPL_LOOP NAME=ERRORS>
<TR>
  <TD CLASS=body WIDTH="20%" ALIGN=right>
    <FONT COLOR=red><TMPL_VAR NAME=FIELD></FONT>:
</TD>
  <TD CLASS=body ALIGN=left>
    <TMPL_VAR NAME=REASON>
  </TD>
</TR>
</TMPL_LOOP>
</TABLE>
Please try again
[download]

If using a full-blown object is too much for your needs, just boil the code down to it's basic element - a hash. As you find errors, just shove them into a hash (or an array, but a hash is more flexible), when the time comes to see if any errors were generated - do it once, not each time you check a value.

Tear that apart and build something useful for yourself :)

Jeff

R-R-R--R-R-R--R-R-R--R-R-R--R-R-R--
L-L--L-L--L-L--L-L--L-L--L-L--L-L--

I like the idea of putting the errors in a object, having the storage and the handling in one place, I will definitely have a closer look at your code.

However, a problem with this seems to be that if a package is going to share the same error standard, it would need have it's own instance of the error class. So either I have to check in two places to find my error code, OR I would have to pass my main routine's error object explicitly to each subroutine call, eg:

use Users;
use Error;
my $error = new Error;

($formatted_users = &format(&Users::get_users($filehandle))
  or $error->handle or $Users::error->handle;

====================OR====================
use Users;
use Error;
my $error = new Error;

($formatted_users = &format(&Users::get_users($file_handle,$error)))
        or $error->handle;
[download]

which are both a bit messier than I'd like (although I've supplied a pretty messy example)

If your Users module was object oriented, you could simply pass it a reference to a single Error object. Here is how I would handle your example with the Error module:

package Users;

use strict;

sub new {
    my ($class,$error) = @_;
    my $self  = {
        ERRORS => $error,
        # and maybe even more . . . $fh?
    };
    bless $self, $class;
    return $self;
}

sub get_users {
    my ($self,$fh) = shift;
    # rest of your sub

    # oops, an error happened
    $self->{ERRORS}->add_error('oops','i like vb');
}

# rest of your Users module

package main;

use strict;

use Users;
use Error;

my $ERROR = Error->new();
my $user  = Users->new($ERROR);

$user->foo();
print $ERROR->generate_errors();

# or maybe even
my @stuff = $user->foo() or print $ERROR->generate_errors();
[download]

Also, I really should have included this method below in the Error class. I think it's name explains it's function well enough:

package Error;

sub clear {
    my ($self) = @_;
    $self->{ERRORS} = undef;
}

# rest of Error module
[download]

My original requirements didn't warrant the need for that method, but yours just might.

Jeff

R-R-R--R-R-R--R-R-R--R-R-R--R-R-R--
L-L--L-L--L-L--L-L--L-L--L-L--L-L--

You can die from anywhere in your sub. You can catch an error from a bunch of nested or strung-together calls. You get the message back without having to use return values. And you don't have to deal with the error until any number of layers.

For example:

eval{
  my $a = b();
  $a = c();
  ## etc...
};
if ($@){
  print "This error happened: $@";
  exit;
}

sub a{
  open FILE, $file or die "File open error ($!)";
  ## other similar stuff
}
[download]

-- iakobski

open FILE, ">file.txt" or die $!;
[download]

my $sth = $dbi->prepare("SELECT * FROM TABLE") or die DBi->errstr;
[download]

So I'd say the best way to do it is to make sure you use packages and for each one, create a package-level variable that is to store any error messages. Then your functions should return any defined value if no error occured, or undef if one did, then you can use the typcal  $var=function() or die $msg pattern above. The only gotcha to all this is if 0 or '' is a valid return from a function in addition to undef, in which case you might have to handle the checking via  defined($var=function()) or die $msg.

For this last idea, I'd pass the whole $ERR hashref to the fatal_error function. Up to the function to decide, based on configuration variables (possibly, a --debug command-line option), whether to print something on STDERR, send a email or whatever.

Besides that, have you considered using the exception handling mechanism? Run the code that can cause an error within an eval {} construct. The code in question will simply die should anything go amiss, with a usefull error message or error code. After the eval, you just test whether $@ is true and handle the error depending on its value. e.g.

eval {
    # format_output or get_user may die
    $formatted_users = format_output(get_users($fh));
}
if ( $@ ) {
    # test the value of $@ to know what's been going on.
    die $@
}
[download]

This approach let you separate in distinct blocs the actual code (eval { ... }) and the error handling (if ( $@ ) { ... }).

UPDATE: of course, you still need to come up with a convention about the contents and format of $@.

UPDATE: When testing the value of $@, you can of course choose not to die, but send an email, come up with a reasonable default for the value that failed just to be created, or do whatever you care to handle the error. If you can't figure out what happened by testing on $@, then die $@ so that the error is caught at an upper level, where it might become fatal.

HTH

--bwana147

My gut feeling when I read this was that there was going to be a pretty serious impact on program speed; but assuming my Benchmarking isn't totally silly, there is no significant efficiency loss:

use strict;
use Benchmark;

timethese(100000, {
          'Using Eval'  => 'eval { &test or die }; $@ and warn("maths 
+sux:$@");',
          'using or'    => '(&test) or warn("maths sux:$@");',
});


sub test {
        #A test which always returns true
  for(1..100) {($_>0) || return 0}
  return 1;
}
boldra@trinity:~/workspace$ ./eval_test.pl
Benchmark: timing 100000 iterations of Using Eval, using or...
Using Eval: 10 wallclock secs ( 6.46 usr +  0.06 sys =  6.52 CPU)
  using or: 10 wallclock secs ( 6.28 usr +  0.11 sys =  6.39 CPU)
[download]

It does, however, look pretty messy to (IMHO) do this for every subroutine call, and it doesn't allow me to put non-fatal errors in my subroutines.

You might like to look at the Exception module, which provides a structure similar to the exception handling in C++. It uses a __DIE__ handler, so it also catches regular die() events. Some examples (loosely from the manpage):

# to raise an exception (simply):
 Exception->raise('text');

# to trap exceptions 'foo', /bar/, or 'baz':
 my $err=new Exception 'baz';
 try {
    something_that_could_raise_an_exception();
  } when ['foo', qr/bar/, $err], except {
      shift->croak;
    };
[download]

update:Yes, I meant Exception-1.4. What part didn't match?

That CPAN link points to 45 modules called Exception. Which/whose are you suggesting? (The one called Exception-1.4 doesn't match your example).

How about return 0 for success and non-zero for an error with that non-zero number perhaps being an error code?

my $rc = doThis();
if ( $rc ) {  
  error_routine($rc);  # error_routine handles messaging for various e
+rrors
}
[download]

Here's a few reasons I don't like this:
• I can't return anything but errors (For one thing, I like to assign a meaningful variable name to the output to help explain the purpose of the subroutine)
• The truth value of a subroutine is counter intuitive (The opposite of perl's built-in functions)
• I still have the unreadability of mixing lots of technical error gunk with procedural code.
Thanks for the suggestion anyway :)

Well, I voted you up, for your entry adds some food for thought, but I disagree. Returning 0 on success and an error code in case of failure, that's what the shell works. In a a shell script, you mostly run commands for what they give you on the standard output, which you can pipe into other commands. The return value is merely a side effect, that can only cary a number, and that is perfect for error reporting. To this effect, the truth in Shell is the opposite as in Perl: 0 is true, while everything else is false.

If you want to do the same in Perl, you'd have to cram ! everywhere, which IMHO does not participate to the legibility of your code. And you deprive yourself of the ability of returning a wealth of data, scalars, lists, references from functions.

--bwana147

For example, if an error is fatal, I like to have the sub that generated it 'die' (or croak) right away. If the code is used in a short lived script that's good enough. If it is is something that needs to be more "macho", I'll try to get away with logging, generating caller info, etc by defining my own $SIG{__DIE__} proc in the caller -- that way the sub code stays simple. If I end up calling someone else's package that happens to die, I don't have to wrap it in an eval block just to log the message (i.e. timelocal). (Of course I'll need to use eval if I don't really want it to die.)

Handling non-fatal errors is harder. You could use $SIG{__WARN__} to handle logging them, but you'll still need to do something like your method above of storing off the message somewhere until you finally report it. One way to do this might be to have the $SIG{__WARN__} proc save off the message, without displaying it and then have the caller decide whether or not it's worth reporting.

FWIW, you may want to use "or" instead of "||" in your cases above. It turns code that looks like this...

($a = foo()) || bar();
[download]

$a = foo() or bar();
[download]

So far this looks like the most attractive idea to me.

The code stays very clean, with all the error-handling kept out of the main routine and the loose coupling is certainly a bonus. It also looks like it would work beautifully with Carp for extra verbosity in the errors.

My || usage is just a habit now; I might think about changing it. I do prefer to use the extra brackets though, even if they aren't always needed.

Thanks for the suggestion. If that Serbian contractor hadn't pinched my camel book, I might have figured it out myself :)

  open (FILE, ">>$file") or fail "Couldn't open $file";
[download]

fail then decides how to act, given the string. It can simply log and die, or it can parse the string and warn instead of dying.

This gets slightly messy with multiple modules, but that's eased if you're using OO, so long as fail sits up top in your objects' family tree and you're using $self->fail.

The really tricky thing about this approach is that if you want die/warn to correctly report the line number, you're going to have to play with caller.

But for real power, look into Error.pm, which could be described as an OO eval on steroids.

-- Frag.

In your example, get_users() will return a list of users, and an empty list means there are none. If there is an error of some kind, the caller doesn't need to know just what and how to check. Instead, the system is pro-active and jumps to the error handler. In Perl that's done with die/eval.

—John

Actually, the way my examples would have worked (and it wasn't explicitly spelt out), was that they returned a reference to a list of users. Since assigning a reference to a empty list is true I wouldn't have gotten a false negative by returning an empty list. eg:

@foo = (); 
$bar = \@foo; 
($baz = $bar) 
or warn("assigning a (reference to an empty list) to another scalar is
+ false");
[download]

Of course, what you pointed out is a common gotcha for newbies, and one that I've fallen for a couple of times. Not this time though :)

As I said in reply to bluto's suggestion, I do like the "Exceptional Philosophy", but so far the neatest implementation seems to be signal handling (IMHO).

- Boldra

sub makeclosure {
 my @x=(@_);
 return sub {
  return @x
 }
}
sub yoursubhere{
#do stuff
return makeclosure(val1,val2);
#on error
return bless sub {undef or die},"errormessage";
[download]

if(ref($return=&yoursubhere($a->(),$s->())ne"CODE"){
#error
}
&nextsub($return->())
[download]

This looks really interesting. I wish I could understand more of it!

You lost me just after the closure (which I have read about in The Panther Book, but have never used). Am I right in thinking that the closure creates a place to store return values, and that if a closure is not returned, an error is? Or is the error in the closure? Where exactly? Or is that left up to me?

Boldra

The closure is a holder for a value. You can instead return an error. That is a subref (legally the same as a closure, but not holding a value) that on deref gives a default (including a possibility to leave the program for dead) but is blessed to contain the error and at the same time providing an easy test to distinguish from a closure.