1package Vimana::Logger; 2use strict; 3use warnings; 4 5*get_logger = sub { 'Vimana::Logger::Compat' }; 6 7sub import { 8 my $class = shift; 9 my $var = shift || 'logger'; 10 11 # it's ok if people add a sigil; we can get rid of that. 12 $var =~ s/^\$*//; 13 14 # Find out which package we'll export into. 15 my $caller = caller() . ''; 16 17 (my $name = $caller) =~ s/::/./g; 18 my $logger = get_logger(lc($name)); 19 { 20 # As long as we don't use a package variable, each module we export 21 # into will get their own object. Also, this allows us to decide on 22 # the exported variable name. Hope it isn't too bad form... 23 no strict 'refs'; 24 *{ $caller . "::$var" } = \$logger; 25 } 26} 27 28 29package Vimana::Logger::Compat; 30require Carp; 31 32my $current_level; 33my $level; 34 35BEGIN { 36 my $i; 37 $level = { map { $_ => ++$i } reverse qw( debug info warn error fatal ) }; 38 $current_level = $level->{lc($ENV{VIMANA_LOGLEVEL} || "info")} || $level->{info}; 39 40 my $ignore = sub { return }; 41 my $warn = sub { 42 shift; 43 my $s = join "", @_; 44 chomp $s; 45 print "$s\n"; 46 }; 47 my $die = sub { shift; die $_[0]."\n"; }; 48 my $carp = sub { shift; goto \&Carp::carp }; 49 my $confess = sub { shift; goto \&Carp::confess }; 50 my $croak = sub { shift; goto \&Carp::croak }; 51 52 *debug = $current_level >= $level->{debug} ? $warn : $ignore; 53 *info = $current_level >= $level->{info} ? $warn : $ignore; 54 *warn = $current_level >= $level->{warn} ? $warn : $ignore; 55 *error = $current_level >= $level->{warn} ? $warn : $ignore; 56 *fatal = $die; 57 *logconfess = $confess; 58 *logdie = $die; 59 *logcarp = $carp; 60 *logcroak = $croak; 61} 62 631; 64__END__ 65 66=encoding utf8 67 68=head1 NAME 69 70Vimana::Logger - logging framework for Vimana 71 72=head1 SYNOPSIS 73 74 use Vimana::Logger; 75 76 $logger->warn('foo'); 77 $logger->info('bar'); 78 79or 80 81 use Vimana::Logger '$foo'; 82 83 $foo->error('bad thingimajig'); 84 85=head2 DESCRIPTION 86 87Vimana::Logger is a wrapper around Log::Log4perl. When using the module, it 88imports into your namespace a variable called $logger (or you can pass a 89variable name to import to decide what the variable should be) with a 90category based on the name of the calling module. 91 92this class is from L<SVK::Logger>; 93 94=cut 95