libmojolicious-plugin-mailexception-perl-0.18/0000755000000000000000000000000012236375477020276 5ustar rootrootlibmojolicious-plugin-mailexception-perl-0.18/Makefile.PL0000664000000000000000000000166412236367647022261 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.18/t/0000775000000000000000000000000012236373736020537 5ustar rootrootlibmojolicious-plugin-mailexception-perl-0.18/t/010-tplugun.t0000644000000000000000000001017712236373736022724 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 => 33; 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'); $t -> get_ok('/') -> status_is(200) -> content_is('Hello') ; $t -> get_ok('/crash') -> status_is(500) -> element_exists('div#showcase > pre') -> content_like(qr{
превед, медвед})
    -> content_like(qr{
        ]+class="important"[^>]*>
        \s*
        
        \s*
        ]+class="value"[^>]*>
        \s*
        ]+class="prettyprint"[^>]*>
        \s*
        [^>]*
        die\s+marker1
    }x
    )
;



is  scalar @elist, 1, 'one caugth exception';
my $e = shift @elist;



like $e->message, qr{превед, медвед}, 'text of message';
like $e->line->[1], qr{die "превед, медвед"}, '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)
    -> element_exists('div#showcase > pre')
    -> content_like(qr{
медвед превед})
    -> content_like(qr{
        ]+class="important"[^>]*>
        \s*
        
        \s*
        ]+class="value"[^>]*>
        \s*
        ]+class="prettyprint"[^>]*>
        \s*
        [^>]*
        die\s+marker2
    }x
    )
;
;
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)
    -> element_exists('div#showcase > pre')
    -> content_like(qr{
immediate})
    -> content_like(qr{
        ]+class="important"[^>]*>
        \s*
        
        \s*
        ]+class="value"[^>]*>
        \s*
        ]+class="prettyprint"[^>]*>
        \s*
        [^>]*
        die\s+marker3
    }x
    )
;
;
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 "превед, медвед"; ### die marker1
}

sub crash_sig {
    local $SIG{__DIE__} = sub {
        die $_[0];
    };
    die "медвед превед"; ### die marker2
}

sub crash_sub {
    $_[0]->mail_exception('immediate', { 'x-test' => 123 });  ### die marker3
}

package MpemTest;
use utf8;
use strict;
use warnings;

use Mojo::Base 'Mojolicious';


sub startup {
    my ($self) = @_;

    $self->secret('my secret phrase');
    $self->mode('development');

    $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 => {},
    );
    for 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;
libmojolicious-plugin-mailexception-perl-0.18/.gitignore0000664000000000000000000000041712105764116022255 0ustar  rootrootMYMETA.yml
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.18/Changes0000777000000000000000000000000012122163326024640 2debian/changelogustar  rootrootlibmojolicious-plugin-mailexception-perl-0.18/lib/0000775000000000000000000000000012064121762021027 5ustar  rootrootlibmojolicious-plugin-mailexception-perl-0.18/lib/Mojolicious/0000775000000000000000000000000012064121762023323 5ustar  rootrootlibmojolicious-plugin-mailexception-perl-0.18/lib/Mojolicious/Plugin/0000775000000000000000000000000012236374460024567 5ustar  rootrootlibmojolicious-plugin-mailexception-perl-0.18/lib/Mojolicious/Plugin/MailException.pm0000644000000000000000000001456312236374460027675 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 (defailt 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 mailheaders.

=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.18';
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;
libmojolicious-plugin-mailexception-perl-0.18/README0000644000000000000000000000222312064121762021136 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.18/MANIFEST0000664000000000000000000000037712122163326021416 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