lib/Log/Abstraction.pm

        start → end → jump
        

    1: package Log::Abstraction;
    2: 
    3: # TODO: OpenTelemetry (OTel) Logs backend — not yet implemented.
    4: #
    5: # The goal is to route log messages to an OTel collector via
    6: # OpenTelemetry::Logs::Logger->emit_record(), allowing Log::Abstraction
    7: # to participate in a unified traces+logs+metrics pipeline.
    8: #
    9: # Why it is blocked (last assessed 2026-07-10, OTel Perl v0.033):
   10: #
   11: #   1. emit_record() is a no-op stub.  OpenTelemetry::Logs::Logger
   12: #      contains "method emit_record ( %args ) { }" — every call is
   13: #      silently discarded.  This has been the case since logs were added
   14: #      as "experimental" in v0.023 (June 2024).
   15: #
   16: #   2. The SDK has no Logs implementation at all.  SDK::Trace::* is
   17: #      complete (providers, processors, samplers, OTLP exporter), but
   18: #      there is no SDK::Logs::LogRecord, no Batch/Simple processor, and
   19: #      no SDK::Logs::LoggerProvider.  OpenTelemetry::Exporter::OTLP::Logs
   20: #      exists as a module but has no processor pipeline to feed it.
   21: #
   22: #   3. The official Log::Any::Adapter::OpenTelemetry has a documented
   23: #      FIXME: it cannot safely cache the Logger at construction time,
   24: #      because acquiring a Logger before a real LoggerProvider is
   25: #      registered returns a no-op that can never be upgraded.  This is
   26: #      an unresolved architectural issue upstream.
   27: #
   28: #   4. is_debug() / is_* detection in the OTel adapter reads
   29: #      otel_config('LOG_LEVEL'), which is the SDK's own internal
   30: #      diagnostic level, not the application log level — a semantic bug
   31: #      that would propagate into any adapter we write on top.
   32: #
   33: #   5. The Logs stack depends on Object::Pad (Corinna), adding a
   34: #      non-trivial dependency and Perl >= 5.26 requirement in practice.
   35: #
   36: # When to revisit: watch for OpenTelemetry::SDK::Logs::LogRecord::Processor
   37: # appearing on CPAN.  That signals the end-to-end SDK pipe is functional.
   38: # Estimated: late 2026, based on the Trace SDK timeline (~6-9 months after
   39: # the Trace API stabilised).
   40: #
   41: # Implementation sketch (for when the above blockers are resolved):
   42: #   - Add an 'opentelemetry' sub-key to the HASH logger backend.
   43: #   - In _log: call otel_logger_provider()->logger()->emit_record(
   44: #         timestamp       => Time::HiRes::time(),
   45: #         severity_text   => $level,
   46: #         severity_number => $OTEL_SEVERITY{$level},
   47: #         body            => $str,
   48: #         attributes      => $self->{ctx} ? { ctx => $self->{ctx} } : {},
   49: #     );
   50: #   - Map internal levels: trace=1, debug=5, info=9, notice=10,
   51: #     warn=13, error=17 (OTel SeverityNumber spec, table 5).
   52: #   - Store the provider reference, not a cached Logger, to survive
   53: #     provider swaps (workaround for blocker 3 above).
   54: 
   55: # Enforce strict variable declarations and enable common warnings
   56: use strict;
   57: use warnings;
   58: 
   59: # Automatically throw exceptions on failed built-in I/O (open, close, print...)
   60: use autodie qw(:all);
   61: 
   62: # Core and CPAN dependencies
   63: use Carp;
   64: use Config::Abstraction 0.36;
   65: use Data::Dumper;
   66: use Params::Get 0.13;
   67: use POSIX qw(strftime);
   68: use Readonly;
   69: use Readonly::Values::Syslog 0.04;
   70: use Return::Set;
   71: use Scalar::Util 'blessed';
   72: 
   73: # Sub::Private in enforce mode: _-prefixed subs decorated :Private croak when
   74: # called from outside this package.  HARNESS_ACTIVE bypasses checks during
   75: # make test so white-box tests can still reach private methods.
   76: BEGIN { $Sub::Private::config{mode} = 'enforce' }
   77: use Sub::Private;
   78: 
   79: # Sys::Syslog imported with bare-function names used in _log
   80: use Sys::Syslog 0.28;
   81: 
   82: # ---------------------------------------------------------------------------
   83: # Module-level constants -- no magic strings or numbers anywhere below
   84: # ---------------------------------------------------------------------------
   85: 
   86: # Default minimum log level when none is specified in new()
   87: Readonly::Scalar my $DEFAULT_LEVEL => 'warning';
   88: 
   89: # Default SMTP delivery parameters for the sendmail backend
   90: Readonly::Scalar my $DEFAULT_SMTP_HOST => 'localhost';
   91: Readonly::Scalar my $DEFAULT_SMTP_PORT => 25;
   92: Readonly::Scalar my $DEFAULT_FROM_ADDR => 'noreply@localhost';
   93: Readonly::Scalar my $MIN_PORT          => 1;
   94: Readonly::Scalar my $MAX_PORT          => 65535;
   95: 
   96: # Default syslog connection parameters
   97: Readonly::Scalar my $DEFAULT_SYSLOG_FACILITY => 'local0';
   98: Readonly::Scalar my $DEFAULT_SYSLOG_OPTIONS  => 'cons,pid';
   99: Readonly::Scalar my $DEFAULT_SYSLOG_IDENTITY => 'user';
  100: 
  101: # Default log-line format tokens for file/fd/scalar-path backends
  102: Readonly::Scalar my $DEFAULT_FORMAT         => '%level%> [%timestamp%] %class% %callstack% %message%';
  103: Readonly::Scalar my $DEFAULT_FORMAT_NOCLASS => '%level%> [%timestamp%] %callstack% %message%';
  104: 
  105: # Map internal level names to POSIX syslog priority strings
  106: Readonly::Hash my %LEVEL_TO_SYSLOG_PRIORITY => (
  107: 	trace   => 'debug',
  108: 	debug   => 'debug',
  109: 	info    => 'info',
  110: 	notice  => 'notice',
  111: 	warn    => 'warning',
  112: 	warning => 'warning',
  113: 	error   => 'err',
  114: );
  115: 
  116: # Regex: characters forbidden in a log-file path (prevents command injection)
  117: Readonly::Scalar my $RE_SAFE_PATH => qr/^([^<>|*?;!`\$"\x00-\x1F]+)$/;
  118: 
  119: # Regex: path component that would escape the intended directory
  120: Readonly::Scalar my $RE_DOTDOT => qr/\.\./;
  121: 
  122: # Regex: characters forbidden in an SMTP hostname (allows a-z, A-Z, 0-9, dot, hyphen)
  123: Readonly::Scalar my $RE_SAFE_HOST => qr/[^a-zA-Z0-9.\-]/;
  124: 
  125: # Regex: a valid TCP port number string (decimal digits only; range checked separately)
  126: Readonly::Scalar my $RE_PORT => qr/^\d+$/;
  127: 
  128: # Default path to the journald native-protocol socket on systemd systems
  129: Readonly::Scalar my $DEFAULT_JOURNALD_SOCKET => '/run/systemd/journal/socket';
  130: 
  131: =head1 NAME
  132: 
  133: Log::Abstraction - Logging Abstraction Layer
  134: 
  135: =head1 VERSION
  136: 
  137: 0.32
  138: 
  139: =cut
  140: 
  141: our $VERSION = 0.32;
  142: 
  143: =head1 SYNOPSIS
  144: 
  145:   use Log::Abstraction;
  146: 
  147:   my $logger = Log::Abstraction->new(logger => 'logfile.log');
  148: 
  149:   $logger->debug('This is a debug message');
  150:   $logger->info('This is an info message');
  151:   $logger->notice('This is a notice message');
  152:   $logger->trace('This is a trace message');
  153:   $logger->warn({ warning => 'This is a warning message' });
  154: 
  155: =head1 DESCRIPTION
  156: 
  157: The C<Log::Abstraction> class provides a flexible logging layer on top of
  158: different types of loggers, including code references, arrays, file paths,
  159: and objects.  It also supports logging to syslog if configured.
  160: 
  161: =head1 METHODS
  162: 
  163: =head2 new
  164: 
  165:   my $logger = Log::Abstraction->new(%args);
  166:   my $logger = Log::Abstraction->new(\%args);
  167:   my $logger = Log::Abstraction->new($file_path);
  168: 
  169:   # Clone with optional overrides
  170:   my $clone = $logger->new(level => 'debug');
  171: 
  172: Creates a new C<Log::Abstraction> instance, or clones an existing one when
  173: called on an object.
  174: 
  175: =head3 Arguments
  176: 
  177: =over 4
  178: 
  179: =item * C<carp_on_warn>
  180: 
  181: If set to 1, and no C<logger> is given, call C<Carp::carp> on C<warn()>.
  182: Also causes C<error()> to C<carp> if C<croak_on_error> is not set.
  183: 
  184: =item * C<croak_on_error>
  185: 
  186: If set to 1, and no C<logger> is given, call C<Carp::croak> on C<error()>.
  187: 
  188: =item * C<config_file>
  189: 
  190: Path to a configuration file (YAML, XML, INI, etc.) whose contents are
  191: merged with the constructor arguments.  On non-Windows systems the class
  192: can also be configured via environment variables prefixed with
  193: C<"Log::Abstraction::">.  For example:
  194: 
  195:   export Log::Abstraction::script_name=foo
  196: 
  197: =item * C<ctx>
  198: 
  199: Arbitrary context value passed through to CODE-ref logger callbacks as
  200: C<$args-E<gt>{ctx}>.
  201: 
  202: =item * C<format>
  203: 
  204: Format string for file/fd backends.  Tokens expanded at log time:
  205: 
  206:   %callstack%   caller file and line number
  207:   %class%       blessed class of the logger object
  208:   %level%       upper-cased level name
  209:   %message%     the joined log message
  210:   %timestamp%   YYYY-MM-DD HH:MM:SS (local time)
  211:   %env_FOO%     value of $ENV{FOO}, or empty string if unset
  212: 
  213: The special value C<"json"> (not a format string but a magic keyword) switches
  214: all file and fd backends to emit one compact JSON object per log line:
  215: 
  216:   {"timestamp":"...","level":"info","message":"...","file":"...","line":42}
  217: 
  218: This format is compatible with log aggregators such as journald, Loki,
  219: Elasticsearch, and Splunk.  C<class> is included when the logger is a subclass
  220: of C<Log::Abstraction>.
  221: 
  222: B<Security note:> because C<format> may contain C<%env_*%> tokens, avoid
  223: granting untrusted sources write access to config files that set this key.
  224: 
  225: =item * C<level>
  226: 
  227: Minimum level at which to emit log entries.  Defaults to C<"warning">.
  228: Valid values (case-insensitive): C<trace>, C<debug>, C<info>, C<notice>,
  229: C<warn>/C<warning>, C<error>.
  230: 
  231: =item * C<logger>
  232: 
  233: One of:
  234: 
  235: =over 4
  236: 
  237: =item * A code reference -- called with a hashref C<{ class, file, line, level, message, ctx }>
  238: 
  239: =item * An object -- method matching the level name is called on it
  240: 
  241: =item * A hash reference -- may contain C<file>, C<array>, C<fd>, C<syslog>, C<journald>, and/or C<sendmail> keys
  242: 
  243: =item * An array reference -- C<{ level, message }> hashrefs are pushed onto it
  244: 
  245: =item * A scalar string -- treated as a file path to append to
  246: 
  247: =back
  248: 
  249: When not supplied, L<Log::Log4perl> is initialised as the default backend.
  250: 
  251: The C<sendmail> sub-hash supports:
  252: C<host>, C<port>, C<to>, C<from>, C<subject>, C<level>, C<min_interval>.
  253: At most one email is sent per C<min_interval> seconds per instance.
  254: 
  255: The C<journald> sub-hash sends each message as a single datagram to the
  256: systemd journal using the journald native protocol.  Supported keys:
  257: 
  258: =over 4
  259: 
  260: =item * C<socket> -- path to the journald socket (default: F</run/systemd/journal/socket>)
  261: 
  262: =item * C<identifier> -- value for the C<SYSLOG_IDENTIFIER> field (default: basename of C<$0>)
  263: 
  264: =item * any other key -- included verbatim as an uppercase journald field name
  265: 
  266: =back
  267: 
  268: The C<PRIORITY> field is set automatically from the log level (0=emerg...7=debug).
  269: Delivery failures are silent (C<Carp::carp> only); the application is never crashed by a journald error.
  270: 
  271: =item * C<script_name>
  272: 
  273: Script name reported to syslog.  Auto-detected from C<$0> if not supplied.
  274: 
  275: =item * C<verbose>
  276: 
  277: When using the default Log::Log4perl backend, raises the logging level to
  278: DEBUG when set to a true value.
  279: 
  280: =back
  281: 
  282: =head3 Returns
  283: 
  284: A blessed C<Log::Abstraction> object.
  285: 
  286: =head3 Side Effects
  287: 
  288: Loads C<File::Basename> if C<syslog> is configured and C<script_name> is
  289: not supplied.  Loads C<Log::Log4perl> if no logger backend is specified.
  290: 
  291: =head3 Example
  292: 
  293:   my $logger = Log::Abstraction->new(
  294:       level  => 'debug',
  295:       logger => \@messages,
  296:   );
  297: 
  298:   my $clone = $logger->new(level => 'info');
  299: 
  Mutants (Total: 2, Killed: 2, Survived: 0)
  300: =head3 API Specification
  301: 
  302: =head4 Input
  303: 
  304:   {
  305:       carp_on_warn   => { type => 'boolean', optional => 1 },
  306:       config_file    => { type => 'string',  optional => 1 },
  Mutants (Total: 1, Killed: 1, Survived: 0)
  307:       croak_on_error => { type => 'boolean', optional => 1 },
  Mutants (Total: 1, Killed: 1, Survived: 0)
  308:       ctx            => { optional => 1 },
  309:       format         => { type => 'string',  optional => 1 },
  310:       level          => { type => 'string',  regex => qr/^(trace|debug|info|notice|warn(?:ing)?|error)$/i, optional => 1 },
  Mutants (Total: 1, Killed: 1, Survived: 0)
  311:       logger         => { optional => 1 },
  312:       script_name    => { type => 'string',  optional => 1 },
  313:       verbose        => { type => 'boolean', optional => 1 },
  314:   }
  315: 
  316: =head4 Output
  317: 
  Mutants (Total: 1, Killed: 1, Survived: 0)
  318:   { type => 'object', class => 'Log::Abstraction' }
  319: 
  320: =head3 MESSAGES
  321: 
  322:   Error                                     Meaning / Action
  323:   ----------------------------------------  -----------------------------------------

					

					
Mutants (Total: 1, Killed: 0, Survived: 1)
					

				
COND_INV_323_4: Invert condition if to unless
MEDIUM: Add tests asserting both true and false outcomes

  324:   "<class>: <path>: File not readable"      config_file path exists but is unreadable.
  325:                                             Check file permissions.
  326:   "<class>: Can't load configuration       Config::Abstraction could not parse the
  327:     from <path>"                            file.  Check syntax and format.
  328:   "<class>: syslog needs to know the        syslog backend requested but script_name
  329:     script name"                            could not be determined.  Pass it explicitly.
  330:   "<class>: attempt to encapsulate          logger => Log::Abstraction would create
  331:     Log::Abstraction as a logging class,    a needless forwarding loop.  Use a
  332:     that would add a needless indirection"  different backend.
  Mutants (Total: 1, Killed: 1, Survived: 0)
  333:   "<class>: invalid syslog level '<l>'"     level value is not a recognised syslog
  334:                                             level name.  Use trace/debug/info/notice/
  335:                                             warn/warning/error.
  336: 
  337: =head3 PSEUDOCODE
  Mutants (Total: 1, Killed: 1, Survived: 0)
  338: 
  339:   FUNCTION new(class_or_obj, args...)
  Mutants (Total: 1, Killed: 1, Survived: 0)
  340: 
  341:     Parse args:
  342:       IF single non-hash scalar
  343:       THEN store as logger shorthand
  344:       ELSE extract named params via Params::Get
  345: 
  346:     IF config_file present:
  Mutants (Total: 2, Killed: 2, Survived: 0)
  347:       CROAK if file is not readable
  348:       Load via Config::Abstraction, merge into args (constructor args win)
  349:       Restore caller-supplied array ref that config merge would have dropped
  350: 
  Mutants (Total: 1, Killed: 1, Survived: 0)
  351:     IF called on a blessed instance (clone form):
  352:       shallow-clone self merged with override args
  353:       validate and store new level integer if level given in args
  354:       deep-copy message history list
  355:       RETURN clone
  356: 
  357:     IF syslog requested and script_name not supplied:
  358:       auto-detect script name via File::Basename
  359:       CROAK if still undefined
  Mutants (Total: 1, Killed: 1, Survived: 0)
  360: 
  Mutants (Total: 1, Killed: 1, Survived: 0)
  361:     IF logger arg is a Log::Abstraction object:
  362:       CROAK (would create a needless forwarding loop)
  363: 
  364:     IF no logger AND no file AND no array:
  365:       load Log::Log4perl, easy_init at DEBUG or ERROR per verbose flag
  366:       store Log4perl logger as the backend
  367: 
  368:     Normalise and validate level:
  369:       IF level is an arrayref, take first element
  370:       lc() the level string
  371:       CROAK if not in syslog_values lookup
  372:       default to $DEFAULT_LEVEL if not supplied
  373: 
  374:     RETURN bless { messages => [], merged args, level => numeric } as class
  375: 
  376:   END FUNCTION
  377: 
  378: =cut
  379: 
  Mutants (Total: 1, Killed: 1, Survived: 0)
  380: sub new {
  Mutants (Total: 1, Killed: 1, Survived: 0)
●381 → 385 → 392  381: 	my $class = shift;
  382: 
  383: 	# Accept a plain hash, a hashref, or a single scalar (file-path shorthand)
  384: 	my %args;
  Mutants (Total: 1, Killed: 1, Survived: 0)
  385: 	if((scalar(@_) == 1) && (ref($_[0]) ne 'HASH')) {
  386: 		$args{'logger'} = shift;
  387: 	} elsif(my $params = Params::Get::get_params(undef, \@_)) {
  388: 		%args = %{$params};
  389: 	}
  390: 
  391: 	# Load configuration from a file when config_file is present
●392 → 392 → 418  392: 	if(exists($args{'config_file'})) {
  393: 		if(!-r $args{'config_file'}) {
  Mutants (Total: 2, Killed: 2, Survived: 0)
  394: 			croak("$class: ", $args{'config_file'}, ': File not readable');
  395: 		}
  396: 		if(my $config = Config::Abstraction->new(
  397: 			config_dirs => [''],
  398: 			config_file => $args{'config_file'},
  399: 			env_prefix  => "${class}::",
  400: 		)) {
  401: 			# Merge file config with constructor args; constructor wins
  402: 			$config = $config->all();
  403: 			if($config->{$class}) {
  404: 				$config = $config->{$class};
  405: 			}
  406: 			my $array = $args{'array'};
  407: 			%args = (%{$config}, %args);
  408: 			# Restore caller-supplied array ref after merge (config can't supply refs)
  409: 			if($array) {
  410: 				$args{'array'} = $array;
  411: 			}
  412: 		} else {
  413: 			croak("$class: Can't load configuration from ", $args{'config_file'});
  414: 		}
  415: 	}
  416: 
  417: 	# Handle function-call form: Log::Abstraction::new() with no class
  Mutants (Total: 2, Killed: 2, Survived: 0)
●418 → 418 → 436  418: 	if(!defined($class)) {
  419: 		$class = __PACKAGE__;
  420: 	} elsif(Scalar::Util::blessed($class)) {
  421: 		# Called on an existing instance -- return a shallow clone
  422: 		my $clone = bless { %{$class}, %args }, ref($class);
  423: 		if(my $level = $args{'level'}) {
  424: 			$level = lc($level);
  425: 			if(!defined($syslog_values{$level})) {
  426: 				Carp::croak("$class: invalid syslog level '$level'");
  427: 			}
  428: 			$clone->{level} = $syslog_values{$level};
  429: 		}
  430: 		# Deep-copy the message history so parent and clone diverge independently
  431: 		$clone->{messages} = [ @{$class->{messages}} ];
  432: 		return $clone;
  433: 	}
  434: 
  435: 	# Auto-detect script name when syslog backend is requested
●436 → 436 → 444  436: 	if($args{'syslog'} && !$args{'script_name'}) {
  437: 		require File::Basename;
  438: 		$args{'script_name'} = File::Basename::basename($ENV{'SCRIPT_NAME'} || $0);
  439: 		croak("$class: syslog needs to know the script name")
  440: 			if(!defined($args{'script_name'}));
  Mutants (Total: 1, Killed: 1, Survived: 0)
  441: 	}
  Mutants (Total: 2, Killed: 2, Survived: 0)
  442: 
  443: 	# Reject attempts to use this module as its own logger backend
●444 → 444 → 463  444: 	if(defined(my $logger = $args{logger})) {
  445: 		if(Scalar::Util::blessed($logger) && (ref($logger) eq __PACKAGE__)) {
  446: 			croak(
  447: 				"$class: attempt to encapsulate ",
  448: 				__PACKAGE__,
  449: 				' as a logging class, that would add a needless indirection',
  450: 			);
  451: 		}
  452: 	} elsif((!$args{'file'}) && (!$args{'array'})) {
  453: 		# Fall back to Log::Log4perl when no other backend is configured
  454: 		require Log::Log4perl;
  455: 		Log::Log4perl->import();
  456: 		Log::Log4perl->easy_init(
  457: 			$args{verbose} ? $Log::Log4perl::DEBUG : $Log::Log4perl::ERROR
  458: 		);
  459: 		$args{'logger'} = Log::Log4perl->get_logger();
  460: 	}
  461: 
  462: 	# Resolve and store the numeric threshold for the requested level
●463 → 464 → 478  463: 	my $level = $args{'level'};
  464: 	if($level) {
  465: 		if(ref($level) eq 'ARRAY') {
  466: 			$level = $level->[0];
  467: 		}
  468: 		$level = lc($level);
  469: 		if(!defined($syslog_values{$level})) {
  470: 			Carp::croak("$class: invalid syslog level '$level'");
  471: 		}
  472: 		$args{'level'} = $level;
  473: 	} else {
  474: 		$args{'level'} = $DEFAULT_LEVEL;
  475: 	}
  476: 
  477: 	# Construct and return the blessed object
  478: 	return bless {
  479: 		messages => [],
  480: 		%args,
  481: 		level => $syslog_values{ $args{'level'} },
  482: 	}, $class;
  483: }
  484: 
  485: # ---------------------------------------------------------------------------
  486: # _sanitize_email_header -- remove CR/LF to prevent SMTP header injection
  487: #
  488: # Purpose:      Strip carriage-return and line-feed characters from any string
  489: #               that will appear in a MIME header field (To, From, Subject).
  490: # Entry:        $value -- a scalar, possibly containing \r, \n, or \r\n.
  491: # Exit:         Returns the sanitised scalar, or undef if input was undef.
  492: # Notes:        Called from _log before every header_set() call.
  493: # ---------------------------------------------------------------------------
  494: sub _sanitize_email_header :Private {
  495: 	my ($value) = @_;
  496: 
  497: 	return unless defined $value;
  498: 
  499: 	# Strip all CR, LF and CRLF sequences
  500: 	$value =~ s/\r\n?|\n//g;
  501: 
  502: 	return Return::Set::set_return(
  503: 		$value,
  504: 		{ type => 'string', 'matches' => qr/^[^\r\n]*$/ },
  505: 	);
  506: }
  507: 
  508: # ---------------------------------------------------------------------------
  Mutants (Total: 2, Killed: 2, Survived: 0)
  509: # _validate_file_path -- validate and untaint a filesystem path
  510: #
  511: # Purpose:      Ensure a caller-supplied path does not contain dangerous
  512: #               characters or directory-traversal sequences before it is
  513: #               passed to open().
  514: # Entry:        $self  -- the logger object (for error context in croak).
  515: #               $path  -- the raw path string to validate.
  516: # Exit:         Returns the untainted capture (Perl taint-safe string).
  517: #               Croaks with a descriptive message if validation fails.
  518: # Notes:        Blocks the character set <, >, |, *, ?, ;, !, `, $, "
  519: #               and all C0 control characters, as well as ".." sequences.
  520: # ---------------------------------------------------------------------------
  521: sub _validate_file_path :Private {
●522 → 525 → 528  522: 	my ($self, $path) = @_;
  523: 
  524: 	# Block ".." path-traversal and all dangerous shell metacharacters
  525: 	if($path =~ $RE_SAFE_PATH && $path !~ $RE_DOTDOT) {
  526: 		return $1;    # $1 is the untainted capture from RE_SAFE_PATH
  527: 	}
  528: 	Carp::croak(ref($self), ": Invalid file name: $path");
  529: }
  530: 
  531: # ---------------------------------------------------------------------------
  532: # _journald_send -- encode fields and send one datagram to the journald socket
  533: #
  534: # Purpose:      Format key=value fields in the journald native protocol and
  535: #               deliver them as a single Unix-domain SOCK_DGRAM packet.
  536: # Entry:        $self        -- the logger object (unused but required for
  537: #                              consistent OOP dispatch; enforces Sub::Private).
  538: #               $socket_path -- filesystem path of the journald socket.
  539: #               %fields      -- FIELD_NAME => value pairs; names must be
  540: #                              uppercase ASCII + digits + underscore.
  541: # Exit:         Returns nothing.  Croaks on socket or send failure (the caller
  542: #               wraps every call in eval{} so failures are silent to the app).
  543: # Side effects: Opens a transient Unix datagram socket, sends, closes.
  544: # Notes:        Values containing newline or NUL use the binary framing
  545: #               (field-name NL uint64-LE-length value NL) as specified by
  546: #               https://systemd.io/JOURNAL_NATIVE_PROTOCOL/.
  547: #               Values without newlines or NULs use the simpler FIELD=VALUE NL
  548: #               text format.
  549: # ---------------------------------------------------------------------------
  550: sub _journald_send :Private {
●551 → 555 → 566  551: 	my ($self, $socket_path, %fields) = @_;
  552: 
  553: 	# Build the datagram payload from all supplied fields
  554: 	my $payload = '';
  555: 	for my $key (sort keys %fields) {
  556: 		my $value = defined($fields{$key}) ? "$fields{$key}" : '';
  557: 		if($value =~ /[\n\0]/) {
  558: 			# Binary framing: field-name LF uint64LE-length value LF
  559: 			$payload .= $key . "\n" . pack('Q<', length($value)) . $value . "\n";
  560: 		} else {
  561: 			$payload .= "$key=$value\n";
  562: 		}
  563: 	}
  564: 
  565: 	# Open a Unix-domain datagram socket, send, and close
  566: 	require Socket;
  567: 	socket(my $sock, Socket::AF_UNIX(), Socket::SOCK_DGRAM(), 0);
  568: 	my $dest = Socket::sockaddr_un($socket_path);
  569: 	send($sock, $payload, 0, $dest);
  570: 	close $sock;
  571: }
  572: 
  573: # ---------------------------------------------------------------------------
  574: # _format_message -- expand a log-format string into a final log line
  575: #
  576: # Purpose:      Centralise the repeated format-token substitution so that
  577: #               file, fd, and scalar-path backends all share one code path.
  578: # Entry:        $self        -- the logger object (source of 'format' setting).
  579: #               $level       -- log level string (e.g. 'debug').
  580: #               $str         -- the already-joined message string.
  581: #               $use_class   -- 1 to include %class% in the default format,
  582: #                               0 to use the no-class format.
  583: #               $caller_file -- pre-resolved source file of the logging call.
  584: #               $caller_line -- pre-resolved source line of the logging call.
  585: # Exit:         Returns the formatted log line (without trailing newline).
  586: # Notes:        %env_FOO% tokens are expanded with a // '' fallback so that
  587: #               missing environment variables expand silently to empty string.
  588: #               caller_file/caller_line are computed by _log at the correct
  Mutants (Total: 1, Killed: 1, Survived: 0)
  589: #               stack depth (adjusted for the extra _high_priority frame on
  590: #               warn/error calls) so the reported location is always the
  591: #               caller's code, not an internal dispatch frame.
  592: #
  593: # Pseudocode:
  Mutants (Total: 1, Killed: 1, Survived: 0)
  594: #   FUNCTION _format_message(self, level, str, use_class, caller_file, caller_line)
  595: #     IF self->{'format'} eq 'json':
  596: #       Build hash: timestamp, level, message, file=caller_file, line=caller_line
  597: #                   (+ class if subclass)
  598: #       RETURN JSON::PP::encode_json(\%hash)   [single compact line]
  Mutants (Total: 4, Killed: 4, Survived: 0)
  599: #
  600: #     Choose default format template:
  601: #       use_class=1 → DEFAULT_FORMAT (includes %class%)
  602: #       use_class=0 → DEFAULT_FORMAT_NOCLASS
  603: #     Override with self->{'format'} if the caller supplied a custom format
  Mutants (Total: 2, Killed: 2, Survived: 0)
  604: #
  605: #     Compute token values:
  606: #       ulevel    = uc(level)
  607: #       class     = blessed class if it is a subclass, else '' (base package)
  608: #       callstack = caller_file and caller_line
  609: #       timestamp = strftime 'YYYY-MM-DD HH:MM:SS'
  610: #
  611: #     Expand tokens in format string:
  612: #       %level%       → ulevel
  613: #       %class%       → class (may be empty)
  614: #       %message%     → str
  615: #       %callstack%   → callstack
  616: #       %timestamp%   → timestamp
  617: #       %env_FOO%     → $ENV{FOO} // '' (silent if env var unset)
  Mutants (Total: 1, Killed: 1, Survived: 0)
  618: #
  619: #     RETURN formatted line string
  620: #   END FUNCTION
  621: # ---------------------------------------------------------------------------
  622: sub _format_message :Private {
●623 → 628 → 644  623: 	my ($self, $level, $str, $use_class, $caller_file, $caller_line) = @_;
  624: 
  Mutants (Total: 1, Killed: 1, Survived: 0)
  625: 	my $format = $self->{'format'};
  626: 
  Mutants (Total: 1, Killed: 1, Survived: 0)
  627: 	# 'json' is a magic format value: emit a compact JSON object per line
  628: 	if(defined($format) && ($format eq 'json')) {
  629: 		require JSON::PP;
  630: 		my $bclass = blessed($self);
  631: 		my $class  = ($bclass && $bclass ne __PACKAGE__) ? $bclass : undef;
  632: 		my %obj = (
  633: 			timestamp => strftime('%Y-%m-%d %H:%M:%S', localtime),
  634: 			level     => $level,
  635: 			message   => $str,
  Mutants (Total: 1, Killed: 1, Survived: 0)
  636: 			file      => $caller_file,
  637: 			line      => $caller_line + 0,
  638: 		);
  639: 		$obj{class} = $class if defined($class);
  640: 		return JSON::PP::encode_json(\%obj);
  641: 	}
  642: 
  643: 	# Select the appropriate default when no custom format is configured ('' is falsy)
  644: 	my $default = $use_class ? $DEFAULT_FORMAT : $DEFAULT_FORMAT_NOCLASS;
  645: 	$format = $format || $default;
  646: 
  647: 	my $ulevel = uc($level);
  648: 
  Mutants (Total: 1, Killed: 1, Survived: 0)
  649: 	# Suppress the class name for the base package (only show for subclasses)
  650: 	my $bclass = blessed($self);
  651: 	my $class  = ($bclass && $bclass ne __PACKAGE__) ? $bclass : '';
  652: 
  653: 	my $callstack = "$caller_file $caller_line";
  654: 	my $timestamp = strftime '%Y-%m-%d %H:%M:%S', localtime;
  655: 
  656: 	# Expand all recognised tokens in a single pass per token type
  657: 	$format =~ s/%level%/$ulevel/g;
  658: 	$format =~ s/%class%/$class/g;
  659: 	$format =~ s/%message%/$str/g;
  660: 	$format =~ s/%callstack%/$callstack/g;
  661: 	$format =~ s/%timestamp%/$timestamp/g;
  Mutants (Total: 1, Killed: 1, Survived: 0)
  662: 	$format =~ s/%env_(\w+)%/$ENV{$1} \/\/ ''/ge;
  663: 
  664: 	return $format;
  665: }
  666: 
  Mutants (Total: 1, Killed: 1, Survived: 0)
  667: # ---------------------------------------------------------------------------
  668: # _log -- central dispatcher that routes a message to all active backends
  669: #
  670: # Purpose:      Every public logging method ultimately calls _log.  It checks
  Mutants (Total: 1, Killed: 1, Survived: 0)
  671: #               the current level threshold, records the message in the
  Mutants (Total: 3, Killed: 3, Survived: 0)
  672: #               internal history, then dispatches to the configured backend(s).
  673: # Entry:        $self    -- the logger object.
  674: #               $level   -- one of trace/debug/info/notice/warn/error.
  675: #               @messages -- one or more message strings (or a single arrayref).
  Mutants (Total: 1, Killed: 1, Survived: 0)
  676: # Exit:         Returns nothing (void).  Croaks on configuration errors.
  677: # Side effects: Appends to $self->{messages}.  May write to a file, fd,
  678: #               array, syslog, or email backend.  May load Email::* modules.
  Mutants (Total: 3, Killed: 3, Survived: 0)
  679: # Notes:        Enforced private: croaks if called from outside this package.
  680: #               The caller depth used for file/line in CODE-ref callbacks is
  681: #               caller(1), which resolves correctly for trace/debug/info/notice
  Mutants (Total: 1, Killed: 1, Survived: 0)
  682: #               but points one frame inward for warn/error (via _high_priority).
  683: #
  684: # Pseudocode:
  685: #   FUNCTION _log(self, level, messages...)
  686: #     CROAK if caller package is not this package (private method guard)
  687: #     CROAK if level is not a recognised syslog level name
  688: #     RETURN early if syslog_values{level} > self->{'level'} (below threshold)
  689: #

					

					
Mutants (Total: 3, Killed: 0, Survived: 3)
					

				
NUM_BOUNDARY_689_18_>: Numeric boundary flip >= to >
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
NUM_BOUNDARY_689_18_<: Numeric boundary flip >= to <
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
NUM_BOUNDARY_689_18_<=: Numeric boundary flip >= to <=
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
  690: #     Flatten single-arrayref argument to a list; filter out undefs; join to $str

					

					
Mutants (Total: 3, Killed: 0, Survived: 3)
					

				
NUM_BOUNDARY_690_18_<: Numeric boundary flip <= to <
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
NUM_BOUNDARY_690_18_>: Numeric boundary flip <= to >
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
NUM_BOUNDARY_690_18_>=: Numeric boundary flip <= to >=
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
  691: #     Push { level, message } onto self->{messages} (always recorded)
  692: #     Set $class = '' for base package, else the blessed class name
  693: #
  694: #     IF self->{'logger'} is a CODE ref:
  695: #       Build args hashref { class, file, line, level, message, ctx? }
  696: #       Call logger->( args )
  697: #
  698: #     ELSIF self->{'logger'} is an ARRAY ref:
  699: #       Push { level, message }
  700: #
  701: #     ELSIF self->{'logger'} is a HASH ref:
  702: #       IF 'file' key present:
  703: #         validate path; format line; (eval) open>>file, print, close
  704: #       IF 'array' key present:
  705: #         push { level, message }
  706: #       IF 'sendmail' key present with a 'to' address:
  707: #         IF level passes threshold AND not throttled:
  708: #           CROAK if host contains unsafe characters
  709: #           CROAK if port is out of 1-65535 range
  710: #           (eval) load Email::* modules; build email with sanitised headers;
  711: #                  send via SMTP transport; carp on delivery failure
  712: #           Record timestamp for throttle
  713: #       IF 'syslog' key present:
  Mutants (Total: 1, Killed: 1, Survived: 0)
  714: #         IF level passes threshold:
  715: #           Open syslog connection on first use (setlogsock, openlog)
  716: #           (eval) map level to syslog priority; call Sys::Syslog::syslog;
  717: #                  carp with Data::Dumper output on failure
  718: #       IF 'journald' key present:
  719: #         Map level to syslog PRIORITY integer
  720: #         Build fields: MESSAGE, PRIORITY, SYSLOG_IDENTIFIER, plus any extra
  721: #         (eval) _journald_send(socket_path, %fields); carp on failure
  722: #       IF 'fd' key present:
  723: #         Format line; print to filehandle
  724: #       ELSIF no actionable key (no file/array/syslog/sendmail/journald/fd):
  725: #         CROAK (configuration error)
  726: #
  727: #     ELSIF self->{'logger'} is an unblessed scalar (file path):
  728: #       Validate path; format line; (eval) open>>file, print, close
  Mutants (Total: 1, Killed: 1, Survived: 0)
  729: #
  730: #     ELSIF self->{'logger'} is a blessed object:
  731: #       Map 'notice' to 'info' for backends without notice() (e.g. Log::Log4perl)
  732: #       CROAK if object cannot handle the level
  733: #       Call $logger->$level(@messages)
  734: #
  735: #     ELSIF self->{'array'} top-level key:
  736: #       Push { level, message }
  737: #
  738: #     IF self->{'file'} top-level key:
  739: #       Validate path; format line; (eval) open>>file, print, close
  740: #     IF self->{'fd'} top-level key:
  Mutants (Total: 1, Killed: 1, Survived: 0)
  741: #       Format line; print to filehandle
  Mutants (Total: 1, Killed: 1, Survived: 0)
  742: #   END FUNCTION
  Mutants (Total: 3, Killed: 3, Survived: 0)
  743: # ---------------------------------------------------------------------------
  744: sub _log :Private {
●745 → 748 → 753  745: 	my ($self, $level, @messages) = @_;
  Mutants (Total: 1, Killed: 1, Survived: 0)
  746: 
  747: 	# Reject direct calls from outside this package (also enforced by :Private)
  748: 	if(!(caller)[0]->isa(__PACKAGE__)) {
  749: 		Carp::croak('Illegal Operation: _log is a private method');
  750: 	}
  Mutants (Total: 1, Killed: 1, Survived: 0)
  751: 
  752: 	# Sanity-check the level (should not be reachable in normal use)
●753 → 753 → 758  753: 	if(!defined($syslog_values{$level})) {
  754: 		Carp::croak(ref($self), ": Invalid level '$level'");
  755: 	}
  756: 
  757: 	# Drop messages that fall below the configured threshold
●758 → 758 → 763  758: 	if($syslog_values{$level} > $self->{'level'}) {
  759: 		return;
  760: 	}
  761: 
  762: 	# Flatten a single arrayref argument to a plain list
●763 → 763 → 768  763: 	if((scalar(@messages) == 1) && (ref($messages[0]) eq 'ARRAY')) {
  764: 		@messages = @{$messages[0]};
  765: 	}
  766: 
  767: 	# Remove any undef elements before joining
  Mutants (Total: 1, Killed: 1, Survived: 0)
●768 → 777 → 784  768: 	@messages = grep { defined } @messages;
  769: 	my $str = join('', @messages);
  770: 	chomp($str);
  771: 
  772: 	# Record in the internal message history regardless of backend
  773: 	push @{$self->{messages}}, { level => $level, message => $str };
  774: 
  775: 	# Compute class once; suppress the package name for base-class instances
  776: 	my $class = blessed($self) || $self;
  Mutants (Total: 1, Killed: 1, Survived: 0)
  777: 	if($class eq __PACKAGE__) {
  778: 		$class = '';
  779: 	}
  780: 
  781: 	# Resolve caller file/line at the correct stack depth.
  782: 	# For trace/debug/info/notice: _log ← public_method ← user → depth=1
  783: 	# For warn/error: _log ← _high_priority ← public_method ← user → depth=2
●784 → 791 → 1022  784: 	my $depth = ((caller(1))[3] // '') =~ /::_high_priority$/ ? 2 : 1;
  785: 	my $caller_file = (caller($depth))[1];
  786: 	my $caller_line = (caller($depth))[2];
  787: 
  788: 	# -----------------------------------------------------------------------
  789: 	# Dispatch to the configured backend(s)
  790: 	# -----------------------------------------------------------------------
  791: 	if(my $logger = $self->{'logger'}) {
  792: 		if(ref($logger) eq 'CODE') {
  793: 			# CODE-ref backend: build the args hashref and invoke the callback
  794: 			my $args = {
  795: 				class   => blessed($self) || __PACKAGE__,
  796: 				file    => $caller_file,
  797: 				line    => $caller_line,
  798: 				level   => $level,
  799: 				message => \@messages,
  800: 			};
  801: 			if(my $ctx = $self->{ctx}) {
  802: 				$args->{ctx} = $ctx;
  Mutants (Total: 1, Killed: 1, Survived: 0)
  803: 			}
  Mutants (Total: 1, Killed: 1, Survived: 0)
  804: 			$logger->($args);
  805: 		} elsif(ref($logger) eq 'ARRAY') {
  806: 			# ARRAY-ref backend: push a simple hashref
  807: 			push @{$logger}, { level => $level, message => $str };
  808: 		} elsif(ref($logger) eq 'HASH') {
  809: 			# HASH backend: route to whichever sub-keys are present
  810: 
  811: 			# -- file sub-backend -------------------------------------------
  812: 			if(my $raw_file = $logger->{'file'}) {
  813: 				my $file = $self->_validate_file_path($raw_file);
  814: 				my $use_class = ($class ne '') ? 1 : 0;
  815: 				my $line = $self->_format_message($level, $str, $use_class, $caller_file, $caller_line);
  816: 				# Log failures are silent by design; the app must not crash on I/O errors
  817: 				eval {
  818: 					open(my $fout, '>>', $file);
  819: 					print $fout "$line\n";
  820: 					close $fout;
  821: 				};
  822: 			}
  823: 
  824: 			# -- array sub-backend ------------------------------------------
  825: 			if(my $array = $logger->{'array'}) {
  826: 				push @{$array}, { level => $level, message => $str };
  827: 			}
  828: 
  Mutants (Total: 1, Killed: 1, Survived: 0)
  829: 			# -- sendmail sub-backend ---------------------------------------
  830: 			if(exists($logger->{'sendmail'}) && exists($logger->{'sendmail'}->{'to'})) {
  831: 				my $sm = $logger->{'sendmail'};
  832: 
  833: 				# Check the level threshold for email (undef means send always)
  834: 				if((!defined($sm->{'level'})) ||
  835: 				   ($syslog_values{$level} <= $syslog_values{ $sm->{'level'} })) {
  836: 
  837: 					# Honour the minimum-interval throttle
  838: 					my $throttled = 0;
  839: 					if(my $interval = $sm->{'min_interval'}) {
  840: 						my $now = time();
  Mutants (Total: 1, Killed: 1, Survived: 0)
  841: 						$throttled = defined($self->{_last_email_sent})
  842: 							&& ($now - $self->{_last_email_sent}) < $interval;
  843: 					}
  844: 
  845: 					if(!$throttled) {
  846: 						# Validate host and port before any eval so bad config croaks immediately
  847: 						my $host = $sm->{'host'} || $DEFAULT_SMTP_HOST;
  848: 						Carp::croak(ref($self), ": Invalid SMTP host: $host")
  849: 							if $host =~ $RE_SAFE_HOST;
  850: 						my $port = $sm->{'port'} || $DEFAULT_SMTP_PORT;
  851: 						Carp::croak(ref($self), ": Invalid SMTP port: $port")
  852: 							unless $port =~ $RE_PORT
  853: 								&& $port >= $MIN_PORT
  854: 								&& $port <= $MAX_PORT;
  855: 
  856: 						# Load mail modules lazily; wrap only I/O in eval to handle delivery failures
  857: 						eval {
  858: 							require Email::Simple;
  859: 							require Email::Sender::Simple;
  860: 							require Email::Sender::Transport::SMTP;
  861: 
  862: 							Email::Simple->import();
  863: 							Email::Sender::Simple->import('sendmail');
  864: 							Email::Sender::Transport::SMTP->import();
  865: 
  866: 							# Build the email object with sanitised headers
  867: 							my $email = Email::Simple->new('');
  868: 							$email->header_set(
  869: 								'to',
  870: 								_sanitize_email_header($sm->{'to'}),
  871: 							);
  872: 							my $from = $sm->{'from'} || $DEFAULT_FROM_ADDR;
  873: 							$email->header_set(
  874: 								'from',
  875: 								_sanitize_email_header($from),
  876: 							);
  877: 							if(my $subject = $sm->{'subject'}) {
  878: 								$email->header_set(
  879: 									'subject',
  880: 									_sanitize_email_header($subject),
  881: 								);
  882: 							}
  883: 							$email->body_set(join(' ', @messages));
  884: 
  885: 							my $transport = Email::Sender::Transport::SMTP->new({
  886: 								host => $host,
  887: 								port => $port,
  888: 							});
  889: 							sendmail($email, { transport => $transport });
  890: 						};
  891: 
  892: 						if($@) {
  893: 							Carp::carp("Failed to send email: $@");
  894: 							return;
  895: 						}
  Mutants (Total: 1, Killed: 1, Survived: 0)
  896: 
  897: 						# Record send time for the throttle on success
  898: 						$self->{_last_email_sent} = time();
  Mutants (Total: 3, Killed: 3, Survived: 0)
  899: 					}
  900: 				}
  901: 			}
  902: 
  903: 			# -- syslog sub-backend -----------------------------------------
  904: 			if(my $syslog = $logger->{'syslog'}) {
  905: 				if((!defined($syslog->{'level'})) ||
  906: 				   ($syslog_values{$level} <= $syslog->{'level'})) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  907: 
  908: 					# Open the persistent syslog connection on first use
  909: 					if(!$self->{_syslog_opened}) {
  910: 						my $facility = delete $syslog->{'facility'} || $DEFAULT_SYSLOG_FACILITY;
  Mutants (Total: 1, Killed: 1, Survived: 0)
  911: 						my $min_level = delete $syslog->{'level'};
  912: 
  913: 						# Accept 'server' as an alias for 'host' (CHI convention)
  914: 						if($syslog->{'server'}) {
  915: 							$syslog->{'host'} = delete $syslog->{'server'};
  916: 						}
  917: 						Sys::Syslog::setlogsock($syslog) if(scalar keys %{$syslog});
  918: 						$syslog->{'facility'} = $facility;
  919: 						$syslog->{'level'}    = $min_level;
  920: 
  921: 						openlog($self->{script_name}, $DEFAULT_SYSLOG_OPTIONS, $DEFAULT_SYSLOG_IDENTITY);
  Mutants (Total: 1, Killed: 1, Survived: 0)
  922: 						$self->{_syslog_opened} = 1;
  Mutants (Total: 4, Killed: 4, Survived: 0)
  923: 					}
  924: 
  925: 					# Map internal level names to syslog priority strings
  926: 					eval {
  927: 						my $priority = $LEVEL_TO_SYSLOG_PRIORITY{$level} // 'warning';
  928: 						my $facility = $syslog->{'facility'};
  929: 						Sys::Syslog::syslog("$priority|$facility", join(' ', @messages));
  930: 					};
  931: 					if($@) {
  932: 						my $err = $@;
  933: 						$err .= ":\n" . Data::Dumper->new([$syslog])->Dump();
  Mutants (Total: 4, Killed: 4, Survived: 0)
  934: 						Carp::carp($err);
  Mutants (Total: 1, Killed: 1, Survived: 0)
  935: 					}
  936: 				}
  937: 			}
  938: 
  939: 			# -- journald sub-backend --------------------------------------
  940: 			if(my $jd = $logger->{'journald'}) {
  941: 				# Map internal level name to journald/syslog PRIORITY integer (0=emerg, 7=debug)
  Mutants (Total: 1, Killed: 1, Survived: 0)
  942: 				my $priority  = $syslog_values{$level};
  943: 				my $sock_path = $jd->{'socket'} || $DEFAULT_JOURNALD_SOCKET;
  944: 
  945: 				# Determine the syslog identifier (script name or basename of $0)
  946: 				my $ident = $jd->{'identifier'} || $self->{'script_name'} || do {
  947: 					require File::Basename;
  948: 					File::Basename::basename($0);
  949: 				};
  950: 
  951: 				# Mandatory journald fields
  952: 				my %fields = (
  953: 					MESSAGE           => $str,
  954: 					PRIORITY          => $priority,
  955: 					SYSLOG_IDENTIFIER => $ident,
  956: 				);
  957: 
  958: 				# Include any extra fields from the journald config hash
  959: 				for my $key (keys %{$jd}) {
  960: 					next if lc($key) =~ /^(?:socket|identifier)$/;
  961: 					$fields{uc($key)} = $jd->{$key};
  962: 				}
  963: 
  964: 				# Delivery failures are silent; the app must not crash on log errors
  965: 				eval { $self->_journald_send($sock_path, %fields) };
  966: 				Carp::carp(ref($self), ": journald send failed: $@") if $@;
  967: 			}
  968: 
  969: 			# -- fd sub-backend ---------------------------------------------
  970: 			if(my $fout = $logger->{'fd'}) {
  971: 				my $use_class = ($class ne '') ? 1 : 0;
  972: 				my $line = $self->_format_message($level, $str, $use_class, $caller_file, $caller_line);
  973: 				print $fout "$line\n";
  974: 
  975: 			} elsif(!$logger->{'file'} && !$logger->{'array'}
  976: 					&& !$logger->{'syslog'} && !exists($logger->{'sendmail'})
  977: 					&& !$logger->{'fd'} && !$logger->{'journald'}) {
  978: 				# Hash logger with no recognised sub-key -- configuration error
  979: 				croak(ref($self), ": Don't know how to deal with the $level message");
  980: 			}
  981: 
  982: 		} elsif(!ref($logger)) {
  983: 			# Scalar-path backend: validate path then append to the file
  984: 			my $safe_path = $self->_validate_file_path($logger);
  985: 			my $use_class = ($class ne '') ? 1 : 0;
  986: 			my $line = $self->_format_message($level, $str, $use_class, $caller_file, $caller_line);
  987: 			# Log failures are silent by design; the app must not crash on I/O errors
  988: 			eval {
  989: 				open(my $fout, '>>', $safe_path);
  990: 				print $fout "$line\n";
  991: 				close $fout;
  992: 			};
  993: 
  994: 		} elsif(Scalar::Util::blessed($logger)) {
  995: 			# Object backend: delegate to the method matching the level name
  996: 			if(!$logger->can($level)) {
  997: 				if(($level eq 'notice') && $logger->can('info')) {
  998: 					# Log::Log4perl has no notice() method; map to info()
  999: 					$level = 'info';
 1000: 				} else {
 1001: 					croak(
 1002: 						ref($self), ': ', ref($logger),
 1003: 						" doesn't know how to deal with the $level message",
 1004: 					);
 1005: 				}
 1006: 			}
 1007: 			$logger->$level(@messages);
 1008: 
 1009: 		} else {
 1010: 			croak(ref($self),
 1011: 				": configuration error, no handler written for the $level message");
 1012: 		}
 1013: 
 1014: 	} elsif($self->{'array'}) {
 1015: 		# Top-level 'array' key (not nested inside logger hash)
 1016: 		push @{$self->{'array'}}, { level => $level, message => $str };
 1017: 	}
 1018: 
 1019: 	# -----------------------------------------------------------------------
 1020: 	# Top-level 'file' and 'fd' keys (parallel to 'logger')
 1021: 	# -----------------------------------------------------------------------
●1022 → 1022 → 1034 1022: 	if($self->{'file'}) {
 1023: 		my $file = $self->_validate_file_path($self->{'file'});
 1024: 		my $use_class = ($class ne '') ? 1 : 0;
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1025: 		my $line = $self->_format_message($level, $str, $use_class, $caller_file, $caller_line);
 1026: 		# Log failures are silent by design; the app must not crash on I/O errors
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1027: 		eval {
 1028: 			open(my $fout, '>>', $file);
 1029: 			print $fout "$line\n";
 1030: 			close $fout;
 1031: 		};

					

					
Mutants (Total: 2, Killed: 0, Survived: 2)
					

				
BOOL_NEGATE_1031_3: Negate boolean return expression
MEDIUM: Add tests asserting both true and false outcomes

								

								
🧪 Suggested Test
								
# Boolean branch test suggestion
ok( !func(INPUT), 'Verify boolean branch behaviour' );

								
							
RETURN_UNDEF_1031_3: Replace return expression with undef
LOW: Mutation survived, but impact may be minor

								

								
🧪 Suggested Test
								
# Return value assertion
is( func(INPUT), EXPECTED, 'Verify correct return value' );

								
							
 1032: 	}
 1033: 
●1034 → 1034 → 0 1034: 	if(my $fout = $self->{'fd'}) {
 1035: 		my $use_class = ($class ne '') ? 1 : 0;
  Mutants (Total: 2, Killed: 2, Survived: 0)
 1036: 		my $line = $self->_format_message($level, $str, $use_class, $caller_file, $caller_line);
 1037: 		print $fout "$line\n";
 1038: 	}
 1039: }
 1040: 
 1041: # ---------------------------------------------------------------------------
 1042: # _high_priority -- common handler for warn() and error() calls
 1043: #
 1044: # Purpose:      Extracts the warning/error text from a variety of argument
 1045: #               forms (plain list, named 'warning' key, or arrayref value),
 1046: #               then dispatches to _log and optionally to Carp.
 1047: # Entry:        $self    -- the logger object.
 1048: #               $level   -- 'warn' or 'error'.
 1049: #               @_       -- remaining arguments in any of the accepted forms.
 1050: # Exit:         Returns nothing (void).
 1051: # Side effects: Calls _log, which appends to $self->{messages} and writes to
 1052: #               configured backends.  May call Carp::carp or Carp::croak.
 1053: # Notes:        The duplicated extraction logic that appeared in earlier
 1054: #               versions has been collapsed into a single if/else block.
 1055: #
 1056: # Pseudocode:
 1057: #   FUNCTION _high_priority(self, level, args...)
 1058: #     RETURN early if no args supplied
 1059: #     RETURN early if level is below WARNING threshold (defensive guard)
 1060: #
 1061: #     Attempt to parse args as named-parameter form via Params::Get (in eval)
 1062: #
 1063: #     IF named 'warning' key found in result:
 1064: #       Extract warning value; RETURN if value is undef
 1065: #       IF value is an arrayref: join defined elements into a string
 1066: #     ELSE (plain list form):
 1067: #       Join defined elements of @_ into a string
 1068: #       RETURN if resulting string is empty
 1069: #
 1070: #     IF called as a class method (self is the package name, not an object):
 1071: #       IF error level: CROAK with warning text; RETURN
 1072: #       CARP with warning text; RETURN
 1073: #
 1074: #     Call self->_log(level, warning)
 1075: #
 1076: #     IF error level:
 1077: #       IF croak_on_error flag set OR no logger/array backend configured:
 1078: #         CROAK with warning text
 1079: #
 1080: #     IF carp_on_warn flag set OR no logger/array backend configured:
  Mutants (Total: 5, Killed: 5, Survived: 0)
 1081: #       CARP with warning text
 1082: #   END FUNCTION
 1083: # ---------------------------------------------------------------------------
 1084: sub _high_priority :Private {
●1085 → 1100 → 1115 1085: 	my $self  = shift;
 1086: 	my $level = shift;    # 'warn' or 'error'
 1087: 
 1088: 	# Nothing to log if no arguments supplied
 1089: 	return if(scalar(@_) == 0);
 1090: 
 1091: 	# Silently drop levels lower than WARNING (should not happen in practice)
 1092: 	return if($syslog_values{$level} > $WARNING);
 1093: 
 1094: 	# Try to interpret arguments as warn(warning => VALUE) named form
 1095: 	my $params;
 1096: 	eval { $params = Params::Get::get_params('warning', @_) };
 1097: 
 1098: 	# Determine the final warning string from whichever form was passed
 1099: 	my $warning;
 1100: 	if($params && ref($params) eq 'HASH' && exists($params->{warning})) {
 1101: 		# Named form: warn({ warning => ... }) or warn(warning => ...)
 1102: 		$warning = $params->{warning};
 1103: 		return unless defined($warning);
 1104: 		if(ref($warning) eq 'ARRAY') {
 1105: 			# Arrayref value: join defined elements
 1106: 			$warning = join('', grep { defined } @{$warning});
 1107: 		}
 1108: 	} else {
 1109: 		# Plain list form: warn('text', 'more text', ...)
 1110: 		$warning = join('', grep { defined } @_);
 1111: 		return unless length($warning);
 1112: 	}
 1113: 
 1114: 	# If called as a class method rather than on an instance, use Carp directly
●1115 → 1115 → 1124 1115: 	if($self eq __PACKAGE__) {
 1116: 		if($syslog_values{$level} <= $ERROR) {
 1117: 			Carp::croak($warning);
 1118: 		}
 1119: 		Carp::carp($warning);
 1120: 		return;
 1121: 	}
 1122: 
 1123: 	# Log the message through the normal dispatch path
●1124 → 1127 → 1135 1124: 	$self->_log($level, $warning);
 1125: 
 1126: 	# Optionally escalate to Carp for error-level messages
 1127: 	if($syslog_values{$level} <= $ERROR) {
 1128: 		if($self->{'croak_on_error'}
 1129: 			|| (!defined($self->{logger}) && !defined($self->{array}))) {
 1130: 			Carp::croak($warning);
 1131: 		}
 1132: 	}
 1133: 
 1134: 	# Optionally also emit a Carp::carp for warn-level messages
●1135 → 1135 → 0 1135: 	if($self->{'carp_on_warn'}
 1136: 		|| (!defined($self->{logger}) && !defined($self->{array}))) {
 1137: 		Carp::carp($warning);
 1138: 	}
 1139: }
 1140: 
 1141: =head2 level
 1142: 
 1143:   my $current = $logger->level();
 1144:   $logger->level('debug');
 1145: 
 1146: Get or set the minimum logging level.  When setting, returns C<$self> to
 1147: allow method chaining.  When getting, returns the current level as an
 1148: integer (per the syslog numeric scale; lower numbers are higher priority).
 1149: 
 1150: =head3 Arguments
 1151: 
 1152: =over 4
 1153: 
 1154: =item * C<$level> (optional)
 1155: 
 1156: A level name string: C<trace>, C<debug>, C<info>, C<notice>, C<warn>/C<warning>,
 1157: or C<error>.  Case-insensitive.  Omit to perform a pure get.
 1158: 
 1159: =back
 1160: 
 1161: =head3 Returns
 1162: 
 1163: In getter mode: an integer in the range 0 (emergency) to 7 (debug/trace).
 1164: 
 1165: In setter mode: C<$self> (to allow chaining).
 1166: 
 1167: =head3 Side Effects
 1168: 
 1169: When setting, updates C<$self-E<gt>{level}>.
 1170: 
 1171: =head3 Example
 1172: 
 1173:   $logger->level('debug');
 1174:   my $n = $logger->level();   # e.g. 7
 1175: 
 1176:   # Method chaining
 1177:   $logger->level('info')->info('Now at info level');
 1178: 

					

					
Mutants (Total: 2, Killed: 0, Survived: 2)
					

				
BOOL_NEGATE_1178_2: Negate boolean return expression
MEDIUM: Add tests asserting both true and false outcomes

								

								
🧪 Suggested Test
								
# Boolean branch test suggestion
ok( !func(INPUT), 'Verify boolean branch behaviour' );

								
							
RETURN_UNDEF_1178_2: Replace return expression with undef
LOW: Mutation survived, but impact may be minor

								

								
🧪 Suggested Test
								
# Return value assertion
is( func(INPUT), EXPECTED, 'Verify correct return value' );

								
							
 1179: =head3 API Specification
 1180: 
 1181: =head4 Input
 1182: 
 1183:   {
 1184:       level => { type => 'string', regex => qr/^(trace|debug|info|notice|warn(?:ing)?|error)$/i, optional => 1 },
 1185:   }
 1186: 
 1187: =head4 Output
 1188: 
 1189:   Getter: { type => 'integer', min => 0, max => 7 }
 1190:   Setter: { type => 'object', class => 'Log::Abstraction' }
 1191: 
 1192: =head3 MESSAGES
 1193: 
 1194:   Warning                                   Meaning / Action
 1195:   ----------------------------------------  ------------------------------------------
 1196:   "<class>: invalid syslog level '<l>'"     The supplied level name is not recognised.
 1197:                                             Use trace/debug/info/notice/warn/error.
 1198: 
 1199: =head3 PSEUDOCODE
 1200: 
 1201:   FUNCTION level(self, level?)
 1202: 
 1203:     IF level argument supplied:
 1204:       CARP and RETURN undef if level is not a recognised syslog name
 1205:       Store syslog_values{level} in self->{'level'}
 1206:       RETURN self  (allows method chaining)
 1207: 
 1208:     ELSE (getter mode):
 1209:       RETURN self->{'level'}  (current numeric threshold)
 1210: 
 1211:   END FUNCTION
 1212: 
 1213: =cut
 1214: 
 1215: sub level {
●1216 → 1218 → 1229 1216: 	my ($self, $level) = @_;
 1217: 
 1218: 	if($level) {
 1219: 		# Setter path: validate, store and return $self for chaining
 1220: 		if(!defined($syslog_values{$level})) {
 1221: 			Carp::carp(ref($self), ": invalid syslog level '$level'");
 1222: 			return;    # undef signals the caller that validation failed
 1223: 		}
 1224: 		$self->{'level'} = $syslog_values{$level};
 1225: 		return $self;

					

					
Mutants (Total: 2, Killed: 0, Survived: 2)
					

				
BOOL_NEGATE_1225_2: Negate boolean return expression
MEDIUM: Add tests asserting both true and false outcomes

								

								
🧪 Suggested Test
								
# Boolean branch test suggestion
ok( !func(INPUT), 'Verify boolean branch behaviour' );

								
							
RETURN_UNDEF_1225_2: Replace return expression with undef
LOW: Mutation survived, but impact may be minor

								

								
🧪 Suggested Test
								
# Return value assertion
is( func(INPUT), EXPECTED, 'Verify correct return value' );

								
							
 1226: 	}
 1227: 
 1228: 	# Getter path: return the numeric threshold
 1229: 	return Return::Set::set_return(
 1230: 		$self->{'level'},
 1231: 		{ 'type' => 'integer', 'min' => 0, 'max' => 7 },
 1232: 	);
 1233: }
 1234: 
 1235: =head2 is_debug
 1236: 
 1237:   if($logger->is_debug()) { ... }
 1238: 
 1239: Returns a true value when the logger is configured at C<debug> level or
 1240: below (i.e. debug messages will actually be emitted).  Provided for
 1241: compatibility with L<Log::Any>.
 1242: 
 1243: =head3 Arguments
 1244: 
 1245: None.
 1246: 
 1247: =head3 Returns
 1248: 
 1249: C<1> if the current level threshold includes debug (or trace) messages;
 1250: C<0> otherwise.
 1251: 
 1252: =head3 Example
 1253: 
 1254:   if($logger->is_debug()) {
 1255:       $logger->debug('Expensive diagnostic: ' . Dumper(\%state));
 1256:   }
 1257: 
 1258: =head3 API Specification
 1259: 
 1260: =head4 Input
 1261: 
 1262:   {} (no arguments)
 1263: 
 1264: =head4 Output
 1265: 
 1266:   { type => 'boolean' }
 1267: 
 1268: =cut
 1269: 
 1270: sub is_debug {
 1271: 	my $self = $_[0];
 1272: 

					

					
Mutants (Total: 2, Killed: 0, Survived: 2)
					

				
BOOL_NEGATE_1272_2: Negate boolean return expression
MEDIUM: Add tests asserting both true and false outcomes

								

								
🧪 Suggested Test
								
# Boolean branch test suggestion
ok( !func(INPUT), 'Verify boolean branch behaviour' );

								
							
RETURN_UNDEF_1272_2: Replace return expression with undef
LOW: Mutation survived, but impact may be minor

								

								
🧪 Suggested Test
								
# Return value assertion
is( func(INPUT), EXPECTED, 'Verify correct return value' );

								
							
 1273: 	# $DEBUG is exported by Readonly::Values::Syslog
 1274: 	return ($self->{'level'} && ($self->{'level'} >= $DEBUG)) ? 1 : 0;
 1275: }
 1276: 
 1277: =head2 messages
 1278: 
 1279:   my $aref = $logger->messages();
 1280: 
 1281: Returns a reference to a shallow copy of all messages emitted through this
 1282: logger since it was created (or since the last clone).
 1283: 
 1284: =head3 Arguments
 1285: 
 1286: None.
 1287: 
 1288: =head3 Returns
 1289: 
 1290: An array reference of hashrefs, each with keys C<level> (string) and
 1291: C<message> (string).
 1292: 
 1293: =head3 Side Effects
 1294: 
 1295: None.  The returned array is a copy; modifying it does not affect the
 1296: internal history.
 1297: 
 1298: =head3 Example
 1299: 
 1300:   $logger->info('hello');
 1301:   my $msgs = $logger->messages();
 1302:   # $msgs->[0] = { level => 'info', message => 'hello' }
 1303: 
 1304: =head3 API Specification
 1305: 
 1306: =head4 Input
 1307: 
 1308:   {} (no arguments)
 1309: 
 1310: =head4 Output
 1311: 
 1312:   { type => 'arrayref', element_type => { level => 'string', message => 'string' } }
 1313: 
 1314: =cut
 1315: 
 1316: sub messages {
 1317: 	my $self = $_[0];
 1318: 
 1319: 	return [ @{$self->{messages}} ];
 1320: }

					

					
Mutants (Total: 2, Killed: 0, Survived: 2)
					

				
BOOL_NEGATE_1320_2: Negate boolean return expression
MEDIUM: Add tests asserting both true and false outcomes

								

								
🧪 Suggested Test
								
# Boolean branch test suggestion
ok( !func(INPUT), 'Verify boolean branch behaviour' );

								
							
RETURN_UNDEF_1320_2: Replace return expression with undef
LOW: Mutation survived, but impact may be minor

								

								
🧪 Suggested Test
								
# Return value assertion
is( func(INPUT), EXPECTED, 'Verify correct return value' );

								
							
 1321: 
 1322: =head2 trace
 1323: 
 1324:   $logger->trace(@messages);
 1325:   $logger->trace(\@messages);
 1326: 
 1327: Logs a message at C<trace> level (the most verbose level, below C<debug>).
 1328: The message is dropped silently when the configured level threshold is above
 1329: C<trace>.
 1330: 
 1331: =head3 Arguments
 1332: 
 1333: =over 4
 1334: 
 1335: =item * C<@messages>
 1336: 
 1337: One or more strings, or a single array reference.  All elements are joined
 1338: without a separator before storage.
 1339: 
 1340: =back
 1341: 
 1342: =head3 Returns
 1343: 
 1344: C<$self>, to allow method chaining.
 1345: 
 1346: =head3 Side Effects
 1347: 
 1348: Appends to the internal message history and dispatches to configured backends.
 1349: 
 1350: =head3 Example
 1351: 
 1352:   $logger->trace('entering sub foo, args=', join(',', @args));
 1353: 
 1354:   # Chaining
 1355:   $logger->trace('start')->debug('details')->info('summary');
 1356: 
 1357: =head3 API Specification
 1358: 
 1359: =head4 Input
 1360: 
 1361:   { messages => { type => [ 'arrayref', 'scalar' ] } }
 1362: 
 1363: =head4 Output
 1364: 
 1365:   { type => 'object', class => 'Log::Abstraction' }
 1366: 
 1367: =cut
 1368: 
 1369: sub trace {
 1370: 	my $self = shift;
 1371: 	$self->_log('trace', @_);
 1372: 	return $self;
 1373: }
 1374: 
 1375: =head2 debug
 1376: 
 1377:   $logger->debug(@messages);
 1378:   $logger->debug(\@messages);
 1379: 
 1380: Logs a message at C<debug> level.
 1381: 
 1382: =head3 Arguments
 1383: 
 1384: =over 4
 1385: 
 1386: =item * C<@messages>
  Mutants (Total: 4, Killed: 4, Survived: 0)
 1387: 
 1388: One or more strings, or a single array reference.
 1389: 

					

					
Mutants (Total: 2, Killed: 0, Survived: 2)
					

				
BOOL_NEGATE_1389_2: Negate boolean return expression
MEDIUM: Add tests asserting both true and false outcomes

								

								
🧪 Suggested Test
								
# Boolean branch test suggestion
ok( !func(INPUT), 'Verify boolean branch behaviour' );

								
							
RETURN_UNDEF_1389_2: Replace return expression with undef
LOW: Mutation survived, but impact may be minor

								

								
🧪 Suggested Test
								
# Return value assertion
is( func(INPUT), EXPECTED, 'Verify correct return value' );

								
							
 1390: =back
 1391: 
 1392: =head3 Returns
 1393: 
 1394: C<$self>, to allow method chaining.
 1395: 
 1396: =head3 Side Effects
 1397: 
 1398: Appends to the internal message history and dispatches to configured backends.
 1399: 
 1400: =head3 Example
 1401: 
 1402:   $logger->debug('Query took ', $elapsed, 'ms');
 1403: 
 1404: =head3 API Specification
 1405: 
 1406: =head4 Input
 1407: 
 1408:   { messages => { type => [ 'arrayref', 'scalar' ] } }
 1409: 
 1410: =head4 Output
 1411: 
 1412:   { type => 'object', class => 'Log::Abstraction' }
 1413: 
 1414: =cut
 1415: 
 1416: sub debug {
 1417: 	my $self = shift;
 1418: 	$self->_log('debug', @_);
 1419: 	return $self;
 1420: }
 1421: 
 1422: =head2 info
 1423: 
 1424:   $logger->info(@messages);
 1425:   $logger->info(\@messages);
 1426: 
 1427: Logs a message at C<info> level.
 1428: 
 1429: =head3 Arguments
 1430: 
 1431: =over 4
 1432: 
 1433: =item * C<@messages>
 1434: 
 1435: One or more strings, or a single array reference.
 1436: 
 1437: =back
 1438: 
 1439: =head3 Returns
 1440: 

					

					
Mutants (Total: 2, Killed: 0, Survived: 2)
					

				
BOOL_NEGATE_1440_2: Negate boolean return expression
MEDIUM: Add tests asserting both true and false outcomes

								

								
🧪 Suggested Test
								
# Boolean branch test suggestion
ok( !func(INPUT), 'Verify boolean branch behaviour' );

								
							
RETURN_UNDEF_1440_2: Replace return expression with undef
LOW: Mutation survived, but impact may be minor

								

								
🧪 Suggested Test
								
# Return value assertion
is( func(INPUT), EXPECTED, 'Verify correct return value' );

								
							
 1441: C<$self>, to allow method chaining.
 1442: 
 1443: =head3 Side Effects
 1444: 
 1445: Appends to the internal message history and dispatches to configured backends.
 1446: 
 1447: =head3 Example
 1448: 
 1449:   $logger->info('Server started on port ', $port);
 1450: 
 1451: =head3 API Specification
 1452: 
 1453: =head4 Input
 1454: 
 1455:   { messages => { type => [ 'arrayref', 'scalar' ] } }
 1456: 
 1457: =head4 Output
 1458: 
 1459:   { type => 'object', class => 'Log::Abstraction' }
 1460: 
 1461: =cut
 1462: 
 1463: sub info {
 1464: 	my $self = shift;
 1465: 	$self->_log('info', @_);
 1466: 	return $self;
 1467: }
 1468: 
 1469: =head2 notice
 1470: 
 1471:   $logger->notice(@messages);
 1472:   $logger->notice(\@messages);
 1473: 
 1474: Logs a message at C<notice> level (higher priority than C<info>, lower than
 1475: C<warn>).
 1476: 
 1477: =head3 Arguments
 1478: 
 1479: =over 4
 1480: 
 1481: =item * C<@messages>
 1482: 
 1483: One or more strings, or a single array reference.
 1484: 
 1485: =back

					

					
Mutants (Total: 2, Killed: 0, Survived: 2)
					

				
BOOL_NEGATE_1485_2: Negate boolean return expression
MEDIUM: Add tests asserting both true and false outcomes

								

								
🧪 Suggested Test
								
# Boolean branch test suggestion
ok( !func(INPUT), 'Verify boolean branch behaviour' );

								
							
RETURN_UNDEF_1485_2: Replace return expression with undef
LOW: Mutation survived, but impact may be minor

								

								
🧪 Suggested Test
								
# Return value assertion
is( func(INPUT), EXPECTED, 'Verify correct return value' );

								
							
 1486: 
 1487: =head3 Returns
 1488: 
 1489: C<$self>, to allow method chaining.
 1490: 
 1491: =head3 Side Effects
 1492: 
 1493: Appends to the internal message history and dispatches to configured backends.
 1494: 
 1495: =head3 Example
 1496: 
 1497:   $logger->notice('Configuration reloaded');
 1498: 
 1499: =head3 API Specification
 1500: 
 1501: =head4 Input
 1502: 
 1503:   { messages => { type => [ 'arrayref', 'scalar' ] } }
  Mutants (Total: 1, Killed: 1, Survived: 0)
 1504: 
 1505: =head4 Output
 1506: 
 1507:   { type => 'object', class => 'Log::Abstraction' }
 1508: 
 1509: =cut
 1510: 
 1511: sub notice {
 1512: 	my $self = shift;
 1513: 	$self->_log('notice', @_);
 1514: 	return $self;
 1515: }
 1516: 
 1517: =head2 warn
 1518: 
 1519:   $logger->warn(@messages);
 1520:   $logger->warn(\@messages);
 1521:   $logger->warn(warning => $text);
 1522:   $logger->warn({ warning => $text });
 1523:   $logger->warn(warning => \@parts);
 1524: 
 1525: Logs a warning message.  Also dispatches to syslog and/or email backends
 1526: when those are configured.  Falls back to C<Carp::carp> when no logger
 1527: backend is set.
 1528: 
 1529: A C<warn()> call with an empty or all-undef argument list is a silent no-op.
 1530: 
 1531: =head3 Arguments
 1532: 
 1533: =over 4
 1534: 
 1535: =item * C<@messages>
 1536: 
 1537: A plain list of strings joined without separator, B<or> a named C<warning>
 1538: parameter whose value may be a string or an array reference of strings.
 1539: 
 1540: =back
 1541: 
 1542: =head3 Returns
 1543: 
 1544: C<$self>, to allow method chaining.
 1545: 
 1546: =head3 Side Effects
 1547: 
 1548: Appends to internal message history.  Writes to all configured backends.
 1549: May call C<Carp::carp> if C<carp_on_warn> is set or no backend is active.
 1550: 
 1551: =head3 Example
 1552: 
 1553:   $logger->warn('Disk usage is high');
 1554:   $logger->warn(warning => 'Connection reset', ' retrying');
 1555:   $logger->warn({ warning => ['Part A', 'Part B'] });
 1556: 
 1557: =head3 API Specification
 1558: 
 1559: =head4 Input
 1560: 
 1561:   # Named form
 1562:   { warning => { type => [ 'scalar', 'arrayref' ] } }
 1563:   # Plain-list form
 1564:   { messages => { type => 'arrayref' } }
 1565: 
 1566: =head4 Output
 1567: 
 1568:   { type => 'object', class => 'Log::Abstraction' }
 1569: 
 1570: =head3 MESSAGES
 1571: 
 1572:   (no croak/carp messages from this method itself; see _high_priority)
 1573: 
 1574: =cut
 1575: 
 1576: sub warn {
●1577 → 1580 → 1583 1577: 	my $self = shift;
 1578: 
 1579: 	# Empty argument list is a documented no-op
 1580: 	if(scalar(@_) > 0) {
 1581: 		$self->_high_priority('warn', @_);
 1582: 	}
 1583: 	return $self;
 1584: }
 1585: 
 1586: =head2 error
 1587: 
 1588:   $logger->error(@messages);
 1589:   $logger->error(warning => $text);
 1590: 
 1591: Logs an error-level message.  Behaves identically to C<warn()> but at the
 1592: C<error> level, which triggers C<Carp::croak> if C<croak_on_error> is set
 1593: or no logger backend is active.
 1594: 
 1595: =head3 Arguments
 1596: 
 1597: Same argument forms as C<warn()>.
 1598: 
 1599: =head3 Returns
 1600: 
 1601: C<$self>, to allow method chaining.  Note: if C<croak_on_error> is set, the
 1602: method never returns -- execution unwinds via C<Carp::croak>.
 1603: 
 1604: =head3 Side Effects
 1605: 
 1606: Same as C<warn()> plus optional C<Carp::croak> escalation.
 1607: 
 1608: =head3 Example
 1609: 
 1610:   $logger->error('Fatal: database unavailable');
 1611: 
 1612: =head3 API Specification
 1613: 
 1614: =head4 Input
 1615: 
 1616:   { warning => { type => [ 'scalar', 'arrayref' ], optional => 1 } }
 1617: 
 1618: =head4 Output
 1619: 
 1620:   { type => 'object', class => 'Log::Abstraction' }
 1621: 
 1622: =head3 MESSAGES
 1623: 
 1624:   Croak                                     Meaning / Action
 1625:   ----------------------------------------  ------------------------------------------
 1626:   (the error message text itself)           croak_on_error is set, or no backend is
 1627:                                             active.  The call stack is unwound.
 1628: 
 1629: =cut
 1630: 
 1631: sub error {
 1632: 	my $self = shift;
 1633: 	$self->_high_priority('error', @_);
 1634: 	return $self;
 1635: }
 1636: 
 1637: =head2 fatal
 1638: 
 1639:   $logger->fatal(@messages);
 1640: 
 1641: Synonym for C<error()>.  Provided for compatibility with logging frameworks
 1642: that use C<fatal> as the highest-severity level name.
 1643: 
 1644: =head3 Arguments
 1645: 
 1646: Same as C<error()>.
 1647: 
 1648: =head3 Returns
 1649: 
 1650: C<$self>.
 1651: 
 1652: =head3 Side Effects
 1653: 
 1654: Same as C<error()>.
 1655: 
 1656: =head3 Example
 1657: 
 1658:   $logger->fatal('Unrecoverable state; aborting');
 1659: 
 1660: =head3 API Specification
 1661: 
 1662: =head4 Input
 1663: 
 1664:   { warning => { type => [ 'scalar', 'arrayref' ], optional => 1 } }
 1665: 
 1666: =head4 Output
 1667: 
 1668:   { type => 'object', class => 'Log::Abstraction' }
 1669: 
 1670: =head3 MESSAGES
 1671: 
 1672: Same as C<error()>.
 1673: 
 1674: =cut
 1675: 
 1676: sub fatal {
 1677: 	my $self = shift;
 1678: 	$self->_high_priority('error', @_);
 1679: 	return $self;
 1680: }
 1681: 
 1682: # ---------------------------------------------------------------------------
 1683: # DESTROY -- close the persistent syslog connection when the object is freed
 1684: #
 1685: # Purpose:      Ensure the syslog socket is closed cleanly on object
 1686: #               destruction, avoiding resource leaks under persistent
 1687: #               interpreters such as mod_perl.
 1688: # Entry:        $self -- the logger object being destroyed.
 1689: # Exit:         void
 1690: # Side effects: Calls Sys::Syslog::closelog() and removes _syslog_opened flag.
 1691: # Notes:        Uses fully-qualified Sys::Syslog::closelog() so that
 1692: #               Test::Mockingbird can intercept the call in tests.
 1693: # ---------------------------------------------------------------------------
 1694: sub DESTROY {
●1695 → 1697 → 0 1695: 	my $self = $_[0];
 1696: 
 1697: 	if($self->{_syslog_opened}) {
 1698: 		Sys::Syslog::closelog();
 1699: 		delete $self->{_syslog_opened};
 1700: 	}
 1701: }
 1702: 
 1703: =encoding utf-8
 1704: 
 1705: =head1 EXAMPLES
 1706: 
 1707: =head2 CSV file logging for BI import
 1708: 
 1709: The code-reference backend gives you full control over the output format.
 1710: The example below writes every message at C<trace> level and above as a
 1711: CSV row to a file, producing output that can be loaded directly into a
 1712: spreadsheet or BI tool (Tableau, Power BI, Metabase, etc.).
 1713: 
 1714: Each row contains: C<timestamp>, C<level>, C<class>, C<file>, C<line>, C<message>.
 1715: 
 1716:   use Log::Abstraction;
 1717: 
 1718:   my $csv_file = 'app_events.csv';
 1719: 
 1720:   # Write the header row once (skip if the file already exists and has data).
 1721:   unless (-s $csv_file) {
 1722:       open my $fh, '>', $csv_file or die "Cannot open $csv_file: $!";
 1723:       print $fh qq{timestamp,level,class,file,line,message\n};
 1724:       close $fh;
 1725:   }
 1726: 
 1727:   # Helper: quote a single CSV field (escapes embedded double-quotes).
 1728:   my $csv_field = sub {
 1729:       my $v = defined $_[0] ? $_[0] : '';
 1730:       $v =~ s/"/""/g;
 1731:       return qq{"$v"};
 1732:   };
 1733: 
 1734:   my $logger = Log::Abstraction->new(
 1735:       level  => 'trace',        # capture everything from trace upwards
 1736:       logger => sub {
 1737:           my $args = $_[0];
 1738: 
 1739:           my $timestamp = POSIX::strftime('%Y-%m-%dT%H:%M:%SZ', gmtime);
 1740:           my $message  = join(' ', @{ $args->{message} // [] });
 1741: 
 1742:           open my $fh, '>>', $csv_file or return;
 1743:           print $fh join(',',
 1744:               $csv_field->($timestamp),
 1745:               $csv_field->($args->{level}),
 1746:               $csv_field->($args->{class}),
 1747:               $csv_field->($args->{file}),
 1748:               $csv_field->($args->{line}),
 1749:               $csv_field->($message),
 1750:           ), "\n";
 1751:           close $fh;
 1752:       },
 1753:   );
 1754: 
 1755:   $logger->trace('application started');
 1756:   $logger->info('user logged in', { user => 'alice' });
 1757:   $logger->warn({ warning => 'disk usage above 80%' });
 1758: 
 1759: The resulting C<app_events.csv> looks like:
 1760: 
 1761:   timestamp,level,class,file,line,message
 1762:   "2026-05-27T14:00:00Z","trace","Log::Abstraction","app.pl","42","application started"
 1763:   "2026-05-27T14:00:01Z","info","Log::Abstraction","app.pl","43","user logged in"
 1764:   "2026-05-27T14:00:02Z","warn","Log::Abstraction","Log/Abstraction.pm","820","disk usage above 80%"
 1765: 
 1766: Note: C<class> is always C<Log::Abstraction> (or the subclass name if you subclass the
 1767: module).  For C<trace>, C<debug>, C<info>, and C<notice> calls, C<file> and C<line>
 1768: resolve to the caller's source location.  For C<warn> and C<error> calls the
 1769: extra C<_high_priority> stack frame shifts the resolution one level inward, so
 1770: C<file> and C<line> point into the module rather than the calling script.
 1771: 
 1772: For production use, consider replacing the manual C<$csv_field> quoting with
 1773: L<Text::CSV> for correct handling of embedded newlines and other edge cases.
 1774: 
 1775: If you also want real-time alerting on critical events, add the email logic
 1776: directly inside the code-ref callback -- test C<$args-E<gt>{level}> and call
 1777: your mailer for C<warn> / C<error> messages while still writing the CSV row
 1778: for every message.
 1779: 
 1780: Alternatively, use the C<sendmail> hash-ref backend on its own (without the
 1781: code-ref) and add a C<level> key to restrict emails to warn-and-above:
 1782: 
 1783:   my $logger = Log::Abstraction->new(
 1784:       level  => 'warn',
 1785:       logger => {
 1786:           sendmail => {
 1787:               host         => 'smtp.example.com',
 1788:               to           => 'ops@example.com',
 1789:               from         => 'logger@example.com',
 1790:               subject      => 'Application alert',
 1791:               level        => 'warn',   # only email at warn level and above
 1792:               min_interval => 300,      # at most one alert email per 5 minutes
 1793:           },
 1794:       },
 1795:   );
 1796: 
 1797: Note: the C<sendmail> backend writes the module's standard text format, not
 1798: CSV.  To produce CSV rows I<and> send email alerts from the same logger,
 1799: embed both the CSV-write and the mail-send logic inside a single code-ref
 1800: callback as described above.
 1801: 
 1802: =head1 LIMITATIONS
 1803: 
 1804: =over 4
 1805: 
 1806: =item B<Syslog hash mutation>
 1807: 
 1808: The C<syslog> sub-hash passed to C<new()> is mutated in-place on the first
 1809: log call: C<facility> and C<level> are temporarily removed before
 1810: C<setlogsock()> is called, then restored; C<server> is permanently renamed
 1811: to C<host>.  Sharing a syslog hashref between two C<Log::Abstraction>
 1812: instances is not supported and produces undefined behaviour on the second
 1813: instance.
 1814: 
 1815: =item B<No structured log fields>
 1816: 
 1817: All backends except the CODE-ref backend reduce the message to a flat string.
 1818: To log structured key/value pairs, use a CODE-ref backend that formats the
 1819: data itself.
 1820: 
 1821: =item B<Single-threaded email throttle>
 1822: 
 1823: The C<min_interval> throttle for the C<sendmail> backend and the
 1824: C<_syslog_opened> first-open flag are stored on the object without mutex
 1825: protection.  Under Perl ithreads or other concurrency models, objects shared
 1826: between threads are not safe.
 1827: 
 1828: =item B<OpenTelemetry not yet supported>
 1829: 
 1830: The OTel Logs SDK for Perl is incomplete; see the TODO block at the top of
 1831: F<lib/Log/Abstraction.pm> for a full status report and the list of blockers.
 1832: Monitor L<https://metacpan.org/pod/OpenTelemetry::SDK> for progress.
 1833: 
 1834: =item B<Log::Log4perl is a de-facto required dependency>
 1835: 
 1836: When no C<logger>, C<file>, or C<array> backend is configured, C<new()>
 1837: loads L<Log::Log4perl> and uses it as the default backend.  Although listed
 1838: as an optional runtime dependency, it is required in that default-backend
 1839: path.
 1840: 
 1841: =back
 1842: 
 1843: =head1 AUTHOR
 1844: 
 1845: Nigel Horne C<njh@nigelhorne.com>
 1846: 
 1847: =head1 SEE ALSO
 1848: 
 1849: =over 4
 1850: 
 1851: =item * L<Log::Any> and L<Log::Any::Adapter::Abstraction>
 1852: 
 1853: Route messages from any C<Log::Any>-using CPAN module through
 1854: C<Log::Abstraction> with a single C<Log::Any::Adapter-E<gt>set()> call.
 1855: 
 1856: =item * L<Test Dashboard|https://nigelhorne.github.io/Log-Abstraction/coverage/>
 1857: 
 1858: =back
 1859: 
 1860: =head1 SUPPORT
 1861: 
 1862: This module is provided as-is without any warranty.
 1863: 
 1864: Please report any bugs or feature requests to C<bug-log-abstraction at rt.cpan.org>,
 1865: or through the web interface at
 1866: L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Log-Abstraction>.
 1867: I will be notified, and then you'll
 1868: automatically be notified of progress on your bug as I make changes.
 1869: 
 1870: You can find documentation for this module with the perldoc command.
 1871: 
 1872:     perldoc Log::Abstraction
 1873: 
 1874: You can also look for information at:
 1875: 
 1876: =over 4
 1877: 
 1878: =item * MetaCPAN
 1879: 
 1880: L<https://metacpan.org/dist/Log-Abstraction>
 1881: 
 1882: =item * RT: CPAN's request tracker
 1883: 
 1884: L<https://rt.cpan.org/NoAuth/Bugs.html?Dist=Log-Abstraction>
 1885: 
 1886: =item * CPAN Testers' Matrix
 1887: 
 1888: L<http://matrix.cpantesters.org/?dist=Log-Abstraction>
 1889: 
 1890: =item * CPAN Testers Dependencies
 1891: 
 1892: L<http://deps.cpantesters.org/?module=Log::Abstraction>
 1893: 
 1894: =back
 1895: 
 1896: =head1 FORMAL SPECIFICATION
 1897: 
 1898: =head2 new
 1899: 
 1900:   ┌─ LogState ──────────────────────────────────────────────────
 1901:   │ level    : ℤ
 1902:   │ messages : seq { level : STRING; message : STRING }
 1903:   │ logger   : LOGGER
 1904:   └─────────────────────────────────────────────────────────────
 1905: 
 1906:   ┌─ New ───────────────────────────────────────────────────────
 1907:   │ args? : Args
 1908:   │ result! : LogState
 1909:   ├─────────────────────────────────────────────────────────────
 1910:   │ result!.level = syslog_values(args?.level ∨ 'warning')
 1911:   │ result!.messages = ⟨⟩
 1912:   │ result!.logger = args?.logger
 1913:   └─────────────────────────────────────────────────────────────
 1914: 
 1915:   Clone operation (called on an existing object):
 1916: 
 1917:   ┌─ Clone ─────────────────────────────────────────────────────
 1918:   │ ΔLogState
 1919:   │ overrides? : Args
 1920:   ├─────────────────────────────────────────────────────────────
 1921:   │ result!.level    = syslog_values(overrides?.level ∨ level)
 1922:   │ result!.messages = messages   {deep copy}
 1923:   │ result!.logger   = overrides?.logger ∨ logger
 1924:   └─────────────────────────────────────────────────────────────
 1925: 
 1926: =head2 level
 1927: 
 1928:   ┌─ LevelGet ─────────────────────────────────────────────────
 1929:   │ ΞLogState
 1930:   │ result! : ℤ
 1931:   ├─────────────────────────────────────────────────────────────
 1932:   │ result! = level
 1933:   │ 0 ≤ result! ∧ result! ≤ 7
 1934:   └─────────────────────────────────────────────────────────────
 1935: 
 1936:   ┌─ LevelSet ─────────────────────────────────────────────────
 1937:   │ ΔLogState
 1938:   │ new_level? : STRING
 1939:   ├─────────────────────────────────────────────────────────────
 1940:   │ new_level? ∈ dom(syslog_values)
 1941:   │ level' = syslog_values(new_level?)
 1942:   └─────────────────────────────────────────────────────────────
 1943: 
 1944: =head2 is_debug
 1945: 
 1946:   ┌─ IsDebug ──────────────────────────────────────────────────
 1947:   │ ΞLogState
 1948:   │ result! : BOOLEAN
 1949:   ├─────────────────────────────────────────────────────────────
 1950:   │ result! = (level ≥ syslog_values('debug'))
 1951:   └─────────────────────────────────────────────────────────────
 1952: 
 1953: =head2 messages
 1954: 
 1955:   ┌─ Messages ─────────────────────────────────────────────────
 1956:   │ ΞLogState
 1957:   │ result! : seq { level : STRING; message : STRING }
 1958:   ├─────────────────────────────────────────────────────────────
 1959:   │ result! = messages
 1960:   └─────────────────────────────────────────────────────────────
 1961: 
 1962: =head2 trace
 1963: 
 1964:   ┌─ Trace ────────────────────────────────────────────────────
 1965:   │ ΔLogState
 1966:   │ msg? : seq STRING
 1967:   ├─────────────────────────────────────────────────────────────
 1968:   │ msg? ≠ ⟨⟩
 1969:   │ syslog_values('trace') ≤ level
 1970:   │ messages' = messages ⌢ ⟨{level ↦ 'trace', message ↦ ⊕(msg?)}⟩
 1971:   └─────────────────────────────────────────────────────────────
 1972: 
 1973: =head2 debug
 1974: 
 1975:   ┌─ Debug ────────────────────────────────────────────────────
 1976:   │ ΔLogState
 1977:   │ msg? : seq STRING
 1978:   ├─────────────────────────────────────────────────────────────
 1979:   │ msg? ≠ ⟨⟩
 1980:   │ syslog_values('debug') ≤ level
 1981:   │ messages' = messages ⌢ ⟨{level ↦ 'debug', message ↦ ⊕(msg?)}⟩
 1982:   └─────────────────────────────────────────────────────────────
 1983: 
 1984: =head2 info
 1985: 
 1986:   ┌─ Info ─────────────────────────────────────────────────────
 1987:   │ ΔLogState
 1988:   │ msg? : seq STRING
 1989:   ├─────────────────────────────────────────────────────────────
 1990:   │ msg? ≠ ⟨⟩
 1991:   │ syslog_values('info') ≤ level
 1992:   │ messages' = messages ⌢ ⟨{level ↦ 'info', message ↦ ⊕(msg?)}⟩
 1993:   └─────────────────────────────────────────────────────────────
 1994: 
 1995: =head2 notice
 1996: 
 1997:   ┌─ Notice ───────────────────────────────────────────────────
 1998:   │ ΔLogState
 1999:   │ msg? : seq STRING
 2000:   ├─────────────────────────────────────────────────────────────
 2001:   │ msg? ≠ ⟨⟩
 2002:   │ syslog_values('notice') ≤ level
 2003:   │ messages' = messages ⌢ ⟨{level ↦ 'notice', message ↦ ⊕(msg?)}⟩
 2004:   └─────────────────────────────────────────────────────────────
 2005: 
 2006: =head2 warn
 2007: 
 2008:   ┌─ Warn ─────────────────────────────────────────────────────
 2009:   │ ΔLogState
 2010:   │ msg? : seq STRING | { warning : STRING | seq STRING }
 2011:   ├─────────────────────────────────────────────────────────────
 2012:   │ msg? ≠ ∅ ∧ join(msg?) ≠ ''
 2013:   │ syslog_values('warn') ≤ level
 2014:   │ messages' = messages ⌢ ⟨{level ↦ 'warn', message ↦ join(msg?)}⟩
 2015:   └─────────────────────────────────────────────────────────────
 2016: 
 2017: =head2 error
 2018: 
 2019:   ┌─ Error ────────────────────────────────────────────────────
 2020:   │ ΔLogState
 2021:   │ msg? : seq STRING | { warning : STRING | seq STRING }
 2022:   ├─────────────────────────────────────────────────────────────
 2023:   │ msg? ≠ ∅ ∧ join(msg?) ≠ ''
 2024:   │ syslog_values('error') ≤ level
 2025:   │ messages' = messages ⌢ ⟨{level ↦ 'error', message ↦ join(msg?)}⟩
 2026:   │ croak_on_error = 1 ⟹ execution_continues = false
 2027:   └─────────────────────────────────────────────────────────────
 2028: 
 2029: =head2 fatal
 2030: 
 2031:   fatal ≡ error   (identical operation schema)
 2032: 
 2033: =head1 COPYRIGHT AND LICENSE
 2034: 
 2035: Copyright (C) 2025-2026 Nigel Horne
 2036: 
 2037: Usage is subject to the GPL2 licence terms.
 2038: If you use it,
 2039: please let me know.
 2040: 
 2041: =cut
 2042: 
 2043: 1;