File Coverage

blib/lib/Modern/OpenAPI/Generator/CodeGen/StubData.pm
Criterion Covered Total %
statement 22 22 100.0
branch n/a
condition 2 6 33.3
subroutine 7 7 100.0
pod 1 1 100.0
total 32 36 88.8


line stmt bran cond sub pod time code
1             package Modern::OpenAPI::Generator::CodeGen::StubData;
2              
3 6     6   62 use v5.26;
  6         17  
4 6     6   23 use strict;
  6         9  
  6         129  
5 6     6   19 use warnings;
  6         9  
  6         222  
6 6     6   23 use Carp qw(croak);
  6         10  
  6         1985  
7              
8             # Generated ${base}::StubData — random JSON-shaped data from OpenAPI response
9             # schemas, then ${base}::Model::*->from_json when a generated model exists.
10              
11             sub generate {
12 2     2 1 9 my ( $class, %arg ) = @_;
13 2   33     21 my $writer = $arg{writer} // croak 'writer';
14 2   33     6 my $base = $arg{base} // croak 'base';
15              
16 2         6 my $lib = 'lib/' . _pathify_dir($base);
17 2         5 my $pkg = "$base\::StubData";
18 2         9 $writer->write( "$lib/StubData.pm", _stubdata_pm( $pkg, $base ) );
19             }
20              
21             sub _pathify_dir {
22 2     2   5 my ($name) = @_;
23 2         10 $name =~ s{::}{/}g;
24 2         6 return $name;
25             }
26              
27             sub _stubdata_pm {
28 2     2   6 my ( $pkg, $base ) = @_;
29              
30             # All $ below are escaped for the generated module; ${base} is interpolated once.
31 2         45 return <<"PM";
32             package $pkg;
33              
34             use v5.26;
35             use strict;
36             use warnings;
37              
38             use Carp qw(croak);
39             use JSON::PP ();
40              
41             our \$BASE = '$base';
42              
43             sub for_operation {
44             my ( \$class, \$operation_id ) = \@_;
45             my \$raw = _load_spec();
46             my \$op = _find_operation( \$raw, \$operation_id )
47             // croak "operationId not in spec: \$operation_id";
48             my ( \$status, \$sch ) = _first_json_response_schema( \$op->{responses} // {} );
49             croak "no application/json response for \$operation_id" unless \$sch;
50             my \$hash = _random_for_schema( \$raw, \$sch );
51             my \$is_array = _top_level_array( \$sch );
52             my \$mpkg = _model_pkg_for_response( \$raw, \$sch );
53             if ( length \$mpkg ) {
54             my \$ok = eval "require \$mpkg; 1";
55             if ( \$ok && \$mpkg->can('from_json') ) {
56             my \$obj = \$mpkg->from_json( \$hash, \$is_array ? 1 : 0 );
57             return ( \$status, \$obj );
58             }
59             }
60             return ( \$status, \$hash );
61             }
62              
63             sub _load_spec {
64             state \$data;
65             return \$data if \$data;
66             my \$home = \$ENV{MOJO_HOME} // croak 'MOJO_HOME must be set when using StubData';
67             my \$path = "\$home/share/openapi.yaml";
68             croak "OpenAPI spec not found: \$path" unless -f \$path;
69             require YAML::PP;
70             \$data = YAML::PP->new( boolean => 'JSON::PP' )->load_file(\$path);
71             return \$data;
72             }
73              
74             sub _find_operation {
75             my ( \$raw, \$want ) = \@_;
76             my \$paths = \$raw->{paths} // {};
77             for my \$p ( keys %\$paths ) {
78             my \$item = \$paths->{\$p};
79             next unless ref \$item eq 'HASH';
80             for my \$m (qw(get put post delete patch options head trace)) {
81             my \$op = \$item->{\$m};
82             next unless ref \$op eq 'HASH';
83             my \$oid = \$op->{operationId} // next;
84             return \$op if \$oid eq \$want;
85             }
86             }
87             return undef;
88             }
89              
90             sub _first_json_response_schema {
91             my (\$responses) = \@_;
92             for my \$code (qw(200 201 202)) {
93             next unless exists \$responses->{\$code};
94             my \$content = \$responses->{\$code}{content} // {};
95             for my \$ct (qw(application/json application/problem+json)) {
96             next unless exists \$content->{\$ct};
97             my \$sch = \$content->{\$ct}{schema};
98             next unless ref \$sch eq 'HASH';
99             return ( 0 + \$code, \$sch );
100             }
101             }
102             return;
103             }
104              
105             sub _top_level_array {
106             my (\$sch) = \@_;
107             return 0 unless ref \$sch eq 'HASH';
108             return 1 if ( \$sch->{type} // '' ) eq 'array';
109             return 0;
110             }
111              
112             sub _model_pkg_for_response {
113             my ( \$raw, \$sch ) = \@_;
114             return '' unless ref \$sch eq 'HASH';
115             if ( my \$r = \$sch->{'\$ref'} ) {
116             return _model_pkg_for_schema_name( \$raw, \$r );
117             }
118             if ( ( \$sch->{type} // '' ) eq 'array' && ref \$sch->{items} eq 'HASH' ) {
119             return _model_pkg_for_schema_name( \$raw, \$sch->{items}{'\$ref'} // '' );
120             }
121             return '';
122             }
123              
124             sub _model_pkg_for_schema_name {
125             my ( \$raw, \$ref ) = \@_;
126             return '' unless defined \$ref && \$ref =~ m{#/components/schemas/([^/]+)\\z};
127             my \$name = \$1;
128             my \$def = \$raw->{components}{schemas}{\$name};
129             return '' unless ref \$def eq 'HASH';
130             return '' if \$def->{allOf} || \$def->{oneOf} || \$def->{anyOf};
131             return '' unless ( \$def->{type} // '' ) eq 'object' && ref \$def->{properties} eq 'HASH';
132             ( my \$safe = \$name ) =~ s/[^A-Za-z0-9_]/_/g;
133             return \$BASE . '::Model::' . \$safe;
134             }
135              
136             sub _random_for_schema {
137             my ( \$raw, \$sch ) = \@_;
138             return {} unless ref \$sch eq 'HASH';
139             if ( ref \$sch->{allOf} eq 'ARRAY' && \@{\$sch->{allOf}} ) {
140             return _random_for_schema( \$raw, \$sch->{allOf}[0] );
141             }
142             if ( my \$ref = \$sch->{'\$ref'} ) {
143             my \$res = _resolve_ref( \$raw, \$ref );
144             return _random_for_schema( \$raw, \$res ) if ref \$res eq 'HASH';
145             }
146             my \$t = \$sch->{type} // '';
147             if ( \$t eq 'array' || ( !length \$t && ref \$sch->{items} eq 'HASH' ) ) {
148             my \$it = \$sch->{items} // {};
149             return [] unless ref \$it eq 'HASH';
150             return [ _random_for_schema( \$raw, \$it ) ];
151             }
152             if ( \$t eq 'object' || ( !length \$t && ref \$sch->{properties} eq 'HASH' ) ) {
153             my \$props = \$sch->{properties} // {};
154             my %out;
155             for my \$k ( keys %\$props ) {
156             \$out{\$k} = _random_for_schema( \$raw, \$props->{\$k} );
157             }
158             return \\%out;
159             }
160             if ( \$t eq 'string' ) {
161             if ( ref \$sch->{enum} eq 'ARRAY' && \@{\$sch->{enum}} ) {
162             return \$sch->{enum}[ int( rand( scalar \@{\$sch->{enum}} ) ) ];
163             }
164             return _rnd_str();
165             }
166             if ( \$t eq 'integer' ) {
167             return int( rand( 2_000_000 ) ) - 1_000_000;
168             }
169             if ( \$t eq 'number' ) {
170             return rand( 1_000_000 ) / 1000;
171             }
172             if ( \$t eq 'boolean' ) {
173             return rand() < 0.5 ? JSON::PP::false : JSON::PP::true;
174             }
175             return {};
176             }
177              
178             sub _resolve_ref {
179             my ( \$raw, \$ref ) = \@_;
180             return undef unless defined \$ref && \$ref =~ m{#/components/schemas/([^/]+)\\z};
181             return \$raw->{components}{schemas}{\$1};
182             }
183              
184             sub _rnd_str {
185             join '', map { ( 'a' .. 'z', 'A' .. 'Z', 0 .. 9 )[ int( rand 62 ) ] } 1 .. ( 6 + int( rand 10 ) );
186             }
187              
188             1;
189             PM
190             }
191              
192             1;
193              
194             __END__