view release on metacpan or  search on metacpan

lib/Dancer/Plugin/CRUD.pm  view on Meta::CPAN

            my $subref = delete $triggers{'prefix'};
            $options{prefixed_with_id} = 0;
            my @prefixes =
              map { $_->{prefixed_with_id} ? $_->{prefix_id} : $_->{prefix} }
              grep { exists $_->{prefix} } @$stack;
            local $" = '';
            _prefix( qr{@prefixes}, $subref );
            delete $options{prefixed_with_id};
        }

        my %routes;

        foreach my $action (qw(index create read delete update patch)) {
            next unless exists $triggers{$action};

            my $route;

            if ( $action eq 'index' ) {
                $route = qr{/\Q$resource2\E};
            }
            elsif ( $action eq 'create' ) {
                $route = qr{/\Q$resource1\E};
            }
            else {
                $route = qr{/\Q$resource1\E/(?<$resource1$SUFFIX>$idregex)};
            }

            my $sub = _generate_sub(
                {
                    stack   => $stack,
                    action  => $action,
                    coderef => $triggers{$action},
                }
            );

            $routes{$action} = [];

            if ($altsyntax) {
                push @{ $routes{$action} } => $triggers_map{get}
                  ->( qr{$route/\Q$action\E\.(?<format>json|jsonp|yml|xml|dump)}
                      => $sub );
                push @{ $routes{$action} } =>
                  $triggers_map{get}->( qr{$route/\Q$action\E} => $sub );
            }
            push @{ $routes{$action} } => $triggers_map{$action}
              ->( qr{$route\.(?<format>json|jsonp|yml|xml|dump)} => $sub );
            push @{ $routes{$action} } =>
              $triggers_map{$action}->( $route => $sub );
        }

        pop @$stack;

        return %routes;
    }
);

register(
    wrap => sub($$$) {
        my ( $action, $route, $coderef ) = @_;

        my @route = grep { defined and length } split m{/+}, $route;

        my $parent = @$stack ? $stack->[-1] : undef;
        foreach my $route (@route) {
            push @$stack => { resname => $route };
        }

        if ( defined $parent ) {
            if (    exists $parent->{validation_rules}
                and exists $parent->{validation_rules}->{wrap}
                and exists $parent->{validation_rules}->{wrap}->{$action}
                and
                exists $parent->{validation_rules}->{wrap}->{$action}->{$route}
              )
            {
                $stack->[-1]->{validation_rules} =
                  { lc($action) =>
                      $parent->{validation_rules}->{wrap}->{$action}->{$route}
                  };
            }
        }

        my $sub = _generate_sub(
            {
                action  => lc($action),
                stack   => $stack,
                coderef => $coderef,
            }
        );

        pop @$stack for @route;

        my @routes;

        push @routes => $triggers_map{ lc($action) }
          ->( qr{/\Q$route\E\.(?<format>json|jsonp|yml|xml|dump)} => $sub );
        push @routes =>
          $triggers_map{ lc($action) }->( qr{/\Q$route\E} => $sub );

        return @routes;
    }
);

register send_entity => sub {

    # entity, status_code
    status( $_[1] || 200 );
    $_[0];
};

for my $code ( keys %http_codes ) {
    my $helper_name = lc( $http_codes{$code} );
    $helper_name =~ s/[^\w]+/_/gms;
    $helper_name = "status_${helper_name}";

    register $helper_name => sub {
        if ( $code >= 400 ) {
            send_entity( { error => $_[0] }, $code );
        }
        else {
            send_entity( $_[0], $code );