From d008b335a870caae567ecd1c9fcc278ce56441f2 Mon Sep 17 00:00:00 2001 From: Frank Brehm Date: Fri, 9 Apr 2010 08:29:39 +0000 Subject: [PATCH] =?utf8?q?=C3=84nderung=20am=20Logverhalten?= MIME-Version: 1.0 Content-Type: text/plain; charset=utf8 Content-Transfer-Encoding: 8bit git-svn-id: http://svn.brehm-online.com/svn/my-stuff/Perl@53 ec8d2aa5-1599-4edb-8739-2b3a1bc399aa --- lib/FrBr/Common/MooseX/App.pm | 168 +++++++++++++++++++++++- lib/FrBr/Common/MooseX/Log.pm | 236 ---------------------------------- 2 files changed, 163 insertions(+), 241 deletions(-) delete mode 100644 lib/FrBr/Common/MooseX/Log.pm diff --git a/lib/FrBr/Common/MooseX/App.pm b/lib/FrBr/Common/MooseX/App.pm index be5bc5a..2a6c854 100644 --- a/lib/FrBr/Common/MooseX/App.pm +++ b/lib/FrBr/Common/MooseX/App.pm @@ -20,10 +20,13 @@ use Moose::Role; use MooseX::Getopt::Meta::Attribute; use MooseX::Getopt::Meta::Attribute::NoGetopt; use MooseX::Types::Path::Class; +use Moose::Util::TypeConstraints; +use Log::Log4perl; use Path::Class; use File::Basename; use FindBin; use Encode qw( decode_utf8 encode_utf8 ); +use Data::Dump; use utf8; @@ -134,9 +137,49 @@ sub _build_exit_code { return 0; } +#----------------------------------------- + +=head2 watch_delay_log_conf + +Alle wieviel Sekunden soll nach Änderung der Konfigurationsdatei für Log4perl gesehen werden + +=cut + +has 'watch_delay_log_conf' => ( + is => 'rw', + isa => 'UnsignedInt', + traits => [ 'Getopt' ], + lazy => 1, + builder => '_build_watch_delay_log_conf', + documentation => 'INT: Alle wieviel Sekunden soll nach Änderung der Konfigurationsdatei für Log4perl gesehen werden', + cmd_flag => 'watch-delay-log-conf', + cmd_aliases => 'watch-delay', +); + +#------ + +sub _build_watch_delay_log_conf { + return 60; +} + +#----------------------------------------- + +has 'logger' => ( + is => 'rw', + isa => 'Log::Log4perl::Logger', + traits => [ 'NoGetopt' ], + lazy => 1, + default => sub { my $self = shift; return Log::Log4perl->get_logger(ref($self)) } +); + +sub log { + return Log::Log4perl->get_logger($_[1]) if ($_[1] && !ref($_[1])); + return $_[0]->logger; +} + #--------------------------------------------------------------------------- -with 'FrBr::Common::MooseX::Log'; +# Ändern der Eigenschaften einiger geerbter Attribute #--------------------------------------------------------------------------- @@ -155,16 +198,131 @@ around BUILDARGS => sub { #warn "Bin in '" . __PACKAGE__ . "'\n"; - # verbose auf verbose_bool setzen -# $Args{'verbose'} = 1 if $Args{'verbose_bool'} and not exists $Args{'verbose'}; -# delete $Args{'verbose_bool'} if exists $Args{'verbose_bool'}; - return $class->$orig(%Args); }; #--------------------------------------------------------------------------- +before BUILD => sub { + + my $self = shift; + $self->_init_log(); + +}; + +#--------------------------------- + +sub _init_log { + + my $self = shift; + + # Initialisierung Log::Log4Perl ... + my $log4perl_cfg; + if ( $self->does( 'FrBr::Common::MooseX::Config' ) ) { + $log4perl_cfg = file( $self->cfg_dir, 'log4perl_local.conf' ); + } + else { + $log4perl_cfg = file( $self->basedir, 'log4perl_local.conf' ); + } + warn sprintf( "Suche nach Log-Config-Datei %s ...\n", $log4perl_cfg ) if $self->verbose >= 2; + unless ( -f $log4perl_cfg->stringify ) { + if ( $self->does( 'FrBr::Common::MooseX::Config' ) ) { + $log4perl_cfg = file( $self->cfg_dir, 'log4perl.conf' ); + } + else { + $log4perl_cfg = file( $self->basedir, 'log4perl.conf' ); + } + warn sprintf( "Suche nach Log-Config-Datei %s ...\n", $log4perl_cfg ) if $self->verbose >= 2; + undef $log4perl_cfg unless -f $log4perl_cfg->stringify; + } + if ( $log4perl_cfg ) { + my $delay = $self->watch_delay_log_conf; + if ($delay) { + Log::Log4perl::init_and_watch( $log4perl_cfg->stringify, $delay ); + } else { + Log::Log4perl::init( $log4perl_cfg->stringify ); + } + $self->debug( "Verwende $log4perl_cfg als Konfigurationsdatei für Log::Log4Perl." ); + } + else { + my $app = $self->progname; + my $conf_hash = { + 'log4perl.rootLogger' => ( $self->verbose ? 'DEBUG' : 'INFO' ) . ', ScreenApp', + # Normaler Screen-Appender auf StdErr + 'log4perl.appender.ScreenApp' => 'Log::Log4perl::Appender::Screen', + 'log4perl.appender.ScreenApp.stderr' => 1, + #'log4perl.appender.ScreenApp.utf8' => 1, + 'log4perl.appender.ScreenApp.layout' => 'PatternLayout', + 'log4perl.appender.ScreenApp.layout.ConversionPattern' => '[%d] [' . $app . '] [%p] %m%n', + }; + Log::Log4perl->init($conf_hash); + $self->debug( "Standardkonfiguration für Log::Log4Perl initialisiert." ); + } + + $SIG{__WARN__} = sub { $self->_log( __PACKAGE__, 'warn', 2, \@_ ); }; + +} + +#--------------------------------- + +{ + + my @levels = ( 'debug', 'info', 'warn', 'error', 'fatal' ); + + for my $level ( @levels ) { + + no strict 'refs'; + + *{$level} = sub { + + my ( $self, @message ) = @_; + my ( $package, $filename, $line ) = caller; + + return if $level eq 'debug' and $self->verbose < 1; + + my $msg = []; + for my $m ( @message ) { + next unless defined $m; + if ( ref($m) ) { + $m = Data::Dump::dump($m); + } + push @$msg, $m; + } + + my $depth = $Log::Log4perl::caller_depth; + $depth = 1 unless $depth > 0; + $depth++; + $self->_log( $package, $level, $depth, $msg ); + + }; + + } + +} + +#--------------------------------- + +sub _log { + + my $self = shift; + + local $SIG{CHLD} = 'DEFAULT'; + + my ( $package, $type, $depth, $message ) = @_; + + my @Msg = (); + for my $m ( @$message ) { + push @Msg, encode_utf8($m); + } + + local $Log::Log4perl::caller_depth = $depth; + $self->log($package)->$type( @Msg ); + +} + +#--------------------------------------------------------------------------- + no Moose::Role; 1; diff --git a/lib/FrBr/Common/MooseX/Log.pm b/lib/FrBr/Common/MooseX/Log.pm deleted file mode 100644 index 3bf0d33..0000000 --- a/lib/FrBr/Common/MooseX/Log.pm +++ /dev/null @@ -1,236 +0,0 @@ -package FrBr::Common::MooseX::Log; - -# $Id$ -# $URL$ - -=head1 NAME - -FrBr::Common::MooseX::Log; - -=head1 DESCRIPTION - -Rollen-Modul zum Einbinden von Loggingmöglichkeiten per Log::Log4perl - -=cut - -#--------------------------------------------------------------------------- - -use Moose::Role; - -use MooseX::Getopt::Meta::Attribute; -use MooseX::Getopt::Meta::Attribute::NoGetopt; -use Log::Log4perl; -use MooseX::Types::Path::Class; -use Path::Class; -use File::Basename; -use FindBin; -use Encode qw( decode_utf8 encode_utf8 ); -use Data::Dump; - -use utf8; - -use Carp (); - -with 'MooseX::Log::Log4perl'; -with 'FrBr::Common::MooseX::Types'; - -#--------------------------------------------------------------------------- - -# Versionitis - -my $Revis = <<'ENDE'; - $Revision$ -ENDE -$Revis =~ s/^.*:\s*(\S+)\s*\$.*/$1/s; - -use version; our $VERSION = qv("0.1"); $VERSION .= " r" . $Revis; - -############################################################################ - -=head1 ATTRIBUTES - -Alle durch diese Rolle definierten Attribute - -=cut - -#----------------------------------------- - -=head2 watch_delay_log_conf - -Alle wieviel Sekunden soll nach Änderung der Konfigurationsdatei für Log4perl gesehen werden - -=cut - -has 'watch_delay_log_conf' => ( - is => 'rw', - isa => 'UnsignedInt', - traits => [ 'Getopt' ], - lazy => 1, - builder => '_build_watch_delay_log_conf', - documentation => 'INT: Alle wieviel Sekunden soll nach Änderung der Konfigurationsdatei für Log4perl gesehen werden', - cmd_flag => 'watch-delay-log-conf', - cmd_aliases => 'watch-delay', -); - -#------ - -sub _build_watch_delay_log_conf { - return 60; -} - -#has '+logger' => ( -# traits => [ 'NoGetopt' ], -#); - -#--------------------------------------------------------------------------- - -=head1 METHODS - -Methoden dieser Rolle sowie Methodenmodifizierer - -=cut - -#around BUILDARGS => sub { -# -# my $orig = shift; -# my $class = shift; -# -# my %Args = @_; -# -# #warn "Bin in '" . __PACKAGE__ . "'\n"; -# -# # verbose auf verbose_bool setzen -# $Args{'verbose'} = 1 if $Args{'verbose_bool'} and not exists $Args{'verbose'}; -# delete $Args{'verbose_bool'} if exists $Args{'verbose_bool'}; -# -# return $class->$orig(%Args); -# -#}; - -#--------------------------------------------------------------------------- - -before BUILD => sub { - - my $self = shift; - $self->_init_log(); - -}; - -#--------------------------------- - -sub _init_log { - - my $self = shift; - - # Initialisierung Log::Log4Perl ... - my $log4perl_cfg; - if ( $self->does( 'FrBr::Common::MooseX::Config' ) ) { - $log4perl_cfg = file( $self->cfg_dir, 'log4perl_local.conf' ); - } - else { - $log4perl_cfg = file( $self->basedir, 'log4perl_local.conf' ); - } - warn sprintf( "Suche nach Log-Config-Datei %s ...\n", $log4perl_cfg ) if $self->verbose >= 2; - unless ( -f $log4perl_cfg->stringify ) { - if ( $self->does( 'FrBr::Common::MooseX::Config' ) ) { - $log4perl_cfg = file( $self->cfg_dir, 'log4perl.conf' ); - } - else { - $log4perl_cfg = file( $self->basedir, 'log4perl.conf' ); - } - warn sprintf( "Suche nach Log-Config-Datei %s ...\n", $log4perl_cfg ) if $self->verbose >= 2; - undef $log4perl_cfg unless -f $log4perl_cfg->stringify; - } - if ( $log4perl_cfg ) { - my $delay = $self->watch_delay_log_conf; - if ($delay) { - Log::Log4perl::init_and_watch( $log4perl_cfg->stringify, $delay ); - } else { - Log::Log4perl::init( $log4perl_cfg->stringify ); - } - $self->debug( "Verwende $log4perl_cfg als Konfigurationsdatei für Log::Log4Perl." ); - } - else { - my $app = $self->progname; - my $conf_hash = { - 'log4perl.rootLogger' => ( $self->verbose ? 'DEBUG' : 'INFO' ) . ', ScreenApp', - # Normaler Screen-Appender auf StdErr - 'log4perl.appender.ScreenApp' => 'Log::Log4perl::Appender::Screen', - 'log4perl.appender.ScreenApp.stderr' => 1, - #'log4perl.appender.ScreenApp.utf8' => 1, - 'log4perl.appender.ScreenApp.layout' => 'PatternLayout', - 'log4perl.appender.ScreenApp.layout.ConversionPattern' => '[%d] [' . $app . '] [%p] %m%n', - }; - Log::Log4perl->init($conf_hash); - $self->debug( "Standardkonfiguration für Log::Log4Perl initialisiert." ); - } - - $SIG{__WARN__} = sub { $self->_log( __PACKAGE__, 'warn', 2, \@_ ); }; - -} - -#--------------------------------- - -{ - - my @levels = ( 'debug', 'info', 'warn', 'error', 'fatal' ); - - for my $level ( @levels ) { - - no strict 'refs'; - - *{$level} = sub { - - my ( $self, @message ) = @_; - my ( $package, $filename, $line ) = caller; - - return if $level eq 'debug' and $self->verbose < 1; - - my $msg = []; - for my $m ( @message ) { - next unless defined $m; - if ( ref($m) ) { - $m = Data::Dump::dump($m); - } - push @$msg, $m; - } - - my $depth = $Log::Log4perl::caller_depth; - $depth = 1 unless $depth > 0; - $depth++; - $self->_log( $package, $level, $depth, $msg ); - - }; - - } - -} - -#--------------------------------- - -sub _log { - - my $self = shift; - - local $SIG{CHLD} = 'DEFAULT'; - - my ( $package, $type, $depth, $message ) = @_; - - my @Msg = (); - for my $m ( @$message ) { - push @Msg, encode_utf8($m); - } - - local $Log::Log4perl::caller_depth = $depth; - $self->log($package)->$type( @Msg ); - -} - -#--------------------------------------------------------------------------- - -no Moose::Role; -1; - -__END__ - -# vim: noai: filetype=perl ts=4 sw=4 : expandtab -- 2.39.5