—package
OpenInteract::Error;
# $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+)/);
# 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