not_ results from the CPAN

Badger

#========================================================================
#
# Badger::Base
#
# DESCRIPTION
#   Base class module implementing common functionality for various
#   other Badger modules.
#
# AUTHOR
#   Andy Wardley   <abw@wardley.org>
#
#========================================================================

package Badger::Base;

use Badger::Class
    version   => 0.01,
    debug     => 0,
    constants => 'CODE HASH ARRAY BLANK SPACE PKG REFS ONCE WARN NONE',
    import    => 'class classes',
    utils     => 'blessed reftype xprintf',
    words     => 'ID EXCEPTION THROWS ERROR DECLINED before after',
    constant  => {
        base_id => 'Badger',      # stripped from class name to make id
        TRIAL   => 'Badger::Base::Trial',
    };

use Badger::Exception;              # TODO: autoload
use Badger::Debug 'debug debug_up dump_data_inline dump_data dump_list dump_hash';

our $EXCEPTION = 'Badger::Exception' unless defined $EXCEPTION;
our $ON_WARN   = WARN;
our $MESSAGES  = {
    not_found       => '%s not found: %s',
    not_found_in    => '%s not found in %s',
    not_implemented => '%s is not implemented %s',
    no_component    => 'No %s component defined',
    bad_method      => "Invalid method '%s' called on %s at %s line %s",
    invalid         => 'Invalid %s specified: %s',
    unexpected      => 'Invalid %s specified: %s (expected a %s)',
    missing_to      => 'No %s specified to %s',
    missing         => 'No %s specified',
    todo            => '%s is TODO %s',
    at_line         => '%s at line %s',
    at_file_line    => '%s in %s at line %s',
};


sub new {
    my $class = shift;

    # install warning handling for odd number of parameters when DEBUG enabled
    local $SIG{__WARN__} = sub {
        Badger::Utils::odd_params(@_);
    } if DEBUG;

    my $args  = @_ && ref $_[0] eq HASH ? shift : { @_ };
    my $self  = bless { }, ref $class || $class;
       $self  = $self->init($args);

    # be careful to account for object that overload the boolean comparison
    # operator and may return false to a simple truth test.
    return defined $self
        ? $self
        : $self->error("init() method failed\n");
}

sub init {
    my $self = shift;
    # default action is to store reference to entire configuration so
    # that methods can examine it later if they need to
    $self->{ config } = shift;
    return $self;
}

sub warn {
    my $self  = shift;
    return unless @_;

    my $message  = join(BLANK, @_);
    my $handlers = $self->on_warn;

    $self->debug("dispatching handlers for warn: ", $self->dump_data_inline($handlers), "\n") if DEBUG;
    $self->_dispatch_handlers( warn => $handlers => $message )
        if $handlers && @$handlers;

    # Warning is usually raised by the last handler in the chain which
    # defaults to 'warn', so it's OK to just drop out here.
}

sub error {
    my $self  = shift;
    my $class = ref     $self || $self;
    my $type  = reftype $self || BLANK;
    no strict   REFS;
    no warnings ONCE;

lib/Badger/Base.pm view on Meta::CPAN

    }

    require Carp;
    Carp::confess("Fatal badger error: ", @_);
}


#-----------------------------------------------------------------------
# messages
#-----------------------------------------------------------------------

sub message {
    my $self   = shift;
    my $name   = shift
        || $self->fatal("message() called without format name");
    my $ref    = $self && reftype $self;
    my $format;

    # allow $self object to have an internal messages hash
    if ($self && $ref && $ref eq HASH && $self->{ messages }) {
        $format = $self->{ messages }->{ $name }
            if reftype $self->{ messages } eq HASH;
    }

    $format = class($self)->hash_value( MESSAGES => $name )
        || $self->fatal("message() called with invalid message type: $name")
            unless defined $format;

    xprintf($format, @_);
}

sub warn_msg {
    # explicitly quantify local message() method in case a subclass decides
    # to re-implement the message() method to do something else
    $_[0]->warn( message(@_) );
}

sub error_msg {
    $_[0]->error( message(@_) );
}

sub fatal_msg {
    $_[0]->fatal( message(@_) );
}

sub decline_msg {
    $_[0]->decline( message(@_) );
}

sub debug_msg {
    $_[0]->debug( message(@_) );
}

sub throw_msg {
    my $self = shift;
    $self->throw( shift, message($self, @_) );
}


#-----------------------------------------------------------------------
# generate not_implemented() and todo() methods
#-----------------------------------------------------------------------

class->methods(
    map {
        my $name = $_;
        $name => sub {
            my $self = shift;
            my $ref  = ref $self || $self;
            my ($pkg, $file, $line, $sub) = caller(0);
            $sub = (caller(1))[3];   # subroutine the caller was called from
            $sub =~ s/(.*):://;
            my $msg  = @_ ? join(BLANK, SPACE, @_) : BLANK;
            return $self->error_msg( $name => "$sub()$msg", "for $ref in $file at line $line" );
        };
    }
    qw( not_implemented todo )
);


#-----------------------------------------------------------------------
# generate on_warn() and on_error() methods
#-----------------------------------------------------------------------

class->methods(
    map {
        my $on_event = $_;
        my $ON_EVENT = uc $on_event;

        $on_event => sub {
            my $self  = shift;
            my $class = class($self);
            my $list;

            if (ref $self && reftype $self eq HASH) {
                # look in $self->{ config }->{ on_xxx } or in $ON_XXX pkg
                # var for one or more event handlers
                $list = $self->{ $ON_EVENT }
                    ||= $self->{ config }->{ $on_event }
                    ||  $class->list_vars($ON_EVENT);
                # careful!  the config value might be a single handler
                $list = $self->{ $ON_EVENT } = [$list]
                    unless ref $list eq ARRAY;
                $self->debug("got $on_event handlers: ", $self->dump_data_inline($list), "\n") if DEBUG;
            }
            else {
                # class method or non-hash objects use pkg vars only
                $list = $class->var_default($ON_EVENT, []);
                $list = $class->var($ON_EVENT, [$list])
                    unless ref $list eq ARRAY;
            }

            # Add to the list any extra handlers passed as args.  First
            # argument can be 'before' or 'after' to add remaining args
            # to start or end of list, otherwise the entire list is replaced.
            if (@_) {
                if ($_[0] eq before) {
                    shift;
                    unshift(@$list, @_);
                }
                elsif ($_[0] eq after) {
                    shift;
                    push(@$list, @_);
                }
                else {
                    @$list = @_;
                }
            }
            # push(@$list, @_);

            return $list;
        }
    }
    qw( on_warn on_error )
);

lib/Badger/Base.pm view on Meta::CPAN

like this.

First, it makes it easy to reuse the same message format in different places.
Also known as the "DRY" principle - I<Don't Repeat Yourself>.

Second, it allows you to put all your messages in one place instead of dotting
them all over your code. The benefit here is a clearer I<separation of
concerns> between the underlying logic of your application and the
presentational aspects.

The third benefit comes as a result of this clear separation - it becomes
trivially easy to change the messages generated by your application because
they're all defined in one place (possibly in several different modules if
that's how you choose to break it down, but at least they're in I<one> place
in each of those modules). Possible applications of this include: localising
an application to different spoken languages; generating messages in colour
(as the L<Badger::Debug> and L<Badger::Test> modules do); or formatting
messages as HTML.

=head2 warn_msg($message, @args)

This is a wrapper around the L<warn()> and L<message()> methods.
The first argument defines a message format.  The remaining arguments
are then applied to that format via the L<message()> method.  The
resulting output is then forwarded to the L<warn()> method.

    our $NAME     = 'Badger';
    our $MESSAGES = {
        using_default => "Using default value for %s: %s",
    };

    sub init {
        my ($self, $config) = @_;

        if ($config->{ name }) {
            $self->{ name } = $config->{ name };
        }
        else {
            $self->warn_msg( using_default => name => $NAME );
            $self->{ name } = $NAME;
        }

        return $self;
    }

If a C<name> isn't provided as a configuration parameter then the
default C<$NAME> will be used and the following warning will be
generated:

    Using default value for name: Badger

=head2 error_msg($message, @args)

This is a wrapper around the L<error()> and L<message()> methods,
similar to L<warn_msg()>.

    package Your::Zoo;
    use base 'Badger::Base';

    our $MESSAGES = {
        not_found => "I can't find the %s you asked for: %s",
    }

    sub animal {
        my ($self, $name) = @_;

        return $self->fetch_an_animal($name)
            || $self->error_msg( missing => animal => $name );
    }

Calling the C<animal()> method on this object with an animal that can't
be found, like this:

    $zoo->animal('Badgerpotamus');

Will generate an error message like this:

    your.zoo error - I can't find the animal you asked for: Badgerpotamus

=head2 decline_msg($message, @args)

This is a wrapper around the L<decline()> and L<message()> methods,
similar to L<warn_msg()> and L<error_msg()>.

    our $MESSAGES = {
        not_found => 'No %s found in the forest',
    };

    sub forage {
        my ($self, $name) = @_;

        return $self->database->fetch_item($name)
            || $self->decline_msg( not_found => $name );
    }

The L<reason()> method can be used to return the message generated.

    my $food = $forager->forage('nuts')
        || warn $forager->reason;       # No nuts found in the forest

=head2 fatal_msg($message, @args)

This is a wrapper around the L<fatal()> and L<message()> methods,
similar to L<error_msg()> and co.

=head2 throw($type, $info, %more_info)

This method throws an exception by calling C<die()>.  It can be called
with one argument, which can either be a L<Badger::Exception> object
(or subclass), or an error message which is upgraded to an exception
object (which makes it behave exactly the same as L<error()>).

    # error message - same thing as error()
    $object->throw('an error has occurred');

    # exception object
    $e = Badger::Exception->new(
        type => 'engine',
        info => 'warp drive offline'
    );
    $object->throw($e);

In the first case, the L<exception()> and L<throws()> methods will be
called to determine the exception class (L<Badger::Exception> by default)
and type for the exception, respectively.

The method can also be called with two arguments. The first defines the
exception C<type>, the second the error message.

    $object->throw( engine => 'warp drive offline' );

The second argument can also be another exception object.  If the
exception has the same type as the first argument then it is re-thrown
unchanged.

    $e = Badger::Exception->new(
        type => 'engine',
        info => 'warp drive offline'
    );
    $object->throw( engine => $e ) };

In the example above, the C<$e> exception already has a type of C<engine> and
so is thrown without change.  If the exception types don't match, or if the
exception isn't the right kind of exception object that we're expecting
(as reported by L<exception()>) then a new exception is thrown with the
old one attached via the C<info> field.

     $object->throw( propulsion => $e );

Here a new C<propulsion> exception is thrown, with the previous C<engine>
exception linked in via the C<info> field. The exception object has
L<type()|Badger::Exception/type()> and L<info()|Badger::Exception/info()>
methods that allow you to inspect its value, iteratively if necessary. Or you

lib/Badger/Base.pm view on Meta::CPAN

value from C<$config> into C<$self-E<gt>{THROWS}>.

    # example 1: store entire config for later
    sub init {
        my ($self, $config) = @_;
        $self->{ config } = $config;
        # do other stuff
        return $self;
    }

    # example 2: extract specific parameter up front
    sub init {
        my ($self, $config) = @_;
        $self->{ THROWS } = $config->{ throws };
        # do other stuff
        return $self;
    }

You can set the default exception type for your own modules that inherit
from C<Badger::Base> by adding a C<$THROWS> package variable;

    package Badger::Example;
    use base 'Badger::Base';
    our $THROWS = 'food';

If you don't specify an exception type then one will be generated from
the module's class name using the L<id()|Badger::Class/id()> method in
L<Badger::Class>.

=head2 exception($class)

This method can be used to get or set the exception class for an object.
The default value is L<Badger::Exception>.

    use Badger::Example;
    use Some::Other::Exception;
    Badger::Example->exception('Some::Other::Exception');

    # now Badger::Example objects throw Some::Other::Exception

You can set the default exception class for your own modules that inherit
from C<Badger::Base> by adding a C<$EXCEPTION> package variable;

    package Badger::Example;
    use base 'Badger::Base';
    use Some::Other::Exception;
    our $EXCEPTION = 'Some::Other::Exception';

=head2 fatal($info, $more_info, ...)

This method is used internally to raise a fatal error.  It bypasses the
normal error reporting mechanism and dies with a stack backtrace by calling
C<confess()> (see L<Carp>).

The most common reason for a fatal error being raised is calling the
L<message()> method (or either of the L<error_msg()> or L<decline_msg()>
wrapper methods) with a message format that doesn't exist. The stack backtrace
will tell you where in your code you're making the call so you can easily find
and fix it.

=head2 not_implemented($what)

A method of convenience which raises an error indicating that the method
isn't implemented

    sub example_method {
        shift->not_implemented;
    }

Calling the C<example_method()> would result in an error message similar
to this (shown here split across two lines):

    your.badger.module error - example_method() is not implemented
    for Your::Badger::Module in /path/to/your/script.pl at line 42

Note that it tells you where the C<example_method()> was called from,
not where the method is defined.

The C<not_implemented()> method is typically used in methods defined in a base
classes that subclasses are expected to re-define (a.k.a. pure virtual methods
or abstract methods).

You can pass an argument to be more specific about what it is that
isn't implemented.

    sub example_method {
        shift->not_implemented('in base class');
    }

The argument is added to the generated error message following the
method name.  A single space is also added to separate them.

    your.badger.module error - example_method() is not implemented in
    base class for Your::Badger::Module in ...etc...

=head2 todo($what)

A method of convenience useful during developing to indicate that a method
isn't implemented yet.  It raises an error stating that the method is
still TODO.

    sub not_yet_working {
        shift->todo;
    }

The error message generated looks something like this:

    your.badger.module error - not_yet_working() is TODO in
    Your::Badger::Module at line 42

You can pass an argument to be more specific about what is still TODO.

    sub not_yet_working {
        my ($self, $x) = @_;
        if (ref $x) {
            $self->todo('support for references');
        }
        else {
            # do something
        }
    }

The error message generated would then be:

    your.badger.module error - not_yet_working() support for
    references is TODO in Your::Badger::Module at line 42

=head2 debug($msg1,$msg2,...)

This method is mixed in from the L<Badger::Debug> module. It provides a simple
way of generating debugging messages which include the source module and line
number where the message was generated.

    sub example {
        my $self = shift;
        $self->debug('entered example()');
        # ... some code ...
        $self->debug('leaving example()');
    }

=head2 debug_msg($message, @args)

This is a wrapper around the L<debug()> and L<message()> methods,
similar to L<warn_msg()>, L<error_msg()> and friends.

    our $MESSAGES = {
        here => 'You are in %s',
    };

    sub example {
        my $self = shift;

        $self->debug_msg(
            here => 'a maze of twisty little passages, all alike'
        ) if DEBUG;

        # ... some code ...

        $self->debug_msg(
            here => 'boat, floating on a sea of purest green'
        ) if DEBUG;
    }

=head2 debug_up($level,$msg1,$msg2,...)

Another debugging method mixed in from L<Badger::Debug>.  This is a wrapper
around L<debug()> which reports the file and line number of a caller
higher up the call stack.  This is typically used when you create your
own debugging methods, as shown in the following example.


    sub parse {
        my $self = shift;

        while (my ($foo, $bar) = $self->get_foo_bar) {
            $self->trace($foo, $bar);               # report line here
            # do something
        }
    }

    sub trace {
        my ($self, $foo, $bar) = @_;
        $self->debug_up(2, "foo: $foo  bar: $bar"); # not here
    }

lib/Badger/Base.pm view on Meta::CPAN

        # your gnarly code
    }

The C<Badger::Class> module defines the C<debug> method and import hook
which will automatically define a C<$DEBUG> variable for you.

    package Your::Badger::Module;

    use Badger::Class
        base  => 'Badger::Base',
        debug => 0;

=head2 $DECLINED

This package variable is defined in each subclass derived from
C<Badger::Base>. It is a boolean (0/1) flag used by the L<error()>,
L<decline()> and L<declined()> methods. The L<decline()> method sets it to
C<1> to indicate that the object declined a request. The L<error()> method
clears it back to C<0> to indicate that a hard error occurred. The
L<declined()> method simply returns the value.

=head2 $ERROR

This package variable is defined in each subclass derived from
C<Badger::Base>.  It stores the most recent error message raised
by L<decline()> or L<error()>.

=head2 $EXCEPTION

This package variable is used to define the name of the class
that should be used to instantiate exception objects.  The default
value in C<Badger::Base> is C<Badger::Exception>.

Subclasses may define an C<$EXCEPTION> package variable to change this
value.

    package Your::Badger::Module;
    use base 'Badger::Base';
    use Your::Exception;
    our $EXCEPTION = 'Your::Exception';

Those that don't explicitly define an C<$EXCEPTION> will inherit the value
from any of their base classes, possibly coming all the way back up to the
default value in C<Badger::Base>.

Calling the C<exception()> class method with an argument will update the
C<$EXCEPTION> package variable in that class.

    # sets $Your::Badger::Module::EXCEPTION
    Your::Badger::Module->exception('Your::Exception');

=head2 $MESSAGES

This package variable is used to reference a hash array of messages that can
be used with the L<message()>, L<warn_msg()>, L<error_msg()> and
L<decline_msg()> methods. The C<Badger::Base> module defines a number of
messages that it uses internally.


    our $MESSAGES = {
        not_found       => '%s not found: %s',
        not_found_in    => '%s not found in %s',
        not_implemented => '%s is not implemented %s',
        no_component    => 'No %s component defined',
        bad_method      => "Invalid method '%s' called on %s at %s line %s",
        invalid         => 'Invalid %s specified: %s',
        unexpected      => 'Invalid %s specified: %s (expected a %s)',
        missing_to      => 'No %s specified to %s',
        missing         => 'No %s specified',
        todo            => '%s is TODO %s',
        at_line         => '%s at line %s',
        at_file_line    => '%s in %s at line %s',
    };

The L<message()> method searches for C<$MESSAGES> in the current class
and those of any base classes.  That means that any objects derived from
C<Badger::Base> can use these message formats.

    package Your::Badger::Module;
    use base 'Badger::Base';

    sub init {
        my ($self, $config) = @_;
        $self->{ name } = $config->{ name }
            || $self->error_msg( missing => $name );
        return $self;
    }

You can define additional C<$MESSAGES> for your own classes.

    package Your::Badger::Module;
    use base 'Badger::Base';

    our $MESSAGES = {
        life_jim  => "It's %s Jim, but not as we know it",
    }

    sub bones {
        my ($self, $thing)= @_;
        $self->warn_msg( life_jim => $thing );
        return $self;
    }

Calling the C<bones()> method like this:

    $object->bones('a badger');

will generate a warning like this:

    It's a badger Jim, but not as we know it.

=head2 $ON_ERROR

This package variable is used to define one or more error handlers
that will be invoked whenever the L<error()> method is called.

The C<Badger::Base> module doesn't define any C<$ON_ERROR> package
variable by default.  The L<on_error()> method can be called as a
class method to set the C<$ON_ERROR> package variable.

    Your::Badger::Module->on_error(\&my_handler);

You can also define an C<$ON_ERROR> handler or list of handlers in

( run in 0.775 second using v1.01-cache-2.11-cpan-98e64b0badf )