File Coverage

lib/Net/API/CPAN/Generic.pm
Criterion Covered Total %
statement 30 86 34.8
branch 3 28 10.7
condition 0 20 0.0
subroutine 11 15 73.3
pod 5 6 83.3
total 49 155 31.6


line stmt bran cond sub pod time code
1             ##----------------------------------------------------------------------------
2             ## Meta CPAN API - ~/lib/Net/API/CPAN/Generic.pm
3             ## Version v0.1.0
4             ## Copyright(c) 2023 DEGUEST Pte. Ltd.
5             ## Author: Jacques Deguest <jack@deguest.jp>
6             ## Created 2023/07/26
7             ## Modified 2023/07/26
8             ## All rights reserved
9             ##
10             ##
11             ## This program is free software; you can redistribute it and/or modify it
12             ## under the same terms as Perl itself.
13             ##----------------------------------------------------------------------------
14             package Net::API::CPAN::Generic;
15             BEGIN
16             {
17 24     24   10681 use strict;
  24         53  
  24         727  
18 24     24   129 use warnings;
  24         54  
  24         664  
19 24     24   115 use parent qw( Module::Generic );
  24         54  
  24         192  
20 24     24   243824 use vars qw( $VERSION );
  24         94  
  24         1310  
21 24     24   629 our $VERSION = 'v0.1.0';
22             };
23              
24 24     24   178 use strict;
  24         56  
  24         550  
25 24     24   154 use warnings;
  24         72  
  24         17813  
26              
27             sub init
28             {
29 33     33 1 102 my $self = shift( @_ );
30 33 100       142 $self->{api} = undef unless( CORE::exists( $self->{api} ) );
31 33         74 $self->{_init_strict_use_sub} = 1;
32 33         59 $self->{_exception_class} = 'Net::API::CPAN::Exception';
33 33 50       204 $self->SUPER::init( @_ ) || return( $self->pass_error );
34 33         7829519 return( $self );
35             }
36              
37 10     10 1 1839456 sub api { return( shift->_set_get_object( 'api', 'Net::API::CPAN', @_ ) ); }
38              
39             sub apply
40             {
41 0     0 1 0 my $self = shift( @_ );
42 0         0 my $hash = $self->_get_args_as_hash( @_ );
43 0 0       0 return( $self ) if( !scalar( keys( %$hash ) ) );
44 0 0 0     0 if( CORE::exists( $self->{_init_preprocess} ) &&
45             ref( $self->{_init_preprocess} ) eq 'CODE' )
46             {
47 0         0 $hash = $self->{_init_preprocess}->( $hash );
48             }
49            
50 0         0 foreach my $k ( keys( %$hash ) )
51             {
52 0         0 my $code;
53             # if( !CORE::exists( $dict->{ $k } ) )
54 0 0       0 if( !( $code = $self->can( $k ) ) )
55             {
56 0 0 0     0 warn( "No method \"$k\" found in class ", ( ref( $self ) || $self ), " when applying data to this object. Skipping it." ) if( $self->_is_warnings_enabled );
57 0         0 next;
58             }
59 0         0 $code->( $self, $hash->{ $k } );
60             }
61 0         0 return( $self );
62             }
63              
64             # sub as_hash
65             # {
66             # my $self = shift( @_ );
67             # my $hash = {};
68             # my $fields;
69             # if( !$self->can( 'fields' ) )
70             # {
71             # warn( "Method fields is not implemented in this class '", ( ref( $self ) || $self ), "'." );
72             # $fields = $self->new_array( [grep( !/^(_|debug|verbose|error|version)/, keys( %$self ) )] );
73             # }
74             # else
75             # {
76             # $fields = $self->fields;
77             # }
78             # $self->fields->foreach(sub
79             # {
80             # $hash->{ $_ } = $self->$_();
81             # });
82             # return( $hash );
83             # }
84              
85 0     0 1 0 sub fields { return( shift->_set_get_array_as_object( 'fields', @_ ) ); }
86              
87             # Takes an hash of data retrieved from the remote REST API, and fill all the class properties with it
88             sub populate
89             {
90 0     0 1 0 my $self = shift( @_ );
91 0   0     0 my $ref = shift( @_ ) || return( $self->error( "No hash to populate was provided." ) );
92 0 0       0 return( $self->error( "Hash provided is not an hash reference." ) ) if( ref( $ref ) ne 'HASH' );
93              
94 0 0 0     0 if( CORE::exists( $self->{_init_preprocess} ) &&
95             ref( $self->{_init_preprocess} ) eq 'CODE' )
96             {
97 0         0 $ref = $self->{_init_preprocess}->( $ref );
98             }
99            
100 0         0 my $keys;
101 0         0 my $dubious = 0;
102 0 0 0     0 if( scalar( @_ ) == 1 && $self->_is_array( $_[0] ) )
    0          
103             {
104 0         0 $dubious++;
105 0         0 $keys = $self->new_array( @{$_[0]} );
  0         0  
106             }
107             elsif( $self->can( 'fields' ) )
108             {
109 0         0 $keys = $self->fields->clone;
110             }
111             else
112             {
113 0         0 $dubious++;
114 0         0 $keys = [keys( %$ref )];
115             }
116            
117 0         0 foreach my $this ( @$keys )
118             {
119 0         0 my $meth = $this;
120 0         0 $meth =~ tr/-/_/;
121 0 0 0     0 if( $dubious && !$self->can( $meth ) )
122             {
123 0   0     0 warn( "No method found for \"$meth\" in class ", ( ref( $self ) || $self ), " when populating data. Skipping it." );
124 0         0 next;
125             }
126 0         0 $self->$meth( $ref->{ $this } );
127             }
128 0         0 return( $self );
129             }
130              
131 1     1   5 sub _object_type_to_class { return( shift->api->_object_type_to_class( @_ ) ); }
132              
133             sub TO_JSON
134             {
135 0     0 0   my $self = shift( @_ );
136 0           my $hash = {};
137 0 0         if( $self->can( 'fields' ) )
138             {
139 0           my $keys = $self->fields;
140 0           foreach my $f ( @$keys )
141             {
142 0           $hash->{ $f } = $self->$f();
143             }
144             }
145             else
146             {
147             # my $hash = $self->as_hash;
148             # return( $hash );
149 0           my $class = ref( $self );
150 24     24   200 no strict 'refs';
  24         54  
  24         6319  
151 0           my @methods = grep( !/^(?:new|init|TO_JSON|FREEZE|THAW|AUTOLOAD|DESTROY)$/, grep{ defined &{"${class}::$_"} } keys( %{"${class}::"} ) );
  0            
  0            
  0            
152 0           foreach my $meth ( sort( @methods ) )
153             {
154 0 0         next if( substr( $meth, 0, 1 ) eq '_' );
155 0           local $@;
156 0           my $rv = eval{ $self->$meth };
  0            
157 0 0         if( $@ )
158             {
159 0           warn( "An error occured while accessing method $meth: $@\n" );
160 0           next;
161             }
162 0           $hash->{ $meth } = $rv;
163             }
164             }
165 0           return( $hash );
166             }
167              
168             1;
169             # NOTE: POD
170             __END__
171              
172             =encoding utf-8
173              
174             =head1 NAME
175              
176             Net::API::CPAN::Generic - Meta CPAN API Generic Class
177              
178             =head1 SYNOPSIS
179              
180             use Net::API::CPAN::Generic;
181             package Net::API::CPAN::Author;
182             use parent qw( Net::API::CPAN::Generic );
183             # ...
184              
185             =head1 VERSION
186              
187             v0.1.0
188              
189             =head1 DESCRIPTION
190              
191             C<Net::API::CPAN::Generic> contains some standard methods to inherit from.
192              
193             =head1 METHODS
194              
195             =head2 init
196              
197             Initialise some default properties and return the current object.
198              
199             This C<init> method is called by L<Module::Generic/new>
200              
201             =head2 api
202              
203             Sets or gets the C<Net::API::CPAN> API object.
204              
205             In scalar context, this would return C<undef> if none is defined yet, but in object context, this would automatically instantiate a new C<Net::API::CPAN> object. For example:
206              
207             my $api = $obj->api; # undef
208             my $resp = $api->ua->get( $somewhere ); # HTTP::Promise::Response
209              
210             =head2 apply
211              
212             $obj->apply( key1 => $val1, key2 => $val2 );
213             $obj->apply({ key1 => $val1, key2 => $val2 });
214              
215             This takes an hash or an hash reference of key-value pairs, and this will call the corresponding method if they exist in the object class, and set the associated value.
216              
217             It returns the current object.
218              
219             =head2 as_hash
220              
221             my $hash_ref = $obj->as_hash;
222              
223             This returns an hash reference of key-value pairs corresponding to all the object class methods.
224              
225             =head2 fields
226              
227             Sets or gets an L<array object|Module::Generic::Array> of the package methods.
228              
229             =head2 populate
230              
231             This is a variation of L<apply|/apply>. It takes an hash reference, and an optional array reference of associated properties to set their values. If no array reference is specified, it will use the object C<fields> methods to get the object class known properties if the C<fields> method is supported, otherwise, it will use all they hash reference keys as a default array reference of properties to set.
232              
233             It returns the current object upon success, or, upon error, sets an L<error|Net::API::CPAN::Exception> and returns C<undef> in scalar context, or an empty list in list context.
234              
235             =for Pod::Coverage _object_type_to_class
236              
237             =head1 ERRORS
238              
239             This module does not die or croak, but instead set an L<error object|Net::API::CPAN::Exception> using L<Module::Generic/error> and returns C<undef> in scalar context, or an empty list in list context.
240              
241             You can retrieve the latest error object set by calling L<error|Module::Generic/error> inherited from L<Module::Generic>
242              
243             Errors issued by this distributions are all instances of class L<Net::API::CPAN::Exception>
244              
245             =head1 AUTHOR
246              
247             Jacques Deguest E<lt>F<jack@deguest.jp>E<gt>
248              
249             =head1 SEE ALSO
250              
251             L<perl>
252              
253             =head1 COPYRIGHT & LICENSE
254              
255             Copyright(c) 2023 DEGUEST Pte. Ltd.
256              
257             All rights reserved
258              
259             This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
260              
261             =cut