r35057 - in /branches/upstream/libexception-class-perl/current: Changes MANIFEST META.yml SIGNATURE lib/Exception/Class.pm lib/Exception/Class/ lib/Exception/Class/Base.pm t/basic.t
ansgar-guest at users.alioth.debian.org
ansgar-guest at users.alioth.debian.org
Fri May 8 23:52:30 UTC 2009
Author: ansgar-guest
Date: Fri May 8 23:52:26 2009
New Revision: 35057
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=35057
Log:
[svn-upgrade] Integrating new upstream version, libexception-class-perl (1.29)
Added:
branches/upstream/libexception-class-perl/current/lib/Exception/Class/
branches/upstream/libexception-class-perl/current/lib/Exception/Class/Base.pm
Modified:
branches/upstream/libexception-class-perl/current/Changes
branches/upstream/libexception-class-perl/current/MANIFEST
branches/upstream/libexception-class-perl/current/META.yml
branches/upstream/libexception-class-perl/current/SIGNATURE
branches/upstream/libexception-class-perl/current/lib/Exception/Class.pm
branches/upstream/libexception-class-perl/current/t/basic.t
Modified: branches/upstream/libexception-class-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libexception-class-perl/current/Changes?rev=35057&op=diff
==============================================================================
--- branches/upstream/libexception-class-perl/current/Changes (original)
+++ branches/upstream/libexception-class-perl/current/Changes Fri May 8 23:52:26 2009
@@ -1,3 +1,19 @@
+1.29 May 8, 2009
+
+- Make sure that there is only one line that the toolchain can pick up
+ when looking for this module's $VERSION.
+
+
+1.28 May 6, 2009
+
+* Removed Exception::Class::Base->do_trace and ->NoObjectRefs, both of
+ which have been undocumented for many years.
+
+- Moved Exception::Class::Base to its own file, so it doesn't
+ overwrite the $VERSION in Exception::Class (and for general
+ sanity). Reported by Kirk Baucom.
+
+
1.27 May 4, 2009
* The error message for an exception no longer defaults to $!. This
Modified: branches/upstream/libexception-class-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libexception-class-perl/current/MANIFEST?rev=35057&op=diff
==============================================================================
--- branches/upstream/libexception-class-perl/current/MANIFEST (original)
+++ branches/upstream/libexception-class-perl/current/MANIFEST Fri May 8 23:52:26 2009
@@ -2,6 +2,7 @@
Build.PL
Changes
lib/Exception/Class.pm
+lib/Exception/Class/Base.pm
LICENSE
Makefile.PL
MANIFEST This list of files
Modified: branches/upstream/libexception-class-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libexception-class-perl/current/META.yml?rev=35057&op=diff
==============================================================================
--- branches/upstream/libexception-class-perl/current/META.yml (original)
+++ branches/upstream/libexception-class-perl/current/META.yml Fri May 8 23:52:26 2009
@@ -1,8 +1,8 @@
---
name: Exception-Class
-version: 1.27
+version: 1.29
author:
- - 'Dave Rolsky, <autarch at urth.org>'
+ - 'Dave Rolsky, E<gt>autarch at urth.orgE<lt>'
abstract: A module that allows you to declare real exception classes in Perl
license: perl
resources:
@@ -17,10 +17,10 @@
provides:
Exception::Class:
file: lib/Exception/Class.pm
- version: 1.27
+ version: 1.29
Exception::Class::Base:
- file: lib/Exception/Class.pm
- version: 1.2
+ file: lib/Exception/Class/Base.pm
+ version: 1.20
generated_by: Module::Build version 0.32
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.2.html
Modified: branches/upstream/libexception-class-perl/current/SIGNATURE
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libexception-class-perl/current/SIGNATURE?rev=35057&op=diff
==============================================================================
--- branches/upstream/libexception-class-perl/current/SIGNATURE (original)
+++ branches/upstream/libexception-class-perl/current/SIGNATURE Fri May 8 23:52:26 2009
@@ -16,13 +16,14 @@
SHA1 5f0d8c63d57e17a4fd71f16253c4199459fbf78c .shipit
SHA1 cddc6c2496a35c0fbc8be01e0026abdf01d81165 Build.PL
-SHA1 68859fceab4295913294dc2ff322c1d760cccb64 Changes
+SHA1 e40686366802fbe2ce894ba71bcd4d9e406db36a Changes
SHA1 f235ba4160673bcb7c9d58c2f09dbc7fc0efadea LICENSE
-SHA1 e1326666ba4000b34cf057dbd3d807acb92ed2d9 MANIFEST
-SHA1 ec5197edc4993d7a5380c6480352e9ae9bb32836 META.yml
+SHA1 23c99bd3e732dcf46172dba3bdf9924073bba79e MANIFEST
+SHA1 1deb8fee646695e0cdf64bdeae384af671b83f14 META.yml
SHA1 39708f6431bd5b45268b7728ee1f4e713b68a965 Makefile.PL
-SHA1 d59f1c0d24fcfb615dc6ce6359fd580a0f411964 lib/Exception/Class.pm
-SHA1 cec61865b88cb8e9ce8b9a5e930e85c44142dd2e t/basic.t
+SHA1 7ab0d98d16332249ee8e2fcfd25abc8738ed1651 lib/Exception/Class.pm
+SHA1 b1cb734e49381f006225771643f0004ad42eb133 lib/Exception/Class/Base.pm
+SHA1 cc15e4261598af96bc997c1ec7c56e6113a8e2a1 t/basic.t
SHA1 58af03881eb473337b01aa4f07469e86d2090d8d t/caught.t
SHA1 d6e425dcfb12707a1a33c0592641dbf5dd558370 t/ignore.t
SHA1 9de9dfd55e96087b41493345c1bb756529661124 t/pod-coverage.t
@@ -30,7 +31,7 @@
-----BEGIN PGP SIGNATURE-----
Version: GnuPG v1.4.9 (GNU/Linux)
-iEYEARECAAYFAkn/ZuYACgkQ3Or3ZzQuifMgXwCgmsRNV/NRM4mAWEDjbC52DQ54
-WIsAniuXPKEwuNqmsYMFwQnyaaJQdbHc
-=UuW2
+iEYEARECAAYFAkoC6N8ACgkQ3Or3ZzQuifN0HwCfVGMNvm103hPzVLlMI29DbpKx
+XcQAoNhSOR5xS4V8pae7UOvEwvaT914e
+=oxIN
-----END PGP SIGNATURE-----
Modified: branches/upstream/libexception-class-perl/current/lib/Exception/Class.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libexception-class-perl/current/lib/Exception/Class.pm?rev=35057&op=diff
==============================================================================
--- branches/upstream/libexception-class-perl/current/lib/Exception/Class.pm (original)
+++ branches/upstream/libexception-class-perl/current/lib/Exception/Class.pm Fri May 8 23:52:26 2009
@@ -4,12 +4,13 @@
use strict;
+use Exception::Class::Base;
use Scalar::Util qw(blessed);
our $BASE_EXC_CLASS;
BEGIN { $BASE_EXC_CLASS ||= 'Exception::Class::Base'; }
-our $VERSION = '1.27';
+our $VERSION = '1.29';
our %CLASSES;
@@ -119,14 +120,14 @@
}
$isa ||= $BASE_EXC_CLASS;
+ my $version_name = 'VERSION';
+
my $code = <<"EOPERL";
package $subclass;
-use vars qw(\$VERSION);
-
use base qw($isa);
-\$VERSION = '1.1';
+our \$$version_name = '1.1';
1;
@@ -186,224 +187,6 @@
}
sub Classes { sort keys %Exception::Class::CLASSES }
-
-package Exception::Class::Base;
-
-use Class::Data::Inheritable;
-use Devel::StackTrace 1.20;
-
-use base qw(Class::Data::Inheritable);
-
-BEGIN
-{
- __PACKAGE__->mk_classdata('Trace');
- *do_trace = \&Trace;
- __PACKAGE__->mk_classdata('NoRefs');
- *NoObjectRefs = \&NoRefs;
- __PACKAGE__->NoRefs(1);
-
- __PACKAGE__->mk_classdata('RespectOverload');
- __PACKAGE__->RespectOverload(0);
-
- __PACKAGE__->mk_classdata('MaxArgLength');
- __PACKAGE__->MaxArgLength(0);
-
- sub Fields { () }
-}
-
-use overload
- # an exception is always true
- bool => sub { 1 },
- '""' => 'as_string',
- fallback => 1;
-
-use vars qw($VERSION);
-
-$VERSION = '1.2';
-
-# Create accessor routines
-BEGIN
-{
- my @fields = qw( message pid uid euid gid egid time trace );
-
- foreach my $f (@fields)
- {
- my $sub = sub { my $s = shift; return $s->{$f}; };
-
- no strict 'refs';
- *{$f} = $sub;
- }
- *error = \&message;
-
- my %trace_fields =
- ( package => 'package',
- file => 'filename',
- line => 'line',
- );
-
- while ( my ( $f, $m ) = each %trace_fields )
- {
- my $sub = sub
- {
- my $s = shift;
- return $s->{$f} if exists $s->{$f};
-
- my $frame = $s->trace->frame(0);
-
- return $s->{$f} = $frame ? $frame->$m() : undef;
- };
- no strict 'refs';
- *{$f} = $sub;
- }
-}
-
-1;
-
-sub Classes { Exception::Class::Classes() }
-
-sub throw
-{
- my $proto = shift;
-
- $proto->rethrow if ref $proto;
-
- die $proto->new(@_);
-}
-
-sub rethrow
-{
- my $self = shift;
-
- die $self;
-}
-
-sub new
-{
- my $proto = shift;
- my $class = ref $proto || $proto;
-
- my $self = bless {}, $class;
-
- $self->_initialize(@_);
-
- return $self;
-}
-
-sub _initialize
-{
- my $self = shift;
- my %p = @_ == 1 ? ( error => $_[0] ) : @_;
-
- $self->{message} = $p{message} || $p{error} || '';
-
- $self->{show_trace} = $p{show_trace} if exists $p{show_trace};
-
- # CORE::time is important to fix an error with some versions of
- # Perl
- $self->{time} = CORE::time();
- $self->{pid} = $$;
- $self->{uid} = $<;
- $self->{euid} = $>;
- $self->{gid} = $(;
- $self->{egid} = $);
-
- my @ignore_class = (__PACKAGE__);
- my @ignore_package = 'Exception::Class';
-
- if ( my $i = delete $p{ignore_class} )
- {
- push @ignore_class, ( ref($i) eq 'ARRAY' ? @$i : $i );
- }
-
- if ( my $i = delete $p{ignore_package} )
- {
- push @ignore_package, ( ref($i) eq 'ARRAY' ? @$i : $i );
- }
-
- $self->{trace} =
- Devel::StackTrace->new( ignore_class => \@ignore_class,
- ignore_package => \@ignore_package,
- no_refs => $self->NoRefs,
- respect_overload => $self->RespectOverload,
- max_arg_length => $self->MaxArgLength,
- );
-
- my %fields = map { $_ => 1 } $self->Fields;
- while ( my ($key, $value) = each %p )
- {
- next if $key =~ /^(?:error|message|show_trace)$/;
-
- if ( $fields{$key})
- {
- $self->{$key} = $value;
- }
- else
- {
- Exception::Class::Base->throw
- ( error =>
- "unknown field $key passed to constructor for class " . ref $self );
- }
- }
-}
-
-sub description
-{
- return 'Generic exception';
-}
-
-sub show_trace
-{
- my $self = shift;
-
- if (@_)
- {
- $self->{show_trace} = shift;
- }
-
- return exists $self->{show_trace} ? $self->{show_trace} : $self->Trace;
-}
-
-sub as_string
-{
- my $self = shift;
-
- my $str = $self->full_message;
- $str .= "\n\n" . $self->trace->as_string
- if $self->show_trace;
-
- return $str;
-}
-
-sub full_message { $_[0]->{message} }
-
-#
-# The %seen bit protects against circular inheritance.
-#
-eval <<'EOF' if $] == 5.006;
-sub isa
-{
- my ($inheritor, $base) = @_;
- $inheritor = ref($inheritor) if ref($inheritor);
-
- my %seen;
-
- no strict 'refs';
- my @parents = ($inheritor, @{"$inheritor\::ISA"});
- while (my $class = shift @parents)
- {
- return 1 if $class eq $base;
-
- push @parents, grep {!$seen{$_}++} @{"$class\::ISA"};
- }
- return 0;
-}
-EOF
-
-sub caught
-{
- return Exception::Class->caught(shift);
-}
-
1;
@@ -465,7 +248,7 @@
It features a simple interface allowing programmers to 'declare'
exception classes at compile time. It also has a base exception
-class, Exception::Class::Base, that can be easily extended.
+class, L<Exception::Class::Base>, that can be easily extended.
It is designed to make structured exception handling simpler and
better by encouraging people to use hierarchies of exceptions in their
@@ -475,10 +258,14 @@
"OTHER EXCEPTION MODULES (try/catch syntax)" section for more
information on how to get this syntax.
+You will also want to look at the documentation for
+L<Exception::Class::Base>, which is the default base class for all
+exception objects created by this module.
+
=head1 DECLARING EXCEPTION CLASSES
Importing C<Exception::Class> allows you to automagically create
-C<Exception::Class::Base> subclasses. You can also create subclasses
+L<Exception::Class::Base> subclasses. You can also create subclasses
via the traditional means of defining your own subclass with C<@ISA>.
These two methods may be easily combined, so that you could subclass
an exception class defined via the automagic import, if you desired
@@ -499,7 +286,7 @@
the parent (see below).
This parameter lets you create arbitrarily deep class hierarchies.
-This can be any other C<Exception::Class::Base> subclass in your
+This can be any other L<Exception::Class::Base> subclass in your
declaration I<or> a subclass loaded from a module.
To change the default exception class you will need to change the
@@ -512,7 +299,7 @@
know.
CAVEAT: If you want to automagically subclass an
-C<Exception::Class::Base> subclass loaded from a file, then you
+L<Exception::Class::Base> subclass loaded from a file, then you
I<must> compile the class (via use or require or some other magic)
I<before> you import C<Exception::Class> or you'll get a compile time
error.
@@ -606,236 +393,6 @@
Of course, this only works if you always call
C<< Exception::Class->caught() >> after an C<eval>.
-=head1 Exception::Class::Base CLASS METHODS
-
-=over 4
-
-=item * Trace($boolean)
-
-Each C<Exception::Class::Base> subclass can be set individually to
-include a a stracktrace when the C<as_string> method is called. The
-default is to not include a stacktrace. Calling this method with a
-value changes this behavior. It always returns the current value
-(after any change is applied).
-
-This value is inherited by any subclasses. However, if this value is
-set for a subclass, it will thereafter be independent of the value in
-C<Exception::Class::Base>.
-
-This is a class method, not an object method.
-
-=item * NoRefs($boolean)
-
-When a C<Devel::StackTrace> object is created, it walks through the
-stack and stores the arguments which were passed to each subroutine on
-the stack. If any of these arguments are references, then that means
-that the C<Devel::StackTrace> ends up increasing the refcount of these
-references, delaying their destruction.
-
-Since C<Exception::Class::Base> uses C<Devel::StackTrace> internally,
-this method provides a way to tell C<Devel::StackTrace> not to store
-these references. Instead, C<Devel::StackTrace> replaces references
-with their stringified representation.
-
-This method defaults to true. As with C<Trace()>, it is inherited by
-subclasses but setting it in a subclass makes it independent
-thereafter.
-
-=item * RespectOverload($boolean)
-
-When a C<Devel::StackTrace> object stringifies, by default it ignores
-stringification overloading on any objects being dealt with.
-
-Since C<Exception::Class::Base> uses C<Devel::StackTrace> internally,
-this method provides a way to tell C<Devel::StackTrace> to respect
-overloading.
-
-This method defaults to false. As with C<Trace()>, it is inherited by
-subclasses but setting it in a subclass makes it independent
-thereafter.
-
-=item * MaxArgLength($boolean)
-
-When a C<Devel::StackTrace> object stringifies, by default it displays
-the full argument for each function. This parameter can be used to
-limit the maximum length of each argument.
-
-Since C<Exception::Class::Base> uses C<Devel::StackTrace> internally,
-this method provides a way to tell C<Devel::StackTrace> to limit the
-length of arguments.
-
-This method defaults to 0. As with C<Trace()>, it is inherited by
-subclasses but setting it in a subclass makes it independent
-thereafter.
-
-=item * Fields
-
-This method returns the extra fields defined for the given class, as
-an array.
-
-=item * throw( $message )
-
-=item * throw( message => $message )
-
-=item * throw( error => $error )
-
-This method creates a new object with the given error message. If no
-error message is given, this will be an empty string. It then die's
-with this object as its argument.
-
-This method also takes a C<show_trace> parameter which indicates
-whether or not the particular exception object being created should
-show a stacktrace when its C<as_string()> method is called. This
-overrides the value of C<Trace()> for this class if it is given.
-
-The frames included in the trace can be controlled by the C<ignore_class>
-and C<ignore_package> parameters. These are passed directly to
-Devel::Stacktrace's constructor. See C<Devel::Stacktrace> for more details.
-
-If only a single value is given to the constructor it is assumed to be
-the message parameter.
-
-Additional keys corresponding to the fields defined for the particular
-exception subclass will also be accepted.
-
-=item * new
-
-This method takes the same parameters as C<throw()>, but instead of
-dying simply returns a new exception object.
-
-This method is always called when constructing a new exception object
-via the C<throw()> method.
-
-=item * description
-
-Returns the description for the given C<Exception::Class::Base>
-subclass. The C<Exception::Class::Base> class's description is
-"Generic exception" (this may change in the future). This is also an
-object method.
-
-=back
-
-=head1 Exception::Class::Base OBJECT METHODS
-
-=over 4
-
-=item * rethrow
-
-Simply dies with the object as its sole argument. It's just syntactic
-sugar. This does not change any of the object's attribute values.
-However, it will cause C<caller()> to report the die as coming from
-within the C<Exception::Class::Base> class rather than where rethrow
-was called.
-
-Of course, you always have access to the original stacktrace for the
-exception object.
-
-=item * message
-
-=item * error
-
-Returns the error/message associated with the exception.
-
-=item * pid
-
-Returns the pid at the time the exception was thrown.
-
-=item * uid
-
-Returns the real user id at the time the exception was thrown.
-
-=item * gid
-
-Returns the real group id at the time the exception was thrown.
-
-=item * euid
-
-Returns the effective user id at the time the exception was thrown.
-
-=item * egid
-
-Returns the effective group id at the time the exception was thrown.
-
-=item * time
-
-Returns the time in seconds since the epoch at the time the exception
-was thrown.
-
-=item * package
-
-Returns the package from which the exception was thrown.
-
-=item * file
-
-Returns the file within which the exception was thrown.
-
-=item * line
-
-Returns the line where the exception was thrown.
-
-=item * trace
-
-Returns the trace object associated with the object.
-
-=item * show_trace($boolean)
-
-This method can be used to set whether or not a strack trace is
-included when the as_string method is called or the object is
-stringified.
-
-=item * as_string
-
-Returns a string form of the error message (something like what you'd
-expect from die). If the class or object is set to show traces then
-then the full trace is also included. The result looks like
-C<Carp::confess()>.
-
-=item * full_message
-
-Called by the C<as_string()> method to get the message. By default,
-this is the same as calling the C<message()> method, but may be
-overridden by a subclass. See below for details.
-
-=back
-
-=head1 OVERLOADING
-
-The C<Exception::Class::Base> object is overloaded so that
-stringification produces a normal error message. It just calls the
-as_string method described above. This means that you can just
-C<print $@> after an C<eval> and not worry about whether or not its an
-actual object. It also means an application or module could do this:
-
- $SIG{__DIE__} = sub { Exception::Class::Base->throw( error => join '', @_ ); };
-
-and this would probably not break anything (unless someone was
-expecting a different type of exception object from C<die()>).
-
-=head1 OVERRIDING THE as_string METHOD
-
-By default, the C<as_string()> method simply returns the value
-C<message> or C<error> param plus a stack trace, if the class's
-C<Trace()> method returns a true value or C<show_trace> was set when
-creating the exception.
-
-However, once you add new fields to a subclass, you may want to
-include those fields in the stringified error.
-
-Inside the C<as_string()> method, the message (non-stack trace)
-portion of the error is generated by calling the C<full_message()>
-method. This can be easily overridden. For example:
-
- sub full_message
- {
- my $self = shift;
-
- my $msg = $self->message;
-
- $msg .= " and foo was " . $self->foo;
-
- return $msg;
- }
-
=head1 USAGE RECOMMENDATION
If you're creating a complex system that throws lots of different
@@ -866,14 +423,14 @@
... );
You may want to create a real module to subclass
-C<Exception::Class::Base> as well, particularly if you want your
+L<Exception::Class::Base> as well, particularly if you want your
exceptions to have more methods.
=head2 Subclassing Exception::Class::Base
As part of your usage of C<Exception::Class>, you may want to create
your own base exception class which subclasses
-C<Exception::Class::Base>. You should feel free to subclass any of
+L<Exception::Class::Base>. You should feel free to subclass any of
the methods documented above. For example, you may want to subclass
C<new()> to add additional information to your exception objects.
@@ -895,7 +452,7 @@
module, which implements this syntax. It also includes its own base
exception class, C<Error::Simple>.
-If you would prefer to use the C<Exception::Class::Base> class
+If you would prefer to use the L<Exception::Class::Base> class
included with this module, you'll have to add this to your code
somewhere:
@@ -933,11 +490,11 @@
=head1 AUTHOR
-Dave Rolsky, <autarch at urth.org>
+Dave Rolsky, E<gt>autarch at urth.orgE<lt>
=head1 COPYRIGHT
-Copyright (c) 2000-2006 David Rolsky. All rights reserved. This
+Copyright (c) 2000-2009 David Rolsky. All rights reserved. This
program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
Added: branches/upstream/libexception-class-perl/current/lib/Exception/Class/Base.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libexception-class-perl/current/lib/Exception/Class/Base.pm?rev=35057&op=file
==============================================================================
--- branches/upstream/libexception-class-perl/current/lib/Exception/Class/Base.pm (added)
+++ branches/upstream/libexception-class-perl/current/lib/Exception/Class/Base.pm Fri May 8 23:52:26 2009
@@ -1,0 +1,496 @@
+package Exception::Class::Base;
+
+use strict;
+use warnings;
+
+our $VERSION = '1.20';
+
+use Class::Data::Inheritable;
+use Devel::StackTrace 1.20;
+
+use base qw(Class::Data::Inheritable);
+
+BEGIN
+{
+ __PACKAGE__->mk_classdata('Trace');
+ __PACKAGE__->mk_classdata('NoRefs');
+ __PACKAGE__->NoRefs(1);
+
+ __PACKAGE__->mk_classdata('RespectOverload');
+ __PACKAGE__->RespectOverload(0);
+
+ __PACKAGE__->mk_classdata('MaxArgLength');
+ __PACKAGE__->MaxArgLength(0);
+
+ sub Fields { () }
+}
+
+use overload
+ # an exception is always true
+ bool => sub { 1 },
+ '""' => 'as_string',
+ fallback => 1;
+
+# Create accessor routines
+BEGIN
+{
+ my @fields = qw( message pid uid euid gid egid time trace );
+
+ foreach my $f (@fields)
+ {
+ my $sub = sub { my $s = shift; return $s->{$f}; };
+
+ no strict 'refs';
+ *{$f} = $sub;
+ }
+ *error = \&message;
+
+ my %trace_fields =
+ ( package => 'package',
+ file => 'filename',
+ line => 'line',
+ );
+
+ while ( my ( $f, $m ) = each %trace_fields )
+ {
+ my $sub = sub
+ {
+ my $s = shift;
+ return $s->{$f} if exists $s->{$f};
+
+ my $frame = $s->trace->frame(0);
+
+ return $s->{$f} = $frame ? $frame->$m() : undef;
+ };
+ no strict 'refs';
+ *{$f} = $sub;
+ }
+}
+
+1;
+
+sub Classes { Exception::Class::Classes() }
+
+sub throw
+{
+ my $proto = shift;
+
+ $proto->rethrow if ref $proto;
+
+ die $proto->new(@_);
+}
+
+sub rethrow
+{
+ my $self = shift;
+
+ die $self;
+}
+
+sub new
+{
+ my $proto = shift;
+ my $class = ref $proto || $proto;
+
+ my $self = bless {}, $class;
+
+ $self->_initialize(@_);
+
+ return $self;
+}
+
+sub _initialize
+{
+ my $self = shift;
+ my %p = @_ == 1 ? ( error => $_[0] ) : @_;
+
+ $self->{message} = $p{message} || $p{error} || '';
+
+ $self->{show_trace} = $p{show_trace} if exists $p{show_trace};
+
+ # CORE::time is important to fix an error with some versions of
+ # Perl
+ $self->{time} = CORE::time();
+ $self->{pid} = $$;
+ $self->{uid} = $<;
+ $self->{euid} = $>;
+ $self->{gid} = $(;
+ $self->{egid} = $);
+
+ my @ignore_class = (__PACKAGE__);
+ my @ignore_package = 'Exception::Class';
+
+ if ( my $i = delete $p{ignore_class} )
+ {
+ push @ignore_class, ( ref($i) eq 'ARRAY' ? @$i : $i );
+ }
+
+ if ( my $i = delete $p{ignore_package} )
+ {
+ push @ignore_package, ( ref($i) eq 'ARRAY' ? @$i : $i );
+ }
+
+ $self->{trace} =
+ Devel::StackTrace->new( ignore_class => \@ignore_class,
+ ignore_package => \@ignore_package,
+ no_refs => $self->NoRefs,
+ respect_overload => $self->RespectOverload,
+ max_arg_length => $self->MaxArgLength,
+ );
+
+ my %fields = map { $_ => 1 } $self->Fields;
+ while ( my ($key, $value) = each %p )
+ {
+ next if $key =~ /^(?:error|message|show_trace)$/;
+
+ if ( $fields{$key})
+ {
+ $self->{$key} = $value;
+ }
+ else
+ {
+ Exception::Class::Base->throw
+ ( error =>
+ "unknown field $key passed to constructor for class " . ref $self );
+ }
+ }
+}
+
+sub description
+{
+ return 'Generic exception';
+}
+
+sub show_trace
+{
+ my $self = shift;
+
+ if (@_)
+ {
+ $self->{show_trace} = shift;
+ }
+
+ return exists $self->{show_trace} ? $self->{show_trace} : $self->Trace;
+}
+
+sub as_string
+{
+ my $self = shift;
+
+ my $str = $self->full_message;
+ $str .= "\n\n" . $self->trace->as_string
+ if $self->show_trace;
+
+ return $str;
+}
+
+sub full_message { $_[0]->{message} }
+
+#
+# The %seen bit protects against circular inheritance.
+#
+eval <<'EOF' if $] == 5.006;
+sub isa
+{
+ my ($inheritor, $base) = @_;
+ $inheritor = ref($inheritor) if ref($inheritor);
+
+ my %seen;
+
+ no strict 'refs';
+ my @parents = ($inheritor, @{"$inheritor\::ISA"});
+ while (my $class = shift @parents)
+ {
+ return 1 if $class eq $base;
+
+ push @parents, grep {!$seen{$_}++} @{"$class\::ISA"};
+ }
+ return 0;
+}
+EOF
+
+sub caught
+{
+ return Exception::Class->caught(shift);
+}
+
+1;
+
+=head1 NAME
+
+Exception::Class::Base - Base class for exception classes created by Exception::Class
+
+=head1 SYNOPSIS
+
+ use Exception::Class 'MyException';
+
+ eval { MyException->throw( error => 'I feel funny.' ) };
+
+ print $@->error();
+
+=head1 DESCRIPTION
+
+This class is the base class for all exceptions created by
+L<Exception::Class>. It provides a number of methods for getting
+information about the exception.
+
+=head1 METHODS
+
+=head2 MyException->Trace($boolean)
+
+Each C<Exception::Class::Base> subclass can be set individually to
+include a a stracktrace when the C<as_string> method is called. The
+default is to not include a stacktrace. Calling this method with a
+value changes this behavior. It always returns the current value
+(after any change is applied).
+
+This value is inherited by any subclasses. However, if this value is
+set for a subclass, it will thereafter be independent of the value in
+C<Exception::Class::Base>.
+
+Do not call this on the C<Exception::Class::Base> class directly or
+you'll change it for all exception classes that use
+L<Exception::Class>, including ones created in modules you don't
+control.
+
+This is a class method, not an object method.
+
+=head2 MyException->NoRefs($boolean)
+
+When a C<Devel::StackTrace> object is created, it walks through the
+stack and stores the arguments which were passed to each subroutine on
+the stack. If any of these arguments are references, then that means
+that the C<Devel::StackTrace> ends up increasing the refcount of these
+references, delaying their destruction.
+
+Since C<Exception::Class::Base> uses C<Devel::StackTrace> internally,
+this method provides a way to tell C<Devel::StackTrace> not to store
+these references. Instead, C<Devel::StackTrace> replaces references
+with their stringified representation.
+
+This method defaults to true. As with C<Trace()>, it is inherited by
+subclasses but setting it in a subclass makes it independent
+thereafter.
+
+Do not call this on the C<Exception::Class::Base> class directly or
+you'll change it for all exception classes that use
+L<Exception::Class>, including ones created in modules you don't
+control.
+
+=head2 MyException->RespectOverload($boolean)
+
+When a C<Devel::StackTrace> object stringifies, by default it ignores
+stringification overloading on any objects being dealt with.
+
+Since C<Exception::Class::Base> uses C<Devel::StackTrace> internally,
+this method provides a way to tell C<Devel::StackTrace> to respect
+overloading.
+
+This method defaults to false. As with C<Trace()>, it is inherited by
+subclasses but setting it in a subclass makes it independent
+thereafter.
+
+Do not call this on the C<Exception::Class::Base> class directly or
+you'll change it for all exception classes that use
+L<Exception::Class>, including ones created in modules you don't
+control.
+
+=head2 MyException->MaxArgLength($boolean)
+
+When a C<Devel::StackTrace> object stringifies, by default it displays
+the full argument for each function. This parameter can be used to
+limit the maximum length of each argument.
+
+Since C<Exception::Class::Base> uses C<Devel::StackTrace> internally,
+this method provides a way to tell C<Devel::StackTrace> to limit the
+length of arguments.
+
+This method defaults to 0. As with C<Trace()>, it is inherited by
+subclasses but setting it in a subclass makes it independent
+thereafter.
+
+Do not call this on the C<Exception::Class::Base> class directly or
+you'll change it for all exception classes that use
+L<Exception::Class>, including ones created in modules you don't
+control.
+
+=head2 MyException->Fields
+
+This method returns the extra fields defined for the given class, as
+an array.
+
+Do not call this on the C<Exception::Class::Base> class directly or
+you'll change it for all exception classes that use
+L<Exception::Class>, including ones created in modules you don't
+control.
+
+=head2 MyException->throw( $message )
+
+=head2 MyException->throw( message => $message )
+
+=head2 MyException->throw( error => $error )
+
+This method creates a new object with the given error message. If no
+error message is given, this will be an empty string. It then die's
+with this object as its argument.
+
+This method also takes a C<show_trace> parameter which indicates
+whether or not the particular exception object being created should
+show a stacktrace when its C<as_string()> method is called. This
+overrides the value of C<Trace()> for this class if it is given.
+
+The frames included in the trace can be controlled by the C<ignore_class>
+and C<ignore_package> parameters. These are passed directly to
+Devel::Stacktrace's constructor. See C<Devel::Stacktrace> for more details.
+
+If only a single value is given to the constructor it is assumed to be
+the message parameter.
+
+Additional keys corresponding to the fields defined for the particular
+exception subclass will also be accepted.
+
+=head2 MyException->new(...)
+
+This method takes the same parameters as C<throw()>, but instead of
+dying simply returns a new exception object.
+
+This method is always called when constructing a new exception object
+via the C<throw()> method.
+
+=head2 MyException->description()
+
+Returns the description for the given C<Exception::Class::Base>
+subclass. The C<Exception::Class::Base> class's description is
+"Generic exception" (this may change in the future). This is also an
+object method.
+
+=head2 $exception->rethrow()
+
+Simply dies with the object as its sole argument. It's just syntactic
+sugar. This does not change any of the object's attribute values.
+However, it will cause C<caller()> to report the die as coming from
+within the C<Exception::Class::Base> class rather than where rethrow
+was called.
+
+Of course, you always have access to the original stacktrace for the
+exception object.
+
+=head2 $exception->message()
+
+=head2 $exception->error()
+
+Returns the error/message associated with the exception.
+
+=head2 $exception->pid()
+
+Returns the pid at the time the exception was thrown.
+
+=head2 $exception->uid()
+
+Returns the real user id at the time the exception was thrown.
+
+=head2 $exception->gid()
+
+Returns the real group id at the time the exception was thrown.
+
+=head2 $exception->euid()
+
+Returns the effective user id at the time the exception was thrown.
+
+=head2 $exception->egid()
+
+Returns the effective group id at the time the exception was thrown.
+
+=head2 $exception->time()
+
+Returns the time in seconds since the epoch at the time the exception
+was thrown.
+
+=head2 $exception->package()
+
+Returns the package from which the exception was thrown.
+
+=head2 $exception->file()
+
+Returns the file within which the exception was thrown.
+
+=head2 $exception->line()
+
+Returns the line where the exception was thrown.
+
+=head2 $exception->trace()
+
+Returns the trace object associated with the object.
+
+=head2 $exception->show_trace($boolean)
+
+This method can be used to set whether or not a strack trace is
+included when the as_string method is called or the object is
+stringified.
+
+=head2 $exception->as_string()
+
+Returns a string form of the error message (something like what you'd
+expect from die). If the class or object is set to show traces then
+then the full trace is also included. The result looks like
+C<Carp::confess()>.
+
+=head2 $exception->full_message()
+
+Called by the C<as_string()> method to get the message. By default,
+this is the same as calling the C<message()> method, but may be
+overridden by a subclass. See below for details.
+
+=head1 OVERLOADING
+
+C<Exception::Class::Base> objects are overloaded so that
+stringification produces a normal error message. This just calls the
+C<< $exception->as_string() >> method described above. This means
+that you can just C<print $@> after an C<eval> and not worry about
+whether or not its an actual object. It also means an application or
+module could do this:
+
+ $SIG{__DIE__} = sub { Exception::Class::Base->throw( error => join '', @_ ); };
+
+and this would probably not break anything (unless someone was
+expecting a different type of exception object from C<die()>).
+
+=head1 OVERRIDING THE as_string METHOD
+
+By default, the C<as_string()> method simply returns the value
+C<message> or C<error> param plus a stack trace, if the class's
+C<Trace()> method returns a true value or C<show_trace> was set when
+creating the exception.
+
+However, once you add new fields to a subclass, you may want to
+include those fields in the stringified error.
+
+Inside the C<as_string()> method, the message (non-stack trace)
+portion of the error is generated by calling the C<full_message()>
+method. This can be easily overridden. For example:
+
+ sub full_message
+ {
+ my $self = shift;
+
+ my $msg = $self->message;
+
+ $msg .= " and foo was " . $self->foo;
+
+ return $msg;
+ }
+
+=head1 AUTHOR
+
+Dave Rolsky, E<gt>autarch at urth.orgE<lt>
+
+=head1 COPYRIGHT
+
+Copyright (c) 2000-2009 David Rolsky. All rights reserved. This
+program is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
+
+The full text of the license can be found in the LICENSE file included
+with this module.
+
+=cut
Modified: branches/upstream/libexception-class-perl/current/t/basic.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libexception-class-perl/current/t/basic.t?rev=35057&op=diff
==============================================================================
--- branches/upstream/libexception-class-perl/current/t/basic.t (original)
+++ branches/upstream/libexception-class-perl/current/t/basic.t Fri May 8 23:52:26 2009
@@ -4,7 +4,7 @@
use File::Spec;
-use Test::More tests => 58;
+use Test::More tests => 56;
use_ok('Exception::Class');
@@ -16,14 +16,8 @@
{
package FooException;
- use vars qw[$VERSION];
-
use Exception::Class;
use base qw(Exception::Class::Base);
-
- $VERSION = 0.01;
-
- 1;
}
use Exception::Class
@@ -55,7 +49,7 @@
$^W = 1;
-# 2-14: Accessors
+# Accessors
{
eval { Exception::Class::Base->throw( error => 'err' ); };
@@ -77,8 +71,8 @@
is( $@->file, $expect,
"File should be '$expect'" );
- is( $@->line, 60,
- "Line should be 60" );
+ is( $@->line, 54,
+ "Line should be 54" );
is( $@->pid, $$,
"PID should be $$" );
@@ -99,7 +93,7 @@
"Exception object should have a stacktrace" );
}
-# 15-23 : Test subclass creation
+# Test subclass creation
{
eval { TestException->throw( error => 'err' ); };
@@ -131,7 +125,7 @@
}
-# 24-29 : Trace related tests
+# Trace related tests
{
ok( ! Exception::Class::Base->Trace,
"Exception::Class::Base class 'Trace' method should return false" );
@@ -162,7 +156,7 @@
"Trace should contain frames from Exception::Class::Base package" );
}
-# 29-30 : overloading
+# overloading
{
Exception::Class::Base->Trace(0);
eval { Exception::Class::Base->throw( error => 'overloaded' ); };
@@ -185,7 +179,7 @@
}
}
-# 32-33 - Test using message as hash key to constructor
+# Test using message as hash key to constructor
{
eval { Exception::Class::Base->throw( message => 'err' ); };
@@ -196,7 +190,6 @@
"Exception's message should be 'err'" );
}
-# 34
{
{
package X::Y;
@@ -212,7 +205,7 @@
"Error message should be 'dead'" );
}
-# 35 - subclass overriding as_string
+# subclass overriding as_string
sub Exc::AsString::as_string { return uc $_[0]->error }
@@ -223,7 +216,7 @@
"Overriding as_string in subclass" );
}
-# 36-37 - fields
+# fields
{
eval { FieldsException->throw( error => 'error', foo => 5 ) };
@@ -234,7 +227,7 @@
"Exception's foo method should return 5" );
}
-# 38-41 - more fields.
+# more fields.
{
eval { MoreFieldsException->throw( error => 'error', yip => 10, foo => 15 ) };
@@ -254,7 +247,7 @@
return join ' ', $_[0]->message, "foo = " . $_[0]->foo;
}
-# 42 - fields + full_message
+# fields + full_message
{
eval { FieldsException->throw (error => 'error', foo => 5) };
@@ -263,16 +256,7 @@
"FieldsException should stringify to include the value of foo" );
}
-# 43 - truth
-{
- Bool->do_trace(0);
- eval { Bool->throw( something => [ 1, 2, 3 ] ) };
-
- ok( $@,
- "All exceptions should evaluate to true in a boolean context" );
-}
-
-# 44 - single arg constructor
+# single arg constructor
{
eval { YAE->throw( 'foo' ) };
@@ -283,7 +267,7 @@
"Single arg constructor should just set error/message" );
}
-# 45 - no refs
+# no refs
{
ObjectRefs2->NoRefs(0);
@@ -296,20 +280,7 @@
"References should be saved in the stack trace" );
}
-# 46 - no object refs (deprecated)
-{
- ObjectRefs->NoObjectRefs(0);
-
- eval { Foo->new->bork };
- my $exc = $@;
-
- my @args = ($exc->trace->frames)[1]->args;
-
- ok( ref $args[0],
- "References should be saved in the stack trace" );
-}
-
-# 47-53 - aliases
+# aliases
{
package FooBar;
More information about the Pkg-perl-cvs-commits
mailing list