view release on metacpan or  search on metacpan

lib/Dancer2/Plugin/OpenAPIRoutes.pm  view on Meta::CPAN

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};