Gecko [ fernandoquevedodop.com ]

Name	Size	Permission
Box	[ DIR ]	drwxr-xr-x
Field	[ DIR ]	drwxr-xr-x
IMAPClient	[ DIR ]	drwxr-xr-x
Mailer	[ DIR ]	drwxr-xr-x
Message	[ DIR ]	drwxr-xr-x
Sender	[ DIR ]	drwxr-xr-x
Transport	[ DIR ]	drwxr-xr-x
Address.pm	6.84 KB	-rw-r--r--
Address.pod	4.07 KB	-rw-r--r--
Box-Cookbook.pod	9.57 KB	-rw-r--r--
Box-Index.pod	9.18 KB	-rw-r--r--
Box-Overview.pod	13.74 KB	-rw-r--r--
Box.pm	20.58 KB	-rw-r--r--
Box.pod	51.29 KB	-rw-r--r--
Cap.pm	6.42 KB	-rw-r--r--
Cap.pod	3.78 KB	-rw-r--r--
Field.pm	4.94 KB	-rw-r--r--
Field.pod	4.91 KB	-rw-r--r--
Filter.pm	1.44 KB	-rw-r--r--
Filter.pod	2.82 KB	-rw-r--r--
Header.pm	13.82 KB	-rw-r--r--
Header.pod	7.76 KB	-rw-r--r--
IMAPClient.pm	103.52 KB	-rw-r--r--
IMAPClient.pod	138.97 KB	-rw-r--r--
Identity.pm	4.09 KB	-rw-r--r--
Identity.pod	8.59 KB	-rw-r--r--
Internet.pm	12.26 KB	-rw-r--r--
Internet.pod	10.24 KB	-rw-r--r--
Mailer.pm	4.94 KB	-rw-r--r--
Mailer.pod	4.1 KB	-rw-r--r--
Message.pm	15.83 KB	-rw-r--r--
Message.pod	44.71 KB	-rw-r--r--
POP3Client.pm	41.92 KB	-rw-r--r--
Reporter.pm	5.57 KB	-rw-r--r--
Reporter.pod	9.72 KB	-rw-r--r--
Send.pm	1.35 KB	-rw-r--r--
Send.pod	3.17 KB	-rw-r--r--
Sender.pm	100.94 KB	-rw-r--r--
Sendmail.pm	32.64 KB	-rw-r--r--
Server.pm	510 B	-rw-r--r--
Server.pod	1.51 KB	-rw-r--r--
Transport.pm	2.8 KB	-rw-r--r--
Transport.pod	7.18 KB	-rw-r--r--
Util.pm	3.36 KB	-rw-r--r--
Util.pod	3.09 KB	-rw-r--r--

Code Editor : Reporter.pm

# Copyrights 2001-2022 by [Mark Overmeer <markov@cpan.org>].
#  For other contributors see ChangeLog.
# See the manual pages for details on the licensing terms.
# Pod stripped from pm file by OODoc 2.03.
# This code is part of distribution Mail-Message.  Meta-POD processed with
# OODoc into POD and HTML manual-pages.  See README.md
# Copyright Mark Overmeer.  Licensed under the same terms as Perl itself.

package Mail::Reporter;
use vars '$VERSION';
$VERSION = '3.012';

use strict;
use warnings;

use Carp;
use Scalar::Util 'dualvar';

my @levelname = (undef, qw(DEBUG NOTICE PROGRESS WARNING ERROR NONE INTERNAL));

my %levelprio = (ERRORS => 5, WARNINGS => 4, NOTICES => 2);
for(my $l = 1; $l < @levelname; $l++)
{   $levelprio{$levelname[$l]} = $l;
    $levelprio{$l} = $l;
}

sub new(@)
{   my $class = shift;
#confess "Parameter list has odd length: @_" if @_ % 2;
    (bless {MR_log => 1, MR_trace => 1}, $class)->init({@_});
}

my($default_log, $default_trace, $trace_callback);
sub init($)
{   my ($self, $args) = @_;
    $self->{MR_log}   = $levelprio{$args->{log}   || $default_log};
    $self->{MR_trace} = $levelprio{$args->{trace} || $default_trace};
    $self;
}

#------------------------------------------

sub _trace_warn($$$)
{   my ($who, $level, $text) = @_;
    warn "$level: $text\n";
}

sub defaultTrace(;$$)
{   my $thing = shift;

return ($default_log, $default_trace)
        unless @_;

my $level = shift;
    my $prio  = $thing->logPriority($level)
        or croak "Unknown trace-level $level.";

if( ! @_)
    {   $default_log    = $default_trace = $prio;
        $trace_callback = \&_trace_warn;
    }
    elsif(ref $_[0])
    {   $default_log    = $thing->logPriority('NONE');
        $default_trace  = $prio;
        $trace_callback = shift;
    }
    else
    {   $default_log    = $prio;
        $default_trace  = $thing->logPriority(shift);
        $trace_callback = \&_trace_warn;
    }

($default_log, $default_trace);
}

__PACKAGE__->defaultTrace('WARNINGS');

#------------------------------------------

sub trace(;$$)
{   my $self = shift;

return $self->logPriority($self->{MR_trace})
        unless @_;

my $level = shift;
    my $prio  = $levelprio{$level}
        or croak "Unknown trace-level $level.";

$self->{MR_trace} = $prio;
}

#------------------------------------------

# Implementation detail: the Mail::Box::Parser::C code avoids calls back
# to Perl by checking the trace-level itself.  In the perl code of this
# module however, just always call the log() method, and let it check
# whether or not to display it.

sub log(;$@)
{   my $thing = shift;

if(ref $thing)   # instance call
    {   return $thing->logPriority($thing->{MR_log})
            unless @_;

my $level = shift;
        my $prio  = $levelprio{$level}
            or croak "Unknown log-level $level";

return $thing->{MR_log} = $prio
            unless @_;

my $text    = join '', @_;
        $trace_callback->($thing, $level, $text)
            if $prio >= $thing->{MR_trace};
use Carp;
$thing->{MR_trace} or confess;

push @{$thing->{MR_report}[$prio]}, $text
            if $prio >= $thing->{MR_log};
    }
    else             # class method
    {   my $level = shift;
        my $prio  = $levelprio{$level}
            or croak "Unknown log-level $level";

$trace_callback->($thing, $level, join('',@_)) 
           if $prio >= $default_trace;
    }

$thing;
}

#------------------------------------------

sub report(;$)
{   my $self    = shift;
    my $reports = $self->{MR_report} || return ();

if(@_)
    {   my $level = shift;
        my $prio  = $levelprio{$level}
            or croak "Unknown report level $level.";

return $reports->[$prio] ? @{$reports->[$prio]} : ();
    }

my @reports;
    for(my $prio = 1; $prio < @$reports; $prio++)
    {   next unless $reports->[$prio];
        my $level = $levelname[$prio];
        push @reports, map { [ $level, $_ ] } @{$reports->[$prio]};
    }

@reports;
}

#-------------------------------------------

sub addReport($)
{   my ($self, $other) = @_;
    my $reports = $other->{MR_report} || return ();

for(my $prio = 1; $prio < @$reports; $prio++)
    {   push @{$self->{MR_report}[$prio]}, @{$reports->[$prio]}
            if exists $reports->[$prio];
    }
    $self;
}
    
#-------------------------------------------

sub reportAll(;$)
{   my $self = shift;
    map { [ $self, @$_ ] } $self->report(@_);
}

#-------------------------------------------

sub errors(@)   {shift->report('ERRORS')}

#-------------------------------------------

sub warnings(@) {shift->report('WARNINGS')}

#-------------------------------------------

sub notImplemented(@)
{   my $self    = shift;
    my $package = ref $self || $self;
    my $sub     = (caller 1)[3];

$self->log(ERROR => "Package $package does not implement $sub.");
    confess "Please warn the author, this shouldn't happen.";
}

#------------------------------------------

sub logPriority($)
{   my $level = $levelprio{$_[1]} or return undef;
    dualvar $level, $levelname[$level];
}

#-------------------------------------------

sub logSettings()
{  my $self = shift;
   (log => $self->{MR_log}, trace => $self->{MR_trace});
}

#-------------------------------------------

sub AUTOLOAD(@)
{   my $thing   = shift;
    our $AUTOLOAD;
    my $class   = ref $thing || $thing;
    (my $method = $AUTOLOAD) =~ s/^.*\:\://;

$Carp::MaxArgLen=20;
    confess "Method $method() is not defined for a $class.\n";
}

#-------------------------------------------

sub DESTROY {shift}

${this.title}

Code Editor : Reporter.pm