package NetHirc::Debug;
use strict;
use warnings;
use POE qw(Kernel Session Wheel::ReadWrite);
my @events = qw(
_start
_stop
debug
);
sub new
{
shift;
POE::Session->create(
'package_states' => [ 'NetHirc::Debug' => [ @events ] ],
'args' => [ @_ ],
);
}
sub _start
{
my ($kernel, $heap, $flags) = @_[KERNEL, HEAP, ARG0];
$kernel->alias_set('nethirc_debug');
my $wheel = new POE::Wheel::ReadWrite(
Handle => \*STDERR,
);
$heap->{'wheel'} = $wheel;
$heap->{'flags'} = $flags;
}
sub _stop
{
my ($heap) = $_[HEAP];
delete $heap->{'wheel'};
}
sub debug
{
no warnings; # Sometimes @args will be empty, we know.
my ($heap, $flag, $format, @args) = @_[HEAP, ARG0, ARG1, ARG2..ARG9];
my $flags = $heap->{'flags'};
return unless $flags =~ /$flag/;
my $wheel = $heap->{'wheel'};
$wheel->put(sprintf("DEBUG($flag,$$): $format", @args));
}
1;
__END__
syntax highlighted by Code2HTML, v. 0.9.1