Path::Router::Route - An object to represent a route

package Path::Router::Route;
use Moose;

our $VERSION   = '0.10';
our $AUTHORITY = 'cpan:STEVAN';

use Path::Router::Types;

with 'MooseX::Clone';

has 'path'  => (
    is       => 'ro',
    isa      => 'Str',
    required => 1
);

has 'defaults' => (
    traits    => [ 'Copy' ],
    is        => 'ro',
    isa       => 'HashRef',
    default   => sub { {} },
    predicate => {
        'has_defaults' => sub {
            scalar keys %{(shift)->{defaults}}
        }
    }
);

has 'validations' => (
    traits    => [ 'Copy' ],
    is        => 'ro',
    isa       => 'Path::Router::Route::ValidationMap',
    coerce    => 1,
    default   => sub { {} },
    predicate => {
        'has_validations' => sub {
            scalar keys %{(shift)->{validations}}
        }
    }
);

has 'components' => (
    traits  => [ 'NoClone' ],
    is      => 'ro',
    isa     => 'ArrayRef[Str]',
    lazy    => 1,
    default => sub { [ grep {$_} split '/' => (shift)->path ] }
);

has 'length' => (
    traits  => [ 'NoClone' ],
    is      => 'ro',
    isa     => 'Int',
    lazy    => 1,
    default => sub { scalar @{(shift)->components} },
);

has 'length_without_optionals' => (
    traits  => [ 'NoClone' ],
    is      => 'ro',
    isa     => 'Int',
    lazy    => 1,
    default => sub {
        scalar grep { ! $_[0]->is_component_optional($_) }
            @{ $_[0]->components }
    },
);

has 'required_variable_component_names' => (
    traits     => [ 'NoClone' ],
    is         => 'ro',
    isa        => 'ArrayRef[Str]',
    lazy_build => 1,
);

has 'optional_variable_component_names' => (
    traits     => [ 'NoClone' ],
    is         => 'ro',
    isa        => 'ArrayRef[Str]',
    lazy_build => 1,
);

has 'target' => (
    # let this just get copied, we
    # assume cloning of this is not
    # what you would want
    is        => 'ro',
    isa       => 'Any',
    predicate => 'has_target'
);

sub _build_required_variable_component_names {
    my $self = shift;
    return [
        map { $self->get_component_name($_) }
        grep {
            $self->is_component_variable($_) &&
            ! $self->is_component_optional($_)
        }
        @{ $self->components }
    ];
}

sub _build_optional_variable_component_names {
    my $self = shift;
    return [
        map { $self->get_component_name($_) }
        grep {
            $self->is_component_variable($_) &&
            $self->is_component_optional($_)
        }
        @{ $self->components }
    ];
}

# misc

sub create_default_mapping {
    my $self = shift;
    +{ %{$self->defaults} }
}

sub has_validation_for {
    my ($self, $name) = @_;
    $self->validations->{$name};
}

# component checking

sub is_component_optional {
    my ($self, $component) = @_;
    $component =~ /^\?\:/;
}

sub is_component_variable {
    my ($self, $component) = @_;
    $component =~ /^\??\:/;
}

sub get_component_name {
    my ($self, $component) = @_;
    my ($name) = ($component =~ /^\??\:(.*)$/);
    return $name;
}

sub match {
    my ($self, $parts) = @_;

    return unless (
        @$parts >= $self->length_without_optionals &&
        @$parts <= $self->length
    );

    my @parts = @$parts; # for shifting

    my $mapping = $self->has_defaults ? $self->create_default_mapping : {};

    for my $c (@{ $self->components }) {
        unless (@parts) {
            die "should never get here: " .
                "no \@parts left, but more required components remain"
                if ! $self->is_component_optional($c);
            last;
        }
        my $part = shift @parts;

        if ($self->is_component_variable($c)) {
            my $name = $self->get_component_name($c);
            if (my $v = $self->has_validation_for($name)) {
                return unless $v->check($part);
            }
            $mapping->{$name} = $part;
        } else {
            return unless $c eq $part;
        }
    }

    return Path::Router::Route::Match->new(
        path    => join ('/', @$parts),
        route   => $self,
        mapping => $mapping,
    );
}

sub generate_match_code {
    my $self = shift;
    my $pos = shift;
    my @regexp;
    my @variables;

    foreach my $c (@{$self->components}) {
        my $re;
        if ($self->is_component_variable($c)) {
            $re = "([^\\/]+)";
            push @variables, $self->get_component_name($c);
        } else {
            $re = $c;
            $re =~ s/([()])/\\$1/g;
        }
        $re = "\\/$re";
        if ($self->is_component_optional($c)) {
            $re = "(?:$re)?";
        }

        push @regexp, $re;
    }

    $regexp[0] = '' unless defined $regexp[0];

    $regexp[0] =~ s/^\\\///;
    my $regexp = '';
    while (my $piece = pop @regexp) {
        $regexp = "(?:$piece$regexp)";
    }

    my $code = "#line " . __LINE__ . ' "' . __FILE__ . "\"\n" .
        "print STDERR \"Attempting to match " . $self->path . " against \$path\\n\" if Path::Router::DEBUG();\n" .
        "print STDERR \"   regexp is $regexp\\n\" if Path::Router::DEBUG();\n" .
        "if (\$path =~ /^$regexp\$/) {\n" .
        "    # " . $self->path . "\n"
    ;
    if (@variables) {
        $code .= "    my %captures = (\n";
        foreach my $i (0..$#variables) {
            my $name = $variables[$i];
            $name =~ s/'/\\'/g;
            $code .= "        '$name' => \$" . ($i + 1) . " || '',\n";
        }
        $code .= "    );\n";
    }
    $code .=
        "    my \$route = \$routes->[$pos];\n" .
        "    my \$valid = 1;\n"
    ;
    ;
    if ($self->has_defaults) {
        $code .=
            "    my \$mapping = \$route->create_default_mapping;\n";
        ;
    } else {
        $code .=
            "    my \$mapping =  {};\n"
        ;
    }

    if (@variables) {
        $code .=
            "    my \$validations = \$route->validations;\n" .
            "    while(my(\$key, \$value) = each \%captures) {\n" .
            "        next unless defined \$value && length \$value;\n"
        ;

        my $if = "if";
        foreach my $v (@variables) {
            if ($self->has_validation_for($v)) {
                $code .=
                    "        $if (\$key eq '$v') {\n" .
                    "            my \$v = \$validations->{$v};\n" .
                    "            if (! \$v->check(\$value)) {\n" .
                    "                print STDERR \"$v failed validation\\n\" if Path::Router::DEBUG;\n" .
                    "                \$valid = 0;\n" .
                    "            }\n" .
                    "        }\n"
                ;
                $if = "elsif";
            }
        }

        $code .=
            "        \$mapping->{\$key} = \$value;\n" .
            "    }\n"
        ;
    }
    $code .=
        "    if (\$valid) {\n" .
        "        print STDERR \"match success\\n\" if Path::Router::DEBUG();\n" .
        "        return bless({\n" .
        "            path => \$path,\n" .
        "            route => \$route,\n" .
        "            mapping => \$mapping,\n" .
        "        }, 'Path::Router::Route::Match');\n" .
        "    }\n" .
        "}\n"
    ;

    return $code;
}

__PACKAGE__->meta->make_immutable;

no Moose; 1

__END__