File Coverage

blib/lib/Medusa.pm

Criterion	Covered	Total	%
statement	60	64	93.7
branch	11	14	78.5
condition			n/a
subroutine	13	13	100.0
pod	0	1	0.0
total	84	92	91.3

package Medusa;

use 5.008003;
use strict;
use warnings;

use B;
use Data::Dumper;
our %LOG;

BEGIN {
	%LOG = (
		LOGGER => 'Medusa::Logger',
		LOG_LEVEL => 'debug',
		LOG_FILE  => 'audit.log',
		LOG => sub {
			(my $module = $LOG{LOGGER}) =~ s/::/\//g;
			require $module . '.pm';
			$LOG{LOGGER}->new(
				file => $LOG{LOG_FILE},
			);
		},
		LOG_FUNCTIONS => {
			error => 'error',
			info  => 'info',
			debug => 'debug',
		}
	);
}

sub import {
	my ($pkg, @import) = @_;
	if (scalar @import % 2) {
		die "odd number of params passed in import";
	}
	my $caller = caller();
	{
		no strict 'refs';
		push @{"${caller}::ISA"}, $pkg;
	}
	while (@import) {
		my ($key, $val) = (shift @import, shift @import);
		$LOG{$key} = $val;
	}
}

sub MODIFY_CODE_ATTRIBUTES {
	my ($class,$code,@attrs) = @_;

	if (ref $LOG{LOG} eq 'CODE') {
		$LOG{LOG} = $LOG{LOG}->();
	}

	if (grep { $_ eq 'Audit' } @attrs) {
		my $meta = B::svref_2object($code);
		my $meth = $meta->GV->NAME;
		my $caller = caller(1);
		no strict 'refs';
		no warnings 'redefine';
		*{"${caller}::$meth"} = sub {
			log_message(
				sprintf(
					"subroutine %s called with params:",
					$meth
				),
				@_
			);
			my @out = $code->(@_);
			log_message(
				sprintf(
					"subroutine %s returned:",
					$meth
				),
				@out
			);
			return wantarray ? @out : shift @out;
		};
		return;
	}

}

sub log_message {
	my $log_message = $_[0];
	my $log_meth = $LOG{LOG_FUNCTIONS}{$LOG{LOG_LEVEL}};
	if (@_ > 1) {
		my $len = scalar @_ - 1;
		for my $i (1 .. $len) {
			my $data = Dumper($_[$i]);
			$data =~ s/\$VAR1\s=\s//;
			$data =~ s/(\s+)(['"][^"]+['"])*/defined $2 ? $2 : ""/gem;
			$data =~ s/;$/ -/ unless $i == $len;
			$log_message = sprintf("%s %s", $log_message, $data);
		}
	}
	$LOG{LOG}->$log_meth($log_message);
}

1;

__END__