File: | lib/JSON/DJARE/Writer.pm |
Coverage: | 82.8% |
line | stmt | bran | cond | sub | pod | time | code |
---|---|---|---|---|---|---|---|
1 | package JSON::DJARE::Writer; | ||||||
2 | |||||||
3 | 3 3 3 | 11 3 53 | use strict; | ||||
4 | 3 3 3 | 5 2 81 | use warnings; | ||||
5 | 3 3 3 | 1840 15073 9 | use Moo; | ||||
6 | 3 3 3 | 3962 4 33 | use JSON qw(); | ||||
7 | 3 3 3 | 6 3 1520 | use Carp qw/croak/; | ||||
8 | our @CARP_NOT; | ||||||
9 | |||||||
10 - 83 | =head1 NAME JSON::DJARE::Writer =head1 DESCRIPTION Simple writer of DJARE documents =head1 SYNOPSIS my $writer = JSON::DJARE::Writer->new( djare_version => '0.0.1', # required meta_version => '0.1.1', # required meta_from => 'my-api' # optional auto_timestamp => 1, # default 0, also accepts coderef ); my $success = $writer->data( { foo => 'bar' }, from => 'my-other-api' # optional if set in constructor ); my $error = $writer->error( "something went wrong", # title schema => 'schema-id', # optional schema id => "12345", # other optional fields ); ### JSON # There's a _json version of both producer methods that returns a JSON string my $json = $writer->data_json( my $json = $writer->error_json( # But if you want to mess around with the document you've created before # encoding it, there's a to_json method that'll help my $doc = $writer->data( $doc->{'meta'}->{'trace'} = "x12345"; my $json = $writer->to_json( $doc ) =head1 DJARE DJARE is documented L<https://github.com/pjlsergeant/dumb-json-api-response-envelope|elsewhere> and this document neither discusses or documents DJARE itself. =head1 METHODS =head2 new Instantiates a new writer object. Options: =over 4 =item * C<djare_version> - required. The version of DJARE you want to produce. The only possible value for this (at the time of writing) is C<0.0.1>. =item * C<meta_version> - required. The version number to include in the DJARE `meta/version` section. This is a L<SemVer|https://semver.org>. =item * C<meta_from> - optional. A DJARE document needs a C<meta/from> field. You can either specify this for all documents this object will produce here, or you can set it at document creation time =item * C<meta_schema> - optional. A DJARE document may include a C<meta/schema> field. You can either specify this for all documents this object will produce here, or you can set it at document creation time =back =cut | ||||||
84 | |||||||
85 | sub new { | ||||||
86 | 4 | 1 | 15 | my ( $class, %options ) = @_; | |||
87 | |||||||
88 | 4 | 9 | my $djare_version = delete $options{'djare_version'}; | ||||
89 | 4 | 18 | croak "new() requires `djare_version`" unless $djare_version; | ||||
90 | 4 | 8 | croak "Only supported `djare_version` is 0.0.2" | ||||
91 | unless $djare_version eq '0.0.2'; | ||||||
92 | |||||||
93 | 4 | 7 | my $meta_version = delete $options{'meta_version'}; | ||||
94 | 4 | 5 | croak "new() requires `meta_version`" unless $meta_version; | ||||
95 | 4 | 17 | croak "`meta_version` needs to be a semver" | ||||
96 | unless $meta_version =~ | ||||||
97 | m/^(?:0|[1-9]\d*)\.(?:0|[1-9]\d*)\.(?:0|[1-9]\d*)$/; | ||||||
98 | |||||||
99 | 4 | 9 | my $meta_presets = { | ||||
100 | version => $meta_version, | ||||||
101 | djare => $djare_version, | ||||||
102 | }; | ||||||
103 | 4 | 9 | for (qw/from schema trace/) { | ||||
104 | 12 | 20 | my $value = delete $options{"meta_$_"}; | ||||
105 | 12 | 21 | $meta_presets->{$_} = $value if defined $value; | ||||
106 | } | ||||||
107 | |||||||
108 | 4 | 6 | my $self = { meta_presets => $meta_presets }; | ||||
109 | 4 | 109 | $self->{'_json'} ||= JSON->new->allow_nonref->canonical; | ||||
110 | |||||||
111 | 4 | 4 | for my $method (qw/auto_timestamp/) { | ||||
112 | 4 | 9 | if ( my $method_value = delete $options{$method} ) { | ||||
113 | 3 | 6 | if ( ref $method_value eq 'CODE' ) { | ||||
114 | 2 | 2 | $self->{$method} = $method_value; | ||||
115 | } | ||||||
116 | elsif ( ref $method_value ) { | ||||||
117 | 0 | 0 | croak "`$method` should either be a boolean or a coderef"; | ||||
118 | } | ||||||
119 | else { | ||||||
120 | $self->{$method} = sub { | ||||||
121 | 1 | 2 | $self->$method(@_); | ||||
122 | 1 | 4 | }; | ||||
123 | } | ||||||
124 | } | ||||||
125 | } | ||||||
126 | |||||||
127 | 4 | 13 | if ( my $error_keys = join '; ', sort keys %options ) { | ||||
128 | 0 | 0 | croak "Unknown options: [$error_keys]"; | ||||
129 | } | ||||||
130 | |||||||
131 | 4 | 9 | bless $self, $class; | ||||
132 | } | ||||||
133 | |||||||
134 | sub to_json { | ||||||
135 | 4 | 0 | 2 | my ( $self, $payload ) = @_; | |||
136 | 4 | 54 | return $self->{'_json'}->encode( $payload ); | ||||
137 | } | ||||||
138 | |||||||
139 | sub data_json { | ||||||
140 | 1 | 0 | 1 | my $self = shift; | |||
141 | 1 | 1 | $self->to_json( $self->data( @_ ) ); | ||||
142 | } | ||||||
143 | |||||||
144 | sub data { | ||||||
145 | 3 | 0 | 5 | my ( $self, $data, %options ) = @_; | |||
146 | |||||||
147 | 3 | 8 | my $meta = $self->meta( from => delete $options{'from'} ); | ||||
148 | 3 | 5 | $self->_check_no_bad_options(%options); | ||||
149 | |||||||
150 | return { | ||||||
151 | 3 | 6 | meta => $meta, | ||||
152 | data => $data | ||||||
153 | }; | ||||||
154 | } | ||||||
155 | |||||||
156 | sub error_json { | ||||||
157 | 1 | 0 | 1 | my $self = shift; | |||
158 | 1 | 2 | $self->to_json( $self->error( @_ ) ); | ||||
159 | } | ||||||
160 | |||||||
161 | |||||||
162 | sub error { | ||||||
163 | 4 | 0 | 8 | my ( $self, $title, %options ) = @_; | |||
164 | |||||||
165 | 4 | 7 | my $meta = $self->meta( from => delete $options{'from'} ); | ||||
166 | my %error = ( | ||||||
167 | title => $title, | ||||||
168 | 4 16 | 5 44 | map { $_ => delete $options{$_} } | ||||
169 | qw/ | ||||||
170 | id code detail trace | ||||||
171 | / | ||||||
172 | ); | ||||||
173 | |||||||
174 | 4 | 6 | $self->_check_no_bad_options(%options); | ||||
175 | |||||||
176 | return { | ||||||
177 | 4 | 8 | meta => $meta, | ||||
178 | error => \%error | ||||||
179 | }; | ||||||
180 | |||||||
181 | } | ||||||
182 | |||||||
183 | sub meta { | ||||||
184 | 7 | 1 | 8 | my ( $self, %options ) = @_; | |||
185 | |||||||
186 | 7 7 | 9 20 | my $meta = { %{ $self->{'meta_presets'} } }; | ||||
187 | |||||||
188 | $meta->{'from'} = delete $options{'from'} | ||||||
189 | 7 | 21 | // $self->{'meta_presets'}->{'from'} | ||||
190 | // croak "`from` must be provided or preset"; | ||||||
191 | |||||||
192 | 7 | 10 | if ( $self->{'auto_timestamp'} ) { | ||||
193 | 3 | 7 | $meta->{'timestamp'} = $self->{'auto_timestamp'}->(); | ||||
194 | } | ||||||
195 | |||||||
196 | 7 | 12 | $self->_check_no_bad_options(%options); | ||||
197 | |||||||
198 | 7 | 6 | return $meta; | ||||
199 | } | ||||||
200 | |||||||
201 | sub _check_no_bad_options { | ||||||
202 | 14 | 9 | my ( $self, %options ) = @_; | ||||
203 | 14 | 25 | if ( my $error_keys = join '; ', sort keys %options ) { | ||||
204 | 0 | 0 | croak "Unknown options: [$error_keys]"; | ||||
205 | } | ||||||
206 | } | ||||||
207 | |||||||
208 | sub auto_timestamp { | ||||||
209 | 2 | 0 | 2 | my $self = shift; | |||
210 | 2 | 10 | my ( $sec, $min, $hour, $mday, $mon, $year ) = gmtime(time); | ||||
211 | 2 | 7 | return sprintf( | ||||
212 | '%04d-%02d-%02d %02d:%02d:%02d+00:00', | ||||||
213 | $year + 1900, | ||||||
214 | $mon + 1, $mday, $hour, $min, $sec | ||||||
215 | ); | ||||||
216 | } | ||||||
217 | |||||||
218 | |||||||
219 | |||||||
220 | 1; |