view release on metacpan or  search on metacpan

t/edge_cases.t  view on Meta::CPAN

# 12. _sanitize_email_header — boundary and injection
# ============================================================

subtest '_sanitize_email_header — empty string returns empty string' => sub {
	plan tests => 1;

	my $result = Log::Abstraction::_sanitize_email_header('');
	is($result, '', 'empty string sanitized to empty string');
};

subtest '_sanitize_email_header — string of only CR/LF returns empty string' => sub {
	plan tests => 1;

	my $result = Log::Abstraction::_sanitize_email_header("\r\n\r\n\n\r");
	is($result, '', 'all-CR/LF string sanitized to empty string');
};

subtest '_sanitize_email_header — header injection attempt neutralised' => sub {
	plan tests => 2;

	my $injected = "victim\@example.com\r\nBcc: attacker\@evil.com";
	my $result   = Log::Abstraction::_sanitize_email_header($injected);
	unlike($result, qr/\r|\n/, 'no CR or LF in sanitized result');
	like($result,   qr/Bcc/,   'Bcc text survives but CR/LF stripped (injection neutralised)');
};

subtest '_sanitize_email_header — very long string handled without crash' => sub {
	plan tests => 1;

	my $long   = 'a' x 1_000_000;
	my $result = Log::Abstraction::_sanitize_email_header($long);
	is(length($result), 1_000_000, '1MB string sanitized without crash');
};

subtest '_sanitize_email_header — unicode content preserved' => sub {
	plan tests => 1;

	my $result = Log::Abstraction::_sanitize_email_header('用户@example.com');
	is($result, '用户@example.com', 'unicode email address preserved');
};

# ============================================================
# 13. Concurrent-ish: rapid level change during logging
# ============================================================

subtest 'rapid level changes during logging — consistent state' => sub {
	plan tests => 2;

	my ($logger, $log) = array_logger('debug');
	my $logged = 0;

	for my $i (1 .. 200) {
		if($i % 2 == 0) {
			$logger->level('error');
		} else {
			$logger->level('debug');
		}
		$logger->debug("msg $i");
	}

	# Only odd iterations have level=debug when debug() is called
	my $m = $logger->messages();
	ok(scalar(@{$m}) > 0,   'some messages logged during level oscillation');
	ok(scalar(@{$m}) < 200, 'some messages filtered during level oscillation');
};

# ============================================================
# 14. DESTROY — edge cases
# ============================================================

subtest 'DESTROY — safe to call on object that never logged' => sub {
	plan tests => 1;

	my $closed = 0;
	my $g = mock_scoped 'Sys::Syslog::closelog' => sub { $closed++ };

	{ my ($logger) = array_logger() }	# DESTROY fires, _syslog_opened not set

	is($closed, 0, 'DESTROY on non-syslog logger does not call closelog');
};

subtest 'DESTROY — closelog not called twice on double-DESTROY' => sub {
	plan tests => 1;

	my $closed = 0;
	my $g_close = mock_scoped 'Sys::Syslog::closelog' => sub { $closed++ };
	my $g_open  = mock_scoped 'Log::Abstraction::openlog' => sub { };
	my $g_log   = mock_scoped 'Sys::Syslog::syslog'   => sub { };
	my $g_sock  = mock_scoped 'Log::Abstraction::setlogsock' => sub { };

	my $logger = Log::Abstraction->new(
		logger => { syslog => { facility => 'local0' } },
		level  => 'debug',
		script_name => 'edge_test',
	);
	$logger->warn('open syslog');
	$logger->DESTROY();		# explicit call
	$logger->DESTROY();		# second call — _syslog_opened now deleted

	is($closed, 1, 'closelog called exactly once even with double DESTROY');
};

# ============================================================
# 15. Miscellaneous boundary conditions
# ============================================================

subtest 'is_debug() — true only at debug/trace, false at all others' => sub {
	plan tests => 7;

	my ($logger) = array_logger();
	my %expect = (
		debug   => 1,
		trace   => 1,
		info    => 0,
		notice  => 0,
		warn    => 0,
		warning => 0,
		error   => 0,
	);
	for my $lvl (sort keys %expect) {
		$logger->level($lvl);