File Coverage

lib/Dancer2/Plugin/OpenAPIRoutes.pm

Criterion	Covered	Total	%
statement	35	223	15.7
branch	1	96	1.0
condition	0	42	0.0
subroutine	12	22	54.5
pod	0	1	0.0
total	48	384	12.5

package Dancer2::Plugin::OpenAPIRoutes;

use strict;
use warnings;

# ABSTRACT: A Dancer2 plugin for creating routes from a Swagger2 spec
our $VERSION = '0.03';                     # VERSION
use File::Spec;
use Dancer2::Plugin;
use Module::Load;
use Carp;
use JSON ();
use JSON::Pointer;
use YAML::XS;
use Data::Walk;

our $ValidationCompiler; ## no critic (Variables::ProhibitPackageVars)

BEGIN {
    no strict 'refs';
    if (%{"JSV::Compiler::"}) {
        $ValidationCompiler = JSV::Compiler->new;
    }
}

sub _path2mod {
    ## no critic (BuiltinFunctions::ProhibitComplexMappings)
    map {s/[\W_]([[:lower:]])/\u$1/g; ucfirst} @_;
}

# this complex function makes routes to module::function mapping
sub _build_path_map {
    my $schema = $_[0];
    my $paths  = $schema->{paths};
    #<<<
    my @paths =
      map {
        my $p  = $_;
        my $ps = $_;
        $p =~ s!/\{[^{}]+\}!!g;
        (
            $p,
            [
                map { +{ method => $_, pspec => $ps } }
                  grep { !/^x-/ }
                  keys %{ $paths->{$_} }
            ]
          )
      }
      sort {    ## no critic (BuiltinFunctions::RequireSimpleSortBlock)
        my @a = split m{/}, $a;
        my @b = split m{/}, $b;
        @b <=> @a;
      }
      grep { !/^x-/ && 'HASH' eq ref $paths->{$_} }
      keys %{$paths};
    #>>>
    my %paths;
    ## no critic (ControlStructures::ProhibitCStyleForLoops)
    for (my $i = 0; $i < @paths; $i += 2) {
        my $p  = $paths[$i];
        my $ma = $paths[$i + 1];
        my $m;
        my $mn = @$ma;
        if ($mn == 1 && !exists $paths{$p}) {
            my @p = split m{/}, $p;
            if (@p > 2) {
                $m = pop @p;
            }
            $p = join "/", @p;
        }
        if ($m) {
            push @{$paths{$p}}, $m;
            my $ps     = $ma->[0]{pspec};
            my $method = $ma->[0]{method};
            $paths->{$ps}{$method}{'x-path-map'} = {
                module_path => $p,
                func        => $m
            };
        } else {
            for (@$ma) {
                my $ps     = $_->{pspec};
                my $method = $_->{method};
                push @{$paths{$p}}, $method;
                $paths->{$ps}{$method}{'x-path-map'} = {
                    module_path => $p,
                    func        => $method
                };

            }
        }
    }
    return \%paths;
}

my %http_methods_func_map_orig = (
    get     => 'fetch',
    post    => 'create',
    patch   => 'update',
    put     => 'replace',
    delete  => 'remove',
    options => 'choices',
    head    => 'check'
);

my %http_methods_func_map;

sub _path_to_fqfn {
    my ($config, $schema, $path_spec, $method) = @_;
    my $paths = $schema->{paths};
    my $module_name;
    my $func = $paths->{$path_spec}{$method}{'x-path-map'}{func};
    my @pwsr = split m{/}, $paths->{$path_spec}{$method}{'x-path-map'}{module_path};
    $module_name = join "::", map {_path2mod $_ } @pwsr;
    if ($http_methods_func_map{"$method:$path_spec"}) {
        my ($mf, $mm) = split /:/, $http_methods_func_map{"$method:$path_spec"}, 2;
        $func        = $mf if $mf;
        $module_name = $mm if $mm;
    }
    if ($module_name eq '') {
        $module_name = $config->{default_module} || $config->{appname};
    } else {
        $module_name = $config->{namespace} . $module_name;
    }
    my $rfunc = $http_methods_func_map{$func} ? $http_methods_func_map{$func} : $func;
    if ($rfunc eq 'create' && $func eq 'post' && $path_spec =~ m{/\{[^/{}]*\}$}) {
        $rfunc = 'update';
    }
    $rfunc =~ s/\W+/_/g;
    return ($module_name, $rfunc);
}

sub load_schema {
    my $config = shift;
    croak "Need schema file" if not $config->{schema};
    my $schema;
    my $file = File::Spec->catfile($config->{app}->location, $config->{schema});
    if ($config->{schema} =~ /\.json/i) {
        require Path::Tiny;
        $schema = JSON::from_json(path($file)->slurp_utf8);
    } elsif ($config->{schema} =~ /\.yaml/i) {
        $schema = YAML::XS::LoadFile $file;
    }
    if ($schema && 'HASH' eq ref $schema) {
        walkdepth + {
            wanted => sub {
                if (   "HASH" eq ref $_
                    && exists $_->{'$ref'}
                    && !ref $_->{'$ref'}
                    && keys %$_ == 1)
                {
                    (my $r = $_->{'$ref'}) =~ s/^#//;
                    my $rp = JSON::Pointer->get($schema, $r);
                    if ('HASH' eq ref $rp) {
                        %$_ = %$rp;
                    } else {
                        croak "Can't load schema part: " . YAML::XS::Dump($_);
                    }
                }
            }
        }, $schema;
    }
    return $schema;
}

sub _make_handler_params {    ## no critic (Subroutines::ProhibitExcessComplexity)
    my ($mpath, $parameters) = @_;
    my $param_eval = '';
    my %schema;
    for my $parameter_spec (@$parameters) {
        next if $parameter_spec =~ /^x-/;
        my $in       = $parameter_spec->{in};
        my $name     = $parameter_spec->{name};
        my $required = $parameter_spec->{required};
        my $req_code = "push \@\$errors, \"required parameter '$name' is absent\" if not exists \$input->{\"$name\"};\n ";
        my $src;
        ## no critic (ControlStructures::ProhibitCascadingIfElse)
        if ($in eq 'body') {
            $req_code
                = $required && !$ValidationCompiler
                ? "push \@\$errors, \"required parameter '$name' is absent\""
                . " if not ref \$input->{\"$name\"} or not keys %{\$input->{\"$name\"}};"
                : '';
              #<<<
            $param_eval .=
                "{ my \$value;\n"
              . "  if (\$app->request->header(\"Content-Type\")\n"
              . "    && \$app->request->header(\"Content-Type\") =~ m{application/json}) {\n"
              . "    \$value = JSON::decode_json (\$app->request->body)\n } else {\n"
              . "    \$value = \$app->request->body }\n"
              . "  \$input->{\"$name\"} = \$value if defined \$value; $req_code"
              . "}\n";
              #>>>
            $req_code = '';
        } elsif ($in eq 'header') {
            $param_eval .= "\$input->{\"$name\"} = \$app->request->header(\"$name\");\n";
        } elsif ($in eq 'query') {
            $src = "\$app->request->params('query')";
        } elsif ($in eq 'path') {
            if ($parameter_spec->{type} && $parameter_spec->{type} eq 'integer') {
                $mpath =~ s/:$name\b/\\E(?<$name>\\d+)\\Q/;
                $src = "\$app->request->captures";
            } else {
                $src = "\$app->request->params('route')";
            }
        } elsif ($in eq 'formData') {
            if ($parameter_spec->{type} && $parameter_spec->{type} eq 'file') {
                $param_eval .= "\$input->{\"$name\"} = \$app->request->upload(\"$name\");\n";
            } else {
                $src = "\$app->request->params('body')";
            }
        }
        if ($src) {
            $param_eval .= "{ my \$src = $src; \$input->{\"$name\"} = \$src->{\"$name\"} if 'HASH' eq ref \$src; }\n";
        }
        if ($ValidationCompiler) {
            $schema{properties}{$name} = $parameter_spec;
            if ($schema{properties}{$name}{type} && $schema{properties}{$name}{type} eq 'file') {
                $schema{properties}{$name}{type}   = 'string';
                $schema{properties}{$name}{format} = 'binary';
            }
            push @{$schema{required}}, $name if $required;
        } else {
            $param_eval .= $req_code if $required;
        }
    }
    if ($ValidationCompiler) {
        $ValidationCompiler->load_schema(\%schema);
        $param_eval .= $ValidationCompiler->compile(input_symbole => '$input', is_required => 0);
    }
    $param_eval
        .= "if(\@\$errors) { \$dsl->status('unprocessable_entity'); \$res = { error => join \"; \", \@\$errors }; }\n";
    if ($mpath =~ /\(\?
        $mpath = "\\Q$mpath\\E";
        $mpath =~ s/\\Q(.*?)\\E/quotemeta($1)/eg;
        $mpath = qr|$mpath|;
    }
    return ($mpath, $param_eval);
}

sub _path_compare {
    my $ssc = sub {
        length($_[1]) >= length($_[0])
            && substr($_[1], 0, 1 + length $_[0]) eq "$_[0]/";
    };
    return 0 if $a eq $b;
    if ($ssc->($a, $b)) {
        return 1;
    }
    if ($ssc->($b, $a)) {
        return -1;
    }
    return $a cmp $b;
}

register OpenAPIRoutes => sub {
    my ($dsl, $debug, $custom_map) = @_;
    my $json = JSON->new->utf8->allow_blessed->convert_blessed;
    my $app  = $dsl->app;
    local $SIG{__DIE__} = sub {Carp::confess(@_)};
    my $config = plugin_setting;
    $config->{app}     = $app;
    $config->{appname} = $dsl->config->{appname};
    my $schema = load_schema($config);
    my $paths  = $schema->{paths};
    _build_path_map($schema);
    %http_methods_func_map = %http_methods_func_map_orig;

    if ($custom_map && 'HASH' eq ref $custom_map) {
        my @cmk = keys %$custom_map;
        @http_methods_func_map{@cmk} = @{$custom_map}{@cmk};
    }
    for my $path_spec (sort _path_compare keys %$paths) {
        next if $path_spec =~ /^x-/;
        my $path = $path_spec;
        $path =~ s/\{([^{}]+?)\}/:$1/g;
        for my $method (sort keys %{$paths->{$path_spec}}) {
            next if $method =~ /^x-/;
            my ($module_name, $module_func) = _path_to_fqfn($config, $schema, $path_spec, $method);
            my @parameters;
            if ($paths->{$path_spec}{$method}{parameters}) {
                @parameters = @{$paths->{$path_spec}{$method}{parameters}};
            }
            my ($mpath, $param_eval) = _make_handler_params($path, \@parameters);
            my $dancer_method = $method eq 'delete' ? 'del' : $method;
            my $get_env = '';
            for (grep {/^x-env-/} keys %{$paths->{$path_spec}{$method}}) {
                my $name = $paths->{$path_spec}{$method}{$_};
                my ($env_var) = /^x-env-(.+)/;
                $env_var = uc $env_var;
                $env_var =~ s/\W/_/;
                $get_env .= "\$input->{'$name'} = \$app->request->env->{'$env_var'} // '';\n";
            }
            my $prolog_code_src = <<"EOS";
            sub {
                my \$input  = {};
                my \$errors = [];
                my \$res;
                my \$status;
                my \$callback;
                $param_eval;
                $get_env;
                (\$res, \$status, \$callback) = eval {${module_name}::$module_func( \$input, \$dsl )} if not \$res;
                if(\$callback && 'CODE' eq ref \$callback) {
                    \$callback->();
                }
                my \$exception = \$\@;
                if( \$app->request->header(\"Accept\")
                    && \$app->request->header(\"Accept\") =~ m{application/json}
                    && (\$exception || ref \$res)) {
                    \$dsl->content_type("application/json");
                    if (not defined \$res) {
                        \$dsl->error(\$exception) if \$exception;
                        \$res = { error => \$exception };
                        \$res->{error} =~ s/ at .*? line \\d+\.\\n?//;
                        \$dsl->status('bad_request');
                    } else {
                        \$dsl->status(\$status) if \$status;
                    }
                    return \$json->encode(\$res);
                } else {
                    die \$exception if \$exception and not defined \$res;
                    \$dsl->status(\$status) if \$status;
                    if(!\$status && \$res && ref(\$res) && "\$res" =~ /^(HASH|ARRAY|SCALAR|CODE)\\(/ ) {
                        \$dsl->status('not_acceptable');
                        return;
                    }
                    return \$res;
                }
            }
EOS
## no critic (BuiltinFunctions::ProhibitStringyEval)
            if ($debug > 1) {
                print STDERR "$method $mpath: $prolog_code_src\n";
            }
            my $prolog_code = eval $prolog_code_src;
            if ($@) {
                my $error = $@;
                $dsl->error("$method $mpath ($error): $prolog_code_src");
                croak "Route $method $mpath cant be compiled: $error";
            }
            my $route = Dancer2::Core::Route->new(
                method => $method,
                regexp => $mpath,
                code   => $prolog_code,
                prefix => $app->prefix
            );
            if ($app->route_exists($route)) {
                croak "Route $method $mpath is already exists";
            }
            $debug && $dsl->debug("$dancer_method $path_spec -> $module_func in $module_name\n");
            my $success_load = eval {load $module_name; 1};
            croak "Can't load module $module_name for path $path_spec: $@"
                if not $success_load or $@;
            my $cref = "$module_name"->can($module_func);
            croak "Can't find function $module_func in module $module_name for path $path_spec"
                if not $cref;
            $dsl->$dancer_method($mpath => $prolog_code);
        }
    }
};

register_plugin;

1;

## no critic (Documentation::RequirePodLinksIncludeText)

__END__