view release on metacpan or  search on metacpan

lib/Catalyst/ControllerRole/URI.pm  view on Meta::CPAN

use Moose::Role;
requires 'ctx';

use Scalar::Util;
use Encode 2.21 'decode_utf8';

after 'register_action_methods', sub {
  my ( $self, $app, @methods ) = @_;
  my $class = ref $self;

  my @endpoints = ();
  my @types = @{ $app->dispatcher->dispatch_types ||+[] };
  foreach my $type (@types) {  
    if(ref($type) eq 'Catalyst::DispatchType::Chained') {
      foreach my $endpoint(@{ $type->{_endpoints} || [] }) {
        if ($endpoint->class eq $class) {
          push @endpoints, [$endpoint, $self->_generate_uri_pattern($type, $endpoint)];
        }
      }
    }
  }

  my $avail_width = Catalyst::Utils::term_width() - 9;
  my $col1_width = ($avail_width * .6) < 35 ? 35 : int($avail_width * .6);
  my $col2_width = $avail_width - $col1_width;
  my $paths = Text::SimpleTable->new(
    [ $col1_width, 'uri' ], [ $col2_width, 'helper' ],
  );

  foreach my $endpoint_proto (@endpoints) {
    my $endpoint = $endpoint_proto->[0];
    my $uri = $endpoint_proto->[1];
    my $path_args = '';
    my $path_arg_count = 0;
    if(my @path_args = @{$endpoint_proto->[2]||[]}) {
      $path_arg_count = scalar(@path_args);
      $path_args = join ',', @path_args if scalar(@path_args) > 0;
      $path_args = "([$path_args])";
    }
    my $name = $endpoint->name;
    my $private_path = $endpoint->private_path; $private_path =~s/^\///; $private_path =~s/\//_/g;
    my $sub = sub {
      my $self = shift;
      my ($parts, @args) = $self->_normalize_uri_args(@_);  
      return $self->ctx->uri_for($self->action_for($name), $parts, @args);
    };
    $paths->row($uri, "${name}_uri${path_args}\n${private_path}_uri${path_args}");

    {
      no strict 'refs';
      my $controller_helper = "${class}::${name}_uri";
      *{$controller_helper} = Sub::Util::set_subname $controller_helper => $sub;
      my $app_helper = "${app}::${private_path}_uri";
      my $helper = $endpoint->private_path;
      *{$app_helper} = Sub::Util::set_subname $app_helper => sub {
        my $c = shift;
        return $c->uri_for($c->dispatcher->get_action_by_path($helper), @_);
      };
    }

  }

  $app->log->debug("URI Helpers for: $class\n" . $paths->draw . "\n");
};

sub _generate_uri_pattern {
  my ($self, $dispatcher, $endpoint) = @_;
  my $args = $endpoint->list_extra_info->{Args};

  my @parts;
  if($endpoint->has_args_constraints) {
      @parts = map { "{$_}" } $endpoint->all_args_constraints;
  } elsif(defined $endpoint->attributes->{Args}) {
      @parts = (defined($endpoint->attributes->{Args}[0]) ? (("*") x $args) : '...');
  }

  my @parents = ();
  my $parent = "DUMMY";
  my $extra  = $dispatcher->_list_extra_http_methods($endpoint);
  my $consumes = $dispatcher->_list_extra_consumes($endpoint);
  my $scheme = $dispatcher->_list_extra_scheme($endpoint);
  my $curr = $endpoint;
  while ($curr) {
      if (my $cap = $curr->list_extra_info->{CaptureArgs}) {
          if($curr->has_captures_constraints) {
              my $names = join '/', map { "{$_}" } $curr->all_captures_constraints;
              unshift(@parts, $names);
          } else {
              unshift(@parts, (("*") x $cap));
          }
      }
      if (my $pp = $curr->attributes->{PathPart}) {