view release on metacpan or  search on metacpan

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

#
# AUTHOR
#   Andy Wardley   <abw@wardley.org>
#
#========================================================================

package Badger::Factory;

use Badger::Debug ':dump';
use Badger::Class
    version   => 0.01,
    debug     => 0,
    base      => 'Badger::Prototype Badger::Exporter',
    import    => 'class',
    utils     => 'plural blessed textlike dotid camel_case',
    words     => 'ITEM ITEMS ISA',
    constants => 'PKG ARRAY HASH REFS ONCE DEFAULT LOADED',
    constant  => {
        OBJECT         => 'object',
        FOUND          => 'found',
        FOUND_REF      => 'found_ref',
        PATH_SUFFIX    => '_PATH',
        NAMES_SUFFIX   => '_NAMES',
        DEFAULT_SUFFIX => '_DEFAULT',
    },
    messages  => {
        no_item    => 'No item(s) specified for factory to manage',
        no_default => 'No default defined for %s factory',
        bad_ref    => 'Invalid reference for %s factory item %s: %s',
        bad_method => qq{Can't locate object method "%s" via package "%s" at %s line %s},
    };

our $RUNAWAY = 0;
our $AUTOLOAD;

*init = \&init_factory;


sub init_factory {
    my ($self, $config) = @_;
    my $class = $self->class;
    my ($item, $items, $path, $map, $default);

    # 'item' and 'items' can be specified as config params or we look for
    # $ITEM and $ITEMS variables in the current package or those of any
    # base classes.  NOTE: $ITEM and $ITEMS must be in the same package
    unless ($item = $config->{ item }) {
        foreach my $pkg ($class->heritage) {
            no strict   REFS;
            no warnings ONCE;

            if (defined ($item = ${ $pkg.PKG.ITEM })) {
                $items = ${ $pkg.PKG.ITEMS };
                last;
            }
        }
    }
    return $self->error_msg('no_item')
        unless $item;

    # use 'items' in config, or grokked from $ITEMS, or guess plural
    $items = $config->{ items } || $items || plural($item);

    my $ipath    = $item.PATH_SUFFIX;
    my $inames   = $item.NAMES_SUFFIX;
    my $idefault = $item.DEFAULT_SUFFIX;

    # Merge all XXXX_PATH package vars with any 'xxxx_path' or 'path' config
    # items.  Ditto for XXXX_NAME / 'xxxx_name' / 'aka' and  XXXXS/ 'xxxxs'

    my @path  = @$config{ path  => lc $ipath  };
    my @names = @$config{ names => lc $inames };

    $self->{ path     } = $class->list_vars(uc $ipath, @path);
    $self->{ names    } = $class->hash_vars(uc $inames, @names);
    $self->{ $items   } = $class->hash_vars(uc $items, $config->{ $items });
    $self->{ items    } = $items;
    $self->{ item     } = $item;
    $self->{ loaded   } = { };
    $self->{ no_cache } = defined $config->{ no_cache }     # quick hack
        ? $config->{ no_cache }
        : $class->any_var('NO_CACHE') || 0;

    # see if a 'xxxx_default' or 'default' configuration option is specified
    # or look for the first XXXX_DEFAULT or DEFAULT package variable.
    $default = $config->{ $idefault }
            || $config->{ default }
            || $class->any_var_in( uc $idefault, uc DEFAULT );
    if ($default) {
        $self->debug("Setting default to $default") if DEBUG;
        $self->{ default } = $self->{ names }->{ default } = $default;
    }

    $self->debug(
        "Initialised $item/$items factory\n",
        " Path: ", $self->dump_data($self->{ path }), "\n",
        "Names: ", $self->dump_data($self->{ names })
    ) if DEBUG;

    return $self;
}

sub path {
    my $self = shift->prototype;
    return @_
        ? ($self->{ path } = ref $_[0] eq ARRAY ? shift : [ @_ ])
        :  $self->{ path };
}

sub default {
    my $self = shift->prototype;
    return @_
        ? ($self->{ default } = $self->{ names }->{ default } = shift)
        :  $self->{ default };
}

sub items {
    my $self  = shift->prototype;
    my $items = $self->{ $self->{ items } };
    if (@_) {
        my $args = ref $_[0] eq HASH ? shift : { @_ };

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

    my $factory = My::Widgets->new(
        widget_path => ['His::Widget', 'Her::Widget'],
        widgets     => {
            extra => 'Another::Widget::Module',
            super => 'Golly::Gosh',
        }
    );

    $w = $factory->widget( foo => { msg => 'Hello World' } );

The L<Badger::Factory::Class> module can be used to simplify the process
of defining factory subclasses.

    package My::Widgets;

    use Badger::Factory::Class
        item    => 'widget',
        path    => 'My::Widget Your::Widget';
        widgets => {
            extra => 'Another::Widget::Module',
            super => 'Golly::Gosh',
        };

=head1 DESCRIPTION

This module implements a base class factory object for loading modules and
instantiating objects on demand. It originated in the L<Template::Plugins>
module, evolved over time in various directions for other projects, and was
eventually pulled back into line to become C<Badger::Factory>.

=head2 Defining a Factory Module

The C<Badger::Factory> module isn't designed to be used by itself. Rather it
should be used as a base class for your own factory modules. For example,
suppose you have a project which has lots of C<My::Widget::*> modules. You can
define a factory for them like so:

    package My::Widgets;
    use base 'Badger::Factory';

    our $ITEM           = 'widget';
    our $ITEMS          = 'widgets';
    our $WIDGET_PATH    = ['My::Widget', 'Your::Widget'];
    our $WIDGET_DEFAULT = 'foo';
    our $WIDGET_NAMES   = {
        html => 'HTML',
    };

    # lookup table for any non-standard spellings/capitalisations/paths
    our $WIDGETS     = {
        url   => 'My::Widget::URL',       # non-standard capitalisation
        color => 'My::Widget::Colour',    # different spelling
        amp   => 'Nigels::Amplifier',     # different path
    };

    1;

The C<$ITEM> and C<$ITEMS> package variables are used to define the
singular and plural names of the items that the factory is responsible for.
In this particular case, the C<$ITEMS> declaration isn't strictly
necessary because the module would correctly "guess" the plural name
C<widgets> from the singular C<widget> defined in C<$ITEM>.  However,
this is only provided as a convenience for those English words that
pluralise regularly and shouldn't be relied upon to work all the time.
See the L<pluralise()|Badger::Utils/pluralise()> method in L<Badger::Utils>
for further information, and explicitly specify the plural in C<$ITEMS> if
you're in any doubt.

The C<$WIDGET_PATH> is used to define one or more base module names under
which your widgets are located.  The name of this variable is derived
from the upper case item name in C<$ITEM> with C<_PATH> appended.  In this
example, the factory will look for the C<Foo::Bar> module as either
C<My::Widget::Foo::Bar> or C<Your::Widget::Foo::Bar>.

The C<$WIDGET_DEFAULT> specifies the default item name to use if a request
is made for a module using an undefined or false name.  If you don't specify
any value for a default then it uses the literal string C<default>.  Adding
a C<default> entry to your C<$WIDGET_NAMES> or C<$WIDGETS> will have the same
effect.

The C<$WIDGET_NAMES> is used to define any additional name mappings. This is
usually required to handle alternate spellings or unusual capitalisations that
the default name mapping algorithm would get wrong. For example, a request for
an C<html> widget would look for C<My::Widget::Html> or C<Your::Widget::Html>.
Adding a C<$WIDGET_MAP> entry mapping C<html> to C<HTML> will instead send it
looking for C<My::Widget::HTML> or C<Your::Widget::HTML>.

If you've got any widgets that aren't located in one of these locations,
or if you want to provide some aliases to particular widgets then you can
define them in the C<$WIDGETS> package variable.  The name of this variable
is the upper case conversion of the value defined in the C<$ITEMS> package
variable.

=head2 Using Your Factory Module

Now that you've define a factory module you can use it like this.

    use My::Widgets;

    my $widgets = My::Widgets->new;
    my $foo_bar = $widgets->widget('Foo::Bar');

The C<widget()> method is provided to load a widget module and instantiate
a widget object.

The above example is equivalent to:

    use My::Widget::Foo::Bar;
    my $foo_bar = My::Widget::Foo::Bar->new;

Although it's not I<strictly> equivalent because the factory could just
has easily have loaded it from C<Your::Widget::Foo::Bar> in the case that
C<My::Widget::Foo::Bar> doesn't exist.

You can specify additional arguments that will be forwarded to the object
constructor method.

    my $foo_bar = $widgets->widget('Foo::Bar', x => 10, y => 20);

If you've specified a C<$WIDGET_DEFAULT> for your factory then you can call
the L<widget()> method without any arguments to get the default object.