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 10     10   65 use Moo;
  10         21  
  10         75  
3 10     10   2923 use JSON 'decode_json';
  10         22  
  10         75  
4 10     10   1141 use Filter::signatures;
  10         19  
  10         75  
5 10     10   262 no warnings 'experimental::signatures';
  10         25  
  10         364  
6 10     10   49 use feature 'signatures';
  10         27  
  10         783  
7 10     10   5820 use Future;
  10         82297  
  10         315  
8              
9 10     10   66 use Carp qw(croak);
  10         19  
  10         7626  
10              
11             our $VERSION = '0.56';
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 66 sub resource_url( $self, $name ) {
  29         57  
  29         48  
  29         40  
63 29         100 my $l = $self->_links;
64 29 50       118 if( exists $l->{$name} ) {
65             $l->{$name}->{href}
66 29         289 }
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 37 sub fetch_resource_future( $self, $name, %options ) {
  18         49  
  18         30  
  18         35  
  18         32  
74 18   66     95 my $class = $options{ class } || ref $self;
75 18         74 my $ua = $self->ua;
76             my $url = $self->resource_url( $name )
77 18 50       81 or croak "Couldn't find resource '$name' in " . join ",", sort keys %{$self->_links};
  0         0  
78 18     18   38 Future->done( $ua->get( $url ))->then( sub( $res ) {
  18         994016  
  18         48  
79 18         46 Future->done( bless { ua => $ua, %{ decode_json( $res->content )} } => $class );
  18         176  
80 18         82 });
81             }
82              
83 1     1 0 2 sub fetch_resource( $self, $name, %options ) {
  1         2  
  1         3  
  1         1  
  1         2  
84 1         5 $self->fetch_resource_future( $name, %options )->get
85             }
86              
87 3     3 0 6 sub navigate_future( $self, %options ) {
  3         5  
  3         7  
  3         5  
88 3   33     12 $options{ class } ||= ref $self;
89 3   50     13 my $path = delete $options{ path } || [];
90 3         25 my $resource = Future->done( $self );
91 3         92 for my $item (@$path) {
92 6         262 my $i = $item;
93 6     6   11 $resource = $resource->then( sub( $r ) {
  6         618  
  6         23  
94 6         39 $r->fetch_resource_future( $i, %options );
95 6         42 });
96             };
97 3         900 $resource
98             }
99              
100 3     3 0 8 sub navigate( $self, %options ) {
  3         6  
  3         12  
  3         6  
101 3         15 $self->navigate_future( %options )->get
102             }
103              
104 5     5 0 12 sub inflate_list( $self, $class, $list ) {
  5         10  
  5         8  
  5         7  
  5         9  
105 5         18 my $ua = $self->ua;
106             map {
107 23         9494 $class->new( ua => $ua, %$_ )
108 5         11 } @{ $list };
  5         44  
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