lib/CatalystX/UriFor/Curried.pm

   1 package CatalystX::UriFor::Curried;
   2 use MooseX::Role::Parameterized;
   3 use Moose::Autobox;
   4 use MooseX::Types::Moose qw/ Str ArrayRef /;
   5 use Scalar::Util qw/ weaken /;
   6 use namespace::autoclean;
   7
   8 parameter method_name => (
   9     isa => Str,
  10     required => 1,
  11 );
  12
  13 parameter stash_captures => (
  14     isa => ArrayRef[Str],
  15     required => 1,
  16 );
  17
  18 role {
  19     my $p = shift;
  20
  21     my $method_name = $p->method_name;
  22     my $stash_captures => $p->stash_captures;
  23
  24     method $method_name => sub {
  25         my ($ctx, $action_or_private_path, $captures, @args)  = @_;
  26         my $weak_ctx = $ctx; # Just for safety so it can't be closed over.
  27         weaken($weak_ctx);
  28         my $params = ref($args[-1]) eq 'HASH' ? pop(@args) : {};
  29         if (ref($captures) eq 'ARRAY' || (!$captures && !scalar(@args))) { # FIXME BUG IN THIS LOGIC
  30             $captures ||= [];
  31             foreach my $name_or_sub ($stash_captures->flatten) {
  32                 unshift(@$captures, ref($name_or_sub) eq 'CODE' ? $name_or_sub->($weak_ctx) : $ctx->stash->{$name_or_sub});
  33             }
  34             $ctx->uri_for_action($action_or_private_path, $captures, @args, $params);
  35         }
  36     };
  37
  38 };
  39
  40 1;
  41
  42 =head1 NAME
  43
  44 CatalystX::UriFor::Curried -
  45
  46 =head1 DESCRIPTION
  47
  48 =head1 METHODS
  49
  50 =head1 BUGS
  51
  52 =head1 AUTHOR
  53
  54 =head1 COPYRIGHT & LICENSE
  55
  56 Copyright 2009 the above author(s).
  57
  58 This sofware is free software, and is licensed under the same terms as perl itself.
  59
  60 =cut
  61