CatalystX::Imports - Shortcut functions for L<Catalyst> controllers

  package MyApp::Controller::User;
  use base 'Catalyst::Controller';

  use CatalystX::Imports
      Context => { Default => [qw( :all )],
                   Config  => [{model => 'model_name'}, 'template'] },
      Vars    => { Stash   => [qw( $user $user_rs $template )],
                   Session => [qw( @shown_users )],
                   Flash   => [qw( $message )] };

  sub list: Chained {
      $user_rs = model(model_name)->search_rs;
  }

  sub load: Chained PathPart('') CaptureArgs(1) {
      $user = model(model_name)->find($args[0]);
  }

  sub view: Chained('load') {
      push @shown_users, $user->id;
      $template = template;
  }

  sub edit: Chained('load') {
      if (validate_params(request->params)) {
          $user->update(request->params);
          $message = "user updated";
      }
  }

  1;

  use CatalystX::Imports Context => ...

  my ($self, $ctx, @args) = @_;

  use CatalystX::Imports Vars => ...

  CatalystX::Imports->register_action_wrap_in($class, sub {
      my $code     = shift;
      my @wrappers = @{ shift(@_) };

      # ... put your code here ...

      if (my $wrapper = shift @wrappers) {
          return $wrapper->($code, [@wrappers], @_);
      }
      else {
          return $code->(@_);
      }
  });

package CatalystX::Imports;

use warnings;
use strict;

use vars qw(
    $VERSION
    $STORE_CONTROLLER $STORE_CONTEXT $STORE_ARGUMENTS
    $ACTION_WRAPPER_VAR
);

use Class::MOP;
use Carp::Clan        qw{ ^CatalystX::Imports(?:::|$) };
use Filter::EOF;
use Sub::Name 'subname';

$VERSION = '0.05';
$VERSION = eval $VERSION;

# names of the localized stores in the controllers
$STORE_CONTROLLER = 'CATALYSTX_IMPORTS_STORE_CONTROLLER';
$STORE_CONTEXT    = 'CATALYSTX_IMPORTS_STORE_CONTEXT';
$STORE_ARGUMENTS  = 'CATALYSTX_IMPORTS_STORE_ARGUMENTS';

# where the wrappers for action calls will be sitting
$ACTION_WRAPPER_VAR = 'CATALYSTX_IMPORTS_ACTION_WRAPPERS';

sub import {
    my ($class, @args) = @_;

    # the class that 'use'd us
    my $caller = scalar caller;

    # call install_action_wrap_into after package runtime
    Filter::EOF->on_eof_call( sub {
        my $eof = shift;
        $$eof = "; ${class}->install_action_wrap_into('${caller}'); 1;";
    });

    # call current export mechanism
    return $class->export_into($caller, @args);
}

sub register_action_wrap_in {
    my ($class, $target, $code) = @_;
    no strict 'refs';
    no warnings 'once';
    push @{ "${target}::${ACTION_WRAPPER_VAR}" }, $code;
    return 1;
}

sub install_action_wrap_into {
    my ($class, $target) = @_;

    # get all action methods of the target class (not inherited actions)
    my $meta = Class::MOP::class_of($target);
    my @actions = $meta->get_method_with_attributes_list;

    # replace every action code with a wrapper
    for my $action (@actions) {
        # the wrapper fetches controller, context and args and stores
        # them for other parts of the CX:I module
        $meta->add_around_method_modifier($action->name => sub {
            my $next = shift;
            my ($self, $c, @args) = @_;

            # fetch registered action call wrappers
            my @wrappers = do {
                no strict 'refs';
                @{ "${target}::${ACTION_WRAPPER_VAR}" };
            };

            # defines where the needed object will be stored
            my %mapping = (
                CONTROLLER => $self,
                CONTEXT    => $c,
                ARGUMENTS  => \@args,
            );

            # store the objects
            {   no strict 'refs';
                ${ "${target}::CATALYSTX_IMPORTS_STORE_${_}" }
                  = $mapping{ $_ }
                    for keys %mapping;
            }

            # call original code with original arguments
            unless (@wrappers) {
                return $next->(@_);
            }

            # delegate to wrapper
            else {
                my $wrapper = shift @wrappers;
                return $wrapper->($next, [@wrappers], @_);
            }
        });
    }

    return 1;
}

sub export_into {
    my ($class, $target, @args) = @_;

    # we need exporter => options pairs
    croak 'CatalystX::Imports expects a key/value list as argument'
        if @args % 2;
    my %exporters = @args;

    # walk the exporters list and let every one export itself
    # to the target class
    for my $exporter (keys %exporters) {
        my $exporter_class = __PACKAGE__ . "::$exporter";
        Class::MOP::load_class($exporter_class);
        $exporter_class->export_into($target, $exporters{ $exporter });
    }

    return 1;
}

sub resolve_component {
    my ($class, $controller, $c, $type, $name, $args) = @_;

    # just use the name if nothing is configured at all
    my $config = $controller->config->{component_prefix};

    # a hashref means per-type configuration
    if (ref($config) eq 'HASH') {
        $config = exists($config->{ $type })  ? $config->{ $type }
                : exists($config->{-default}) ? $config->{-default}
                : return $name;
    }

    # if the result of the above is not an arrayref, make it one
    # for convenience reasons
    unless (ref($config) eq 'ARRAY') {
        $config = [$config];
    }

    # try to find a component under that prefix and return it if found
    for my $prefix (@$config) {
        my $comp_name = join('::', grep { $_ } $prefix, $name);
        my $comp = $c->$type($comp_name, @{ $args || [] });
        return $comp if defined($comp);
    }

    # nothing found
    return;
}

1;