File Coverage

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

linestmtbrancondsubpodtimecode
1package 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/;
8our @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
85sub 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
134sub to_json {
135
4
0
2
    my ( $self, $payload ) = @_;
136
4
54
    return $self->{'_json'}->encode( $payload );
137}
138
139sub data_json {
140
1
0
1
    my $self = shift;
141
1
1
    $self->to_json( $self->data( @_ ) );
142}
143
144sub 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
156sub error_json {
157
1
0
1
    my $self = shift;
158
1
2
    $self->to_json( $self->error( @_ ) );
159}
160
161
162sub 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
183sub 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
201sub _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
208sub 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
2201;