FancyExample.pm

package FancyExample;

use strict;
use warnings;

use base 'Exporter';
our @EXPORT = qw( fancy_death );

use Exception::Class::OnCaller ex => {
    fields      => "data",
    description => "This exception has many bells and whistles!",
    -as         => 'throw',
    -subclass   => 'BlingError',
};

sub fancy_death {
    die throw( error => "meep", data => { stuff => 'goes here' } );
}

1;

OnCaller.pm

package Exception::Class::OnCaller;

use strict;
use warnings;

use Sub::Exporter -setup => {
    exports => [
        ex => \&build_named_exception_builder,
    ],
};

use Exception::Class;

sub build_named_exception_builder {
    my ( undef, undef, $exception_args ) = @_;

    $exception_args ||= {};
    my $exception_subname = delete( $exception_args->{-subclass} ) || 'Error';
    my $exception_name = caller( 3 ) . "::" . $exception_subname;

    Exception::Class->import( $exception_name => $exception_args );

    my $exception_builder = sub { exception_builder( $exception_name, @_ ) };

    return $exception_builder;
}

sub exception_builder {
    my ( $exception_name, @exception_args ) = @_;

    my $exception = $exception_name->new( @exception_args );
    clean_trace( $exception->{trace} );

    return $exception;
}

sub clean_trace {
    my ( $trace ) = @_;

    $trace->frame_count;    # force the trace object to initialize so we can fiddle with the frames

    my @filters = filters();
    $trace->{frames} = apply_filter( $_, $trace->{frames} ) for @filters;

    return;
}

sub filters {
    return (
        sub { $_->subroutine !~ /^Try::Tiny/ }, # clear Try::Tiny frames
        sub { $_->package    !~ /^Try::Tiny/ }, # clear Try::Tiny frames
        sub { $_->package    ne __PACKAGE__  }, # clear our own frames
    );
}

sub apply_filter {
    my ( $filter, $frames ) = @_;
    my @frames = grep $filter->(), @{$frames};
    return \@frames
}

1;

script.pl

#!/usr/bin/perl

use feature 'say';
use Try::Tiny;
use Data::Dumper;

use lib 'lib';
use SimpleExample;
use FancyExample;

try {
    try_marp();
}
catch {
    say ref( $_ ) . ' - ' . $_->description, ' - ', $_->error, "\n\n", $_->trace->as_string;
    say join ' ', $_->euid, $_->egid, $_->uid, $_->gid, $_->pid, $_->time;
    say "";
};

say "###############################################################################\n";

try {
    fancy_death();
}
catch {
    say ref( $_ ) . ' - ' . $_->description, ' - ', $_->error, "\n\n", $_->trace->as_string;
    say Dumper( $_->data );
    say join ' ', $_->euid, $_->egid, $_->uid, $_->gid, $_->pid, $_->time;
    say "";
};

exit;

__END__

SimpleExample::Error - Generic exception - simple error with no bells or whistles

Trace begun at lib\SimpleExample.pm line 12
SimpleExample::try_marp at script.pl line 12

0 0 0 0 6600 1286555030

###############################################################################

FancyExample::BlingError - This exception has many bells and whistles! - meep

Trace begun at lib\FancyExample.pm line 17
FancyExample::fancy_death at script.pl line 23

$VAR1 = {
          'stuff' => 'goes here'
        };

0 0 0 0 6600 1286555030

SimpleExample.pm

package SimpleExample;

use strict;
use warnings;

use base 'Exporter';
our @EXPORT = qw( try_marp );

use Exception::Class::OnCaller 'ex';

sub try_marp {
    die ex "simple error with no bells or whistles";
}

1;