File Coverage

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

linestmtbrancondsubtimecode
1package Log::Abstraction;
2
3# TODO: add a minimum logging level
4
5
7
7
7
553108
6
81
use strict;
6
7
7
7
9
2
118
use warnings;
7
7
7
7
12
5
191
use Carp;       # Import Carp for warnings
8
7
7
7
1385
201460
95
use Config::Abstraction 0.36;
9
7
7
7
21
4
180
use Data::Dumper;
10
7
7
7
10
33
78
use Params::Get 0.13;   # Import Params::Get for parameter handling
11
7
7
7
12
5
23
use POSIX qw(strftime);
12
7
7
7
1538
26953
461
use Readonly::Values::Syslog 0.03;
13
7
7
7
924
1589
105
use Return::Set;
14
7
7
7
13
5
101
use Scalar::Util 'blessed';     # Import Scalar::Util for object reference checking
15
7
7
7
1283
25053
10569
use Sys::Syslog 0.28;   # Import Sys::Syslog for syslog support
16
17=encoding utf-8
18
19 - 27
=head1 NAME

Log::Abstraction - Logging Abstraction Layer

=head1 VERSION

0.27

=cut
28
29our $VERSION = 0.27;
30
31 - 184
=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

=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>.

=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
185
186sub new {
187
22
377150
        my $class = shift;
188
189        # Handle hash or hashref arguments
190
22
17
        my %args;
191
192
22
97
        if((scalar(@_) == 1) && (ref($_[0]) ne 'HASH')) {
193
1
1
                $args{'logger'} = shift;
194        } elsif(my $params = Params::Get::get_params(undef, @_)) {
195
16
16
189
21
                %args = %{$params};
196        }
197
198        # Load the configuration from a config file, if provided
199
22
74
        if(exists($args{'config_file'})) {
200                # my $config = YAML::XS::LoadFile($params->{'config_file'});
201
4
23
                if(!-r $args{'config_file'}) {
202
1
20
                        croak("$class: ", $args{'config_file'}, ': File not readable');
203                }
204
3
11
                if(my $config = Config::Abstraction->new(config_dirs => [''], config_file => $args{'config_file'}, env_prefix => "${class}::")) {
205
3
2496
                        $config = $config->all();
206
3
14
                        if($config->{$class}) {
207
2
5
                                $config = $config->{$class};
208                        }
209
3
1
                        my $array = $args{'array'};
210
3
3
3
6
                        %args = (%{$config}, %args);
211
3
4
                        if($array) {
212
0
0
                                $args{'array'} = $array;
213                        }
214                } else {
215
0
0
                        croak("$class: Can't load configuration from ", $args{'config_file'});
216                }
217        }
218
219
21
52
        if(!defined($class)) {
220
1
2
                if((scalar keys %args) > 0) {
221                        # Using Log::Abstraction:new(), not Log::Abstraction->new()
222
0
0
                        carp(__PACKAGE__, ' use ->new() not ::new() to instantiate');
223
0
0
                        return;
224                }
225
226                # FIXME: this only works when no arguments are given
227
1
1
                $class = __PACKAGE__;
228        } elsif(Scalar::Util::blessed($class)) {
229                # If $class is an object, clone it with new arguments
230
2
2
2
4
                my $clone = bless { %{$class}, %args }, ref($class);
231
2
2
2
1
                $clone->{messages} = [ @{$class->{messages}} ];   # Deep copy
232
2
5
                return $clone;
233        }
234
235
19
62
        if($args{'syslog'} && !$args{'script_name'}) {
236
1
12
                require File::Basename && File::Basename->import() unless File::Basename->can('basename');
237
238                # Determine script name
239
1
35
                $args{'script_name'} = File::Basename::basename($ENV{'SCRIPT_NAME'} || $0);
240
241
1
2
                croak("$class: syslog needs to know the script name") if(!defined($args{'script_name'}));
242        }
243
244
19
17
        my $level = $args{'level'};
245
19
44
        if(defined(my $logger = $args{logger})) {
246
9
16
                if(Scalar::Util::blessed($logger) && (ref($logger) eq __PACKAGE__)) {
247
0
0
                        croak("$class: attempt to encapulate ", __PACKAGE__, ' as a logging class, that would add a needless indirection');
248                }
249        } elsif((!$args{'file'}) && (!$args{'array'})) {
250                # Default to Log4perl
251
10
1629
                require Log::Log4perl;
252
10
70072
                Log::Log4perl->import();
253
254                # FIXME: add default minimum logging level
255
10
133
                Log::Log4perl->easy_init($args{verbose} ? $Log::Log4perl::DEBUG : $Log::Log4perl::ERROR);
256
10
9564
                $args{'logger'} = Log::Log4perl->get_logger();
257        }
258
259
19
802
        if($level) {
260
7
14
                if(ref($level) eq 'ARRAY') {
261
0
0
                        $level = $level->[0];
262                }
263
7
8
                $level = lc($level);
264
7
12
                if(!defined($syslog_values{$level})) {
265
0
0
                        Carp::croak("$class: invalid syslog level '$level'");
266                }
267
7
6
                $args{'level'} = $level;
268        } else {
269                # The default minimum level at which to log something is 'warning'
270
12
16
                $args{'level'} = 'warning';
271        }
272
273        # Bless and return the object
274        return bless {
275                messages => [],      # Initialize messages array
276                %args,
277
19
85
                level => $syslog_values{$args{'level'}},
278        }, $class;
279}
280
281 - 323
=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
324
325sub _sanitize_email_header {
326
0
0
        my $value = $_[0];
327
328
0
0
        return unless defined $value;
329
0
0
        $value =~ s/\r\n?|\n//g;        # Remove CR/LF characters
330
331
0
0
        return Return::Set::set_return($value, { type => 'string', 'matches' => qr /^[^\r\n]*$/ });
332}
333
334# Internal method to log messages. This method is called by other logging methods.
335# $logger->_log($level, @messages);
336# $logger->_log($level, \@messages);
337
338sub _log {
339
23
48
        my ($self, $level, @messages) = @_;
340
341
23
27
        if(!UNIVERSAL::isa((caller)[0], __PACKAGE__)) {
342
1
32
                Carp::croak('Illegal Operation: _log is a private method');
343        }
344
345
22
194
        if(!defined($syslog_values{$level})) {
346
0
0
                Carp::Croak(ref($self), ": Invalid level '$level'");  # "Can't happen"
347        }
348
349
22
25
        if($syslog_values{$level} > $self->{'level'}) {
350                # The level is too low to log
351
3
4
                return;
352        }
353
354
19
31
        if((scalar(@messages) == 1) && (ref($messages[0]) eq 'ARRAY')) {
355                # Passed a reference to an array
356
0
0
0
0
                @messages = @{$messages[0]};
357        }
358
19
26
        @messages = grep defined, @messages;
359
360
19
21
        my $str = join('', @messages);
361
19
18
        chomp($str);
362
363        # Push the message to the internal messages array
364
19
19
11
23
        push @{$self->{messages}}, { level => $level, message => $str };
365
366
19
32
        my $class = blessed($self) || $self;
367
19
21
        if($class eq __PACKAGE__) {
368
18
9
                $class = '';
369        }
370
371
19
350
        my $timestamp = strftime "%Y-%m-%d %H:%M:%S", localtime;
372
373
19
22
        if(my $logger = $self->{'logger'}) {
374
19
41
                if(ref($logger) eq 'CODE') {
375                        # If logger is a code reference, call it with log details
376
3
7
                        $logger->({
377                                class => blessed($self) || __PACKAGE__,
378                                file => (caller(1))[1],
379                                # function => (caller(1))[3],
380                                line => (caller(1))[2],
381                                level => $level,
382                                message => \@messages,
383                        });
384                } elsif(ref($logger) eq 'ARRAY') {
385                        # If logger is an array reference, push the log message to the array
386
7
7
4
7
                        push @{$logger}, { level => $level, message => $str };
387                } elsif(ref($logger) eq 'HASH') {
388
3
4
                        if(my $file = $logger->{'file'}) {
389                                # if($file =~ /^([-\@\w.\/\\]+)$/) {
390
2
27
                                if($file =~ /^([^<>|*?;!`$"\0-\037]+)$/) {
391
2
2
                                        $file = $1;     # Will untaint
392                                } else {
393
0
0
                                        Carp::croak(ref($self), ": Invalid file name: $file");
394                                }
395
2
20
                                if(open(my $fout, '>>', $logger->{'file'})) {
396
2
2
                                        my $format = $self->{'format'} || '%level%> [%timestamp%] %class% %callstack% %message%';
397
2
3
                                        my $ulevel = uc($level);
398
2
3
                                        my $callstack = (caller(1))[1] . ' ' . (caller(1))[2];
399
400
2
24
                                        $format =~ s/%level%/$ulevel/g;
401
2
1
                                        $format =~ s/%class%/$class/g;
402
2
3
                                        $format =~ s/%message%/$str/g;
403
2
2
                                        $format =~ s/%callstack%/$callstack/g;
404
2
2
                                        $format =~ s/%timestamp%/$timestamp/g;
405
2
1
                                        $format =~ s/%env_(\w+)%/$ENV{$1}/g;
406
2
12
                                        print $fout "$format\n" or Carp::croak(ref($self), ": Can't write to $file: $!");
407
2
18
                                        close $fout;
408                                }
409                        }
410
3
5
                        if(my $array = $logger->{'array'}) {
411
0
0
0
0
                                push @{$array}, { level => $level, message => $str };
412                        }
413
3
4
                        if($logger->{'sendmail'}->{'to'}) {
414                                # Send an email
415                                # TODO: throttle the number of emails
416
0
0
                                if((!defined($logger->{'sendmail'}->{'level'})) ||
417                                   ($syslog_values{$level} <= $syslog_values{$logger->{'sendmail'}->{'level'}})) {
418
0
0
                                        eval {
419
0
0
                                                require Email::Simple;
420
0
0
                                                require Email::Sender::Simple;
421
0
0
                                                require Email::Sender::Transport::SMTP;
422
423
0
0
                                                Email::Simple->import();
424
0
0
                                                Email::Sender::Simple->import('sendmail');
425
0
0
                                                Email::Sender::Transport::SMTP->import();
426
427
0
0
                                                my $email = Email::Simple->new('');
428
0
0
                                                $email->header_set('to', _sanitize_email_header($logger->{'sendmail'}->{'to'}));
429
0
0
                                                if(my $from = $logger->{'sendmail'}->{'from'}) {
430
0
0
                                                        $email->header_set('from', _sanitize_email_header($from));
431                                                } else {
432
0
0
                                                        $email->header_set('from', 'noreply@localhost');
433                                                }
434
0
0
                                                if(my $subject = $logger->{'sendmail'}->{'subject'}) {
435
0
0
                                                        $email->header_set('subject', _sanitize_email_header($subject));
436                                                }
437
0
0
                                                $email->body_set(join(' ', @messages));
438
439                                                # Configure SMTP transport (adjust for your SMTP server)
440                                                my $transport = Email::Sender::Transport::SMTP->new({
441                                                        host => $logger->{'sendmail'}->{'host'} || 'localhost',
442
0
0
                                                        port => $logger->{'sendmail'}->{'port'} || 25
443                                                });
444
445
0
0
                                                sendmail($email, { transport => $transport });
446                                        };
447
448
0
0
                                        if ($@) {
449
0
0
                                                Carp::carp("Failed to send email: $@");
450
0
0
                                                return;
451                                        }
452                                }
453                        }
454
3
7
                        if(my $syslog = $logger->{'syslog'}) {
455
1
3
                                if((!defined($syslog->{'level'})) || ($syslog_values{$level} <= $syslog->{'level'})) {
456
1
1
                                        if(!$self->{_syslog_opened}) {
457                                                # Open persistent syslog connection
458
1
3
                                                my $facility = delete $syslog->{'facility'} || 'local0';
459
1
0
                                                my $min_level = delete $syslog->{'level'};
460                                                # CHI uses server, Sys::Syslog uses host :-(
461
1
2
                                                if($syslog->{'server'}) {
462
0
0
                                                        $syslog->{'host'} = delete $syslog->{'server'};
463                                                }
464
1
1
0
1
                                                Sys::Syslog::setlogsock($syslog) if(scalar keys %{$syslog});
465
1
2
                                                $syslog->{'facility'} = $facility;
466
1
5
                                                $syslog->{'level'} = $min_level;
467
468
1
3
                                                openlog($self->{script_name}, 'cons,pid', 'user');
469
1
48
                                                $self->{_syslog_opened} = 1; # Flag to track active connection
470                                        }
471
472                                        # Handle syslog-based logging
473
1
1
                                        eval {
474
1
2
                                                my $priority = ($level eq 'error') ? 'err' : 'warning';
475
1
1
                                                my $facility = $syslog->{'facility'};
476
1
2
                                                Sys::Syslog::syslog("$priority|$facility", join(' ', @messages));
477                                        };
478
1
365
                                        if($@) {
479
0
0
                                                my $err = $@;
480
0
0
                                                $err .= ":\n" . Data::Dumper->new([$syslog])->Dump();
481
0
0
                                                Carp::carp($err);
482                                        }
483                                }
484                        }
485
486
3
12
                        if(my $fout = $logger->{'fd'}) {
487
0
0
                                my $format = $self->{'format'} || '%level%> [%timestamp%] %class% %callstack% %message%';
488
0
0
                                my $ulevel = uc($level);
489
0
0
                                my $callstack = (caller(1))[1] . ' ' . (caller(1))[2];
490
491
0
0
                                $format =~ s/%level%/$ulevel/g;
492
0
0
                                $format =~ s/%class%/$class/g;
493
0
0
                                $format =~ s/%message%/$str/g;
494
0
0
                                $format =~ s/%callstack%/$callstack/g;
495
0
0
                                $format =~ s/%timestamp%/$timestamp/g;
496
0
0
                                $format =~ s/%env_(\w+)%/$ENV{$1}/g;
497
498
0
0
                                print $fout "$format\n" or Carp::croak(ref($self), ": Can't write to file descriptor: $!");
499                        } elsif((!$logger->{'file'}) && (!$logger->{'syslog'}) && (!$logger->{'sendmail'})) {
500
0
0
                                croak(ref($self), ": Don't know how to deal with the $level message");
501                        }
502                } elsif(!ref($logger)) {
503                        # If logger is a file path, append the log message to the file
504
2
24
                        if(open(my $fout, '>>', $logger)) {
505
2
5
                                my $format = $self->{'format'} || '%level%> [%timestamp%] %class% %callstack% %message%';
506
2
2
                                my $ulevel = uc($level);
507
2
2
                                my $callstack = (caller(1))[1] . ' ' . (caller(1))[2];
508
509
2
50
                                $format =~ s/%level%/$ulevel/g;
510
2
3
                                $format =~ s/%class%/$class/g;
511
2
4
                                $format =~ s/%message%/$str/g;
512
2
4
                                $format =~ s/%callstack%/$callstack/g;
513
2
3
                                $format =~ s/%timestamp%/$timestamp/g;
514
2
2
                                $format =~ s/%env_(\w+)%/$ENV{$1}/g;
515
516
2
8
                                print $fout "$format\n" or Carp::croak(ref($self), ": Can't write to $logger: $!");
517
2
30
                                close $fout;
518                        }
519                } elsif(Scalar::Util::blessed($logger)) {
520                        # If logger is an object, call the appropriate method on the object
521
4
10
                        if(!$logger->can($level)) {
522
0
0
                                if(($level eq 'notice') && $logger->can('info')) {
523                                        # Map notice to info for Log::Log4perl
524
0
0
                                        $level = 'info';
525                                } else {
526
0
0
                                        croak(ref($self), ': ', ref($logger), " doesn't know how to deal with the $level message");
527                                }
528                        }
529
4
6
                        $logger->$level(@messages);
530                } else {
531
0
0
                        croak(ref($self), ": configuration error, no handler written for the $level message");
532                }
533        } elsif($self->{'array'}) {
534
0
0
0
0
                push @{$self->{'array'}}, { level => $level, message => $str };
535        }
536
537
19
986
        if($self->{'file'}) {
538
0
0
                my $file = $self->{'file'};
539
540                # Untaint the file name
541                # if($file =~ /^([-\@\w.\/\\]+)$/) {
542
0
0
                if($file =~ /^([^<>|*?;!`$"\0-\037]+)$/) {
543
0
0
                        $file = $1;     # untainted version
544                } else {
545
0
0
                        croak(ref($self), ": Tainted or unsafe filename: $file");
546                }
547
548
0
0
                if(open(my $fout, '>>', $file)) {
549
0
0
                        my $ulevel = uc($level);
550
0
0
                        my $callstack = (caller(1))[1] . ' ' . (caller(1))[2];
551
0
0
                        my $format;
552
553
0
0
                        if(blessed($self) eq __PACKAGE__) {
554
0
0
                                $format = $self->{'format'} || '%level%> [%timestamp%] %callstack% %message%';
555                        } else {
556
0
0
                                $format = $self->{'format'} || '%level%> [%timestamp%] %class% %callstack% %message%';
557                        }
558
559
0
0
                        $format =~ s/%level%/$ulevel/g;
560
0
0
                        $format =~ s/%class%/$class/g;
561
0
0
                        $format =~ s/%message%/$str/g;
562
0
0
                        $format =~ s/%callstack%/$callstack/g;
563
0
0
                        $format =~ s/%timestamp%/$timestamp/g;
564
0
0
                        $format =~ s/%env_(\w+)%/$ENV{$1}/g;
565
566
0
0
                        print $fout "$format\n" or Carp::croak("ref($self): Can't write to ", $self->{'file'}, ": $!");
567
0
0
                        close $fout;
568                }
569        }
570
19
30
        if(my $fout = $self->{'fd'}) {
571
2
3
                my $ulevel = uc($level);
572
2
2
                my $callstack = (caller(1))[1] . ' ' . (caller(1))[2];
573
2
44
                my $format;
574
575
2
4
                if(blessed($self) eq __PACKAGE__) {
576
2
6
                        $format = $self->{'format'} || '%level%> [%timestamp%] %callstack% %message%';
577                } else {
578
0
0
                        $format = $self->{'format'} || '%level%> [%timestamp%] %class% %callstack% %message%';
579                }
580
581
2
4
                $format =~ s/%level%/$ulevel/g;
582
2
2
                $format =~ s/%class%/$class/g;
583
2
3
                $format =~ s/%message%/$str/g;
584
2
3
                $format =~ s/%callstack%/$callstack/g;
585
2
2
                $format =~ s/%timestamp%/$timestamp/g;
586
2
2
                $format =~ s/%env_(\w+)%/$ENV{$1}/g;
587
588
2
7
                print $fout "$format\n" or Carp::croak(ref($self), ": Can't write to file descriptor: $!");
589        }
590}
591
592 - 597
=head2 level($self, $level)

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

=cut
598
599sub level()
600{
601
1
3
        my ($self, $level) = @_;
602
603
1
7
        if($level) {
604
1
5
                if(!defined($syslog_values{$level})) {
605
0
0
                        Carp::carp(ref($self), ": invalid syslog level '$level'");
606
0
0
                        return;
607                }
608
1
2
                $self->{'level'} = $syslog_values{$level};
609        }
610
1
6
        return Return::Set::set_return($self->{'level'}, { 'type' => 'integer', 'min' => 0, 'max' => 7 });
611}
612
613 - 618
=head2  is_debug

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

=cut
619
620sub is_debug
621{
622
2
129
        my $self = $_[0];
623
624
2
9
        return ($self->{'level'} && ($self->{'level'} >= $DEBUG)) ? 1 : 0;
625}
626
627 - 631
=head2 messages

Return all the messages emitted so far

=cut
632
633sub messages
634{
635
2
234
        my $self = $_[0];
636
637
2
2
1
10
        return [ @{$self->{messages}} ];     # Return a shallow copy
638}
639
640 - 646
=head2 debug

  $logger->debug(@messages);

Logs a debug message.

=cut
647
648sub debug {
649
9
18
        my $self = shift;
650
9
12
        $self->_log('debug', @_);
651}
652
653 - 659
=head2 info

  $logger->info(@messages);

Logs an info message.

=cut
660
661sub info {
662
7
11
        my $self = shift;
663
7
10
        $self->_log('info', @_);
664}
665
666 - 672
=head2 notice

  $logger->notice(@messages);

Logs a notice message.

=cut
673
674sub notice {
675
1
2
        my $self = shift;
676
1
2
        $self->_log('notice', @_);
677}
678
679 - 687
=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
688
689sub error {
690
0
0
        my $self = shift;
691
692
0
0
        $self->_high_priority('error', @_);
693}
694
695 - 701
=head2 fatal

    $logger->fatal(@messages);

Synonym of error.

=cut
702
703sub fatal {
704
0
0
        my $self = shift;
705
706
0
0
        $self->_high_priority('error', @_);
707}
708
709 - 715
=head2 trace

  $logger->trace(@messages);

Logs a trace message.

=cut
716
717sub trace {
718
1
2
        my $self = shift;
719
1
2
        $self->_log('trace', @_);
720}
721
722 - 732
=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
733
734sub warn {
735
4
35
        my $self = shift;
736
737
4
6
        $self->_high_priority('warn', @_);
738}
739
740 - 744
=head2 _high_priority

Helper to handle important messages.

=cut
745
746sub _high_priority
747{
748
4
2
        my $self = shift;
749
4
3
        my $level = shift;      # 'warn' or 'error'
750
4
6
        my $params = Params::Get::get_params('warning', @_);    # Get parameters
751
752        # Validate input parameters
753
4
53
        return unless ($params && (ref($params) eq 'HASH'));
754
755        # Only logging things higher than warn level
756
4
16
        return if($syslog_values{$level} > $WARNING);
757
758
4
12
        my $warning = $params->{warning};
759
4
6
        if(!defined($warning)) {
760
1
2
                if(scalar(@_) && !ref($_[0])) {
761                        # Given an array
762
1
1
                        $warning = join('', @_);
763                } else {
764
0
0
                        return;
765                }
766        }
767
4
6
        if(ref($warning) eq 'ARRAY') {
768                # Given "message => [ ref to array ]"
769
1
1
1
1
                $warning = join('', @{$warning});
770        }
771
772
4
6
        if($self eq __PACKAGE__) {
773                # If called from a class method, use Croak/Carp to warn
774
0
0
                if($syslog_values{$level} <= $ERROR) {
775
0
0
                        Carp::croak($warning);
776                }
777
0
0
                Carp::carp($warning);
778
0
0
                return;
779        }
780
781        # Log the warning message
782
4
8
        $self->_log($level, $warning);
783
784
4
6
        if($syslog_values{$level} <= $ERROR) {
785                # Fall back to Croak if no logger or syslog is defined
786
0
0
                if($self->{'croak_on_error'} || !defined($self->{logger})) {
787
0
0
                        Carp::croak($warning);
788                }
789        }
790
791
4
17
        if($self->{'carp_on_warn'} || !defined($self->{logger})) {
792                # Fallback to Carp if no logger or syslog is defined
793
0
0
                Carp::carp($warning);
794        }
795}
796
797# Destructor to close syslog connection
798sub DESTROY {
799
21
2396
        my $self = $_[0];
800
801
21
222
        if($self->{_syslog_opened}) {
802
1
8
                closelog();
803
1
11
                delete $self->{_syslog_opened};
804        }
805}
806
807 - 862
=head1 AUTHOR

Nigel Horne C<njh@nigelhorne.com>

=head1 SEE ALSO

=over 4

=item * Test coverage report: L<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

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

=cut
863
8641;