File Coverage

blib/lib/Memcached/Client/Log.pm

Criterion	Covered	Total	%
statement	24	45	53.3
branch	2	18	11.1
condition	1	6	16.6
subroutine	8	9	88.8
pod			n/a
total	35	78	44.8

package Memcached::Client::Log;
BEGIN {
  $Memcached::Client::Log::VERSION = '2.01';
}
# ABSTRACT: Logging support for Memcached::Client

use strict;
use warnings;
use Data::Dumper qw{Dumper};
use IO::File qw{};
use Scalar::Util qw{blessed};
use base qw{Exporter};

our @EXPORT = qw{DEBUG LOG};


# Hook into $SIG{__WARN__} if you want to route these debug messages
# into your own logging system.
BEGIN {
    my $log;

    if (exists $ENV{MCTEST} and $ENV{MCTEST}) {
        $ENV{MCDEBUG} = 1;
        open $log, ">>", ",,debug.log" or die "Couldn't open ,,debug.log";
        $log->autoflush (1);
    }

    if ($ENV{MCDEBUG}) {
        *DEBUG = sub () {1};
    } else {
        *DEBUG = sub () {0};
    }

    *LOG = sub (@) {
        local $Data::Dumper::Indent = 1;
        local $Data::Dumper::Quotekeys = 0;
        local $Data::Dumper::Sortkeys = 1;
        local $Data::Dumper::Terse = 1;
        my $format = shift or return;
        chomp (my $entry = @_ ? sprintf $format, map {
            if (defined $_) {
                if (ref $_) {
                    if (blessed $_ and $_->can ('as_string')) {
                        $_->as_string;
                    } else {
                        Dumper $_;
                    }
                } else {
                    $_
                }
            } else {
                '[undef]'
            }
        } @_ : $format);
        # my $output = "$callerinfo[3] $entry\n";
        my $output = "$entry\n";
        if ($ENV{MCTEST}) {
            $log->print ($output);
        } else {
            warn $output;
        }
    };
}

1;

__END__