oqapi/webgui
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

remove webgui specific dbi tracing code, simplify errorhandler

Browse source
This commit is contained in:
Graham Knop 2010-04-13 19:56:25 -05:00
parent 18962e6bc9
commit 907a148313
3 changed files with 22 additions and 75 deletions
Download patch file Download diff file Expand all files Collapse all files

5
lib/WebGUI/SQL.pm
View file

@ -856,10 +856,7 @@ Returns a reference to the current session.
sub session {
my $self = shift;
if (@_) {
my $session = $self->{private_webgui_session} = shift;
require WebGUI::SQL::Trace;
open my $trace_handle, '>:via(WebGUI::SQL::Trace)', $session;
$self->trace('2|SQL', $trace_handle);
$self->{private_webgui_session} = shift;
}
return $self->{private_webgui_session};
}

52
lib/WebGUI/SQL/Trace.pm
View file

@ -1,52 +0,0 @@
package WebGUI::SQL::Trace;
use strict;
#use warnings;
use 5.008008;
our $VERSION = '0.0.1';
sub PUSHED {
my ($class, $mode, $fh) = @_;
my $logger;
return bless \$logger, $class;
}
sub OPEN {
my ($self, $session, $mode, $fh) = @_;
$$self = $session;
return 1;
}
sub WRITE {
my ($self, $buf, $fh) = @_;
if ($buf =~ /\ABinding parameters: /) {
my $sql = $buf;
$sql =~ s/\ABinding parameters: //;
my $depth;
for ( $depth = 1; caller($depth); $depth++) {
my $package = caller($depth);
last
if $package !~ /\A(?:WebGUI::SQL|DBI|DBD)(?:\z|::)/;
}
local $Log::Log4perl::caller_depth = $Log::Log4perl::caller_depth + $depth + 1;
$$self->log->debug("Query - $sql");
}
return length($buf);
}
sub CLOSE {
my $self = shift;
return 0;
}
1;
__END__
=head1 NAME
PerlIO::via::WebGUI - Log DBI output to WebGUI
=cut

40
lib/WebGUI/Session/ErrorHandler.pm
View file

@ -203,8 +203,8 @@ The message to use.
sub fatal {
my $self = shift;
my $message = shift;
@_ = ({ level => 'fatal', message => $message});
goto $self->getLogger;
Sub::Uplevel::uplevel( 1, $self->getLogger, { level => 'fatal', message => $message});
WebGUI::Error::Fatal->throw( error => $message );
}
@ -216,7 +216,25 @@ Returns a reference to the logger.
=cut
sub getLogger { $_[0]->{_logger} }
sub getLogger {
my $self = shift;
if (my $req = $self->session->request) {
my $logger = $req->logger;
return $logger
if $logger;
}
# Thanks to Plack, wG has been decoupled from Log4Perl
# However when called outside a web context, we currently still fall back to Log4perl
# (pending a better idea)
Log::Log4perl->init_once( $self->session->config->getWebguiRoot . "/etc/log.conf" );
my $log4perl = Log::Log4perl->get_logger( $self->session->config->getFilename );
sub {
my $args = shift;
my $level = $args->{level};
$log4perl->$level( $args->{message} );
};
}
#-------------------------------------------------------------------
@ -276,21 +294,6 @@ sub new {
my $session = shift;
my $logger = $session->request && $session->request->logger;
if ( !$logger ) {
# Thanks to Plack, wG has been decoupled from Log4Perl
# However when called outside a web context, we currently still fall back to Log4perl
# (pending a better idea)
require Log::Log4perl;
Log::Log4perl->init_once( WebGUI::Paths->logConfig );
my $log4perl = Log::Log4perl->get_logger( $session->config->getFilename );
$logger = sub {
my $args = shift;
my $level = $args->{level};
$log4perl->$level( $args->{message} );
};
}
bless { _session => $session, _logger => $logger }, $class;
}
@ -364,6 +367,5 @@ sub warn {
goto $self->getLogger;
}
1;