File Coverage

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

linestmtbrancondsubtimecode
1package Log::Abstraction;
2
3# TODO: add a minimum logging level
4
5
7
7
7
553940
4
90
use strict;
6
7
7
7
13
0
107
use warnings;
7
7
7
7
14
6
180
use Carp;       # Import Carp for warnings
8
7
7
7
1462
173807
99
use Config::Abstraction 0.36;
9
7
7
7
16
5
146
use Data::Dumper;
10
7
7
7
12
29
88
use Params::Get 0.13;   # Import Params::Get for parameter handling
11
7
7
7
10
8
15
use POSIX qw(strftime);
12
7
7
7
1649
28207
409
use Readonly::Values::Syslog 0.03;
13
7
7
7
1023
1515
133
use Return::Set;
14
7
7
7
14
5
115
use Scalar::Util 'blessed';     # Import Scalar::Util for object reference checking
15
7
7
7
1242
25521
10736
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.26

=cut
28
29our $VERSION = 0.26;
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
375755
        my $class = shift;
188
189        # Handle hash or hashref arguments
190
22
14
        my %args;
191
192
22
64
        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
203
21
                %args = %{$params};
196        }
197
198        # Load the configuration from a config file, if provided
199
22
71
        if(exists($args{'config_file'})) {
200                # my $config = YAML::XS::LoadFile($params->{'config_file'});
201
4
18
                if(!-r $args{'config_file'}) {
202
1
21
                        croak("$class: ", $args{'config_file'}, ': File not readable');
203                }
204
3
9
                if(my $config = Config::Abstraction->new(config_dirs => [''], config_file => $args{'config_file'}, env_prefix => "${class}::")) {
205
3
2523
                        $config = $config->all();
206
3
10
                        if($config->{$class}) {
207
2
4
                                $config = $config->{$class};
208                        }
209
3
3
                        my $array = $args{'array'};
210
3
3
2
5
                        %args = (%{$config}, %args);
211
3
3
                        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
40
        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
1
4
                my $clone = bless { %{$class}, %args }, ref($class);
231
2
2
3
2
                $clone->{messages} = [ @{$class->{messages}} ];   # Deep copy
232
2
3
                return $clone;
233        }
234
235
19
57
        if($args{'syslog'} && !$args{'script_name'}) {
236
1
6
                require File::Basename && File::Basename->import() unless File::Basename->can('basename');
237
238                # Determine script name
239
1
32
                $args{'script_name'} = File::Basename::basename($ENV{'SCRIPT_NAME'} || $0);
240
241
1
6
                croak("$class: syslog needs to know the script name") if(!defined($args{'script_name'}));
242        }
243
244
19
13
        my $level = $args{'level'};
245
19
37
        if(defined(my $logger = $args{logger})) {
246
9
13
                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
1497
                require Log::Log4perl;
252
10
73365
                Log::Log4perl->import();
253
254                # FIXME: add default minimum logging level
255
10
131
                Log::Log4perl->easy_init($args{verbose} ? $Log::Log4perl::DEBUG : $Log::Log4perl::ERROR);
256
10
9343
                $args{'logger'} = Log::Log4perl->get_logger();
257        }
258
259
19
786
        if($level) {
260
7
9
                if(ref($level) eq 'ARRAY') {
261
0
0
                        $level = $level->[0];
262                }
263
7
8
                $level = lc($level);
264
7
8
                if(!defined($syslog_values{$level})) {
265
0
0
                        Carp::croak("$class: invalid syslog level '$level'");
266                }
267
7
7
                $args{'level'} = $level;
268        } else {
269                # The default minimum level at which to log something is 'warning'
270
12
11
                $args{'level'} = 'warning';
271        }
272
273        # Bless and return the object
274        return bless {
275                messages => [],      # Initialize messages array
276                %args,
277
19
70
                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
45
        my ($self, $level, @messages) = @_;
340
341
23
25
        if(!UNIVERSAL::isa((caller)[0], __PACKAGE__)) {
342
1
25
                Carp::croak('Illegal Operation: _log is a private method');
343        }
344
345
22
183
        if(!defined($syslog_values{$level})) {
346
0
0
                Carp::Croak(ref($self), ": Invalid level '$level'");  # "Can't happen"
347        }
348
349
22
26
        if($syslog_values{$level} > $self->{'level'}) {
350                # The level is too low to log
351
3
3
                return;
352        }
353
354
19
30
        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
25
        @messages = grep defined, @messages;
359
360
19
17
        my $str = join('', @messages);
361
19
15
        chomp($str);
362
363        # Push the message to the internal messages array
364
19
19
12
21
        push @{$self->{messages}}, { level => $level, message => $str };
365
366
19
27
        my $class = blessed($self) || $self;
367
19
18
        if($class eq __PACKAGE__) {
368
18
14
                $class = '';
369        }
370
371
19
287
        my $timestamp = strftime "%Y-%m-%d %H:%M:%S", localtime;
372
373
19
25
        if(my $logger = $self->{'logger'}) {
374
19
35
                if(ref($logger) eq 'CODE') {
375                        # If logger is a code reference, call it with log details
376
3
8
                        $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
3
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
23
                                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
21
                                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
26
                                        $format =~ s/%level%/$ulevel/g;
401
2
1
                                        $format =~ s/%class%/$class/g;
402
2
3
                                        $format =~ s/%message%/$str/g;
403
2
0
                                        $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
9
                                        print $fout "$format\n" or Carp::croak(ref($self), ": Can't write to $file: $!");
407
2
24
                                        close $fout;
408                                }
409                        }
410
3
4
                        if(my $array = $logger->{'array'}) {
411
0
0
0
0
                                push @{$array}, { level => $level, message => $str };
412                        }
413
3
8
                        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
3
                        if(my $syslog = $logger->{'syslog'}) {
455
1
3
                                if((!defined($syslog->{'level'})) || ($syslog_values{$level} <= $syslog->{'level'})) {
456
1
2
                                        if(!$self->{_syslog_opened}) {
457                                                # Open persistent syslog connection
458
1
2
                                                my $facility = delete $syslog->{'facility'} || 'local0';
459
1
1
                                                my $min_level = delete $syslog->{'level'};
460                                                # CHI uses server, Sys::Syslog uses host :-(
461
1
1
                                                if($syslog->{'server'}) {
462
0
0
                                                        $syslog->{'host'} = delete $syslog->{'server'};
463                                                }
464
1
1
0
2
                                                Sys::Syslog::setlogsock($syslog) if(scalar keys %{$syslog});
465
1
1
                                                $syslog->{'facility'} = $facility;
466
1
0
                                                $syslog->{'level'} = $min_level;
467
468
1
2
                                                openlog($self->{script_name}, 'cons,pid', 'user');
469
1
44
                                                $self->{_syslog_opened} = 1; # Flag to track active connection
470                                        }
471
472                                        # Handle syslog-based logging
473
1
1
                                        eval {
474
1
1
                                                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
333
                                        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
9
                        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
20
                        if(open(my $fout, '>>', $logger)) {
505
2
3
                                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
25
                                $format =~ s/%level%/$ulevel/g;
510
2
2
                                $format =~ s/%class%/$class/g;
511
2
3
                                $format =~ s/%message%/$str/g;
512
2
2
                                $format =~ s/%callstack%/$callstack/g;
513
2
2
                                $format =~ s/%timestamp%/$timestamp/g;
514
2
2
                                $format =~ s/%env_(\w+)%/$ENV{$1}/g;
515
516
2
6
                                print $fout "$format\n" or Carp::croak(ref($self), ": Can't write to $logger: $!");
517
2
29
                                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
1050
        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
26
        if(my $fout = $self->{'fd'}) {
571
2
1
                my $ulevel = uc($level);
572
2
2
                my $callstack = (caller(1))[1] . ' ' . (caller(1))[2];
573
2
21
                my $format;
574
575
2
3
                if(blessed($self) eq __PACKAGE__) {
576
2
4
                        $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
1
                $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
9
                print $fout "$format\n" or Carp::croak(ref($self), ": Can't write to file descriptor: $!");
589        }
590}
591
592 - 597
=head2 level

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

=cut
598
599sub level
600{
601
1
2
        my ($self, $level) = @_;
602
603
1
4
        if($level) {
604
1
2
                if(!defined($syslog_values{$level})) {
605
0
0
                        Carp::carp(ref($self), ": invalid syslog level '$level'");
606
0
0
                        return;
607                }
608
1
1
                $self->{'level'} = $syslog_values{$level};
609        }
610
1
2
        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
64
        my $self = $_[0];
623
624
2
7
        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
205
        my $self = $_[0];
636
637
2
2
1
6
        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
17
        my $self = shift;
650
9
10
        $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
5
        $self->_log('info', @_);
664}
665
666 - 672
=head2 notice

  $logger->notice(@messages);

Logs a notice message.

=cut
673
674sub notice {
675
1
1
        my $self = shift;
676
1
1
        $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<Carp>.

=cut
688
689sub error {
690
0
0
        my $self = shift;
691
692
0
0
        $self->_high_priority('error', @_);
693}
694
695 - 701
=head2 trace

  $logger->trace(@messages);

Logs a trace message.

=cut
702
703sub trace {
704
1
1
        my $self = shift;
705
1
2
        $self->_log('trace', @_);
706}
707
708 - 718
=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
719
720sub warn {
721
4
27
        my $self = shift;
722
723
4
6
        $self->_high_priority('warn', @_);
724}
725
726 - 730
=head2 _high_priority

Helper to handle important messages.

=cut
731
732sub _high_priority
733{
734
4
3
        my $self = shift;
735
4
2
        my $level = shift;      # 'warn' or 'error'
736
4
8
        my $params = Params::Get::get_params('warning', @_);    # Get parameters
737
738        # Validate input parameters
739
4
51
        return unless ($params && (ref($params) eq 'HASH'));
740
741        # Only logging things higher than warn level
742
4
8
        return if($syslog_values{$level} > $WARNING);
743
744
4
12
        my $warning = $params->{warning};
745
4
4
        if(!defined($warning)) {
746
1
2
                if(scalar(@_) && !ref($_[0])) {
747                        # Given an array
748
1
1
                        $warning = join('', @_);
749                } else {
750
0
0
                        return;
751                }
752        }
753
4
7
        if(ref($warning) eq 'ARRAY') {
754                # Given "message => [ ref to array ]"
755
1
1
1
5
                $warning = join('', @{$warning});
756        }
757
758
4
6
        if($self eq __PACKAGE__) {
759                # If called from a class method, use Croak/Carp to warn
760
0
0
                if($syslog_values{$level} <= $ERROR) {
761
0
0
                        Carp::croak($warning);
762                }
763
0
0
                Carp::carp($warning);
764
0
0
                return;
765        }
766
767        # Log the warning message
768
4
7
        $self->_log($level, $warning);
769
770
4
5
        if($syslog_values{$level} <= $ERROR) {
771                # Fall back to Croak if no logger or syslog is defined
772
0
0
                if($self->{'croak_on_error'} || !defined($self->{logger})) {
773
0
0
                        Carp::croak($warning);
774                }
775        }
776
777
4
19
        if($self->{'carp_on_warn'} || !defined($self->{logger})) {
778                # Fallback to Carp if no logger or syslog is defined
779
0
0
                Carp::carp($warning);
780        }
781}
782
783# Destructor to close syslog connection
784sub DESTROY {
785
21
2483
        my $self = $_[0];
786
787
21
182
        if($self->{_syslog_opened}) {
788
1
2
                closelog();
789
1
8
                delete $self->{_syslog_opened};
790        }
791}
792
793 - 848
=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 Nigel Horne

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

=cut
849
8501;