# Copyright (c) 2025 Yuki Kimoto
# MIT License
class Mojolicious::Routes::Pattern {
use Mojolicious::Types;
# Fields
has unparsed : rw string;
has defaults : rw Hash;
has regex : rw Regex;
has placeholder_start : rw string;
has relaxed_start : rw string;
has wildcard_start : rw string;
has quote_start : rw string;
has quote_end : rw string;
has placeholders : rw string[];
# Undocumented Fields
has tree : List of string[];
has regex_string : string;
# Class Methods
static method new : Mojolicious::Routes::Pattern ($pattern : string = undef) {
my $self = new Mojolicious::Routes::Pattern;
$self->{placeholder_start} = ":";
$self->{relaxed_start} = "#";
$self->{wildcard_start} = "*";
$self->{quote_end} = ">";
$self->{quote_start} = "<";
$self->{placeholders} = new string[0];
$self->{defaults} = Hash->new;
$self->{tree} = List->new(new string[][0]);
if ($pattern) {
$self->parse($pattern);
}
return $self;
}
# Instance Methods
method match : Hash ($path : string) {
my $path = copy $path;
my $captures = $self->match_partial((mutable string)$path);
return !length $path || $path eq "/" ? $captures : undef;
}
method match_partial : Hash ($path : mutable string) {
# Compile on demand
unless ($self->{regex}) {
$self->_compile;
}
my $captures_length = 0;
my $match_start = -1;
my $match_length = -1;
my $captures = (StringList)undef;
if (my $m = $self->regex->match($path)) {
$captures_length = $m->captures_length;
$match_start = $m->match_start;
$match_length = $m->match_length;
$captures = StringList->new;
for (my $i = 0; $i < $captures_length; $i++) {
$captures->push($m->captures->[$i]);
}
}
else {
return undef;
}
my $new_path = Fn->substr($path, $match_start + $match_length);
set_length($path, length $new_path);
Fn->memcpy($path, 0, $new_path, 0, length $new_path);
my $captures_h = Hash->new($self->defaults->to_options);
for my $placeholder (@{$self->placeholders}) {
unless ($captures->length) {
last;
}
my $capture = $captures->shift;
if (length $capture) {
$captures_h->{$placeholder} = $capture;
}
}
return $captures_h;
}
method parse : void ($pattern : string) {
unless (length $pattern) {
$pattern = "/";
}
$pattern = copy $pattern;
Re->s((mutable string)$pattern, ["^/*|/+", "g"], "/");
if ($pattern eq "/") {
return;
}
Re->s((mutable string)$pattern, "/$", "");
$self->_tokenize($pattern);
}
private method _compile : void () {
my $defaults = $self->defaults;
my $block = my $regex = "";
my $optional = 1;
my $tree = $self->{tree};
for (my $i = @$tree - 1; $i >= 0; $i--) {
my $token = $tree->[$i];
my $op = $token->[0];
my $value = $token->[1];
my $type = $token->[2];
my $part = "";
# Text
if ($op eq "text") {
$part = "\Q$value\E";
$optional = 0;
}
# Slash
elsif ($op eq "slash") {
$regex = ($optional ? "(?:/$block)?" : "/$block") . $regex;
$block = "";
$optional = 1;
next;
}
# Placeholder
else {
my $name = $value;
$part = $type ? $type eq "relaxed" ? "([^/]+)" : "(.+)" : "([^/.]+)";
# Optional placeholder
if ($defaults->exists($name)) {
$part .= "?";
}
else {
$optional = 0;
}
}
$block = $part . $block;
}
# Not rooted with a slash
if ($block) {
$regex = $block . $regex;
}
$regex = "^$regex";
$self->{regex_string} = $regex;
$self->set_regex(Regex->new($regex, "s"));
}
private method _tokenize : void ($pattern : string) {
my $placeholders = StringList->new_ref($self->placeholders);
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 of string[])List->new(new string[][0]);
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->push(["placeholder", "", undef]);
}
}
elsif ($char eq $quote_end) {
$spec = $more = 0;
}
# Placeholder
elsif (!$more && $char eq $start) {
unless ($spec++) {
$tree->push(["placeholder", "", undef]);
}
}
# Relaxed or wildcard (upgrade when quoted)
elsif (!$more && ($char eq $relaxed || $char eq $wildcard)) {
unless ($spec++) {
$tree->push(["placeholder", "", undef]);
}
$tree->[-1][2] = $char eq $relaxed ? "relaxed" : "wildcard";
}
# Slash
elsif ($char eq "/") {
$tree->push(["slash", undef, undef]);
$spec = $more = 0;
}
# Placeholder
elsif ($spec && ++$more) {
$tree->[-1][1] .= $char;
}
# Text (optimize slash+text and *+text+slash+text)
elsif ($tree->[-1][0] eq "text") {
$tree->[-1][1] .= $char;
}
elsif (@$tree == 1 && $tree->[-1][0] eq "slash") {
$tree = (List of string[])List->new([["text", "/$char", undef]]);
}
elsif (@$tree >= 2 && $tree->[-2][0] eq "text" && $tree->[-1][0] eq "slash") {
$tree->pop;
$tree->[-1][1] .= "/$char";
}
else {
$tree->push(["text", $char, undef]);
}
}
# Placeholder types
for (my $i = @$tree - 1; $i >= 0; $i--) {
my $token = $tree->[$i];
unless ($token->[0] eq "placeholder") {
next;
}
$placeholders->unshift($token->[1]);
}
$self->set_unparsed($pattern);
$self->{tree} = $tree;
}
}