File Coverage: lib/JSON/DJARE/Writer.pm

# File Coverage

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 |  |  | 3 |  | 11 3 53 | use strict;
4 | 3 3 3 |  |  | 3 |  | 5 2 81 | use warnings;
5 | 3 3 3 |  |  | 3 |  | 1840 15073 9 | use Moo;
6 | 3 3 3 |  |  | 3 |  | 3962 4 33 | use JSON qw();
7 | 3 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 |  |  | 4 | 1 | 15 | my ( $class, %options ) = @_;
87 |
88 | 4 |  |  |  |  | 9 | my $djare_version = delete $options{'djare_version'};
89 | 4 | 50 |  |  |  | 18 | croak "new() requires `djare_version`" unless $djare_version;
90 | 4 | 50 |  |  |  | 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 | 50 |  |  |  | 5 | croak "new() requires `meta_version`" unless $meta_version;
95 | 4 | 50 |  |  |  | 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 | 100 |  |  |  | 21 | $meta_presets->{$_} = $value if defined $value;
106 |  |  |  |  |  |  | }
107 |
108 | 4 |  |  |  |  | 6 | my $self = { meta_presets => $meta_presets };
109 | 4 |  | 33 |  |  | 109 | $self->{'_json'} ||= JSON->new->allow_nonref->canonical;
110 |
111 | 4 |  |  |  |  | 4 | for my $method (qw/auto_timestamp/) {
112 | 4 | 100 |  |  |  | 9 | if ( my $method_value = delete $options{$method} ) {
113 | 3 | 100 50 |  |  |  | 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 |  |  | 1 |  | 2 | $self->$method(@_);
122 | 1 |  |  |  |  | 4 | };
123 |  |  |  |  |  |  | }
124 |  |  |  |  |  |  | }
125 |  |  |  |  |  |  | }
126 |
127 | 4 | 50 |  |  |  | 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 |  |  | 4 | 0 | 2 | my ( $self, $payload ) = @_;
136 | 4 |  |  |  |  | 54 | return $self->{'_json'}->encode( $payload );
137 |  |  |  |  |  |  | }
138 |
139 |  |  |  |  |  |  | sub data_json {
140 | 1 |  |  | 1 | 0 | 1 | my $self = shift;
141 | 1 |  |  |  |  | 1 | $self->to_json( $self->data( @_ ) );
142 |  |  |  |  |  |  | }
143 |
144 |  |  |  |  |  |  | sub data {
145 | 3 |  |  | 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 |  |  | 1 | 0 | 1 | my $self = shift;
158 | 1 |  |  |  |  | 2 | $self->to_json( $self->error( @_ ) );
159 |  |  |  |  |  |  | }
160 |
161 |
162 |  |  |  |  |  |  | sub error {
163 | 4 |  |  | 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 |  |  | 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 |  | 33 67 |  |  | 21 | // $self->{'meta_presets'}->{'from'}
190 |  |  |  |  |  |  | // croak "`from` must be provided or preset";
191 |
192 | 7 | 100 |  |  |  | 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 |  |  | 14 |  | 9 | my ( $self, %options ) = @_;
203 | 14 | 50 |  |  |  | 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 |  |  | 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;