File Coverage

blib/lib/HAL/Resource.pm
Criterion Covered Total %
statement 77 83 92.7
branch 2 4 50.0
condition 4 8 50.0
subroutine 15 16 93.7
pod 0 7 0.0
total 98 118 83.0


line stmt bran cond sub pod time code
1             package HAL::Resource;
2 9     9   71 use Moo;
  9         23  
  9         84  
3 9     9   3290 use JSON 'decode_json';
  9         23  
  9         76  
4 9     9   1290 use Filter::signatures;
  9         21  
  9         82  
5 9     9   297 no warnings 'experimental::signatures';
  9         20  
  9         412  
6 9     9   60 use feature 'signatures';
  9         35  
  9         921  
7 9     9   6276 use Future;
  9         93488  
  9         361  
8              
9 9     9   80 use Carp qw(croak);
  9         21  
  9         5992  
10              
11             our $VERSION = '0.55';
12              
13             =head1 NAME
14              
15             HAL::Resource - wrap a HAL resource
16              
17             =head1 SYNOPSIS
18              
19             my $ua = WWW::Mechanize->new();
20             my $res = $ua->get('https://api.example.com/');
21             my $r = HAL::Resource->new(
22             ua => $ua,
23             %{ decode_json( $res->decoded_content ) },
24             );
25              
26             =head1 ABOUT
27              
28             This module is just a very thin wrapper for HAL resources. If you find this
29             module useful, I'm very happy to spin it off into its own distribution.
30              
31             =head1 SEE ALSO
32              
33             L<Data::HAL> - similar to this module, but lacks a HTTP transfer facility and
34             currently fails its test suite
35              
36             L<HAL::Tiny> - a module to generate HAL JSON
37              
38             L<WebAPI::DBIC::Resource::HAL> - an adapter to export DBIx::Class structures
39             as HAL
40              
41             Hypertext Application Language - L<https://en.wikipedia.org/wiki/Hypertext_Application_Language>
42              
43             =cut
44              
45             has ua => (
46             weaken => 1,
47             is => 'ro',
48             );
49              
50             has _links => (
51             is => 'ro',
52             );
53              
54             has _external => (
55             is => 'ro',
56             );
57              
58             has _embedded => (
59             is => 'ro',
60             );
61              
62 29     29 0 64 sub resource_url( $self, $name ) {
  29         53  
  29         57  
  29         51  
63 29         96 my $l = $self->_links;
64 29 50       151 if( exists $l->{$name} ) {
65             $l->{$name}->{href}
66 29         206 }
67             }
68              
69 0     0 0 0 sub resources( $self ) {
  0         0  
  0         0  
70 0         0 sort keys %{ $self->_links }
  0         0  
71             }
72              
73 18     18 0 47 sub fetch_resource_future( $self, $name, %options ) {
  18         35  
  18         33  
  18         47  
  18         30  
74 18   66     104 my $class = $options{ class } || ref $self;
75 18         101 my $ua = $self->ua;
76             my $url = $self->resource_url( $name )
77 18 50       119 or croak "Couldn't find resource '$name' in " . join ",", sort keys %{$self->_links};
  0         0  
78 18     18   40 Future->done( $ua->get( $url ))->then( sub( $res ) {
  18         1242595  
  18         62  
79 18         45 Future->done( bless { ua => $ua, %{ decode_json( $res->content )} } => $class );
  18         101  
80 18         111 });
81             }
82              
83 1     1 0 2 sub fetch_resource( $self, $name, %options ) {
  1         3  
  1         2  
  1         2  
  1         45  
84 1         5 $self->fetch_resource_future( $name, %options )->get
85             }
86              
87 3     3 0 7 sub navigate_future( $self, %options ) {
  3         9  
  3         8  
  3         6  
88 3   33     12 $options{ class } ||= ref $self;
89 3   50     13 my $path = delete $options{ path } || [];
90 3         28 my $resource = Future->done( $self );
91 3         92 for my $item (@$path) {
92 6         280 my $i = $item;
93 6     6   11 $resource = $resource->then( sub( $r ) {
  6         519  
  6         14  
94 6         42 $r->fetch_resource_future( $i, %options );
95 6         48 });
96             };
97 3         1033 $resource
98             }
99              
100 3     3 0 8 sub navigate( $self, %options ) {
  3         9  
  3         13  
  3         6  
101 3         17 $self->navigate_future( %options )->get
102             }
103              
104 5     5 0 57 sub inflate_list( $self, $class, $list ) {
  5         14  
  5         10  
  5         10  
  5         9  
105 5         24 my $ua = $self->ua;
106             map {
107 23         12158 $class->new( ua => $ua, %$_ )
108 5         10 } @{ $list };
  5         14  
109             }
110              
111             1;
112              
113             =head1 AUTHOR
114              
115             Max Maischein, E<lt>corion@cpan.orgE<gt>
116              
117             =head1 SEE ALSO
118              
119             L<perl>, L<WWW::Mechanize>.
120              
121             =head1 REPOSITORY
122              
123             The public repository of this module is
124             L<https://github.com/Corion/Finance-Bank-Postbank_de>.
125              
126             =head1 SUPPORT
127              
128             The public support forum of this module is
129             L<https://perlmonks.org/>.
130              
131             =head1 BUG TRACKER
132              
133             Please report bugs in this module via the RT CPAN bug queue at
134             L<https://rt.cpan.org/Public/Dist/Display.html?Name=Finance-Bank-Postbank_de>
135             or via mail to L<finance-bank-postbank_de-Bugs@rt.cpan.org>.
136              
137             =head1 COPYRIGHT (c)
138              
139             Copyright 2003-2018 by Max Maischein C<corion@cpan.org>.
140              
141             =head1 LICENSE
142              
143             This module is released under the same terms as Perl itself.
144              
145             =cut