# Copyright (c) 2025 Yuki Kimoto
# MIT License
class Mojolicious::Routes::Pattern {
use Mojolicious::Types;
# Fields
has defaults : rw Hash;
has constraints : rw Hash;
has types : rw Hash;
has placeholder_start : rw string
get {
unless (exists $self->{placeholder_start}) {
$self->{placeholder_start} = ":";
}
return $self->{placeholder_start};
}
;
has type_start : rw string
get {
unless (exists $self->{type_start}) {
$self->{type_start} = ":";
}
return $self->{type_start};
}
;
has placeholders : rw string[];
has tree : rw object[];
has quote_end : rw string
get {
unless (exists $self->{quote_end}) {
$self->{quote_end} = ">";
}
return $self->{quote_end};
}
;
has quote_start : rw string
get {
unless (exists $self->{quote_start}) {
$self->{quote_start} = "<";
}
return $self->{quote_start};
}
;
has regex : rw Regex;
has unparsed : rw string;
has relaxed_start : rw string
get {
unless (exists $self->{relaxed_start}) {
$self->{relaxed_start} = "#";
}
return $self->{relaxed_start};
}
;
has wildcard_start : rw string
get {
unless (exists $self->{wildcard_start}) {
$self->{wildcard_start} = "#";
}
return $self->{wildcard_start};
}
;
# Class Methods
static method new : Mojolicious::Routes::Pattern ($args : object...) {
my $self = new Mojolicious::Routes::Pattern;
if (@$args) {
$self->parse($args);
}
return $self;
}
private static method _compile_req : string ($req : string|string[]) {
if ($req isa string) {
return "(" . (string)$req . ")";
}
my $reqs = Array->copy_string_address((string[])$req);
Sort->sort_string_desc($reqs);
for (my $i = 0; $i < @$reqs; $i++) {
$reqs->[$i] = "\Q" . $reqs->[$i] . "\E";
}
return "(" . Fn->join("|", $reqs) . ")";
}
private static method _compile_format : string ($format : string|string[], $has_default : int) {
# No regex
unless ($format) {
return "";
}
# Default regex
if ($format isa string && (string)$format eq "1") {
return "/?(?:\.([^/]+))?$" ;
}
# Compile custom regex
my $regex = "\." . &_compile_req($format);
return $has_default ? "/?(?:$regex)?\$" : "/?$regex\$";
}
# Instance Methods
method match : Hash ($path : string, $detect : int = 0) {
my $captures = $self->match_partial(my $_ = [$path], $detect);
$path = $_->[0];
return !$path || $path eq "/" ? $captures : undef;
}
method match_partial : Hash ($pathref : string[], $detect : int = 0) {
# Compile on demand
unless ($self->{regex}) {
$self->_compile($detect);
}
my $captures_length = 0;
my $match_start = -1;
my $match_length = -1;
my $captures_list = (StringList)undef;
if (my $m = $self->regex->match($pathref->[0])) {
$captures_length = $m->captures_length;
$match_start = $m->match_start;
$match_length = $m->match_length;
$captures_list = StringList->new;
for (my $i = 0; $i < $captures_length; $i++) {
$captures_list->push($m->captures->[$i]);
}
}
unless ($captures_length) {
return undef;
}
$pathref->[0] = Fn->substr($pathref->[0], $match_start, $match_length);
my $captures_h = Hash->new($self->defaults->to_array);
my $placeholders = StringList->new($self->placeholders);
$placeholders->push("format");
for my $placeholder (@{$placeholders->get_array}) {
unless ($captures_list->length) {
last;
}
my $capture = $captures_list->shift;
if ($capture) {
$captures_h->set($placeholder, $capture);
}
}
return $captures_h;
}
method parse : void ($args : object...) {
my $args_list = List->new($args);
my $pattern = (mutable string)copy($args_list->length % 2 ? ($args_list->shift->(string) // "/") : "/");
Re->s($pattern, ["^/*|/+", "g"], "/");
if ($pattern eq "/") {
$self->set_constraints(Hash->new((object[])$args_list->get(0))) ;
return;
}
Re->s($pattern, "!/$", "");
$self->set_constraints(Hash->new((object[])$args_list->get(0)));
$self->_tokenize($pattern);
}
private method _compile : void ($detect : int) {
my $constraints = $self->constraints;
my $types = $self->types;
my $defaults = $self->defaults;
my $block = my $regex = "";
my $optional = 1;
my $tree_list = (List of object[])List->new_ref($self->{tree});
for (my $i = $tree_list->length - 1; $i >= 0; $i--) {
my $token = (object[])$tree_list->get($i);
my $op = (string)$token->[0];
my $value = $token->[1];
my $type = (string)$token->[2];
my $part = "";
# Text
if ($op eq "text") {
$part = "\Q" . (string)$value . "\E";
$optional = 0;
}
# Slash
elsif ($op eq "slash") {
$regex = ($optional ? "(?:/$block)?" : "/$block") . $regex;
$block = "";
$optional = 1;
next;
}
# Placeholder
else {
my $value = (string[])$value;
if (@$value > 1) {
$part = &_compile_req($types->get($value->[1]) // "?!");
}
else {
$part = $type ? $type eq "relaxed" ? "([^/]+)" : "(.+)" : "([^/.]+)";
}
# Custom regex
if (my $c = $constraints->get($value->[0])) { $part = &_compile_req($c); }
# Optional placeholder
if ($defaults->exists($value->[0])) {
$part .= "?";
}
else {
$optional = 0;
}
}
$block = $part . $block;
}
# Not rooted with a slash
if ($block) {
$regex = $block . $regex;
}
# Format
if ($detect) {
$regex .= &_compile_format($constraints->get("format"), $defaults->exists("format")) ;
}
$self->set_regex(Regex->new($regex));
}
method _tokenize : void ($pattern : string) {
my $placeholders = StringList->new_ref($self->placeholders);
my $type_start = $self->type_start;
my $quote_end = $self->quote_end;
my $quote_start = $self->quote_start;
my $start = $self->placeholder_start;
my $relaxed = $self->relaxed_start;
my $wildcard = $self->wildcard_start;
my $tree_list = List->new;
my $spec = 0;
my $more = 0;
for (my $i = 0; $i < length $pattern; $i++) {
my $char = Fn->substr($pattern, $i, 1);
# Quoted
if ($char eq $quote_start) {
if (++$spec) {
$tree_list->push([(object)"placeholder", "", undef]);
}
}
elsif ($char eq $quote_end) { $spec = $more = 0; }
# Placeholder
elsif (!$more && $char eq $start) {
unless ($spec++) {
$tree_list->push([(object)"placeholder", "", undef]);
}
}
# Relaxed or wildcard (upgrade when quoted)
elsif (!$more && ($char eq $relaxed || $char eq $wildcard)) {
unless ($spec++) {
$tree_list->push([(object)"placeholder", "", undef]);
}
$tree_list->get($tree_list->length - 1)->(object[])->[2] = $char eq $relaxed ? "relaxed" : "wildcard";
}
# Slash
elsif ($char eq "/") {
$tree_list->push([(object)"slash", undef, undef]);
$spec = $more = 0;
}
# Placeholder
elsif ($spec && ++$more) {
my $_ = $tree_list->get($tree_list->length - 1)->(object[])->[1]->(string);
$tree_list->get($tree_list->length - 1)->(object[])->[1] = $_ . $char;
}
# Text (optimize slash+text and *+text+slash+text)
elsif ($tree_list->get($tree_list->length - 1)->(object[])->[0]->(string) eq "text") {
my $token = $tree_list->get($tree_list->length - 1)->(object[]);
my $_ = $token->[@$token - 1]->(string);
$token->[@$token - 1] = $_ . $char;
}
elsif (!$tree_list->get($tree_list->length - 2) && $tree_list->get($tree_list->length - 1)->(object[])->[0]->(string) eq "slash") {
$tree_list = List->new(["text", "/$char"]);
}
elsif ($tree_list->get($tree_list->length - 2) && $tree_list->get($tree_list->length - 2)->(object[])->[0]->(string) eq "text" && $tree_list->get($tree_list->length - 1)->(object[])->[0]->(string) eq "slash") {
if ($tree_list->length) {
$tree_list->pop;
my $_ = $tree_list->get($tree_list->length - 1)->(object[])->[$tree_list->length]->(string);
my $token = $tree_list->get($tree_list->length - 1)->(object[]);
$token->[@$token - 1] = "$_/$char";
}
}
else {
$tree_list->push([(object)"text", $char, undef]);
}
}
# Placeholder types
for (my $i = $tree_list->length - 1; $i >= 0; $i--) {
my $token = (object[])$tree_list->get($i);
unless ($token->[0]->(string) eq "placeholder") {
next;
}
if (my $m = Re->m((string)$token->[1], "^(.+)\Q$type_start\E(.+)$")) {
$token->[1] = [(object)$m->cap1, $m->cap2, undef];
}
else {
$token->[1] = [(object)$token->[1], undef, undef];
}
$placeholders->unshift($token->[1]->(object[])->[0]->(string));
}
$self->set_unparsed($pattern);
$self->set_tree($tree_list->get_array);
}
method render : string ($values : Hash, $endpoint : int) {
# Placeholders can only be optional without a format
my $optional = !(my $format = $values->{"format"}->(string));
my $str = "";
my $tree_list = (List of object[])List->new_ref($self->tree);
for (my $i = $tree_list->length - 1; $i >= 0; $i--) {
my $token = (object[])$tree_list->get($i);
my $op = (string)$token->[0];
my $value = $token->[1];
my $part = "";
# Text
if ($op eq "text") {
$part = (string)$value;
$optional = 0;
}
# Slash
elsif ($op eq "slash") {
unless ($optional) {
$part = "/";
}
}
# Placeholder
else {
my $name = $value->(object[])->[0]->(string);
my $default = $self->defaults->{$name}->(string);
$part = $values->{$name}->(string) // $default // "";
if (!$default || ($default ne $part)) { $optional = 0; }
elsif ($optional) { $part = ""; }
}
$str = $part . $str;
}
# Format can be optional
return $endpoint && $format ? "$str.$format" : $str;
}
}