in reply to style for returning errors from subroutines

How about a 'global' errors hash. Here is a little module that i used on an HTML::Template application, particularly, did the user correctly fill out the form: 
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]
And a client uses it like so: 
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 error template is included by all other templates and looks like this: 
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]
That's a lot of code to chew on - but i wanted to give you something that actually worked. The idea is to use a class to collect all the errors. After all possible user errors have been tested, any failures will be stored in the Error object. Then, you just tell the object to generate it's errors - if there are none, nothing happens, otherwise, in this case, the errors are reported back to the user along with the form that they failed to fill out correctly.

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--

Replies are listed 'Best First'.
Re: (jeffa) Re: style for returning errors from subroutines
by Boldra (Curate) on Jun 14, 2001 at 20:07 UTC
    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)
[reply]
[d/l]
      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--
[reply]
[d/l]
[select]

In Section Seekers of Perl Wisdom