This file is indexed.

/usr/share/perl5/Log/Dispatch.pm is in liblog-dispatch-perl 2.58-1.

This file is owned by root:root, with mode 0o644.

The actual contents of the file can be viewed below.

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
package Log::Dispatch;

use 5.006;

use strict;
use warnings;

our $VERSION = '2.58';

use base qw( Log::Dispatch::Base );

use Log::Dispatch::Vars qw( %CanonicalLevelNames @OrderedLevels );
use Module::Runtime qw( use_package_optimistically );
use Params::Validate 1.03 qw(validate_with ARRAYREF CODEREF);
use Carp ();

BEGIN {
    foreach my $l ( keys %CanonicalLevelNames ) {
        my $sub = sub {
            my $self = shift;
            $self->log(
                level   => $CanonicalLevelNames{$l},
                message => @_ > 1 ? "@_" : $_[0],
            );
        };

        no strict 'refs';
        *{$l} = $sub;
    }
}

sub new {
    my $proto = shift;
    my $class = ref $proto || $proto;

    my %p = validate_with(
        params => \@_,
        spec   => {
            outputs   => { type => ARRAYREF,           optional => 1 },
            callbacks => { type => ARRAYREF | CODEREF, optional => 1 }
        },
        allow_extra => 1,    # for backward compatibility
    );

    my $self = bless {}, $class;

    my @cb = $self->_get_callbacks(%p);
    $self->{callbacks} = \@cb if @cb;

    if ( my $outputs = $p{outputs} ) {
        if ( ref $outputs->[1] eq 'HASH' ) {

            # 2.23 API
            # outputs => [
            #   File => { min_level => 'debug', filename => 'logfile' },
            #   Screen => { min_level => 'warning' }
            # ]
            while ( my ( $class, $params ) = splice @$outputs, 0, 2 ) {
                $self->_add_output( $class, %$params );
            }
        }
        else {

            # 2.24+ syntax
            # outputs => [
            #   [ 'File',   min_level => 'debug', filename => 'logfile' ],
            #   [ 'Screen', min_level => 'warning' ]
            # ]
            foreach my $arr (@$outputs) {
                die "expected arrayref, not '$arr'"
                    unless ref $arr eq 'ARRAY';
                $self->_add_output(@$arr);
            }
        }
    }

    return $self;
}

sub clone {
    my $self = shift;

    my %clone = (
        callbacks => [ @{ $self->{callbacks} || [] } ],
        outputs   => { %{ $self->{outputs}   || {} } },
    );

    return bless \%clone, ref $self;
}

sub _add_output {
    my $self  = shift;
    my $class = shift;

    my $full_class
        = substr( $class, 0, 1 ) eq '+'
        ? substr( $class, 1 )
        : "Log::Dispatch::$class";

    use_package_optimistically($full_class);

    $self->add( $full_class->new(@_) );
}

sub add {
    my $self   = shift;
    my $object = shift;

    # Once 5.6 is more established start using the warnings module.
    if ( exists $self->{outputs}{ $object->name } && $^W ) {
        Carp::carp(
            "Log::Dispatch::* object ", $object->name,
            " already exists."
        );
    }

    $self->{outputs}{ $object->name } = $object;
}

sub remove {
    my $self = shift;
    my $name = shift;

    return delete $self->{outputs}{$name};
}

sub outputs {
    my $self = shift;

    return values %{ $self->{outputs} };
}

sub callbacks {
    my $self = shift;

    return @{ $self->{callbacks} };
}

sub log {
    my $self = shift;
    my %p    = @_;

    if ( exists $p{level} && $p{level} =~ /\A[0-7]\z/ ) {
        $p{level} = $OrderedLevels[ $p{level} ];
    }

    return unless $self->would_log( $p{level} );

    $self->_log_to_outputs( $self->_prepare_message(%p) );
}

sub _prepare_message {
    my $self = shift;
    my %p    = @_;

    $p{message} = $p{message}->()
        if ref $p{message} eq 'CODE';

    $p{message} = $self->_apply_callbacks(%p)
        if $self->{callbacks};

    return %p;
}

sub _log_to_outputs {
    my $self = shift;
    my %p    = @_;

    foreach ( keys %{ $self->{outputs} } ) {
        $p{name} = $_;
        $self->_log_to(%p);
    }
}

sub log_and_die {
    my $self = shift;

    my %p = $self->_prepare_message(@_);

    $self->_log_to_outputs(%p) if $self->would_log( $p{level} );

    $self->_die_with_message(%p);
}

sub log_and_croak {
    my $self = shift;

    $self->log_and_die( @_, carp_level => 3 );
}

sub _die_with_message {
    my $self = shift;
    my %p    = @_;

    my $msg = $p{message};

    local $Carp::CarpLevel = ( $Carp::CarpLevel || 0 ) + $p{carp_level}
        if exists $p{carp_level};

    Carp::croak($msg);
}

sub log_to {
    my $self = shift;
    my %p    = @_;

    $p{message} = $self->_apply_callbacks(%p)
        if $self->{callbacks};

    $self->_log_to(%p);
}

sub _log_to {
    my $self = shift;
    my %p    = @_;
    my $name = $p{name};

    if ( exists $self->{outputs}{$name} ) {
        $self->{outputs}{$name}->log(@_);
    }
    elsif ($^W) {
        Carp::carp(
            "Log::Dispatch::* object named '$name' not in dispatcher\n");
    }
}

sub output {
    my $self = shift;
    my $name = shift;

    return unless exists $self->{outputs}{$name};

    return $self->{outputs}{$name};
}

sub level_is_valid {
    shift;
    my $level = shift;

    if ( !defined $level ) {
        Carp::croak('Logging level was not provided');
    }

    return $CanonicalLevelNames{$level};
}

sub would_log {
    my $self  = shift;
    my $level = shift;

    return 0 unless $self->level_is_valid($level);

    foreach ( values %{ $self->{outputs} } ) {
        return 1 if $_->_should_log($level);
    }

    return 0;
}

sub is_debug     { $_[0]->would_log('debug') }
sub is_info      { $_[0]->would_log('info') }
sub is_notice    { $_[0]->would_log('notice') }
sub is_warning   { $_[0]->would_log('warning') }
sub is_warn      { $_[0]->would_log('warn') }
sub is_error     { $_[0]->would_log('error') }
sub is_err       { $_[0]->would_log('err') }
sub is_critical  { $_[0]->would_log('critical') }
sub is_crit      { $_[0]->would_log('crit') }
sub is_alert     { $_[0]->would_log('alert') }
sub is_emerg     { $_[0]->would_log('emerg') }
sub is_emergency { $_[0]->would_log('emergency') }

1;

# ABSTRACT: Dispatches messages to one or more outputs

__END__

=pod

=encoding UTF-8

=head1 NAME

Log::Dispatch - Dispatches messages to one or more outputs

=head1 VERSION

version 2.58

=head1 SYNOPSIS

  use Log::Dispatch;

  # Simple API
  #
  my $log = Log::Dispatch->new(
      outputs => [
          [ 'File',   min_level => 'debug', filename => 'logfile' ],
          [ 'Screen', min_level => 'warning' ],
      ],
  );

  $log->info('Blah, blah');

  # More verbose API
  #
  my $log = Log::Dispatch->new();
  $log->add(
      Log::Dispatch::File->new(
          name      => 'file1',
          min_level => 'debug',
          filename  => 'logfile'
      )
  );
  $log->add(
      Log::Dispatch::Screen->new(
          name      => 'screen',
          min_level => 'warning',
      )
  );

  $log->log( level => 'info', message => 'Blah, blah' );

  my $sub = sub { my %p = @_; return reverse $p{message}; };
  my $reversing_dispatcher = Log::Dispatch->new( callbacks => $sub );

=head1 DESCRIPTION

This module manages a set of Log::Dispatch::* output objects that can be
logged to via a unified interface.

The idea is that you create a Log::Dispatch object and then add various
logging objects to it (such as a file logger or screen logger). Then you
call the C<log> method of the dispatch object, which passes the message to
each of the objects, which in turn decide whether or not to accept the
message and what to do with it.

This makes it possible to call single method and send a message to a
log file, via email, to the screen, and anywhere else, all with very
little code needed on your part, once the dispatching object has been
created.

=head1 METHODS

This class provides the following methods:

=head2 Log::Dispatch->new(...)

This method takes the following parameters:

=over 4

=item * outputs( [ [ class, params, ... ], [ class, params, ... ], ... ] )

This parameter is a reference to a list of lists. Each inner list consists of
a class name and a set of constructor params. The class is automatically
prefixed with 'Log::Dispatch::' unless it begins with '+', in which case the
string following '+' is taken to be a full classname. e.g.

    outputs => [ [ 'File',          min_level => 'debug', filename => 'logfile' ],
                 [ '+My::Dispatch', min_level => 'info' ] ]

For each inner list, a new output object is created and added to the
dispatcher (via the C<add()> method).

See L<OUTPUT CLASSES> for the parameters that can be used when creating an
output object.

=item * callbacks( \& or [ \&, \&, ... ] )

This parameter may be a single subroutine reference or an array
reference of subroutine references. These callbacks will be called in
the order they are given and passed a hash containing the following keys:

 ( message => $log_message, level => $log_level )

In addition, any key/value pairs passed to a logging method will be
passed onto your callback.

The callbacks are expected to modify the message and then return a
single scalar containing that modified message. These callbacks will
be called when either the C<log> or C<log_to> methods are called and
will only be applied to a given message once. If they do not return
the message then you will get no output. Make sure to return the
message!

=back

=head2 $dispatch->clone()

This returns a I<shallow> clone of the original object. The underlying output
objects and callbacks are shared between the two objects. However any changes
made to the outputs or callbacks that the object contains are not shared.

=head2 $dispatch->log( level => $, message => $ or \& )

Sends the message (at the appropriate level) to all the output objects that
the dispatcher contains (by calling the C<log_to> method repeatedly).

The level can be specified by name or by an integer from 0 (debug) to 7
(critical).

This method also accepts a subroutine reference as the message
argument. This reference will be called only if there is an output
that will accept a message of the specified level.

=head2 $dispatch->debug (message), info (message), ...

You may call any valid log level (including valid abbreviations) as a method
with a single argument that is the message to be logged. This is converted
into a call to the C<log> method with the appropriate level.

For example:

 $log->alert('Strange data in incoming request');

translates to:

 $log->log( level => 'alert', message => 'Strange data in incoming request' );

If you pass an array to these methods, it will be stringified as is:

 my @array = ('Something', 'bad', 'is', 'here');
 $log->alert(@array);

 # is equivalent to

 $log->alert("@array");

You can also pass a subroutine reference, just like passing one to the
C<log()> method.

=head2 $dispatch->log_and_die( level => $, message => $ or \& )

Has the same behavior as calling C<log()> but calls
C<_die_with_message()> at the end.

=head2 $dispatch->log_and_croak( level => $, message => $ or \& )

This method adjusts the C<$Carp::CarpLevel> scalar so that the croak
comes from the context in which it is called.

You can throw exception objects by subclassing this method.

If the C<carp_level> parameter is present its value will be added to
the current value of C<$Carp::CarpLevel>.

=head2 $dispatch->log_to( name => $, level => $, message => $ )

Sends the message only to the named object. Note: this will not properly
handle a subroutine reference as the message.

=head2 $dispatch->add_callback( $code )

Adds a callback (like those given during construction). It is added to the end
of the list of callbacks. Note that this can also be called on individual
output objects.

=head2 $dispatch->remove_callback( $code )

Remove the given callback from the list of callbacks. Note that this can also
be called on individual output objects.

=head2 $dispatch->callbacks()

Returns a list of the callbacks in a given output.

=head2 $dispatch->level_is_valid( $string )

Returns true or false to indicate whether or not the given string is a
valid log level. Can be called as either a class or object method.

=head2 $dispatch->would_log( $string )

Given a log level, returns true or false to indicate whether or not
anything would be logged for that log level.

=head2 $dispatch->is_C<$level>

There are methods for every log level: C<is_debug()>, C<is_warning()>, etc.

This returns true if the logger will log a message at the given level.

=head2 $dispatch->add( Log::Dispatch::* OBJECT )

Adds a new L<output object|OUTPUT CLASSES> to the dispatcher. If an object
of the same name already exists, then that object is replaced, with
a warning if C<$^W> is true.

=head2 $dispatch->remove($)

Removes the output object that matches the name given to the remove method.
The return value is the object being removed or undef if no object
matched this.

=head2 $dispatch->outputs()

Returns a list of output objects.

=head2 $dispatch->output( $name )

Returns the output object of the given name. Returns undef or an empty
list, depending on context, if the given output does not exist.

=head2 $dispatch->_die_with_message( message => $, carp_level => $ )

This method is used by C<log_and_die> and will either die() or croak()
depending on the value of C<message>: if it's a reference or it ends
with a new line then a plain die will be used, otherwise it will
croak.

=head1 OUTPUT CLASSES

An output class - e.g. L<Log::Dispatch::File> or
L<Log::Dispatch::Screen> - implements a particular way
of dispatching logs. Many output classes come with this distribution,
and others are available separately on CPAN.

The following common parameters can be used when creating an output class.
All are optional. Most output classes will have additional parameters beyond
these, see their documentation for details.

=over 4

=item * name ($)

A name for the object (not the filename!). This is useful if you want to
refer to the object later, e.g. to log specifically to it or remove it.

By default a unique name will be generated. You should not depend on the
form of generated names, as they may change.

=item * min_level ($)

The minimum L<logging level|LOG LEVELS> this object will accept. Required.

=item * max_level ($)

The maximum L<logging level|LOG LEVELS> this object will accept. By default
the maximum is the highest possible level (which means functionally that the
object has no maximum).

=item * callbacks( \& or [ \&, \&, ... ] )

This parameter may be a single subroutine reference or an array
reference of subroutine references. These callbacks will be called in
the order they are given and passed a hash containing the following keys:

 ( message => $log_message, level => $log_level )

The callbacks are expected to modify the message and then return a
single scalar containing that modified message. These callbacks will
be called when either the C<log> or C<log_to> methods are called and
will only be applied to a given message once. If they do not return
the message then you will get no output. Make sure to return the
message!

=item * newline (0|1)

If true, a callback will be added to the end of the callbacks list that adds
a newline to the end of each message. Default is false, but some
output classes may decide to make the default true.

=back

=head1 LOG LEVELS

The log levels that Log::Dispatch uses are taken directly from the
syslog man pages (except that I expanded them to full words). Valid
levels are:

=over 4

=item debug

=item info

=item notice

=item warning

=item error

=item critical

=item alert

=item emergency

=back

Alternately, the numbers 0 through 7 may be used (debug is 0 and emergency is
7). The syslog standard of 'err', 'crit', and 'emerg' is also acceptable. We
also allow 'warn' as a synonym for 'warning'.

=head1 SUBCLASSING

This module was designed to be easy to subclass. If you want to handle
messaging in a way not implemented in this package, you should be able to add
this with minimal effort. It is generally as simple as subclassing
Log::Dispatch::Output and overriding the C<new> and C<log_message>
methods. See the L<Log::Dispatch::Output> docs for more details.

If you would like to create your own subclass for sending email then
it is even simpler. Simply subclass L<Log::Dispatch::Email> and
override the C<send_email> method. See the L<Log::Dispatch::Email>
docs for more details.

The logging levels that Log::Dispatch uses are borrowed from the standard
UNIX syslog levels, except that where syslog uses partial words ("err")
Log::Dispatch also allows the use of the full word as well ("error").

=head1 RELATED MODULES

=head2 Log::Dispatch::DBI

Written by Tatsuhiko Miyagawa. Log output to a database table.

=head2 Log::Dispatch::FileRotate

Written by Mark Pfeiffer. Rotates log files periodically as part of
its usage.

=head2 Log::Dispatch::File::Stamped

Written by Eric Cholet. Stamps log files with date and time
information.

=head2 Log::Dispatch::Jabber

Written by Aaron Straup Cope. Logs messages via Jabber.

=head2 Log::Dispatch::Tk

Written by Dominique Dumont. Logs messages to a Tk window.

=head2 Log::Dispatch::Win32EventLog

Written by Arthur Bergman. Logs messages to the Windows event log.

=head2 Log::Log4perl

An implementation of Java's log4j API in Perl. Log messages can be limited by
fine-grained controls, and if they end up being logged, both native Log4perl
and Log::Dispatch appenders can be used to perform the actual logging
job. Created by Mike Schilli and Kevin Goess.

=head2 Log::Dispatch::Config

Written by Tatsuhiko Miyagawa. Allows configuration of logging via a
text file similar (or so I'm told) to how it is done with log4j.
Simpler than Log::Log4perl.

=head2 Log::Agent

A very different API for doing many of the same things that
Log::Dispatch does. Originally written by Raphael Manfredi.

=head1 SEE ALSO

L<Log::Dispatch::ApacheLog>, L<Log::Dispatch::Email>,
L<Log::Dispatch::Email::MailSend>, L<Log::Dispatch::Email::MailSender>,
L<Log::Dispatch::Email::MailSendmail>, L<Log::Dispatch::Email::MIMELite>,
L<Log::Dispatch::File>, L<Log::Dispatch::File::Locked>,
L<Log::Dispatch::Handle>, L<Log::Dispatch::Output>, L<Log::Dispatch::Screen>,
L<Log::Dispatch::Syslog>

=head1 SUPPORT

Bugs may be submitted through L<https://github.com/houseabsolute/Log-Dispatch/issues>.

I am also usually active on IRC as 'autarch' on C<irc://irc.perl.org>.

=head1 DONATIONS

If you'd like to thank me for the work I've done on this module, please
consider making a "donation" to me via PayPal. I spend a lot of free time
creating free software, and would appreciate any support you'd care to offer.

Please note that B<I am not suggesting that you must do this> in order for me
to continue working on this particular software. I will continue to do so,
inasmuch as I have in the past, for as long as it interests me.

Similarly, a donation made in this way will probably not make me work on this
software much more, unless I get so many donations that I can consider working
on free software full time (let's all have a chuckle at that together).

To donate, log into PayPal and send money to autarch@urth.org, or use the
button at L<http://www.urth.org/~autarch/fs-donation.html>.

=head1 AUTHOR

Dave Rolsky <autarch@urth.org>

=head1 CONTRIBUTORS

=for stopwords Doug Bell Graham Ollis Gregory Oschwald Jonathan Swartz Karen Etheridge Konrad Bucheli Olaf Alders Olivier Mengué Rohan Carly Ross Attrill Salvador Fandiño Steve Bertrand Whitney Jackson

=over 4

=item *

Doug Bell <madcityzen@gmail.com>

=item *

Graham Ollis <plicease@cpan.org>

=item *

Gregory Oschwald <goschwald@maxmind.com>

=item *

Jonathan Swartz <swartz@pobox.com>

=item *

Karen Etheridge <ether@cpan.org>

=item *

Konrad Bucheli <kb@open.ch>

=item *

Olaf Alders <olaf@wundersolutions.com>

=item *

Olivier Mengué <dolmen@cpan.org>

=item *

Rohan Carly <se456@rohan.id.au>

=item *

Ross Attrill <ross.attrill@gmail.com>

=item *

Salvador Fandiño <sfandino@yahoo.com>

=item *

Steve Bertrand <steveb@cpan.org>

=item *

Whitney Jackson <whitney.jackson@baml.com>

=back

=head1 COPYRIGHT AND LICENSE

This software is Copyright (c) 2016 by Dave Rolsky.

This is free software, licensed under:

  The Artistic License 2.0 (GPL Compatible)

=cut