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