view release on metacpan or  search on metacpan

lib/Class/Easy/Log.pm  view on Meta::CPAN

#	type => 'log4perl', package => 'Log::Log4perl', constructor => 'get_logger'
# );

sub configure_driver {
	my $class = shift;
	my $params = {@_};
	
	if (Class::Easy::try_to_use ($params->{package})) {
		$driver_config->{$params->{id}} = $params;
	}
}

sub logger { # create logger
	
	my $driver_id;
	my $category;
	my $appender;
	
	my $ref;
	
	if (defined $_[1]) {
		$ref = ref \$_[1];
	}
	
	unless (@_) { # if type omitted, we use current package name as type
		$category = (caller)[0];
	} elsif (scalar (@_) == 2 and $ref eq 'GLOB' and defined *{$_[1]}{IO}) {
		$category = $_[0];
		$appender = $_[1];
	} elsif ((@_ == 2 or @_ == 1) and exists $driver_config->{$_[0]}) {
		$driver_id = $_[0];
		$category = @_ == 1 ? (caller)[0] : $_[1];
	} elsif (@_ == 1) {
		$category = $_[0];
	} else {
		die "you must use logger (), logger (driver), logger (category) or logger (driver => category)";
	}
	
	my $self;
	
	unless (defined $driver_id) { # basic internal driver require no processing
		
		my $existing_logger = $int_loggers->{$category};
		
		$self = $existing_logger || bless {
			category => $category,
			broker   => '',
		}, 'Class::Easy::Log';
		
		unless (defined $existing_logger) {
			$int_loggers->{$category} = $self;
			
			Class::Easy::make_accessor ((caller)[0], 'log_'.$category, default => sub {
				my $caller1  = [caller (1)];
				my $caller0  = [caller];

				unshift @_, $category, $self, $caller1, $caller0;
				goto &_wrapper;
			});

			Class::Easy::make_accessor ((caller)[0], 'timer_'.$category, default => sub {
				Class::Easy::Timer->new (@_, $self)
			});
		}

	} elsif (defined $driver_config->{$driver_id}) { # driver defined
		my $driver = $driver_config->{$driver_id};
		$self = $driver->{package}->can ($driver->{constructor})->($driver->{package}, $category);

		Class::Easy::make_accessor ((caller)[0], 'log_'.$category, default => sub {
			goto &{$self->can ($driver->{log})};
		});
		
		# make_accessor ((caller)[0], 'log_'.$type, default => \&Class::Easy::Log::message);
	}
	
	if ($appender) {
		$self->appender ($appender);
	}
	
	return $self;
}

sub appender {
	my $self     = shift;
	# my $appender = shift;
	
	if (@_) {
		$self->{tied} = 1;
		tie $self->{broker} => 'Class::Easy::Log::Tie', $_[0];
	} else {
		$self->{tied} = 0;
		untie $self->{broker};
	}

}

# example usage: 
# logger (sql); # create sub log_sql
# log_sql ('message'); # log message, but nobody receive this message
# logger (sql => 'STDERR'); # now any log messages go to the STDERR

sub _parse_layout {
	my $logger = shift;
	
	$logger->{layout} ||= $default_layout;
	
	return $logger
		if defined $logger->{_layout} and $logger->{layout} eq $logger->{_layout};
	
	my $layout = $logger->{layout};
	
	my $layout_format = '';
	my @layout_fields = ();
	while ($layout =~ /([^\%]*)\%([^\%cCdFHlLmMnpPrRTxX]*)([\%cCdFHlLmMnpPrRTxX])/g) {
		
		$layout_format .= "$1\%$2";
		if ($3 eq 'L' or $3 eq 'P') {
			$layout_format .= 'd';
		} elsif ($3 eq 'r' or $3 eq 'R') {
			$layout_format .= 'd';
		} elsif ($3 eq '%') {
			$layout_format .= '%';
		} else {
			$layout_format .= 's';
		}
		push @layout_fields, $java_mappings->{$3}
			unless $3 eq '%';
	}
	# TODO: create more failsafe solution
	$layout_format .= substr ($layout, length($layout_format));
	
	$logger->{_layout_format} = $layout_format;
	$logger->{_layout_fields} = \@layout_fields;
	$logger->{_layout} = $layout;
	
	return $logger;
}

sub _format_log {
	my $self = shift;
	
	my $time = time;
	
	my $values = {
		pid      => $$,
		category => $self->{category},
		newline  => "\n",
		ts_start => $time - $^T,
		hostname => $hostname, # doesn't reflect hostname changes in runtime
		date     => $time,
		@_
	};

#	TODO: make sure all these values supported
#	R => 'ts_log',   # use timer_${logger} instead
#	C => 'package',  # useless, because we have %M = method
#	F => 'file',     # who cares about script files?
#	l => 'where',    # wtf?
#	p => 'priority', # log level, if written not for robots
#	T => 'stack',    # everything loves java stacks
#	TODO: add date formatting support
	
#	use Data::Dumper;
#	warn Dumper $self->{_layout_fields};
#	warn Dumper [map {$values->{$_}} @{$self->{_layout_fields}}];
	
#	warn $self->{_layout_format}, join (', ', @{$self->{_layout_fields}}), (join ', ', map {
#		$values->{$_}
#	} @{$self->{_layout_fields}});
	
	return sprintf ($self->{_layout_format}, (map {
		$values->{$_}
	} @{$self->{_layout_fields}}));
	
}

sub _wrapper {
	my $category = shift;
	my $logger   = shift;
	my $caller1  = shift;
	my $caller0  = shift;
	
	my $sub  = $caller1->[3] || 'main';
	my $line = $caller0->[2];
	
	# my ($package, $filename, $line, $subroutine, $hasargs, $wantarray,
	# $evaltext, $is_require, $hints, $bitmask)
	
	$logger->_parse_layout;
		
	$logger->{broker} = $logger->_format_log (
		message => join ('', @_),
		method  => $sub,
		line    => $line
	);
	
	return 1;
}

sub debug {
	my $caller1  = [caller (1)];
	my $caller0  = [caller];

	unshift @_, 'default', $int_loggers->{default}, $caller1, $caller0;

	goto &_wrapper;
}

sub debug_depth {
	my $caller1  = [caller (2)];
	my $caller0  = [caller (1)];

	unshift @_, 'default', $int_loggers->{default}, $caller1, $caller0;

	goto &_wrapper;