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