view release on metacpan or  search on metacpan

lib/Carp/Notify.pm  view on Meta::CPAN

            if ($arg =~ /^$settables$/o){
                $init{$arg} = shift;
            }
            else {$errors .= "\t$arg\n"};
        };

        %init = (%def, %init);

        my( $stored_vars, $stack, $environment ) = ( '', '', '' );

        $stored_vars = store_vars()  if $init{'store_vars'};
        $stack       = stack_trace() if $init{'stack_trace'};
        $environment = store_env()   if $init{'store_env'};

        my $message = "";

        my $method = $Carp::Notify::fatal ? 'explosion' : 'notification';

        $message .= "An error via $method occurred on " . today() . "\n";

        $message .= "\n>>>>>>>>>\nERROR MESSAGES\n>>>>>>>>>\n\n$errors\n<<<<<<<<<\nEND ERROR MESSAGES\n<<<<<<<<<\n"          if $errors;
        $message .= "\n>>>>>>>>>\nSTORED VARIABLES\n>>>>>>>>>\n\n$stored_vars\n<<<<<<<<<\nEND STORED VARIABLES\n<<<<<<<<<\n" if $stored_vars;
        $message .= "\n>>>>>>>>>\nCALL STACK TRACE\n>>>>>>>>>\n\n$stack\n<<<<<<<<<\nEND CALL STACK TRACE\n<<<<<<<<<\n"       if $init{'stack_trace'};
        $message .= "\n>>>>>>>>>\nENVIRONMENT\n>>>>>>>>>\n\n$environment\n<<<<<<<<<\nEND ENVIRONMENT\n<<<<<<<<<\n"           if $init{'store_env'};

        log_it(
            "log_it"         => $init{'log_it'},
            "log_file"       => $init{'log_file'},

            "log_explode"    => $Carp::Notify::fatal && $init{"log_explode"} ? $init{"log_explode"} : 0,
            "explode_log"    => $init{'explode_log'},

            "log_notify"     => ! $Carp::Notify::fatal && $init{"log_notify"} ? $init{"log_notify"} : 0,
            "notify_log"     => $init{"notify_log"},

            "message"        => $message,
            "error_function" => $init{'error_function'}
        );

        simple_smtp_mailer(
            "email"          => $init{'email'},
            "return"         => $init{'return'},
            "message"        => $message,
            "subject"        => $init{'subject'},
            "smtp"           => $init{'smtp'},
            "port"           => $init{'port'},
            "error_function" => $init{'error_function'}
        ) if $init{'email_it'};

        if ($Carp::Notify::fatal){
            if ($init{'die_quietly'}){
                exit;
            }
            elsif ($init{'death_function'}){
                if (ref $init{'death_function'} eq 'CODE'){
                    $init{'death_function'}->(%init, 'errors' => $errors);
                }
                else {
                    # this wants rework, badly
                    no strict 'vars';
                    my ($calling_package) = (caller)[0];
                    my $package = $calling_package . "::";
                    $package = $1 if $init{'death_function'} =~ s/(.+::)//;
                    $init{'death_function'} =~ s/^&//;
                    &{$package . $init{'death_function'}}(%init, 'errors' => $errors);
                    exit;
                };
            }
            else {
                if ($init{'die_to_stdout'}){
                    print STDERR $init{'death_message'} if $init{'die_everywhere'};
                    print $init{'death_message'};
                    exit;
                }
                else {
                    print $init{'death_message'} if $init{'die_everywhere'};
                    die $init{'death_message'};
                };
            };
        }
        else {
            $Carp::Notify::fatal = 1;
            return;
        };
    };
};


# psst!  If you're looking for store_vars, it's up at the top wrapped up with import!

sub store_env {
    my $env = '';
    foreach (sort keys %ENV){
        $env .= "\t$_ : $ENV{$_}\n";
    };
    return $env;
};

sub stack_trace {
    my $caller_count = 1;
    my $caller_stack = undef;
    my @verbose_caller = ("Package: ", "Filename: ", "Line number: ", "Subroutine: ", "Has Args? : ", "Want array? : ", "Evaltext: ", "Is require? : ");

    push @verbose_caller, ("Hints:  ", "Bitmask:  ") if $] >= 5.006; # 5.6 has a more verbose caller stack.

    while (my @caller = caller($caller_count++)){
        $caller_stack .= "\t---------\n";
        foreach (0..$#caller){
            $caller_stack .= "\t\t$verbose_caller[$_]$caller[$_]\n" if $caller[$_];
        };
    };

    $caller_stack .= "\t---------\n";
    return $caller_stack;
};

sub log_it {
    my %init = @_;

    my $message  = $init{message};

lib/Carp/Notify.pm  view on Meta::CPAN

        print MAIL $i_say if $i_say;
        my $response = <MAIL> || "";

        if (! $response || $response =~ /^[45]/){
            $i_die =~ s/\?/$response/;
            return error($init{'error_function'}, $i_die);
        };
        return error($init{'error_function'}, "Server disconnected: $response") if $response =~ /^221/;

    };
    # built

    # send the data
    print MAIL "Date: ", today();
    print MAIL "From: $init{'return'}";
    print MAIL "Subject: $init{'subject'}";
    print MAIL "To: $init{'email'}";
    print MAIL "X-Priority:2  (High)";
    print MAIL "X-Carp-Notify: $Carp::Notify::VERSION";

    print MAIL "";

    $message =~ s/^\./../gm;
    $message =~ s/(\r?\n|\r)/\015\012/g;

    print MAIL $message;

    print MAIL ".";
    # sent

    return 1; # yay!
};

sub today {
    my @months = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
    my @days   = qw(Sun Mon Tue Wed Thu Fri Sat);

    my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = localtime(time);
    $year += 1900;
    my ($gmin, $ghour, $gsdst) = (gmtime(time))[1,2, -1];

    my $diffhour = $hour - $ghour;
    $diffhour = 12 - $diffhour if $diffhour > 12;
    $diffhour = 12 + $diffhour if $diffhour < -12;

    ($diffhour = sprintf("%03d", $diffhour)) =~ s/^0/\+/;

    return sprintf("%s, %02d %s %04d %02d:%02d:%02d %05s",
        $days[$wday], $mday, $months[$mon], $year, $hour, $min, $sec, $diffhour . sprintf("%02d", $min - $gmin));
};

# error does nothing unless you specify the error_function, in that case it's called with the error provided.
sub error {
    my ($func, $error) = @_;
    if (ref $func eq 'CODE'){
        $func->($error);
    }
    elsif ($func){
        # this wants reworked
        no strict 'refs';
        my ($calling_package) = (caller)[0];
        my $package = $calling_package . "::";
        $package = $1 if $$func =~ s/(.+::)//;
        &{$package . $func}($error);
    }
    else {
        return;
    };
};


1;

__END__

=pod

=encoding UTF-8

=head1 NAME

Carp::Notify - Loudly complain in lots of places when things break badly

=head1 VERSION

version 1.13

=head1 SYNOPSIS

Use it in place of die or croak, or warn or carp.

 # with Carp;
 use Carp;
 if ($something_a_little_bad) { carp("Oh no, a minor error!")};
 if ($something_bad) { croak ("Oh no an error!")};


 # with Carp::Notify;
 use Carp::Notify;
 if (something_a_little_bad) {notify("Oh no, a minor error!")};
 if ($something_bad) { explode ("Oh no an error!")};

=head1 DESCRIPTION

Carp::Notify is an error reporting module designed for applications that are running unsupervised (a CGI script, for example,
or a cron job).  If a program has an explosion, it terminates (same as die or croak or exit, depending on preference) and
then emails someone with useful information about what caused the problem.  Said information can also be logged to a file.
If you want the program to tell you something about an error that's non fatal (disk size approaching full, but not quite
there, for example), then you can have it notify you of the error but not terminate the program.

Defaults are set up within the module, but they can be overridden once the module is used, or as individual explosions take place.
B<Please> set up your appropriate defaults in the module.  It'll save you headaches later.

=head1 IMPORTANT NOTE

This version is nearly identical to, and I<is> bug-for-bug compatible with, version 1.10 which has been on CPAN
for years but has not been indexed.

This public release is intended to catch the attention of anyone actually using this module and let them know
that changes are coming!