Badger
26 results

 view release on metacpan or  search on metacpan

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

        "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 : { @_ };
        @$items{ keys %$args } = values %$args;
    }
    return $items;
}

sub item {
    my $self = shift; $self = $self->prototype unless ref $self;
    my ($type, @args) = $self->type_args(@_);

    # In most cases we're expecting $type to be a name (e.g. Table) which we
    # lookup in the items hash, or tack onto one of the module bases in the
    # path (e.g. Template::Plugin) to create a full module name which we load
    # and instantiate (e.g. Template::Plugin::Table).  However, the name might
    # be explicitly mapped to a  reference of some kind, or the $type passed
    # in could already be a reference (e.g. Template::TT2::Filters allow the
    # first argument to be a code ref or object which implements the required
    # filtering behaviour).  In which case, we bypass any name-based lookup
    # and skip straight onto the "look what I found!" phase

    return $self->found($type, $type, \@args)
        unless textlike $type;

    $type = $type . '';     # auto-stringify any textlike objects

    # OK, so $type is a string.  We'll also create a canonical version of the
    # name (lower case dotted) to provide a case/syntax insensitve fallback
    # (e.g. so "foo.bar" can match against "Foo.Bar", "Foo::Bar" and so on)

    my $items = $self->{ $self->{ items } };
    my $canon = dotid $type;

    $self->debug("Looking for '$type' or '$canon' in $self->{ items }") if DEBUG;
#   $self->debug("types: ", $self->dump_data($self->{ types })) if DEBUG;

    # false but defined entry indicates the item is not found
    return $self->not_found($type, \@args)
        if exists $items->{ $type }
           && not $items->{ $type };

    my $item = $items->{ $type  }
            || $items->{ $canon }
            # TODO: this needs to be defined-or, like //
            # Plugins can return an empty string to indicate that they
            # do nothing.
            # HMMM.... or does it?
            ||  $self->find($type, \@args)
#            ||  $self->default($type, \@args)
            ||  return $self->not_found($type, \@args);

    $items->{ $type } = $item
        unless $self->{ no_cache };

    return $self->found($type, $item, \@args);
}

sub type_args {
    # Simple method to grok $type and @args from argument list.  The only
    # processing it does is to set $type to 'default' if it is undefined or
    # false. Subclasses can re-define this to insert their own type mapping or
    # argument munging, e.g. to inject values into the configuration params
    # for an object
    shift;
    my $type = shift || DEFAULT;
    my @args;

    if (ref $type eq HASH) {
        @args = ($type, @_);
        $type = $type->{ type } || DEFAULT;
    }
    else {
        @args = @_;
    }

    return ($type, @args);
}

sub find {
    my $self   = shift;
    my $type   = shift;
    my $bases  = $self->path;
    my $module;

    # run the type through the type map to handle any unusual capitalisation,
    # spelling, aliases, etc.
    $type = $self->{ names }->{ $type } || $type;

    foreach my $base (@$bases) {
        return $module
            if $module = $self->load( $self->module_names($base, $type) );
    }

    return undef;
}

sub load {
    my $self   = shift;
    my $loaded = $self->{ loaded };

    foreach my $module (@_) {
        # see if we've previously loaded a module with this name (true
        # value) or failed to load a module (defined but false value)

        if ($loaded->{ $module }) {
            $self->debug("$module has been previously loaded") if DEBUG;
            return $module;
        }
        elsif (defined $loaded->{ $module }) {
            next;

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

sub found {
    my ($self, $type, $item, $args) = @_;

    if (ref $item) {
        # if it's a reference we found then forward it onto the appropriate
        # method, e.g found_array(), found_hash(), found_code().  Fall back
        # on found_ref()
        my $iref = blessed($item)
            ? OBJECT
            : lc ref $item;

        $self->debug(
            "Looking for handler methods: ",
            FOUND,'_'.$iref, "() or ",
            FOUND_REF, "()"
        ) if DEBUG;

        my $method
             = $self->can(FOUND . '_' . $iref)
            || $self->can(FOUND_REF)
            || return $self->error_msg( bad_ref => $self->{ item }, $type, $iref );

        $item = $method->($self, $type, $item, $args);
    }
    else {
        # otherwise it's the name of a module
        $item = $self->found_module($type, $item, $args);
    }

    # NOTE: an item can be defined but false, e.g. a Template::Plugin which
    # return '' from its new() method to indicate it does nothing objecty
    return unless defined $item;

    $self->debug("Found result: $type => $item") if DEBUG;

    # TODO: what about caching result?  Do we always leave that to subclasses?
    return $self->result($type, $item, $args);
}

sub found_module {
    # This method is called when a module name is found, either by being
    # predefined in the factory entry table, or loaded on demand from disk.
    # It ensures the module is loaded and and instantiates an object from the
    # class name
    my ($self, $type, $module, $args) = @_;
    $self->debug("Found module: $type => $module") if DEBUG;
    $self->{ loaded }->{ $module } ||= class($module)->load;
    return $self->construct($type, $module, $args);
}

sub found_array {
    # This method is called when an ARRAY reference is found.  We assume that
    # the first item is the module name (which needs to be loaded) and the
    # second item is the class name (which needs to be instantiated).
    my ($self, $type, $item, $args) = @_;
    my ($module, $class) = @$item;
    $self->{ loaded }->{ $module } ||= class($module)->load;
    return $self->construct($type, $class, $args);
}

sub not_found {
    my ($self, $type, @args) = @_;

    return $type eq DEFAULT
        ? $self->error_msg( no_default => $self->{ item } )
        : $self->error_msg( not_found => $self->{ item }, $type );
}

sub construct {
    my ($self, $type, $class, $args) = @_;
    $self->debug("constructing class: $type => $class") if DEBUG;
    return $class->new(@$args);
}

sub module_names {
    my $self = shift;
    my @bits =
        map { camel_case($_) }
        map { split /[\.]+/ } @_;

    return (
        join( PKG, map { ucfirst $_ } @bits ),
        join( PKG, @bits )
    );
}


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

    # upgrade class methods to calls on prototype
    $self = $self->prototype unless ref $self;

    # NOTE: this method can get called before we've called init_factory()
    # to define the item/items members, so we tread carefully.
    if ($self->{ item } && $self->{ item } eq $name) {
        return $self->SUPER::can('item');
    }
    elsif ($self->{ items } && $self->{ items } eq $name) {
        return $self->SUPER::can('items');
    }
    else {
        return $self->SUPER::can($name);
    }
}

sub result {
    $_[2];
}

sub AUTOLOAD {
    my ($self, @args) = @_;
    my ($name) = ($AUTOLOAD =~ /([^:]+)$/ );
    return if $name eq 'DESTROY';

    $self->debug("AUTOLOAD $name") if DEBUG;

    local $RUNAWAY = $RUNAWAY;
    $self->error("AUTOLOAD went runaway on $name")
        if ++$RUNAWAY > 10;

    # upgrade class methods to calls on prototype
    $self = $self->prototype unless ref $self;

    $self->debug("factory item: $self->{ item }") if DEBUG;

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


=head2 found_module($module)

This method is called when a requested item has been mapped to a module name.
The module is loaded if necessary, then the L<construct()> method is called
to construct an object.

=head2 found_array(\@array)

An entry in the C<items> (aka C<widgets> in our earlier example) table
can be a reference to a list containing a module name and a separate class
name.

    my $widgets = My::Widgets->new(
        widgets => {
            wizbang => ['Wiz::Bang', 'Wiz::Bang::Bash'],
        },
    );

If the C<wizbang> widget is requested from the C<My::Widgets> factory
in the example above, then the L<found()> method will call C<found_array()>,
passing the array reference as an argument.

The module listed in the first element is loaded.  The class name in
the second element is then used to instantiate an object.

=head2 found_hash(\%hash)

This method isn't implemented in the base class, but can be defined by
subclasses to handle the case where a request is mapped to a hash reference.

=head2 found_scalar(\$scalar)

This method isn't implemented in the base class, but can be defined by
subclasses to handle the case where a request is mapped to a scalar reference.

=head2 found_object($object)

This method isn't defined in the base class, but can be defined by subclasses
to handle the case where a request is mapped to an existing object.

=head2 construct($name,$class,\@args)

This method instantiates a C<$class> object using the arguments provided.
In the base class this method  simply calls:

    $class->new(@$args);

=head2 result($name,$result,\@args)

This method is called at the end of a successful request after an object
has been instantiated (or perhaps re-used from an internal cache).  In the
base class it simply returns C<$result> but can be redefined in a subclass
to do something more interesting.

=head2 module_names($type)

This method performs the necessary mapping from a requested module name to
its canonical form.

=head2 not_found($name,@args)

This method is called when the requested item is not found. The method simply
throws an error using the C<not_found> message format. The method can be
redefined in subclasses to perform additional fallback handing.

=head2 can($method)

This method implements the magic to ensure that the item-specific accessor
methods (e.g. C<widget()>/C<widgets()>) are generated on demand.

=head2 AUTOLOAD(@args)

This implements the other bit of magic to generate the item-specific accessor
methods on demand.

=head1 AUTHOR

Andy Wardley L<http://wardley.org/>

=head1 COPYRIGHT

Copyright (C) 2006-2009 Andy Wardley.  All Rights Reserved.

This module is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.

=head1 SEE ALSO

L<Badger::Factory::Class>, L<Badger::Codecs>.

=cut

# Local Variables:
# mode: perl
# perl-indent-level: 4
# indent-tabs-mode: nil
# End:
#
# vim: expandtab shiftwidth=4:



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