libmojolicious-plugin-mailexception-perl-0.19/0000775000000000000000000000000012420273172020261 5ustar rootrootlibmojolicious-plugin-mailexception-perl-0.19/Makefile.PL0000644000000000000000000000166412420270601022232 0ustar rootrootuse 5.008008; use ExtUtils::MakeMaker; WriteMakefile( NAME => 'Mojolicious::Plugin::MailException', VERSION_FROM => 'lib/Mojolicious/Plugin/MailException.pm', PREREQ_PM => { 'Mojolicious' => 0, 'MIME::Words' => 0, 'MIME::Lite' => 0, }, ($] >= 5.005 ? (ABSTRACT_FROM => 'lib/Mojolicious/Plugin/MailException.pm', AUTHOR => 'Dmitry E. Oboukhov ') : ()), LICENSE => 'Perl', META_MERGE => { resources => { homepage => 'https://github.com/dr-co/libmojolicious-plugin-mail_exception', repository => 'https://github.com/dr-co/libmojolicious-plugin-mail_exception', bugtracker => 'https://github.com/dr-co/libmojolicious-plugin-mail_exception/issues', } } ); open my $fh, '>>', 'Makefile' or exit 0; print $fh "\n\nTEST_VERBOSE=1\n\n"; libmojolicious-plugin-mailexception-perl-0.19/Changes0000777000000000000000000000000012420270601024635 2debian/changelogustar rootrootlibmojolicious-plugin-mailexception-perl-0.19/.gitignore0000664000000000000000000000043312420271472022252 0ustar rootrootMYMETA.yml MYMETA.json Makefile blib/* debian/files debian/libmojolicious-plugin-mailexception-perl.debhelper.log debian/libmojolicious-plugin-mailexception-perl.substvars debian/libmojolicious-plugin-mailexception-perl/ pm_to_blib Mojolicious-Plugin-MailException-*.tar.gz .project libmojolicious-plugin-mailexception-perl-0.19/README0000644000000000000000000000222312420270601021130 0ustar rootrootMojolicious-Plugin-MailException ================================ The README is used to introduce the module and provide instructions on how to install the module, any machine dependencies it may have (for example C compilers and installed libraries) and any other information that should be provided before the module is installed. A README file is required for CPAN modules since CPAN extracts the README file from a module distribution so that people browsing the archive can use it get an idea of the modules uses. It is usually a good idea to provide version information here so that people can decide whether fixes for the module are worth downloading. INSTALLATION To install this module type the following: perl Makefile.PL make make test make install DEPENDENCIES The module is plugin for Mojolicious to send crash information to email. COPYRIGHT AND LICENCE Copyright (C) 2012 by Dmitry E. Oboukhov 2012 by Roman V. Nikolaev This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.8.8 or, at your option, any later version of Perl 5 you may have available. libmojolicious-plugin-mailexception-perl-0.19/MANIFEST0000664000000000000000000000037712420270601021413 0ustar rootrootlib/Mojolicious/Plugin/MailException.pm Makefile.PL MANIFEST README t/010-tplugun.t debian/changelog debian/compat debian/control debian/copyright debian/libmojolicious-plugin-mailexception-perl.docs debian/rules debian/source/format debian/watch Changes libmojolicious-plugin-mailexception-perl-0.19/t/0000775000000000000000000000000012420273130020516 5ustar rootrootlibmojolicious-plugin-mailexception-perl-0.19/t/010-tplugun.t0000644000000000000000000000743312420273130022704 0ustar rootroot#!/usr/bin/perl use warnings; use strict; use utf8; use open qw(:std :utf8); use lib qw(lib ../lib); use FindBin; use lib "$FindBin::Bin/../lib"; use Test::More tests => 29; use Encode qw(decode encode decode_utf8); my @elist; my @mails; BEGIN { # Подготовка объекта тестирования для работы с utf8 my $builder = Test::More->builder; binmode $builder->output, ":utf8"; binmode $builder->failure_output, ":utf8"; binmode $builder->todo_output, ":utf8"; use_ok 'Test::Mojo'; require_ok 'Mojolicious'; require_ok 'MIME::Lite'; require_ok 'MIME::Words'; require_ok 'Mojolicious::Plugin::MailException'; } my $t = Test::Mojo->new('MpemTest'); # Workaround for newer Mojolicious Versions so the Namespace stays the same $t->app->routes->namespaces(['MpemTest']) if $t->app->can('routes') and $t->app->routes->can('namespaces'); $t->get_ok('/') ->status_is(200) ->content_is('Hello'); $t->get_ok('/crash') ->status_is(500) ->content_like(qr{^Exception: die marker1 outside eval}) ->content_like(qr{Exception Line: die "die marker1 outside eval"; ### die marker1\n$}); is scalar @elist, 1, 'one caugth exception'; my $e = shift @elist; like $e->message, qr{^die marker1 outside eval}, 'text of message'; like $e->line->[1], qr{^ die "die marker1 outside eval"; ### die marker1$}, 'line'; is scalar @mails, 1, 'one prepared mail'; my $m = shift @mails; # note decode_utf8 $t->tx->res->to_string; # note decode_utf8 $m->as_string; note decode_utf8 $m->as_string if $ENV{SHOW}; $m->send if $ENV{SEND}; isa_ok $m => 'MIME::Lite'; $m = $m->as_string; like $m, qr{^Stack}m, 'Stack'; like $m, qr{^Content-Disposition:\s*inline}m, 'Content-Disposition'; @mails = (); $t->get_ok('/crash_sig') ->status_is(500) ->content_like(qr{^Exception: die marker2 sig}) ->content_like(qr{Exception Line: die "die marker2 sig"; ### die marker2\n$}); is scalar @mails, 1, 'one prepared mail'; $m = shift @mails; # note decode_utf8 $m->as_string; @mails = (); $t->get_ok('/crash_sub') ->status_is(500) ->content_like(qr{^Exception: mail exception marker3}); # couldn get thi to work: # ->content_like(qr!Exception Line: \$_[0]->mail_exception("mail exception marker3", { 'x-test' => 123 }); ### die marker3!); is scalar @mails, 1, 'one prepared mail'; $m = shift @mails; like $m->header_as_string, qr{^X-Test:\s*123$}m, 'Additional header'; package MpemTest::Ctl; use Mojo::Base 'Mojolicious::Controller'; sub hello { $_[0]->render(text => 'Hello'); } sub crash { eval { die "die marker1 inside eval"; }; die "die marker1 outside eval"; ### die marker1 } sub crash_sig { local $SIG{__DIE__} = sub { die $_[0]; }; die "die marker2 sig"; ### die marker2 } sub crash_sub { $_[0]->mail_exception("mail exception marker3", { 'x-test' => 123 }); ### die marker3 } package MpemTest; use utf8; use strict; use warnings; use Mojo::Base 'Mojolicious'; sub startup { my ($self) = @_; $self->secrets(['my secret phrase']); $self->mode('development'); push @{$self->renderer->classes}, 'MpemTest'; $self->plugin('MailException', send => sub { my ($m, $e) = @_; push @elist => $e; push @mails => $m; }, $ENV{FROM} ? ( from => $ENV{FROM} ) : (), $ENV{TO} ? ( to => $ENV{TO} ) : (), subject => 'Случилось страшное (тест)!', headers => {}, ); my $r = $self->routes; $r->get('/')->to('ctl#hello'); $r->get('/crash')->to('ctl#crash'); $r->get('/crash_sig')->to('ctl#crash_sig'); $r->get('/crash_sub')->to('ctl#crash_sub'); } 1; __DATA__ @@ exception.html.ep Exception: <%== $exception %> Exception Line: <%== $exception->line->[1] %> libmojolicious-plugin-mailexception-perl-0.19/lib/0000775000000000000000000000000012420270601021021 5ustar rootrootlibmojolicious-plugin-mailexception-perl-0.19/lib/Mojolicious/0000775000000000000000000000000012420270601023315 5ustar rootrootlibmojolicious-plugin-mailexception-perl-0.19/lib/Mojolicious/Plugin/0000775000000000000000000000000012420270736024564 5ustar rootrootlibmojolicious-plugin-mailexception-perl-0.19/lib/Mojolicious/Plugin/MailException.pm0000644000000000000000000001456412420270736027673 0ustar rootroot=head1 NAME Mojolicious::Plugin::MailException - Mojolicious plugin to send crash information by email =head1 SYNOPSIS package MyServer; use Mojo::Base 'Mojolicious'; sub startup { my ($self) = @_; $self->plugin(MailException => { from => 'robot@my.site.com', to => 'mail1@my.domain.com, mail2@his.domain.com', subject => 'My site crashed!', headers => { 'X-MySite' => 'crashed' } }); } =head1 DESCRIPTION The plugin catches all exceptions, packs them into email and sends them to email. There are some plugin options: =over =item from From-address for email (default B) =item to To-address(es) for email (default B) =item subject Subject for crash email =item headers Hash with headers that have to be added to mail =item send Subroutine that can be used to send the mail, example: sub startup { my ($self) = @_; $self->plugin(MailException => { send => sub { my ($mail, $exception) = @_; $mail->send; # prepared MIME::Lite object } }); } In the function You can send email by yourself and (or) prepare and send Your own mail (sms, etc) message using B<$exception> object. See L. =back The plugin provides additional method (helper) B. $cx->mail_exception('my_error', { 'X-Add-Header' => 'value' }); You can use the helper to raise exception with additional mail headers. =head1 VCS The plugin is placed on L. =head1 COPYRIGHT AND LICENCE Copyright (C) 2012 by Dmitry E. Oboukhov Copyright (C) 2012 by Roman V. Nikolaev This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.8.8 or, at your option, any later version of Perl 5 you may have available. =cut package Mojolicious::Plugin::MailException; our $VERSION = '0.19'; use 5.008008; use strict; use warnings; use Mojo::Base 'Mojolicious::Plugin'; use Data::Dumper; use Mojo::Exception; use Carp; use MIME::Lite; use MIME::Words ':all'; my $mail_prepare = sub { my ($e, $conf, $self, $from, $to, $headers) = @_; my $subject = $conf->{subject} || 'Caught exception'; $subject .= ' (' . $self->req->method . ': ' . $self->req->url->to_abs->to_string . ')'; utf8::encode($subject) if utf8::is_utf8 $subject; $subject = encode_mimeword $subject, 'B', 'utf-8'; my $text = ''; $text .= "Exception\n"; $text .= "~~~~~~~~~\n"; $text .= $e->message; $text .= "\n"; my $maxl = eval { length $e->lines_after->[-1][0]; }; $maxl ||= 5; $text .= sprintf " %*d %s\n", $maxl, @{$_}[0,1] for @{ $e->lines_before }; $text .= sprintf " * %*d %s\n", $maxl, @{ $e->line }[0,1] if $e->line->[0]; $text .= sprintf " %*d %s\n", $maxl, @{$_}[0,1] for @{ $e->lines_after }; if (@{ $e->frames }) { $text .= "\n"; $text .= "Stack\n"; $text .= "~~~~~\n"; for (@{ $e->frames }) { $text .= sprintf " %s: %d\n", @{$_}[1,2]; } } if (eval { $self->session; scalar keys %{ $self->session } }) { local $Data::Dumper::Indent = 1; local $Data::Dumper::Terse = 1; local $Data::Dumper::Useqq = 1; local $Data::Dumper::Deepcopy = 1; local $Data::Dumper::Maxdepth = 0; $text .= "\n"; $text .= "Session\n"; $text .= "~~~~~~~\n"; $text .= Dumper($self->session); } eval { utf8::encode($text) if utf8::is_utf8 $text }; my $mail = MIME::Lite->new( From => $from, To => $to, Subject => $subject, Type => 'multipart/mixed', ); $mail->attach( Type => 'text/plain; charset=utf-8', Data => $text ); $text = "Request\n"; $text .= "~~~~~~~\n"; my $req = $self->req->to_string; $req =~ s/^/ /gm; $text .= $req; $mail->attach( Type => 'text/plain; charset=utf-8', Filename => 'request.txt', Disposition => 'inline', Data => $text ); $mail->add($_ => $headers->{$_}) for keys %$headers; return $mail; }; sub register { my ($self, $app, $conf) = @_; my $cb = $conf->{send} || sub { $_[0]->send }; croak "Usage: app->plugin('ExceptionMail'[, send => sub { ... })'" unless 'CODE' eq ref $cb; my $headers = $conf->{headers} || {}; my $from = $conf->{from} || 'root@localhost'; my $to = $conf->{to} || 'webmaster@localhost'; croak "headers must be a HASHREF" unless 'HASH' eq ref $headers; $app->hook(around_dispatch => sub { my ($next, $c) = @_; my $e; { local $SIG{__DIE__} = sub { ($e) = @_; unless (ref $e and $e->isa('Mojo::Exception')) { my @caller = caller; $e = Mojo::Exception->new( sprintf '%s at %s line %d', "$e", @caller[1,2]); my @frames; for (my $i = 0; caller($i); $i++) { push @frames => [ caller $i ]; } $e->frames(\@frames); } CORE::die $_[0]; }; eval { $next->() }; } return unless $@; $e = Mojo::Exception->new($@) unless $e; my $hdrs = $headers; $hdrs = { %$hdrs, %{ $e->{local_headers} } } if ref $e->{local_headers}; my $mail = $mail_prepare->( $e, $conf, $c, $from, $to, $hdrs ); eval { local $SIG{CHLD} = 'IGNORE'; local $SIG{__DIE__}; $cb->($mail, $e); 1; } or warn $@; # propagate Mojo::Exception die $e; }); $app->helper(mail_exception => sub { my ($self, $et, $hdrs) = @_; my @caller = caller 1; $et ||= 'exception'; my $e = Mojo::Exception->new( sprintf '%s at %s line %d', $et, @caller[1,2] ); my @frames; for (my $i = 1; caller($i); $i++) { push @frames => [ caller $i ]; } $e->frames(\@frames); $e->{local_headers} = $hdrs; CORE::die $e; }); } 1;