File Coverage

File:blib/lib/Log/Abstraction.pm
Coverage:92.8%

linestmtbrancondsubtimecode
1package Log::Abstraction;
2
3
13
13
13
794238
7
208
use strict;
4
13
13
13
22
9
245
use warnings;
5
13
13
13
23
8
322
use Carp;       # Import Carp for warnings
6
13
13
13
2840
465007
220
use Config::Abstraction 0.36;
7
13
13
13
1317
14580
364
use Data::Dumper;
8
13
13
13
27
86
178
use Params::Get 0.13;   # Import Params::Get for parameter handling
9
13
13
13
25
5
46
use POSIX qw(strftime);
10
13
13
13
3152
18348
875
use Readonly::Values::Syslog 0.03;
11
13
13
13
2060
3172
252
use Return::Set;
12
13
13
13
26
10
246
use Scalar::Util 'blessed';     # Import Scalar::Util for object reference checking
13
13
13
13
2904
59167
22710
use Sys::Syslog 0.28;   # Import Sys::Syslog for syslog support
14
15 - 23
=head1 NAME

Log::Abstraction - Logging Abstraction Layer

=head1 VERSION

0.29

=cut
24
25our $VERSION = 0.29;
26
27 - 190
=head1 SYNOPSIS

  use Log::Abstraction;

  my $logger = Log::Abstraction->new(logger => 'logfile.log');

  $logger->debug('This is a debug message');
  $logger->info('This is an info message');
  $logger->notice('This is a notice message');
  $logger->trace('This is a trace message');
  $logger->warn({ warning => 'This is a warning message' });

=head1 DESCRIPTION

The C<Log::Abstraction> class provides a flexible logging layer on top of different types of loggers,
including code references, arrays, file paths, and objects.
It also supports logging to syslog if configured.

=head1 METHODS

=head2 new

    my $logger = Log::Abstraction->new(%args);

Creates a new C<Log::Abstraction> object.

The argument can be a hash,
a reference to a hash or the C<logger> value.
The following arguments can be provided:

=over

=item * C<carp_on_warn>

If set to 1,
and C<logger> is not given,
call C<Carp:carp> on C<warn()>.

Causes C<error()> to C<carp> if C<croak_on_error> is not given.

=item * C<croak_on_error>

If set to 1,
and C<logger> is not given,
call C<Carp:croak> on C<error()>.

=item * C<config_file>

Points to a configuration file which contains the parameters to C<new()>.
The file can be in any common format,
including C<YAML>, C<XML>, and C<INI>.
This allows the parameters to be set at run time.

On a non-Windows system,
the class can be configured using environment variables starting with C<"Log::Abstraction::">.
For example:

  export Log::Abstraction::script_name=foo

It doesn't work on Windows because of the case-insensitive nature of that system.

=item * C<level>

The minimum level at which to log something,
the default is "warning".

=item * C<logger>

A logger can be one or more of:

=over

=item * a code reference

The code will be called with a hashref containing:

=over

=item * class

=item * file

=item * line

=item * level

=item * message - an arrayref of messages

=item * ctx - passed to C<new()>, an argument that can help to give context to the caller

=back

=item * an object

=item * a hash of options

=item * sendmail - send higher priority messages to an email address

To send an e-mail,
you need L<require Email::Simple>, L<require Email::Sender::Simple> and L<Email::Sender::Transport::SMTP>.

The C<sendmail> hash also accepts a C<min_interval> key (seconds).
When set, at most one email is sent per C<min_interval> seconds; any
messages that arrive during the cooldown are still logged to other
backends but do not trigger a new email.
The send time is stored in C<_last_email_sent> on the object, so each
instance has its own cooldown window; cloned objects inherit the
parent's last-send timestamp at the moment of cloning.

=item * array - a reference to an array

=item * fd - containing a file descriptor to log to

=item * file - containing the filename

=back

Defaults to L<Log::Log4perl>.
In that case,
the argument 'verbose' to new() will raise the logging level.

=item * C<format>

The format of the message.
Expands:

=over

=item * %callstack%

=item * %level%

=item * %class%

=item * %message%

=item * %timestamp%

=%item * %env_foo%

Replaces with C<$ENV{foo}>

=back

=item * C<syslog>

A hash reference for syslog configuration.
Only warnings and above will be sent to syslog.
This restriction should be lifted in the future,
since it's reasonable to send notices and above to the syslog.

=item * C<script_name>

The name of the script.
It's needed when C<syslog> is given,
if none is passed, the value is guessed.

=back

Clone existing objects with or without modifications:

    my $clone = $logger->new();

=cut
191
192sub new {
193
1349
1520168
        my $class = shift;
194
195        # Handle hash or hashref arguments
196
1349
768
        my %args;
197
198
1349
1788
        if((scalar(@_) == 1) && (ref($_[0]) ne 'HASH')) {
199
5
8
                $args{'logger'} = shift;
200        } elsif(my $params = Params::Get::get_params(undef, \@_)) {
201
328
328
4206
395
                %args = %{$params};
202        }
203
204        # Load the configuration from a config file, if provided
205
1349
7429
        if(exists($args{'config_file'})) {
206                # my $config = YAML::XS::LoadFile($params->{'config_file'});
207
10
62
                if(!-r $args{'config_file'}) {
208
2
56
                        croak("$class: ", $args{'config_file'}, ': File not readable');
209                }
210
8
57
                if(my $config = Config::Abstraction->new(config_dirs => [''], config_file => $args{'config_file'}, env_prefix => "${class}::")) {
211
8
13795
                        $config = $config->all();
212
8
44
                        if($config->{$class}) {
213
2
1
                                $config = $config->{$class};
214                        }
215
8
12
                        my $array = $args{'array'};
216
8
8
11
25
                        %args = (%{$config}, %args);
217
8
16
                        if($array) {
218
4
7
                                $args{'array'} = $array;
219                        }
220                } else {
221
0
0
                        croak("$class: Can't load configuration from ", $args{'config_file'});
222                }
223        }
224
225
1347
1455
        if(!defined($class)) {
226                # Using Log::Abstraction:new(), not Log::Abstraction->new()
227
1
1
                $class = __PACKAGE__;
228        } elsif(Scalar::Util::blessed($class)) {
229                # If $class is an object, clone it with new arguments
230
1019
1019
476
1025
                my $clone = bless { %{$class}, %args }, ref($class);
231
1019
849
                if(my $level = $args{'level'}) {
232                        # The clone is at a different level
233
6
7
                        $level = lc($level);
234
6
11
                        if(!defined($syslog_values{$level})) {
235
1
6
                                Carp::croak("$class: invalid syslog level '$level'");
236                        }
237
5
4
                        $clone->{level} = $syslog_values{$level};
238                }
239
1018
1018
524
673
                $clone->{messages} = [ @{$class->{messages}} ];   # Deep copy
240
1018
997
                return $clone;
241        }
242
243
328
482
        if($args{'syslog'} && !$args{'script_name'}) {
244
3
12
                require File::Basename && File::Basename->import() unless File::Basename->can('basename');
245
246                # Determine script name
247
3
74
                $args{'script_name'} = File::Basename::basename($ENV{'SCRIPT_NAME'} || $0);
248
249
3
5
                croak("$class: syslog needs to know the script name") if(!defined($args{'script_name'}));
250        }
251
252
328
267
        my $level = $args{'level'};
253
328
669
        if(defined(my $logger = $args{logger})) {
254
81
133
                if(Scalar::Util::blessed($logger) && (ref($logger) eq __PACKAGE__)) {
255
2
11
                        croak("$class: attempt to encapulate ", __PACKAGE__, ' as a logging class, that would add a needless indirection');
256                }
257        } elsif((!$args{'file'}) && (!$args{'array'})) {
258                # Default to Log4perl
259
16
2717
                require Log::Log4perl;
260
16
129729
                Log::Log4perl->import();
261
262                # FIXME: add default minimum logging level
263
16
300
                Log::Log4perl->easy_init($args{verbose} ? $Log::Log4perl::DEBUG : $Log::Log4perl::ERROR);
264
16
13627
                $args{'logger'} = Log::Log4perl->get_logger();
265        }
266
267
326
1821
        if($level) {
268
306
284
                if(ref($level) eq 'ARRAY') {
269
1
1
                        $level = $level->[0];
270                }
271
306
265
                $level = lc($level);
272
306
315
                if(!defined($syslog_values{$level})) {
273
3
22
                        Carp::croak("$class: invalid syslog level '$level'");
274                }
275
303
256
                $args{'level'} = $level;
276        } else {
277                # The default minimum level at which to log something is 'warning'
278
20
26
                $args{'level'} = 'warning';
279        }
280
281        # Bless and return the object
282        return bless {
283                messages => [],      # Initialize messages array
284                %args,
285
323
1089
                level => $syslog_values{$args{'level'}},
286        }, $class;
287}
288
289=encoding utf-8
290
291 - 333
=head2 _sanitize_email_header

    my $clean_value = _sanitize_email_header($raw_value);

Internal routine to remove carriage return and line feed characters from an email header value to prevent header injection or formatting issues.

=over 4

=item * Input

Takes a single scalar value, typically a string representing an email header field.

=item * Behavior

If the input is undefined, returns `undef`. Otherwise, removes all newline characters (`\n`), carriage returns (`\r`), and CRLF pairs from the string.

=item * Output

Returns the sanitized string with CR/LF characters removed.

=back

=head3 FORMAL SPECIFICATION

If the input is undefined (∅), the output is also undefined (∅).

If the input is defined, the result is a defined string with CR and LF characters removed.

    [CHAR]

    CR, LF : CHAR
    CR == '\r'
    LF == '\n'

    STRING == seq CHAR

    SanitizeEmailHeader
        raw?: STRING
        sanitized!: STRING
        -------------------------------------------------
        sanitized! = [ c : raw? | c ≠ CR ∧ c ≠ LF ]

=cut
334
335sub _sanitize_email_header {
336
28
20154
        my $value = $_[0];
337
338
28
32
        return unless defined $value;
339
27
957
        $value =~ s/\r\n?|\n//g;        # Remove CR/LF characters
340
341
27
67
        return Return::Set::set_return($value, { type => 'string', 'matches' => qr /^[^\r\n]*$/ });
342}
343
344# Internal method to log messages. This method is called by other logging methods.
345# $logger->_log($level, @messages);
346# $logger->_log($level, \@messages);
347
348sub _log {
349
10560
6884
        my ($self, $level, @messages) = @_;
350
351
10560
11169
        if(!UNIVERSAL::isa((caller)[0], __PACKAGE__)) {
352
2
33
                Carp::croak('Illegal Operation: _log is a private method');
353        }
354
355
10558
9051
        if(!defined($syslog_values{$level})) {
356
0
0
                Carp::croak(ref($self), ": Invalid level '$level'");  # "Can't happen"
357        }
358
359
10558
7528
        if($syslog_values{$level} > $self->{'level'}) {
360                # The level is too low to log
361
142
123
                return;
362        }
363
364
10416
10626
        if((scalar(@messages) == 1) && (ref($messages[0]) eq 'ARRAY')) {
365                # Passed a reference to an array
366
5
5
3
7
                @messages = @{$messages[0]};
367        }
368
10416
7599
        @messages = grep defined, @messages;
369
370
10416
7310
        my $str = join('', @messages);
371
10416
5378
        chomp($str);
372
373        # Push the message to the internal messages array
374
10416
10416
5202
10248
        push @{$self->{messages}}, { level => $level, message => $str };
375
376
10416
10037
        my $class = blessed($self) || $self;
377
10416
7831
        if($class eq __PACKAGE__) {
378
10411
5343
                $class = '';
379        }
380
381
10416
71441
        my $timestamp = strftime '%Y-%m-%d %H:%M:%S', localtime;
382
383
10416
10831
        if(my $logger = $self->{'logger'}) {
384
103
197
                if(ref($logger) eq 'CODE') {
385                        # If logger is a code reference, call it with log details
386
19
72
                        my $args = {
387                                class => blessed($self) || __PACKAGE__,
388                                file => (caller(1))[1],
389                                # function => (caller(1))[3],
390                                line => (caller(1))[2],
391                                level => $level,
392                                message => \@messages
393                        };
394
19
107
                        if(my $ctx = $self->{ctx}) {
395
6
6
                                $args->{ctx} = $ctx;
396                        };
397
19
29
                        $logger->($args);
398                } elsif(ref($logger) eq 'ARRAY') {
399                        # If logger is an array reference, push the log message to the array
400
15
15
8
23
                        push @{$logger}, { level => $level, message => $str };
401                } elsif(ref($logger) eq 'HASH') {
402
46
61
                        if(my $file = $logger->{'file'}) {
403                                # if($file =~ /^([-\@\w.\/\\]+)$/) {
404
8
126
                                if($file =~ /^([^<>|*?;!`$"\0-\037]+)$/) {
405
5
9
                                        $file = $1;     # Will untaint
406                                } else {
407
3
16
                                        Carp::croak(ref($self), ": Invalid file name: $file");
408                                }
409
5
62
                                if(open(my $fout, '>>', $logger->{'file'})) {
410
4
9
                                        my $format = $self->{'format'} || '%level%> [%timestamp%] %class% %callstack% %message%';
411
4
7
                                        my $ulevel = uc($level);
412
4
9
                                        my $callstack = (caller(1))[1] . ' ' . (caller(1))[2];
413
414
4
41
                                        $format =~ s/%level%/$ulevel/g;
415
4
6
                                        $format =~ s/%class%/$class/g;
416
4
7
                                        $format =~ s/%message%/$str/g;
417
4
6
                                        $format =~ s/%callstack%/$callstack/g;
418
4
5
                                        $format =~ s/%timestamp%/$timestamp/g;
419
4
5
                                        $format =~ s/%env_(\w+)%/$ENV{$1}/g;
420
4
34
                                        print $fout "$format\n" or Carp::croak(ref($self), ": Can't write to $file: $!");
421
4
77
                                        close $fout;
422                                }
423                        }
424
43
50
                        if(my $array = $logger->{'array'}) {
425
6
6
4
8
                                push @{$array}, { level => $level, message => $str };
426                        }
427
43
59
                        if(exists($logger->{'sendmail'}) && exists($logger->{'sendmail'}->{'to'})) {
428                                # Send an email
429
16
27
                                if((!defined($logger->{'sendmail'}->{'level'})) ||
430                                   ($syslog_values{$level} <= $syslog_values{$logger->{'sendmail'}->{'level'}})) {
431
14
8
                                        my $throttled = 0;
432
14
16
                                        if(my $min_interval = $logger->{'sendmail'}->{'min_interval'}) {
433
3
2
                                                my $now = time();
434                                                # _last_email_sent: epoch time of the most recent successfully sent email
435
3
7
                                                $throttled = defined($self->{_last_email_sent}) && ($now - $self->{_last_email_sent}) < $min_interval;
436                                        }
437
14
14
                                        if(!$throttled) {
438
12
16
                                                eval {
439
12
21
                                                        require Email::Simple;
440
12
14
                                                        require Email::Sender::Simple;
441
12
14
                                                        require Email::Sender::Transport::SMTP;
442
443
12
22
                                                        Email::Simple->import();
444
12
19
                                                        Email::Sender::Simple->import('sendmail');
445
12
181
                                                        Email::Sender::Transport::SMTP->import();
446
447
12
20
                                                        my $email = Email::Simple->new('');
448
12
52
                                                        $email->header_set('to', _sanitize_email_header($logger->{'sendmail'}->{'to'}));
449
12
1010
                                                        if(my $from = $logger->{'sendmail'}->{'from'}) {
450
2
2
                                                                $email->header_set('from', _sanitize_email_header($from));
451                                                        } else {
452
10
10
                                                                $email->header_set('from', 'noreply@localhost');
453                                                        }
454
12
155
                                                        if(my $subject = $logger->{'sendmail'}->{'subject'}) {
455
1
2
                                                                $email->header_set('subject', _sanitize_email_header($subject));
456                                                        }
457
12
80
                                                        $email->body_set(join(' ', @messages));
458
459                                                        # Configure SMTP transport (adjust for your SMTP server)
460                                                        my $transport = Email::Sender::Transport::SMTP->new({
461                                                                host => $logger->{'sendmail'}->{'host'} || 'localhost',
462
12
46
                                                                port => $logger->{'sendmail'}->{'port'} || 25
463                                                        });
464
465
12
27
                                                        sendmail($email, { transport => $transport });
466                                                };
467
468
12
708
                                                if ($@) {
469
1
4
                                                        Carp::carp("Failed to send email: $@");
470
1
2
                                                        return;
471                                                }
472
11
28
                                                $self->{_last_email_sent} = time();  # record send time for throttle
473                                        }
474                                }
475                        }
476
42
46
                        if(my $syslog = $logger->{'syslog'}) {
477
14
28
                                if((!defined($syslog->{'level'})) || ($syslog_values{$level} <= $syslog->{'level'})) {
478
13
16
                                        if(!$self->{_syslog_opened}) {
479                                                # Open persistent syslog connection
480
11
18
                                                my $facility = delete $syslog->{'facility'} || 'local0';
481
11
9
                                                my $min_level = delete $syslog->{'level'};
482                                                # CHI uses server, Sys::Syslog uses host :-(
483
11
14
                                                if($syslog->{'server'}) {
484
1
2
                                                        $syslog->{'host'} = delete $syslog->{'server'};
485                                                }
486
11
11
7
16
                                                Sys::Syslog::setlogsock($syslog) if(scalar keys %{$syslog});
487
11
12
                                                $syslog->{'facility'} = $facility;
488
11
13
                                                $syslog->{'level'} = $min_level;
489
490
11
31
                                                openlog($self->{script_name}, 'cons,pid', 'user');
491
11
68
                                                $self->{_syslog_opened} = 1; # Flag to track active connection
492                                        }
493
494                                        # Handle syslog-based logging
495
13
10
                                        eval {
496
13
18
                                                my $priority = ($level eq 'error') ? 'err' : 'warning';
497
13
8
                                                my $facility = $syslog->{'facility'};
498
13
26
                                                Sys::Syslog::syslog("$priority|$facility", join(' ', @messages));
499                                        };
500
13
898
                                        if($@) {
501
1
1
                                                my $err = $@;
502
1
6
                                                $err .= ":\n" . Data::Dumper->new([$syslog])->Dump();
503
1
47
                                                Carp::carp($err);
504                                        }
505                                }
506                        }
507
508
42
132
                        if(my $fout = $logger->{'fd'}) {
509
2
4
                                my $format = $self->{'format'} || '%level%> [%timestamp%] %class% %callstack% %message%';
510
2
3
                                my $ulevel = uc($level);
511
2
5
                                my $callstack = (caller(1))[1] . ' ' . (caller(1))[2];
512
513
2
6
                                $format =~ s/%level%/$ulevel/g;
514
2
2
                                $format =~ s/%class%/$class/g;
515
2
3
                                $format =~ s/%message%/$str/g;
516
2
1
                                $format =~ s/%callstack%/$callstack/g;
517
2
3
                                $format =~ s/%timestamp%/$timestamp/g;
518
2
1
4
3
                                $format =~ s/%env_(\w+)%/$ENV{$1} \/\/ ''/ge;
519
520
2
12
                                print $fout "$format\n" or Carp::croak(ref($self), ": Can't write to file descriptor: $!");
521                        } elsif(!$logger->{'file'} && !$logger->{'array'} && !$logger->{'syslog'} && !exists($logger->{'sendmail'}) && !$logger->{'fd'}) {
522
1
7
                                croak(ref($self), ": Don't know how to deal with the $level message");
523                        }
524                } elsif(!ref($logger)) {
525                        # If logger is a file path, append the log message to the file
526
5
56
                        if(open(my $fout, '>>', $logger)) {
527
4
11
                                my $format = $self->{'format'} || '%level%> [%timestamp%] %class% %callstack% %message%';
528
4
5
                                my $ulevel = uc($level);
529
4
11
                                my $callstack = (caller(1))[1] . ' ' . (caller(1))[2];
530
531
4
32
                                $format =~ s/%level%/$ulevel/g;
532
4
7
                                $format =~ s/%class%/$class/g;
533
4
7
                                $format =~ s/%message%/$str/g;
534
4
6
                                $format =~ s/%callstack%/$callstack/g;
535
4
5
                                $format =~ s/%timestamp%/$timestamp/g;
536
4
0
7
0
                                $format =~ s/%env_(\w+)%/$ENV{$1} \/\/ ''/ge;
537
538
4
24
                                print $fout "$format\n" or Carp::croak(ref($self), ": Can't write to $logger: $!");
539
4
71
                                close $fout;
540                        }
541                } elsif(Scalar::Util::blessed($logger)) {
542                        # If logger is an object, call the appropriate method on the object
543
18
50
                        if(!$logger->can($level)) {
544
4
14
                                if(($level eq 'notice') && $logger->can('info')) {
545                                        # Map notice to info for Log::Log4perl
546
2
2
                                        $level = 'info';
547                                } else {
548
2
12
                                        croak(ref($self), ': ', ref($logger), " doesn't know how to deal with the $level message");
549                                }
550                        }
551
16
21
                        $logger->$level(@messages);
552                } else {
553
0
0
                        croak(ref($self), ": configuration error, no handler written for the $level message");
554                }
555        } elsif($self->{'array'}) {
556
10293
10293
5118
10096
                push @{$self->{'array'}}, { level => $level, message => $str };
557        }
558
559
10407
8611
        if($self->{'file'}) {
560
34
33
                my $file = $self->{'file'};
561
562                # Untaint the file name
563                # if($file =~ /^([-\@\w.\/\\]+)$/) {
564
34
253
                if($file =~ /^([^<>|*?;!`$"\0-\037]+)$/) {
565
30
36
                        $file = $1;     # untainted version
566                } else {
567
4
22
                        croak(ref($self), ": Tainted or unsafe filename: $file");
568                }
569
570
30
330
                if(open(my $fout, '>>', $file)) {
571
30
31
                        my $ulevel = uc($level);
572
30
88
                        my $callstack = (caller(1))[1] . ' ' . (caller(1))[2];
573
30
59
                        my $format;
574
575
30
50
                        if(blessed($self) eq __PACKAGE__) {
576
28
59
                                $format = $self->{'format'} || '%level%> [%timestamp%] %callstack% %message%';
577                        } else {
578
2
5
                                $format = $self->{'format'} || '%level%> [%timestamp%] %class% %callstack% %message%';
579                        }
580
581
30
51
                        $format =~ s/%level%/$ulevel/g;
582
30
27
                        $format =~ s/%class%/$class/g;
583
30
39
                        $format =~ s/%message%/$str/g;
584
30
40
                        $format =~ s/%callstack%/$callstack/g;
585
30
61
                        $format =~ s/%timestamp%/$timestamp/g;
586
30
4
39
12
                        $format =~ s/%env_(\w+)%/$ENV{$1} \/\/ ''/ge;
587
588
30
164
                        print $fout "$format\n" or Carp::croak("ref($self): Can't write to ", $self->{'file'}, ": $!");
589
30
495
                        close $fout;
590                }
591        }
592
10403
10830
        if(my $fout = $self->{'fd'}) {
593
8
12
                my $ulevel = uc($level);
594
8
24
                my $callstack = (caller(1))[1] . ' ' . (caller(1))[2];
595
8
39
                my $format;
596
597
8
14
                if(blessed($self) eq __PACKAGE__) {
598
7
20
                        $format = $self->{'format'} || '%level%> [%timestamp%] %callstack% %message%';
599                } else {
600
1
4
                        $format = $self->{'format'} || '%level%> [%timestamp%] %class% %callstack% %message%';
601                }
602
603
8
18
                $format =~ s/%level%/$ulevel/g;
604
8
9
                $format =~ s/%class%/$class/g;
605
8
11
                $format =~ s/%message%/$str/g;
606
8
13
                $format =~ s/%callstack%/$callstack/g;
607
8
12
                $format =~ s/%timestamp%/$timestamp/g;
608
8
0
9
0
                $format =~ s/%env_(\w+)%/$ENV{$1} \/\/ ''/ge;
609
610
8
35
                print $fout "$format\n" or Carp::croak(ref($self), ": Can't write to file descriptor: $!");
611        }
612}
613
614 - 619
=head2 level($self, $level)

Get/set the minimum level to log at.
Returns the current level, as an integer.

=cut
620
621sub level()
622{
623
252
7774
        my ($self, $level) = @_;
624
625
252
216
        if($level) {
626
233
206
                if(!defined($syslog_values{$level})) {
627
2
13
                        Carp::carp(ref($self), ": invalid syslog level '$level'");
628
2
3
                        return;
629                }
630
231
146
                $self->{'level'} = $syslog_values{$level};
631        }
632
250
352
        return Return::Set::set_return($self->{'level'}, { 'type' => 'integer', 'min' => 0, 'max' => 7 });
633}
634
635 - 640
=head2  is_debug

Are we at a debug level that will emit debug messages?
For compatibility with L<Log::Any>.

=cut
641
642sub is_debug
643{
644
25
725
        my $self = $_[0];
645
646
25
82
        return ($self->{'level'} && ($self->{'level'} >= $DEBUG)) ? 1 : 0;
647}
648
649 - 653
=head2 messages

Return all the messages emitted so far

=cut
654
655sub messages
656{
657
66
1327
        my $self = $_[0];
658
659
66
66
44
161
        return [ @{$self->{messages}} ];     # Return a shallow copy
660}
661
662 - 668
=head2 debug

  $logger->debug(@messages);

Logs a debug message.

=cut
669
670sub debug {
671
10350
23899
        my $self = shift;
672
10350
6858
        $self->_log('debug', @_);
673}
674
675 - 681
=head2 info

  $logger->info(@messages);

Logs an info message.

=cut
682
683sub info {
684
51
520
        my $self = shift;
685
51
60
        $self->_log('info', @_);
686}
687
688 - 694
=head2 notice

  $logger->notice(@messages);

Logs a notice message.

=cut
695
696sub notice {
697
26
373
        my $self = shift;
698
26
36
        $self->_log('notice', @_);
699}
700
701 - 709
=head2 error

    $logger->error(@messages);

Logs an error message. This method also supports logging to syslog if configured.
If not logging mechanism is set,
falls back to C<croak>.

=cut
710
711sub error {
712
32
1900
        my $self = shift;
713
714
32
35
        $self->_high_priority('error', @_);
715}
716
717 - 723
=head2 fatal

    $logger->fatal(@messages);

Synonym of error.

=cut
724
725sub fatal {
726
9
82
        my $self = shift;
727
728
9
13
        $self->_high_priority('error', @_);
729}
730
731 - 737
=head2 trace

  $logger->trace(@messages);

Logs a trace message.

=cut
738
739sub trace {
740
12
40
        my $self = shift;
741
12
19
        $self->_log('trace', @_);
742}
743
744 - 754
=head2 warn

  $logger->warn(@messages);
  $logger->warn(\@messages);
  $logger->warn(warning => \@messages);

Logs a warning message. This method also supports logging to syslog if configured.
If not logging mechanism is set,
falls back to C<Carp>.

=cut
755
756sub warn {
757
83
1005
        my $self = shift;
758
759
83
104
        return if(scalar(@_) == 0);
760
80
93
        $self->_high_priority('warn', @_);
761}
762
763 - 767
=head2 _high_priority

Helper to handle important messages.

=cut
768
769sub _high_priority
770{
771
123
2719
        my $self = shift;
772
123
85
        my $level = shift;      # 'warn' or 'error'
773
774
123
95
        return if(scalar(@_) == 0);     # No message - return quickly
775
776        # Only logging things at warning or higher
777
123
260
        return if($syslog_values{$level} > $WARNING);
778
779
123
307
        my $warning;
780
781        # Check if called as warn(warning => ...) or warn('plain', 'args')
782        my $params;
783
123
123
91
123
        eval { $params = Params::Get::get_params('warning', @_) };
784
123
3545
        if($@ || !$params || ref($params) ne 'HASH' || !exists($params->{warning})) {
785                # Plain list form — join directly
786
5
15
6
13
                $warning = join('', grep { defined } @_);
787
5
7
                return unless length($warning);
788        } else {
789
118
94
                $warning = $params->{warning};
790
118
92
                return unless defined($warning);
791
116
103
                if(ref($warning) eq 'ARRAY') {
792
10
26
10
11
50
12
                        $warning = join('', grep { defined } @{$warning});
793                }
794        }
795
796
121
244
        if($params && ref($params) eq 'HASH' && exists($params->{warning})) {
797
116
107
                $warning = $params->{warning};
798
116
97
                return unless defined($warning);        # warn(warning => undef) → no-op
799
116
102
                if(ref($warning) eq 'ARRAY') {
800                        # Given "warning => [ ref to array ]"
801
10
26
10
8
24
9
                        $warning = join('', grep { defined } @{$warning});
802                }
803        } else {
804                # Plain list: warn('This ', 'is ', 'a ', 'list')
805                # Filter undefs and join
806
5
15
5
11
                $warning = join('', grep { defined } @_);
807
5
8
                return unless length($warning);         # all-undef list → no-op
808        }
809
810
121
161
        if($self eq __PACKAGE__) {
811                # If called from a class method, use croak/carp to warn
812
2
19
                if($syslog_values{$level} <= $ERROR) {
813
1
6
                        Carp::croak($warning);
814                }
815
1
4
                Carp::carp($warning);
816
1
2
                return;
817        }
818
819        # Log the warning message
820
119
137
        $self->_log($level, $warning);
821
822
119
168
        if($syslog_values{$level} <= $ERROR) {
823                # Fall back to croak if no logger or syslog is defined
824
41
162
                if($self->{'croak_on_error'} || (!defined($self->{logger}) && (!defined($self->{array})))) {
825
10
79
                        Carp::croak($warning);
826                }
827        }
828
829
109
496
        if($self->{'carp_on_warn'} || (!defined($self->{logger}) && (!defined($self->{array})))) {
830                # Fallback to Carp if no logger or syslog is defined
831
8
13
                Carp::carp($warning);
832        }
833}
834
835# Destructor to close syslog connection
836sub DESTROY {
837
1340
153891
        my $self = $_[0];
838
839
1340
3856
        if($self->{_syslog_opened}) {
840
12
25
                Sys::Syslog::closelog();
841
12
110
                delete $self->{_syslog_opened};
842        }
843}
844
845 - 901
=head1 AUTHOR

Nigel Horne C<njh@nigelhorne.com>

=head1 SEE ALSO

=over 4

=item * L<Test Dashboard|https://nigelhorne.github.io/Log-Abstraction/coverage/>

=back

=head1 SUPPORT

This module is provided as-is without any warranty.

Please report any bugs or feature requests to C<bug-log-abstraction at rt.cpan.org>,
or through the web interface at
L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Log-Abstraction>.
I will be notified, and then you'll
automatically be notified of progress on your bug as I make changes.

You can find documentation for this module with the perldoc command.

    perldoc Log::Abstraction

You can also look for information at:

=over 4

=item * MetaCPAN

L<https://metacpan.org/dist/Log-Abstraction>

=item * RT: CPAN's request tracker

L<https://rt.cpan.org/NoAuth/Bugs.html?Dist=Log-Abstraction>

=item * CPAN Testers' Matrix

L<http://matrix.cpantesters.org/?dist=Log-Abstraction>

=item * CPAN Testers Dependencies

L<http://deps.cpantesters.org/?module=Log::Abstraction>

=back

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2025-2026 Nigel Horne

Usage is subject to the GPL2 licence terms.
If you use it,
please let me know.

=cut
902
9031;