[Catalyst] extending apps to use alternate root namespaces at setup() time

[Peter Karman]

</tickle>

...

This is a bit of an involved question. I'm looking mostly for feedback on
whether (a) what I am attempting is sane and (b) if my method for attempting it
is sane.

I have a base Cat app called Foo. It implements some base controllers and
models, as well as the typical Foo.pm class. I want to allow folks to use it
like this:

 # create a MyApp.pm file
 package MyApp;
 use base qw( Foo );
 use Catalyst::Runtime;
 use Catalyst qw(-Debug Static::Simple);
 __PACKAGE__->setup();


setup() should find all the MyApp::* Catalyst::Component-based files and
instantiate them. But it should also find all the Foo::*
Catalyst::Component-based files as well, preferring MyApp files with the same
name. Think of it like a @INC for Catalyst setup(), with more than one
$base_prefix to inspect.

The idea is that MyApp components need only subclass and override the base
classes that they want to change, and also extend the basic Foo features by
just adding new components. Sort of like taking the extensible nature of
Catalyst itself and applying it Catalyst applications.

Example: if Foo/Controller/Bar.pm exists but there is no equivalent
MyApp/Controller/Bar.pm, then use the Foo version, but create a class
on-the-fly called MyApp::Controller::Bar that isa Foo::Controller::Bar.
Likewise, if Foo/Controller/Blip.pm exists and so does
MyApp/Controller/Blip.pm, then prefer the MyApp version, loading it at ignoring
the Foo version.

So I could conceivably create a single MyApp.pm file, and then get all the Foo
components loaded into the MyApp namespace without having to subclass each one
into a real .pm file.

Below is the code that I use to implement this. It seemed to me that there
wasn't a way to do this using the standard setup_components() since
$base_prefix gets, well, prefixed everywhere, and there didn't seem to be a
suitable option to Module::Pluggable::Object to do what I wanted.

So again, is the idea itself worthwhile? And also, is the implementation the
best way to accomplish it?

TIA.

-------------------------------------------
package CatalystX::AppExtender;

use warnings;
use strict;
use Carp;
use Class::C3;
use Class::Inspector;
use Module::Pluggable::Object;
use Catalyst::Utils;

my $setup_called;

sub setup {
    my $class = shift;
    return if $setup_called++;
    $class->next::method( @_, qw( C3 ) ); # use C3 plugin always
}

=head2 make_components

Artificial class-maker to simplify apps that are ExtendableApp subclasses.

=cut

my %base_components;

sub make_components {
    my $class      = shift;
    my $this_class = __PACKAGE__;

    # look in the namespaces for all the classes that subclass this one,
    # except for $class, since Catalyst will take care of that one.
    my @to_examine = grep { $_ ne $class }
        @{ Class::Inspector->subclasses($this_class) };

    #carp "examining components in: " . dump \@to_examine;

    my %seen_component;
    for my $child (@to_examine) {
        my $this_path = Class::Inspector->loaded_filename($child);
        $this_path =~ s/\.pm$//;

        # find all the $child components and use those if
        # comparable $class subclass isn't found.
        # the MPO stuff comes from setup_components

        my @this_paths = qw( ::Controller ::Model ::View );
        my $this_search_path = [ map { s/^(?=::)/$child/; $_; } @this_paths ];

        # all components for $child
        my $locator = Module::Pluggable::Object->new(
            search_path => $this_search_path );

        my @child_comps = sort { length $a <=> length $b } $locator->plugins;
        my %child_comps = map { Catalyst::Utils::class2classsuffix($_) => $_ }
            @child_comps;

        for my $component ( keys %child_comps ) {

            next if $seen_component{$component}++;

            my $child_component = $child_comps{$component};

            Catalyst::Utils::ensure_class_loaded( $child_component,
                { ignore_loaded => 1 } );

            # if an equivalent $class component does not exist,
            # make a subclass in the $class namespace
            # that is a subclass of $child_component
            # I.e., a strange world where $child_component becomes
            # its grandparent's base component.

            my $class_component = join( '::', $class, $component );

            local $@;
            eval "require $class_component";
            if ($@) {

                # create a class since no .pm could be loaded.
                {
                    no strict 'refs';
                    @{ $class_component . '::ISA' } = ($child_component);
                }
            }
            $base_components{$component} = $class_component;
        }
    }

    # is this necessary?
    Class::C3::reinitialize();
}

=head2 setup_components( I<args> )

Overrides the Catalyst->setup_components() method to load
native classes where any subclasses are missing. Analogous to
overriding .tt files by placing yours further up in the include path.

=cut

sub setup_components {
    my $class = shift;
    $class->make_components;
    $class->next::method(@_);

    # fill in any missing
    for my $component ( sort keys %base_components ) {
        my $base_component = $base_components{$component};
        next if exists $class->components->{$base_component};
        $class->components->{$base_component}
            = $class->setup_component($base_component);
    }

}

1;

__END__



-- 
Peter Karman  .  peter at peknet.com  .  http://peknet.com/


_______________________________________________
List: Catalyst at lists.scsys.co.uk
Listinfo: http://lists.scsys.co.uk/cgi-bin/mailman/listinfo/catalyst
Searchable archive: http://www.mail-archive.com/catalyst@lists.rawmode.org/
Dev site: http://dev.catalyst.perl.org/