I'm in the process of authoring a module that manages Log::Log4perl in a manner that's consistent so I can use it across a few different programs. I have the basics down, but I'm at a loss as to how to take it to the next level.
Basically, I currently have (effectively, but in reality I haven't figured out how to have private functions yet) two user facing functions: new and add. New takes some parameters, including a YAML::AppConfig object and returns a L4p object. Add is similar, in that it takes most of the same params (including the YAML object) and also requires a valid L4p object. It returns a L4p object that has been modified as requested in the add.
There are two things that I'd like to do:
I started with José's Guide for creating Perl modules as a base, using his recommendations, but the actual business of object construction is eluding me. Any pointers would be appreciated.
Edit:
Original code under the spoiler.
I have taken the advise offered and applied it, and am 90% of the way to where I need to be. The other 10% continues to elude me:
package C247::Logger; use strict; use warnings; use Log::Dispatch::FileRotate; use Log::Dispatch::DBI; use Log::Dispatch::Screen; use Log::Log4perl; use Log::Log4perl::Level; use DBI; use Carp; BEGIN { # No exports. # use Exporter (); use vars qw($VERSION);# @ISA); # @EXPORT @EXPORT_OK %EXPORT_ +TAGS); $VERSION = '0.02'; #@ISA = qw(Exporter); ##Give a hoot don't pollute, do not export more than needed by + default #@EXPORT = qw(); #@EXPORT_OK = qw(); #%EXPORT_TAGS = (); } sub new { my $class = shift; my $self = bless {}, $class; $self->{__yaml} = __verify_yaml($_[0]{'conf'}) or carp("conf not a valid YAML::AppConfig object") ; my $name; my $file; my $type; my $level; if ($_[0]{'name'}) { $name = $_[0]{'name'}; } if ($_[0]{'file'}) { $file = $_[0]{'file'}; } if ($_[0]{'type'}) { $type = $_[0]{'type'}; } else { $type = 'file'; } if ($_[0]{'level'}) { $level = $_[0]{'level'}; } my $logger = Log::Log4perl->get_logger(""); $logger->level($DEBUG); $self->{__logger} = $logger; $self->add({ 'name' => $name, 'type' => $type, 'file' => $file, 'level' => $level, }); return $self; } sub add { my $self = shift; if (ref($_[0]) ne "HASH") { carp( "Expected hash, got " . ref($_[0]) . ". Can't return a Log4perl object." ); } else { my $type = $_[0]{'type'}; my $logger = $self->{__logger}; my %options = __parse_options({ 'conf' => $self->{__yaml}, 'type' => $type }); my $l4playout = Log::Log4perl::Layout::PatternLayout->new( $options{'log_layout'} ); my $log_appender; my $valid_logger; # allow level override via command line options. if ($_[0]{'level'}) { $options{'log_level'} = uc($_[0]{'level'}); } # quick/sleazy check of the logging object. if (ref($logger) eq "Log::Log4perl::Logger") { $valid_logger = 1; } else { carp( "obj is not a valid Log4perl object. " . "Looking for Log::Log4perl::Logger, found" . ref($logger) ); } if ($valid_logger) { my $name; # create a name if one isn't given. if ($_[0]{'name'}) { $name = $_[0]{'name'}; } else { $name = $_[0]{'type'} . '_' . time(); } if ($type eq 'file' && %options) { my $log_file; if (!($_[0]{'file'})) { $log_file = __verify_writable($self->{__yaml}); } else { $log_file = __verify_writable($_[0]{'file'}); } if ($log_file) { $log_appender = __file_rotate({ 'log_file' => $log_file, 'name' => $name, 'log_rotation_period' => $options{'log_rotation_period'}, 'max_log_rotations' => $options{'max_log_rotations'}, 'layout' => $l4playout, 'log_level' => $options{'log_level'}, }); } else { carp("Specified log file is not writable. See previous er +rors"); } } elsif ($type eq 'sql' && %options) { my $sql = __verify_sql($self->{__yaml}); $log_appender = __sql({ 'sql' => $sql, 'name' => $name, 'table' => $options{'db_table'}, 'layout' => $l4playout, 'log_level' => $options{'log_level'}, }); } elsif ($type eq 'screen' && %options) { $log_appender = __screen({ 'name' => $name, 'layout' => $l4playout, 'log_level' => $options{'log_level'}, }); } else { carp("Insufficent options to create logger."); } } else { carp "obj is not a valid Log4perl object."; } if ($log_appender) { $logger->add_appender($log_appender) or carp( "Could not add appender. $@" ); } else { carp("Could not add appender. Please check prior warnings.") } } } sub remove_appender { my $self = shift; $self->{__logger}->remove_appender($_[0]) if $_[0]; } ##### # Message logging. sub debug { my $self = shift; $self->__logger->debug(@_) if @_; } sub info { my $self = shift; $self->__logger->info(@_) if @_; } sub warn { my $self = shift; $self->__logger->warn(@_) if @_; } sub error { my $self = shift; $self->__logger->error(@_) if @_; } sub fatal { my $self = shift; $self->__logger->fatal(@_) if @_; # croak(); } ###### # private routines follow ###### # containers ###### sub __logger { my $self = shift; $self->{__logger} = $_[0] if $_[0]; return $self->{__logger}; } sub __yaml { my $self = shift; $self->{yaml} = $_[0] if $_[0]; return $self->{yaml}; } ##### # sanity checks. ##### # accepts an object, returns object if it is a YAML::AppConfig object sub __verify_yaml { my $return; if (ref($_[0]) ne "YAML::AppConfig") { carp( "conf not a valid YAML::AppConfig object. " . "Looking for YAML::AppConfig, found " . ref($_[0]) ); } else { $return = $_[0]; } return $return; } # accepts a YAML::AppConfig object, returns a DBI object. sub __verify_sql { my $db_name = $_[0]->get('db_name'); my $db_host = $_[0]->get('db_host'); my $db_uid = $_[0]->get('db_uid'); my $db_pwd = $_[0]->get('db_pwd'); my $db_port = '3306'; if ($_[0]->get('db_port')) { $db_port = $_[0]->get('db_port'); } my $dbh = DBI->connect( "DBI:mysql:database=$db_name;host=$db_host;port=$db_port", $db_uid, $db_pwd ) or carp("Could not connect to database"); # todo: user needs at a minimum insert privs return $dbh; } # accepts a YAML::AppConfig object or a string, returns a string sub __verify_writable { my $log_file; if (ref($_[0]) eq "YAML::AppConfig") { my ($exe_drive, $exe_path, $exe_file_name) = (File::Spec->spli +tpath($0)); my $conf = $_[0]; my $conf_log; if (!$conf->get('log_folder')) { $conf_log = "$exe_path/logs"; } else { $conf_log = $conf->get('log_folder'); $conf_log = $exe_path . $conf_log; $conf_log =~ s/\\/\//gi; } # this will at least get a master log working, in a subfolder +called # 'logs' in the folder with the program that uses this module. # check for (and create if needed) logs folder. # required for master log. if (!-d($conf_log)) { print "Didn't find log folder. Creating $conf_log...\n" +; mkdir $conf_log or croak( "Cannot create log file folder (needs $exe_path to be +writeable) at " . "line " . __LINE__ . " in module c247Logger." ); print "Successfully created $conf_log.\n"; } else { print "Found log folder $conf_log. \n"; } $log_file = join "", $conf_log, "\/$exe_file_name\_log.txt"; } else { $log_file = $_[0]; } if (-f $log_file) { # don't want to destroy data... rename($log_file, $log_file . '_' . time()); } # Ensure we can write to the log file. open(my $test, ">>$log_file"); if (!$test) { $log_file = ''; carp("Could not write to $log_file") } else { close $test; unlink $log_file; } return $log_file; } # Accepts a YAML::AppConfig object, returns an array. sub __parse_options { my $conf = $_[0]{'conf'}; my %return; # sane global defaults $return{'log_level'} = 'DEBUG'; $return{'log_layout'} = '%p|%H|%M|%d|%r|%m|%L%n'; if ($conf->get('log_layout')) { $return{'log_layout'} = $conf->get('log_layout'); } if ($conf->get('log_level')) { $return{'log_level'} = uc($conf->get('log_level')); } # sane file_appender defaults. if ($_[0]{'type'} eq 'file_appender') { $return{'log_rotation_period'} = '0:0:0:1*3:0:0'; $return{'max_log_rotations'} = 90; if ($conf->get('log_rotation_period')) { $return{'log_rotation_period'} = $conf->get('log_rotation_ +period'); } if ($conf->get('max_log_rotations')) { $return{'max_log_rotations'} = $conf->get('max_log_rotatio +ns'); } } # check for sql settings. if ($_[0]{'type'} eq 'sql') { # these 4 are required #db_host: #db_uid: #db_name: #db_pwd: if ( !$conf->get('db_host') || !$conf->get('db_name') || !$conf->get('db_uid') || !$conf->get('db_pwd') ) { carp("Insufficent DB params in config file."); } else { # todo: Actually test the connection. $return{'db_host'} = $conf->get('db_host'); $return{'db_name'} = $conf->get('db_name'); $return{'db_uid'} = $conf->get('db_uid'); $return{'db_pwd'} = $conf->get('db_pwd'); } # optional. if ($conf->get('db_port')) { $return{'db_port'} = $conf->get('db_port'); } else { $return{'db_port'} = '3306'; } if ($conf->get('db_table')) { $return{'db_table'} = $conf->get('db_table'); } else { $return{'db_table'} = 'log'; } } return %return; } ##### # private routines for creating log appenders. ##### # all subs here accept an array and return a Log4perl appender. sub __file_rotate { my %options; $options{'filename'} = $_[0]{'log_file'}; $options{'mode'} = 'append'; $options{'name'} = $_[0]{'name'}; if ($_[0]{'log_rotation_period'}) { $options{'DatePattern'} = $_[0]{'log_rotation_period'}; } if ($_[0]{'max_log_rotations'}) { $options{'max'} = $_[0]{'max_log_rotations'}; } $options{'level'} = $_[0]{'level'}; my $log_appender = Log::Log4perl::Appender->new( "Log::Dispatch::FileRotate", %options ); $log_appender->layout($_[0]{'layout'}); $log_appender->threshold($_[0]{'log_level'}); return($log_appender); } sub __sql { my %options; $options{'name'} = $_[0]{'name'}; $options{'dbh'} = $_[0]{'sql'}; $options{'table'} = $_[0]{'table'}; $options{'name'} = $_[0]{'name'}; my $log_appender = Log::Log4perl::Appender->new( "Log::Dispatch::DBI", %options ); $log_appender->layout($_[0]{'layout'}); $log_appender->threshold($_[0]{'log_level'}); return($log_appender); } sub __screen { my $log_appender = Log::Log4perl::Appender->new( "Log::Dispatch::Screen", 'name' => $_[0]{'name'}, ); $log_appender->layout($_[0]{'layout'}); $log_appender->threshold($_[0]{'log_level'}); return($log_appender); }
The problem that I'm now having is that by storing my Log4perl object inside the module, I can't call it directly. This wouldn't be a problem except for the fact that the object collects and reflects caller information in its output, so now it always looks like the module itself is calling the Log4perl object.
Is there a way to get this to work in the fashion intended: That the object is effectively an extended Log4perl object?
Thank you for your time and consideration.
In reply to Module authoring and OO perl by jellisii2
| For: | Use: | ||
| & | & | ||
| < | < | ||
| > | > | ||
| [ | [ | ||
| ] | ] |