package CGI::Application::Plugin::DevPopup::Log;
our $VERSION = '1.03';
use strict;
use IO::Scalar;
use base qw/Exporter/;
use vars qw($VERSION @EXPORT);
@EXPORT = qw(devpopup_log_handle);
sub import
{
my $c = scalar caller;
$c->add_callback( 'devpopup_report', \&_header_report );
goto &Exporter::import;
}
sub _header_report
{
my $self = shift;
my $log = _log_report($self);
$self->devpopup->add_report(
title => 'Logs',
summary => '',
report => qq(
)
);
}
sub _log_report
{
my $self = shift;
my $data = $self->{__DEVPOPUP_LOGDATA};
return '' unless (ref $data eq 'SCALAR');
my $r=0;
my $report = join $/, map {
$r=1-$r;
qq{| $_ |
}
}
split /\n/, $$data;
return $report;
}
sub devpopup_log_handle
{
my $this = shift;
unless (ref $this->{__DEVPOPUP_LOGFH})
{
my $data;
$this->{__DEVPOPUP_LOGDATA} = \$data;
my $fh = new IO::Scalar \$data;
$this->{__DEVPOPUP_LOGFH} = $fh;
}
return $this->{__DEVPOPUP_LOGFH};
}
1; # End of CGI::Application::Plugin::DevPopup::Log
__END__
=head1 NAME
CGI::Application::Plugin::DevPopup::Log - show all data written to an IO::Scalar handle.
=head1 VERSION
version 1.03
=head1 SYNOPSIS
use CGI::Application::Plugin::DevPopup;
use CGI::Application::Plugin::DevPopup::Log;
sub cgiapp_init {
# example using LogDispatch
my $log_fh = $this->devpopup_log_handle;
$this->log_config(
APPEND_NEWLINE => 1,
LOG_DISPATCH_MODULES => [
{ module => 'Log::Dispatch::Handle',
name => 'popup',
min_level => $ENV{CAP_DEVPOPUP_LOGDISPATCH_LEVEL} || 'debug',
handle => $log_fh,
},
]
);
$this->log->debug("log something");
}
The rest of your application follows
...
=head1 DESCRIPTION
CGI::Application::Plugin::DevPopup::Log will create a "Log" section in the DevPopup output. All data written to the filehandle returned by C<$this-Edevpopup_log_handle> will be output.
L is very handy for this, but you can write to that filehandle anyway you'd like.
=head1 METHODS
=over
=item devpopup_log_handle
Generates a (fake) filehandle you can pass on to a logging plugin. See the Synopsis for usage.
=back
=head1 SEE ALSO
L
L
L
=head1 AUTHOR
Joshua I Miller, L
=head1 BUGS
Please report any bugs or feature requests to
L, or through the web
interface at
L.
I will be notified, and then you'll automatically be notified of progress on
your bug as I make changes.
=head1 COPYRIGHT & LICENSE
Copyright 2007 Joshua Miller, all rights reserved.
This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
=cut