File Coverage

blib/lib/Mojolicious/Plugin/Util/Endpoint.pm

Criterion	Covered	Total	%
statement	110	113	97.3
branch	42	48	87.5
condition	15	22	68.1
subroutine	9	9	100.0
pod	1	1	100.0
total	177	193	91.7

package Mojolicious::Plugin::Util::Endpoint;
use Mojo::Base 'Mojolicious::Plugin';
use Mojo::ByteStream 'b';
use Scalar::Util qw/blessed/;
use Mojo::URL;

our $VERSION = '0.23';

# Todo: Support alternative bases for https-paths
# Todo: Update to https://tools.ietf.org/html/rfc6570
# Todo: Allow for changing scheme, port, host etc. afterwards

# Endpoint hash
our %endpoints;

# Register Plugin
sub register {
  my ($plugin, $mojo) = @_;

  # Add 'endpoints' command
  push @{$mojo->commands->namespaces}, __PACKAGE__;

  # Add 'endpoint' shortcut
  $mojo->routes->add_shortcut(
    endpoint => sub {
      my ($route, $name, $param) = @_;

      # Endpoint already defined
      if (exists $endpoints{$name}) {
        $mojo->log->debug(qq{Route endpoint "$name" already defined});
        return $route;
      };

      $param //= {};

      # Route defined
      $param->{route} = $route->name;

      # Set to stash
      $endpoints{$name} = $param // {};

      # Return route for piping
      return $route;
    }
  );


  # Add 'endpoint' helper
  $mojo->helper(
    endpoint => sub {
      my ($c, $name, $values) = @_;
      $values ||= {};

      # Define endpoint by string
      unless (ref $values) {
        return ($endpoints{$name} = Mojo::URL->new($values));
      }

      # Define endpoint by Mojo::URL
      elsif (blessed $values && $values->isa('Mojo::URL')) {
        return ($endpoints{$name} = $values->clone);
      };

      # Set values
      my %values = (
        $c->isa('Mojolicious::Controller') ? %{$c->stash} : %{$c->defaults},
        format => undef,
        %$values
      );

      # Endpoint undefined
      unless (defined $endpoints{$name}) {

        # Named route
        if ($name !~ m!^([^:]+:)?/?/!) {
          return $c->url_for($name)->to_abs->to_string;
        };

        # Interpolate string
        return _interpolate($name, \%values, $values);
      };

      # Return interpolated string
      if (blessed $endpoints{$name} && $endpoints{$name}->isa('Mojo::URL')) {
        return _interpolate(
          $endpoints{$name}->to_abs->to_string,
          \%values,
          $values
        );
      };

      # The following is based on url_for of Mojolicious::Controller
      # and parts of path_for in Mojolicious::Routes::Route
      # Get match object
      my $match;
      unless ($match = $c->match) {
        $match = Mojolicious::Routes::Match->new(get => '/');
        $match->root($c->app->routes);
      };

      # Base
      my $url = Mojo::URL->new;
      my $req = $c->req;
      $url->base($req->url->base->clone);
      my $base = $url->base;
      $base->userinfo(undef);

      # Get parameters
      my $param = $endpoints{$name};

      # Set parameters to url
      $url->scheme($param->{scheme}) if $param->{scheme};
      $url->port($param->{port}) if $param->{port};

      if ($param->{host}) {
        $url->host($param->{host});
        $url->port(undef) unless $param->{port};
        $url->scheme('http') unless $url->scheme;
      };

      # Clone query
      $url->query( [@{$param->{query}}] ) if $param->{query};

      # Get path
      my $path = $url->path;

      # Lookup match
      my $r = $match->root->find($param->{route});

      # Interpolate path
      my @parts;
      while ($r) {
        my $p = '';
        foreach my $part (@{$r->pattern->tree}) {
          my $t = $part->[0];

          # Slash
          if ($t eq 'slash') {
            $p .= '/';
          }

          # Text
          elsif ($t eq 'text') {
            $p .= $part->[1];
          }

          # Various wildcards
          elsif ($t =~ m/^(?:wildcard|placeholder|relaxed)$/) {
            if (exists $values{$part->[1]}) {
              $p .= $values{$part->[1]};
            }
            else {
              $p .= '{' . $part->[1] . '}';
            };
          };
        };

        # Prepend to path array
        unshift(@parts, $p);

        # Go up one level till root
        $r = $r->parent;
      };

      # Set path
      $path->parse(join('', @parts)) if @parts;

      # Fix trailing slash
      $path->trailing_slash(1)
        if (!$name || $name eq 'current')
        && $req->url->path->trailing_slash;

      # Make path absolute
      my $base_path = $base->path;
      unshift @{$path->parts}, @{$base_path->parts};
      $base_path->parts([]);

      # Interpolate url for query parameters
      return _interpolate($url->to_abs->to_string, \%values, $values);
    }
  );


  # Add 'get_endpoints' helper
  $mojo->helper(
    get_endpoints => sub {
      my $c = shift;

      # Get all endpoints
      my %endpoint_hash;
      foreach (keys %endpoints) {
        $endpoint_hash{$_} = $c->endpoint($_);
      };

      # Return endpoint hash
      return \%endpoint_hash;
    });
};


# Interpolate templates
sub _interpolate {
  my $endpoint = shift;

  # Decode escaped symbols
  $endpoint =~
    s/\%7[bB](.+?)\%7[dD]/'{' . b($1)->url_unescape . '}'/ge;

  my $param = shift;
  my $orig_param = shift;

  # Interpolate template
  pos($endpoint) = 0;
  while ($endpoint =~ /\{([^\}\?}\?]+)\??\}/g) {

    # Save search position
    # Todo: That's not exact!
    my $val = $1;
    my $p = pos($endpoint) - length($val) - 1;

    my $fill = undef;

    # Look in param
    if ($param->{$val}) {
      $fill = b($param->{$val})->url_escape;
      $endpoint =~ s/\{$val\??\}/$fill/;
    }

    # unset specific parameters
    elsif (exists $orig_param->{$val}) {

      # Delete specific parameters
      for ($endpoint) {
        if (s/(?<=[\&\?])[^\}][^=]*?=\{$val\??\}//g) {
          s/([\?\&])\&*/$1/g;
          s/\&$//g;
        };
        s/^([^\?]+?)([\/\.])\{$val\??\}\2/$1$2/g;
        s/^([^\?]+?)\{$val\??\}/$1/g;
      };
    };

    # Reset search position
    # Todo: (not exact if it was optional)
    pos($endpoint) = $p + length($fill || '');
  };

  # Ignore optional placeholders
  if (exists $param->{'?'} &&
        !defined $param->{'?'}) {
    for ($endpoint) {
      s/(?<=[\&\?])[^\}][^=]*?=\{[^\?\}]+?\?\}//g or last;
      s/([\?\&])\&*/$1/g;
      s/\&$//g;
    };
  };

  # Strip empty query marker
  $endpoint =~ s/\?$//;
  return $endpoint;
};


1;


__END__