view release on metacpan or  search on metacpan

lib/Data/DynamicValidator/Path.pm  view on Meta::CPAN

package Data::DynamicValidator::Path;
# ABSTRACT: Class represents "splitted" to labelled componets path.
$Data::DynamicValidator::Path::VERSION = '0.05';
use strict;
use warnings;

use Carp;
use Scalar::Util qw/looks_like_number/;

use overload fallback => 1, q/""/ => sub { $_[0]->to_string };

use constant DEBUG => $ENV{DATA_DYNAMICVALIDATOR_DEBUG} || 0;

sub new {
    my ($class, $path) = @_;
    my $self = { };
    bless $self => $class;
    $self->_build_components($path);
    return $self;
}

sub _build_components {
    my ($self, $path) = @_;

    # handle escaped path components
    $_ = $path;
    # substitute all '/'-symbols to "`" and strip
    # surrounding(wraping) ` 
    s[`(.+?)`][my $x=$1;$x=~ tr{/}{`};$x]ge;
    my @elements = split '/';
    for(@elements) {
        tr {`}{/}; # roll back slashes again
    }
    for my $i (0..@elements-1) {
        my @parts = split(':', $elements[$i]);
        if (@parts > 1) {
            $elements[$i] = $parts[1];
            $self->{_labels}->{ $parts[0] } = $i;
        }
    }
    # special name _ for the last route component
    $self->{_labels}->{'_'} = @elements-1;
    $self->{_components} = \@elements;
}

sub components { shift->{_components} }

sub to_string {
    join('/',
         map { /\// ? "`$_`" : $_ }
         @{ shift->{_components} })
}

sub labels {
    my $self = shift;
    my $labels = $self->{_labels};
    sort { $labels->{$a} <=> $labels->{$b} } grep { $_ ne '_' } keys %$labels;
}

sub named_route {
    my ($self, $label) = @_;
    croak("No label '$label' in path '$self'")
        unless exists $self->{_labels}->{$label};
    return $self->_clone_to($self->{_labels}->{$label});
}

sub named_component {
    my ($self, $label) = @_;
    croak("No label '$label' in path '$self'")
        unless exists $self->{_labels}->{$label};
    my $idx = $self->{_labels}->{$label};
    return $self->{_components}->[$idx];
}

sub _clone_to {
    my ($self, $index) = @_;
    my @components;