Beefy Boxes and Bandwidth Generously Provided by pair Networks
"be consistent"
 
PerlMonks  

Module authoring and OO perl

by jellisii2 (Friar)
on Mar 07, 2013 at 14:38 UTC ( #1022247=perlquestion: print w/ replies, xml ) Need Help??
jellisii2 has asked for the wisdom of the Perl Monks concerning the following question:

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'd rather not have to feed the YAML object more than once. The module should be able to hold onto a copy of this object.
  • I'd rather return an object that is effectively an extended L4p object that I can call "add" on, rather than have to feed it a logging object that will currently get eaten if something is wrong with the parameters.

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.

Comment on Module authoring and OO perl
Select or Download Code
Re: Module authoring and OO perl
by Anonymous Monk on Mar 07, 2013 at 15:50 UTC

    Ummm... please edit to use code-tags.

    Superficially, the first thing that seems to be missing here is bless().   The new() method, by convention, should return a “blessed object.”   Yours does not.

Re: Module authoring and OO perl
by sundialsvc4 (Monsignor) on Mar 07, 2013 at 15:50 UTC

    Oops... how did I get logged-out so fast?

    Your constructor, new(), should return a blessed object.   Usually, I define a separate init() method and, if I find that the constructor has been called with parameters, I first create the blessed object and then separately invoke that method to do the rest.

    Any Perl object is, almost always, a hash.   It can therefore “hold on to” anything that it wants.   As for the YAML question, what will make the most sense for the user of this module?   If the YAML object is something that the client program will have already, and will otherwise be using for other purposes, then it makes sense to pass it in and keep it.   But maybe your object should, instead, create a YAML object for its own purposes, i.e. “on demand,” and never tell its user about it at all.

    In the latter case, I normally would define an internal-only method, named _getYAML (following the human convention that a subroutine-name beginning with an underscore isn’t intended for outside use), which will always return a YAML object.   If it doesn’t already have one, it creates one on-the-fly and stashes away its location in a known-but-to-god field of the hash so that it can return the same object next time.   If you are dealing with some other module, in the course of your work, that you know might be able to trash such an object, well, your object has to know about that and to destroy its own known-but-to-god reference at the appropriate time (by setting the stash to undef).   Your object knows, so nobody else has to, and that’s a big-win for the users of your code because “it just works.™”

      Your constructor, new(), should return a blessed object. Usually, I define a separate init() method and, if I find that the constructor has been called with parameters, I first create the blessed object and then separately invoke that method to do the rest.

      I understand this on a superficial level, but cannot grok the idea that you're putting forward for an init. Extending the blessed object is where I think my knowledge is faltering, and I'm unclear as to how to remedy that.

      Any Perl object is, almost always, a hash. It can therefore “hold on to” anything that it wants. As for the YAML question, what will make the most sense for the user of this module? If the YAML object is something that the client program will have already, and will otherwise be using for other purposes, then it makes sense to pass it in and keep it.

      This is exactly the use case I have currently, which is why I want to do what I have described.

Re: Module authoring and OO perl
by tobyink (Abbot) on Mar 07, 2013 at 16:21 UTC

    As others have pointed out, you're not returning a blessed object from your new method. The blessed object would usually be a hashref (doesn't have to be though, other references are fine), and it is quite common to use that hashref to store the internal data about the object.

    Here's an example of a simple object representing a bag for keeping things in. The bag has a colour and some contents. There are methods for painting the bag a new colour, for adding an item to the contents, and for checking if it's empty.

    use v5.12; use Data::Dumper (); { package Backpack; sub new { # the constructor my $class = shift; my %params = @_==1 ? %{$_[0]} : @_; my $self = bless {}, $class; $self->colour($params{'colour'} || 'black'); $self->contents($params{'contents'} || []); return $self; } sub colour { # a so-called "accessor" method my $self = shift; $self->{colour} = $_[0] if @_; return $self->{colour}; } sub contents { # another "accessor" method my $self = shift; $self->{contents} = $_[0] if @_; return $self->{contents}; } sub is_empty { my $self = shift; return (@{$self->contents} == 0); } sub add_item { my $self = shift; my ($item) = @_ or die "what item??\n"; push @{$self->contents}, $item; return $self; } sub paint { my $self = shift; my ($colour) = @_ or die "what colour??\n"; $self->colour($colour); return $self; } sub dump { my $self = shift; Data::Dumper::Dumper($self); } } my $x = Backpack->new(colour => "Red"); $x->add_item("keys"); $x->add_item("mobile phone"); $x->add_item("mobile phone charger"); my $y = Backpack->new(contents => ["pants"]); print $x->dump, $y->dump;

    That should be enough to show you what's going on.

    Writing OO in Perl tends to require a lot of "boilerplate" code - for example the constructor and the accessors. For this reason many people use class builder modules. The most popular one at the moment is Moose which also has a faster, lighter-weight companion Moo if your OO needs are simple. I recommend checking both of these out. Here's the Backpack example written using Moose:

    use v5.12; { package Backpack; use Moose; has colour => ( accessor => 'colour', writer => 'paint', default => sub { 'black' }, ); has contents => ( traits => ['Array'], accessor => 'contents', default => sub { [] }, handles => { add_item => 'push', is_empty => 'is_empty', }, ); } my $x = Backpack->new(colour => "Red"); $x->add_item("keys"); $x->add_item("mobile phone"); $x->add_item("mobile phone charger"); my $y = Backpack->new(contents => ["pants"]); print $x->dump, $y->dump;

    As you can see, it's halved the amount of code we've had to write.

    package Cow { use Moo; has name => (is => 'lazy', default => sub { 'Mooington' }) } say Cow->new->name

      This is an excellent response that has set me on the path to getting to where I wish to go.

      To say that I have many miles to walk down this path is an understatement, but it has put me into a position to where I think I can start walking the path with open eyes and at least a candle to light the way.

      Inheritance is the next thing I'm going to have to learn after I finally understand what's going on here. I have made some alterations to my working code that has helped me achieve functionally what I have set out to do, if not completely in spirit. Thank you.

Re: Module authoring and OO perl
by blue_cowdawg (Prior) on Mar 07, 2013 at 16:24 UTC

    Another nit I'm gonna pick is best explained in perldoc vars:

    vars - Perl pragma to predeclare global variable names (obsolete)
    
    See "Pragmatic Modules" in perlmodlib.


    Peter L. Berghold -- Unix Professional
    Peter -at- Berghold -dot- Net; AOL IM redcowdawg Yahoo IM: blue_cowdawg

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://1022247]
Approved by marto
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others perusing the Monastery: (12)
As of 2014-08-21 13:28 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The best computer themed movie is:











    Results (135 votes), past polls