view release on metacpan or  search on metacpan

lib/App/CamelPKI/Error.pm  view on Meta::CPAN

=cut

package App::CamelPKI::Error::OtherProcess;
use vars qw(@ISA); @ISA=qw(App::CamelPKI::Error);

=head2 App::CamelPKI::Error::User

Thrown when a Camel-PKI mecanism detects an error caused by a bad user
action (or a bad usage in a web service client).

=cut

package App::CamelPKI::Error::User;
use vars qw(@ISA); @ISA=qw(App::CamelPKI::Error);


=begin internals

=head1 OVERLOADED METHODS

=cut

package App::CamelPKI::Error;

=head2 new()

Overloaded from the L</Error> parent class to activate stack traces.

=cut

sub new {
    my $self=shift;
    splice(@_,0,0,"-text") if (@_ % 2);
    my %opts=@_;

    local $Error::Debug = 1;      # activates stack traces...
    local $Carp::MaxEvalLen = 80; # ... but not too long anyway

    local $Error::Depth = $Error::Depth + 1;
    $Error::Depth += $opts{-depth} if (exists $opts{-depth});

    return $self->Error::new(%opts);
}

=head2 stringify()

Overloaded to throw a complete error trace. If this does not match
your need, feel free to trap the exception in your own code.

=cut


sub stringify {
    my ($self) = @_;
    my $retval = sprintf("%s=%s\n",
                         ref($self), $self->SUPER::stringify);
    foreach my $k (keys %$self) {
        next if ($k eq "-text" || $k eq "-stacktrace");
        local $@; # if exceptions brakes exceptions... Where do we goes?!
        my $v = eval {
            require Data::Dumper;
            local $Data::Dumper::Indent = $Data::Dumper::Indent = 1;
            local $Data::Dumper::Terse = $Data::Dumper::Terse = 1;
            Data::Dumper::Dumper($self->{$k});
        } || "<huh?>";
        $retval .= "  $k => $v";
    }
    $retval .= $self->stacktrace;
    return $retval;
}



require My::Tests::Below unless caller();
1;

__END__

use Test::More qw(no_plan);
use Test::Group;
use App::CamelPKI::Error;

test "synopsis: basics" => sub {
    my $code = My::Tests::Below->pod_code_snippet("synopsis basic");
    $code =~ s/warn/our \$foo = /g;
    eval $code; die $@ if $@;
    like(our $foo, qr/oops/i);
};

skip_next_test unless eval { require Class::Facet };
test "synopsic: Class::Facet integration" => sub {
    {
        package My::Object;
        sub new { bless {}, shift }
        sub facet { Class::Facet->make("My::Facet", shift) }
        sub nothing { 1 }
    }
    ok(My::Object->new->nothing);

    my $code = My::Tests::Below->pod_code_snippet("synopsis Class::Facet");
    eval $code; die $@ if $@;
    try {
        My::Object->new->facet->nothing;
        fail("should have thrown - Bug in Class::Facet?");
    } catch App::CamelPKI::Error::Privilege with {
        my $E = shift;
        is($E->{-text}, "Facet error");
        is($E->{-method}, "nothing");
    };
};

use Errno qw(ENOENT);
test "App::CamelPKI::Error::IO and automatic decoration" => sub {
    my $file = "/no/such_/file";
    local *BOGON;
    open(BOGON, $file);
    eval My::Tests::Below->pod_code_snippet("App::CamelPKI::Error::IO");
    my $E = $@;
    is($E->{-IOfile}, $file);
    is($E->{-errorcode}, ENOENT);
    like($E->{-error}, qr/no such file|aucun fichier/i);
};

test "stringify" => sub {