Archive::Lha::Debug - Archive::Lha::Debug documentation

Archive-Lha documentation Contained in the Archive-Lha distribution.

Index

Code Index:

NAME

Top

Archive::Lha::Debug

SYNOPSIS

Top

  DEBUG( warn => "You don't need to use this" );

DESCRIPTION

Top

This is a simple wrapper of Log::Dispatch for debugging. See Log::Dispatch for details.

AUTHOR

Top

Kenichi Ishigaki, <ishigaki@cpan.org>

COPYRIGHT AND LICENSE

Top

Copyright (C) 2007 by Kenichi Ishigaki.

This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.

Archive-Lha documentation Contained in the Archive-Lha distribution. 
package Archive::Lha::Debug;

use strict;
use warnings;
use Log::Dispatch;
use Log::Dispatch::File;
use Log::Dispatch::Screen;
use Data::Dump;

my $logger = Log::Dispatch->new;
   $logger->add( Log::Dispatch::File->new(
     name      => 'file',
     min_level => 'debug',
     filename  => 'debug.log'
   ));
   $logger->add( Log::Dispatch::Screen->new(
     name      => 'screen',
     min_level => 'info',
   ));

sub import {
  my $class = shift;
  my $caller = caller;

  {
    no strict 'refs';
    *{"$caller\::DEBUG"} = sub {
      my ($level, @messages) = @_;
      my $message = join ' ', map {
        unless ( ref $_ ) { $_ }
        elsif  ( ref $_ eq 'Archive::Lha::Table' ) { $_->stringify }
        else   { Data::Dump::dump($_) }
      } @messages;
      $message .= "\n";
      $logger->log( level => $level, message => $message );
    };
  }
}

1;

__END__