# $Id: Error.pm,v 1.6 2002/01/02 02:43:53 lachoy Exp $
use strict;
$OpenInteract::Error::VERSION = sprintf("%d.%02d", q$Revision: 1.6 $ =~ /(\d+)\.(\d+)/);
use constant DEBUG => 0;
# Collection of error tracking variables -- look ma, no 'use vars'!
$OpenInteract::Error::user_msg = undef;
$OpenInteract::Error::system_msg = undef;
$OpenInteract::Error::type = undef;
$OpenInteract::Error::package = undef;
$OpenInteract::Error::filename = undef;
$OpenInteract::Error::line = undef;
$OpenInteract::Error::method = undef;
$OpenInteract::Error::extra = ();
$OpenInteract::Error::notes = undef;
sub clear {
$OpenInteract::Error::user_msg = undef;
$OpenInteract::Error::system_msg = undef;
$OpenInteract::Error::type = undef;
$OpenInteract::Error::package = undef;
$OpenInteract::Error::filename = undef;
$OpenInteract::Error::line = undef;
$OpenInteract::Error::method = undef;
$OpenInteract::Error::extra = {};
$OpenInteract::Error::notes = undef;
}
# Retrieve all the package variables in a hashref
sub get {
my ( $class ) = @_;
return { user_msg => $OpenInteract::Error::user_msg,
system_msg => $OpenInteract::Error::system_msg,
type => $OpenInteract::Error::type,
package => $OpenInteract::Error::package,
filename => $OpenInteract::Error::filename,
line => $OpenInteract::Error::line,
method => $OpenInteract::Error::method,
extra => $OpenInteract::Error::extra,
notes => $OpenInteract::Error::notes };
}
# Set all package variables
sub set {
my ( $class, $p ) = @_;
no strict 'refs';
# First clean everything up so there's nothing
# hanging around from a previous error
OpenInteract::Error->clear;
# Then set everything passed in
foreach my $key ( keys %{ $p } ) {
warn "OpenInteractI::Error::set >> Setting error $key to $p->{ $key }\n" if ( DEBUG );
${ 'OpenInteract::Error::' . $key } = $p->{ $key };
}
# Set the caller information if the user didn't pass
# anything in
unless ( $p->{package} and $p->{filename} and $p->{line} ) {
( $OpenInteract::Error::package,
$OpenInteract::Error::filename,
$OpenInteract::Error::line ) = caller;
}
return OpenInteract::Error->get;
}
# Class method -- really we just collect the caller info and
# send it over to the error object...
sub throw {
my ( $class, $p ) = @_;
my $R = OpenInteract::Request->instance;
unless ( $p->{package} and $p->{filename} and $p->{line} ) {
my ( $cpkg, $cfile, $cline ) = caller;
$p->{package} = $cpkg;
$p->{filename} = $cfile;
$p->{line} = $cline;
}
my $error_obj_class = $R->CONFIG->{error}{error_object_class} ||
$R->CONFIG->{error_object_class};
return $error_obj_class->throw( $p );
}
1;
__END__
=pod
=head1 NAME
OpenInteract::Error - Provide central holding location for Interact errors
=head1 SYNOPSIS
OpenInteract::Error->set( ... );
$R->throw( ... );
my $ei = OpenInteract::Error->get;
print "Last error message: $ei->{system_msg}\n";
=head1 DESCRIPTION
This class provides a central location for error messages from all
Interact modules. The error information collected in these variables
is guaranteed to result from the most recent error generated by
Interact.
=head1 VARIABLES
All of these variables are package variables, so you refer to them
like this:
$OpenInteract::Error::<variable_name>
$OpenInteract::Error::system_msg
See the L<NOTES> section below for hints on making the error variables
shorter.
B<user_msg> ($)
A generic message that is suitable for showing a user. When telling a
user something went wrong, you do not want to tell them:
execute called with 2 bind variables when 1 are needed
instead, you want to tell them:
Database query failed to execute
This variable is identical to the value thrown by the I<die()>
command, so you do not normally need to refer to it.
B<system_msg> ($)
Even though you do not want to show your users details of the error,
you still need to know them! The variable I<system_msg> gives you
details regarding the error.
B<type> ($)
Interact knows about a few types of errors. Some depend on your Interact
implementation (e.g., DBI, dbm, LDAP, etc.). Others can be:
=over 4
=item *
security: There is a security violation and the action could not be completed.
=item *
config: There was a problem reading/writing configuration information.
=back
B<package> ($)
Set to the package from where the error was thrown.
B<method> ($)
Set to the method from where the error was thrown.
B<filename> ($)
Set to the filename from where the error was thrown.
B<line> ($)
Set to the line number from where the error was thrown.
B<extra> (\%)
Different Interact classes have different information related to the
current request. For instance, DBI errors will typically fill the
'sql' and 'values' keys. Other Interact implementations may use different
keys; see their documentation for details.
=head1 METHODS
B<clear> ()
Clears the current error saved in the class. Classes outside the
B<OpenInteract::> hierarchy should never need to call this.
No return value.
B<get()>
Returns a hashref with all the currently set error values.
B<set( \%params )>
First clears the variables then sets them all in one fell swoop. The
variables that are set are passed in the first argument, a
hashref. (See L<VARIABLES> for the names and purposes.) Also sets both
the package and method variables for you, although you can override by
setting manually.
No return value;
B<throw( \%params )>
Throws an error from anywhere in the system. Kept for backward
compatibility -- most of the time you will use:
$R->throw( ... );
We simply pass the parameters (with any caller info) to the method by
the same name in the error object class.
=head1 NOTES
Some people might find it easier to alias a local package variable to
an OpenInteract error variable. For instance, you can do:
*err_user_msg = \$OpenInteract::Error::user_msg;
*err_system_msg = \$OpenInteract::Error::system_msg;
*err_type = \$OpenInteract::Error::type;
*err_extra = \%OpenInteract::Error::extra;
And then refer to the alias in your local package:
my $obj_list = eval { $obj->fetch_group( { where => 'this = that' } ) };
if ( $@ ) {
warn "Error found! Error: $@\n",
"Error type: $err_type\n",
"More specific: $err_system_msg\n",
"Extra stuff:\n",
"--$err_extra{sql}\n",
"--$err_extra{values}\n";
}
=head1 TO DO
Nothing known.
=head1 BUGS
None known.
=head1 COPYRIGHT
Copyright (c) 2001-2002 intes.net, inc.. All rights reserved.
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
=head1 AUTHORS
Chris Winters <chris@cwinters.com>
=cut