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 |