root/lang/perl/CGI-ExceptionManager/trunk/lib/CGI/ExceptionManager.pm @ 24387

Revision 24387, 1.8 kB (checked in by tokuhirom, 5 years ago)

added docs

Line 
1package CGI::ExceptionManager;
2use strict;
3use warnings;
4use 5.00800;
5our $VERSION = '0.01';
6use CGI::ExceptionManager::StackTrace;
7
8sub detach { die bless [], 'CGI::ExceptionManager::Exception' }
9
10sub run {
11    my ($class, %args) = @_;
12
13    my $err_info;
14    local $SIG{__DIE__} = sub {
15        my ($msg) = @_;
16        if (ref $msg eq 'CGI::ExceptionManager::Exception') {
17            undef $err_info;
18        } else {
19            $err_info = CGI::ExceptionManager::StackTrace->new($msg);
20        }
21        die;
22    };
23    local $@;
24    eval {
25        $args{callback}->();
26        undef $err_info;
27    };
28    if ($err_info) {
29        $err_info->output(
30            powered_by => $args{powered_by} || __PACKAGE__,
31        );
32    }
33}
34
351;
36__END__
37
38=encoding utf8
39
40=head1 NAME
41
42CGI::ExceptionManager - DebugScreen with detach!
43
44=head1 SYNOPSIS
45
46    use CGI::ExceptionManager;
47    CGI::ExceptionManager->run(
48        callback => sub {
49            redirect("http://wassr.jp/");
50
51            # do not reach here
52        },
53        powered_by => 'MENTA',
54    );
55
56    sub redirect {
57        my $location = shift;
58        print "Status: 302\n";
59        print "Location: $location\n";
60        print "\n";
61
62        CGI::ExceptionManager::detach();
63    }
64
65=head1 DESCRIPTION
66
67You can easy to implement DebugScreen and Detach architecture =)
68
69=head1 METHODS
70
71=over 4
72
73=item detach
74
75detach from current context.
76
77=item run
78
79    CGI::ExceptionManager->run(
80        callback => \&code,
81        powered_by => 'MENTA',
82    );
83
84run the new context.
85
86=back
87
88=head1 AUTHOR
89
90Tokuhiro Matsuno E<lt>tokuhirom@gmail.comE<gt>
91
92Kazuho Oku
93
94=head1 SEE ALSO
95
96L<Sledge::Plugin::DebugScreen>, L<http://kazuho.31tools.com/nanoa/nanoa.cgi>, L<http://gp.ath.cx/menta/>
97
98=head1 LICENSE
99
100This library is free software; you can redistribute it and/or modify
101it under the same terms as Perl itself.
102
103=cut
Note: See TracBrowser for help on using the browser.