view release on metacpan or  search on metacpan

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

#========================================================================
#
# Badger::Factory
#
# DESCRIPTION
#   Factory module for loading and instantiating other modules.
#
# NOTE
#   This module has grown organically to fit a number of (possibly
#   conflicting) needs.  It needs to be completely refactored, and
#   probably split into a number of different factory modules.  The
#   TT3 code on which this was originally based had separate base class
#   factory modules for modules (that just got loaded), objects (that
#   got loaded and instantiated) and single objects (that got loaded,
#   created and cached).  With hindsight, it was a mistake to try and
#   cram all that functionality into one module.  It should be separated
#   into a base class module/API and a number of specialised subclasses.
#
# 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')