File Coverage

lib/Net/API/Stripe/Generic.pm
Criterion Covered Total %
statement 44 291 15.1
branch 3 210 1.4
condition 1 81 1.2
subroutine 13 32 40.6
pod 4 4 100.0
total 65 618 10.5


line stmt bran cond sub pod time code
1             ##----------------------------------------------------------------------------
2             ## Stripe API - ~/lib/Net/API/Stripe/Generic.pm
3             ## Version v0.101.0
4             ## Copyright(c) 2020 DEGUEST Pte. Ltd.
5             ## Author: Jacques Deguest <jack@deguest.jp>
6             ## Created 2019/11/02
7             ## Modified 2020/12/02
8             ## All rights reserved
9             ##
10             ## This program is free software; you can redistribute it and/or modify it
11             ## under the same terms as Perl itself.
12             ##----------------------------------------------------------------------------
13             package Net::API::Stripe::Generic;
14             BEGIN
15             {
16 137     137   61423 use strict;
  137         320  
  137         4648  
17 137     137   718 use warnings;
  137         298  
  137         4368  
18 137     137   723 use parent qw( Module::Generic );
  137         290  
  137         1042  
19 137     137   74091 use Module::Generic::Exception;
  137         517428  
  137         1225  
20 137     137   51056 use vars qw( $VERSION );
  137         314  
  137         6116  
21 137     137   928 use Nice::Try;
  137         334  
  137         1447  
22 137     137   97900757 use Devel::Confess;
  137         971528  
  137         788  
23 137     137   11420 use Want;
  137         330  
  137         11623  
24 137     137   2909 our( $VERSION ) = 'v0.101.0';
25             };
26              
27 137     137   927 use strict;
  137         362  
  137         2721  
28 137     137   775 use warnings;
  137         351  
  137         231315  
29              
30             sub init
31             {
32 136     136 1 506870807 my $self = shift( @_ );
33             # Get the init params always present and including keys like _parent and _field
34 136 100       3320 my $init = @_ ? shift( @_ ) : {};
35 136         11101 $self->{_parent} = $init->{_parent};
36 136         2036 $self->{_field} = $init->{_field};
37 136         2397 $self->{_error} = '';
38 136         1426 $self->{debug} = $init->{_debug};
39 136 0 33     2314 $self->{_dbh} = $init->{_dbh} if( exists( $init->{_dbh} ) && $init->{_dbh} );
40 136         1323 $self->{_init_strict_use_sub} = 1;
41             # $self->SUPER::init( @_ ) || return;
42 136 50       3758 $self->SUPER::init( @_ ) || return( $self->pass_error );
43 136         13614 return( $self );
44             }
45              
46 0     0 1   sub field { return( shift->_set_get_scalar( '_field', @_ ) ); }
47              
48 0     0 1   sub parent { return( shift->_set_get_scalar( '_parent', @_ ) ); }
49              
50             sub TO_JSON
51             {
52 0     0 1   my $self = shift( @_ );
53 0 0         return( $self->can( 'as_string' ) ? $self->as_string : $self );
54             }
55              
56             # Used in Net::API::Stripe::Payment::Source and Net::API::Stripe::Connect::ExternalAccount::Card
57             sub _address_populate
58             {
59 0     0     my $self = shift( @_ );
60 0   0       my $addr = shift( @_ ) || return;
61             # No 'state' property
62 0           my $map =
63             {
64             line1 => 'line1',
65             line2 => 'line2',
66             city => 'city',
67             state => 'state',
68             postal_code => 'zip',
69             country => 'country',
70             };
71 0 0 0       if( $self->_is_hash( $addr ) )
    0          
72             {
73 0           foreach my $k ( keys( %$map ) )
74             {
75 0 0 0       next unless( exists( $addr->{ $k } ) && length( $addr->{ $k } ) );
76 0           my $sub = "address_" . $map->{ $k };
77 0           $self->$sub( $addr->{ $k } );
78             }
79             }
80             elsif( $self->_is_object( $addr ) && $addr->isa( 'Net::API::Stripe::Address' ) )
81             {
82 0           foreach my $k ( keys( %$map ) )
83             {
84 0 0 0       next unless( exists( $addr->{ $k } ) && length( $addr->{ $k } ) );
85 0           my $sub = "address_" . $map->{ $k };
86 0           $self->$sub( $addr->$k );
87             }
88             }
89             else
90             {
91 0           return( $self->error( "I do not know what to do with '$addr'. I was expecting either a Net::API::Strie::Address or an hash reference." ) );
92             }
93             }
94              
95             sub _convert_measure
96             {
97 0     0     my $self = shift( @_ );
98 0           my $p = shift( @_ );
99 0           my $num = $p->{value};
100 0 0         return if( !length( $num ) );
101 0 0         return( $self->error( "No \"from\" parameter was provided to convert number \"$num\"." ) ) if( !length( $p->{from} ) );
102 0           my $inch_to_cm = 2.54;
103 0           my $cm_to_inch = 0.39370078740157;
104 0           my $ounce_to_gram = 28.34952;
105 0           my $gram_to_ounce = 0.03527396583787;
106 0 0 0       if( lc( $p->{from} ) eq 'inch' )
    0          
    0          
    0          
107             {
108 0           return( $num / $inch_to_cm );
109             }
110             elsif( lc( $p->{from} ) eq 'cm' || lc( $p->{from} ) eq 'centimetre' )
111             {
112 0           return( $num / $cm_to_inch );
113             }
114             elsif( lc( $p->{from} ) eq 'ounce' )
115             {
116 0           return( $num / $ounce_to_gram );
117             }
118             elsif( lc( $p->{from} ) eq 'gram' )
119             {
120 0           return( $num / $gram_to_ounce );
121             }
122             else
123             {
124 0           return( $self->error( "I do not know how to convert from \"$p->{from}\"" ) );
125             }
126             }
127              
128             sub _get_base_class
129             {
130 0     0     my $self = shift( @_ );
131 0           my $class = shift( @_ );
132 0           my $base = __PACKAGE__;
133 0           $base =~ s/\:\:Generic$//;
134 0           my $pkg = ( $class =~ /^($base\:\:(?:[^\:]+)?)/ )[0];
135             }
136              
137             # Overriding Module::Generic
138             sub _instantiate_object
139             {
140 0     0     my $self = shift( @_ );
141 0           my $field = shift( @_ );
142 0 0 0       return( $self->{ $field } ) if( exists( $self->{ $field } ) && Scalar::Util::blessed( $self->{ $field } ) && !$self->_is_array( $self->{ $field } ) );
      0        
143 0           my $class = shift( @_ );
144 0           my $this;
145             my $h =
146             {
147             '_parent' => $self->{_parent},
148             '_field' => $field,
149             '_debug' => $self->{debug},
150 0           };
151 0 0         $h->{_dbh} = $self->{_dbh} if( $self->{_dbh} );
152 0           my $o;
153 0 0 0       try
  0            
  0            
  0            
  0            
  0            
  0            
  0            
154 0     0     {
155             # https://stackoverflow.com/questions/32608504/how-to-check-if-perl-module-is-available#comment53081298_32608860
156             # my $class_file = join( '/', split( /::/, $class ) ) . '.pm';
157             # if( CORE::exists( $INC{ $class_file } ) || defined( *{"${class}::"} ) )
158             # if( Class::Load::is_class_loaded( $class ) )
159             # if( defined( ${"${class}::VERSION"} ) || scalar( @{"$class::ISA"} ) )
160             # {
161             # }
162             # else
163             # {
164             # my $rc = eval( "require $class;" );
165             # }
166 0           my $rc = eval{ $self->_load_class( $class ); };
  0            
167             # print( STDERR __PACKAGE__, "::_instantiate_object(): Error while loading module $class? $@\n" );
168 0 0         return( $self->error( "Unable to load module $class: $@" ) ) if( $@ );
169 0 0         if( $class->isa( 'Module::Generic::Dynamic' ) )
170             {
171 0 0         $o = @_ ? $class->new( @_ ) : $class->new;
172 0           $o->{debug} = $self->{debug};
173 0           $o->{_parent} = $self->{_parent};
174 0           $o->{_field} = $field;
175             }
176             else
177             {
178 0 0         $o = @_ ? $class->new( $h, @_ ) : $class->new( $h );
179             }
180 0 0         return( $self->pass_error( "Unable to instantiate an object of class $class: ", $class->error ) ) if( !defined( $o ) );
181             }
182 0 0 0       catch( $e )
  0 0 0        
  0 0          
  0 0          
  0 0          
  0 0          
  0 0          
  0 0          
  0 0          
  0 0          
  0 0          
  0 0          
  0 0          
  0 0          
  0 0          
  0 0          
  0 0          
  0 0          
  0 0          
  0 0          
  0 0          
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
183 0     0     {
184 0           return( $self->error({ code => 500, message => $e }) );
185 137 0 0 137   1194 }
  137 0 0     420  
  137 0 0     175336  
  0 0 0        
  0 0 0        
  0 0 0        
  0 0 0        
  0 0 0        
  0 0          
  0 0          
  0 0          
  0 0          
  0 0          
  0 0          
  0 0          
  0 0          
  0 0          
  0 0          
  0 0          
  0 0          
  0 0          
  0 0          
  0 0          
  0 0          
  0 0          
  0 0          
  0 0          
  0 0          
  0 0          
  0 0          
  0 0          
  0 0          
  0 0          
  0 0          
  0 0          
  0 0          
  0 0          
  0 0          
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
186 0           return( $o );
187             }
188              
189             sub _object_type_to_class
190             {
191 0     0     my $self = shift( @_ );
192 0   0       my $type = shift( @_ ) || return( $self->error( "No object type was provided" ) );
193 0           require Net::API::Stripe;
194 0           my $ref = $Net::API::Stripe::TYPE2CLASS;
195 0 0         return( $self->error( "No object type '$type' known to get its related class for field $self->{_field}" ) ) if( !exists( $ref->{ $type } ) );
196 0           return( $ref->{ $type } );
197             }
198              
199             sub _set_get_hash
200             {
201 0     0     my $self = shift( @_ );
202 0           my $field = shift( @_ );
203 0           my $o;
204 0 0 0       if( @_ || !$self->{ $field } )
205             {
206 0           my $class = $field;
207 0           $class =~ tr/-/_/;
208 0           $class =~ s/\_{2,}/_/g;
209 0           $class = ref( $self ) . '::' . join( '', map( ucfirst( lc( $_ ) ), split( /\_/, $class ) ) );
210             # require Devel::StackTrace;
211             # my $trace = Devel::StackTrace->new;
212 0           $o = $self->_set_get_hash_as_object( $field, $class, @_ );
213 0           $o->debug( $self->debug );
214 0           $self->{ $field } = $o;
215             }
216 0           $o = $self->{ $field };
217 0 0         if( want( 'OBJECT' ) )
218             {
219 0           return( $o );
220             }
221 0           my $hash = $o->{_data};
222 0           return( $hash );
223             }
224              
225             # Overiden
226             sub _set_get_number
227             {
228 0     0     my $self = shift( @_ );
229 0           my $field = shift( @_ );
230 0 0 0       @_ = () if( scalar( @_ ) == 1 && !defined( $_[0] ) );
231 0 0         if( @_ )
232             {
233 0           $self->{ $field } = Module::Generic::Number->new( shift( @_ ) );
234             }
235 0           return( $self->{ $field } );
236             }
237              
238             sub _set_get_object_array
239             {
240 0     0     my $self = shift( @_ );
241 0           my $field = shift( @_ );
242 0           my $class = shift( @_ );
243 0 0 0       @_ = () if( scalar( @_ ) == 1 && !defined( $_[0] ) );
244 0 0         if( @_ )
245             {
246 0           my $ref = shift( @_ );
247 0 0         return( $self->error( "I was expecting an array ref, but instead got '$ref'" ) ) if( !$self->_is_array( $ref ) );
248 0           my $arr = [];
249 0           for( my $i = 0; $i < scalar( @$ref ); $i++ )
250             {
251 0 0         my $o = defined( $ref->[$i] ) ? $self->_instantiate_object( $field, $class, $ref->[$i] ) : $self->_instantiate_object( $field, $class );
252 0 0         return( $self->error( "Unable to instantiate an object of class $class: ", $class->error ) ) if( !defined( $o ) );
253 0           push( @$arr, $o );
254             }
255 0           $self->{ $field } = $arr;
256             }
257 0           return( $self->{ $field } );
258             }
259              
260             sub _set_get_object_variant
261             {
262 0     0     my $self = shift( @_ );
263 0           my $field = shift( @_ );
264             # The class precisely depends on what we find looking ahead
265             # my $class = shift( @_ );
266 0 0         if( @_ )
267             {
268             my $process = sub
269             {
270 0     0     my $ref = shift( @_ );
271 0   0       my $type = $ref->{object} || return( $self->error( "No object type could be found in hash: ", sub{ $self->_dumper( $ref ) } ) );
272 0           my $class = $self->_object_type_to_class( $type );
273 0           my $o = $self->_instantiate_object( $field, $class, $ref );
274 0           $self->{ $field } = $o;
275             # return( $class->new( %$ref ) );
276             # return( $self->_set_get_object( 'object', $class, $ref ) );
277 0           };
278            
279 0 0         if( ref( $_[0] ) eq 'HASH' )
    0          
280             {
281 0           my $o = $process->( @_ )
282             }
283             # AN array of objects hash
284             elsif( ref( $_[0] ) eq 'ARRAY' )
285             {
286 0           my $arr = shift( @_ );
287 0           my $res = [];
288 0           foreach my $data ( @$arr )
289             {
290 0   0       my $o = $process->( $data ) || return( $self->error( "Unable to create object: ", $self->error ) );
291 0           push( @$res, $o );
292             }
293 0           $self->{ $field } = $res;
294             }
295             }
296 0           return( $self->{ $field } );
297             }
298              
299             sub _set_get_scalar_or_object_array
300             {
301 0     0     my $self = shift( @_ );
302 0           my $field = shift( @_ );
303 0           my $class = shift( @_ );
304 0 0 0       @_ = () if( scalar( @_ ) == 1 && !defined( $_[0] ) );
305 0 0         if( @_ )
306             {
307 0           my $ref = shift( @_ );
308 0 0         return( $self->error( "I was expecting an array ref, but instead got '$ref'" ) ) if( !$self->_is_array( $ref ) );
309 0           my $arr = [];
310 0           for( my $i = 0; $i < scalar( @$ref ); $i++ )
311             {
312             # If this is an HASH reference, we make it an object
313 0           my $o;
314 0 0         if( ref( $ref->[$i] ) )
315             {
316 0           $o = $self->_instantiate_object( $field, $class, $ref->[$i] );
317             }
318             else
319             {
320             # push( @$arr, $ref->[$i] );
321 0 0         $o = defined( $ref->[$i] ) ? $self->_instantiate_object( $field, $class, { id => $ref->[$i] } ) : $self->_instantiate_object( $field, $class );
322             }
323 0 0         return( $self->error( "Unable to instantiate an object of class $class: ", $class->error ) ) if( !defined( $o ) );
324 0           push( @$arr, $o );
325             }
326 0           $self->{ $field } = $arr;
327             }
328 0           return( $self->{ $field } );
329             }
330              
331             sub _set_get_scalar_or_object_variant
332             {
333 0     0     my $self = shift( @_ );
334 0           my $field = shift( @_ );
335 0 0         if( @_ )
336             {
337 0 0 0       if( ref( $_[0] ) eq 'HASH' || ref( $_[0] ) eq 'ARRAY' )
338             {
339 0           return( $self->_set_get_object_variant( $field, @_ ) );
340             }
341             else
342             {
343 0           return( $self->_set_get_scalar( $field, @_ ) );
344             }
345             }
346 0 0 0       if( !$self->{ $field } && want( 'OBJECT' ) )
347             {
348 0           my $null = Module::Generic::Null->new({ debug => $self->{debug}, has_error => 0 });
349 0           rreturn( $null );
350             }
351 0           return( $self->{ $field } );
352             }
353              
354             sub _set_get_uri
355             {
356 0     0     my $self = shift( @_ );
357 0           my $field = shift( @_ );
358 0 0         if( @_ )
359             {
360 0           my $str = $self->SUPER::_set_get_uri( $field, @_ );
361 0 0 0       if( defined( $str ) && Scalar::Util::blessed( $str ) )
362             {
363 0           $self->{ $field } = $str->abs( $self->_parent->api_uri );
364             }
365             }
366 0           return( $self->{ $field } );
367             }
368              
369 0     0     sub _will { return( shift->SUPER::will( @_ ) ); }
370              
371             1;
372              
373             __END__
374              
375             =encoding utf8
376              
377             =head1 NAME
378              
379             Net::API::Stripe::Generic - A Stripe Generic Module
380              
381             =head1 VERSION
382              
383             v0.101.0
384              
385             =head1 DESCRIPTION
386              
387             This is a module inherited by all other L<Net::API::Stripe> modules. Its purpose is to provide some shared methods and special object instantiation procedure with some key properties set such as I<_parent> and I<_field>.
388              
389             =head1 CONSTRUCTOR
390              
391             =head2 new( %ARG )
392              
393             Creates a new L<Net::API::Stripe::Fraud> object.
394             It may also take an hash like arguments, that also are method of the same name.
395              
396             Possible parameters are:
397              
398             =over 4
399              
400             =item I<_parent> The parent calling object
401              
402             =item I<_field> The field or property name this object is associated with
403              
404             =item I<_error>
405              
406             =item I<debug> Integer. A debug level.
407              
408             =item I<_dbh> A Database handler, if any
409              
410             =item I<_init_strict_use_sub> Boolean set for method B<init> in L<Module::Generic>. When set to true, only parameters that have a corresponding method will be accepted.
411              
412             =back
413              
414             =head1 METHODS
415              
416             =head2 field
417              
418             Set/get the field to which this object is associated
419              
420             =head2 parent
421              
422             Set/get the parent (caller) of this object.
423              
424             =head2 TO_JSON
425              
426             Returns a stringified version of this object if the method B<as_string> exists or is inherited, otherwise it just returns the object itself.
427              
428             =head2 _address_populate
429              
430             Provided with an L<Net::API::Stripe::Address> object, and this will set the fields line, line2, city, postal_code, state and country to address_line, address_line2, address_city, address_zip, address_state and address_country.
431              
432             This is used in L<Net::API::Stripe::Payment::Source> and L<Net::API::Stripe::Connect::ExternalAccount::Card>
433              
434             =head2 _get_base_class
435              
436             Get the base class of the object
437              
438             =head2 _instantiate_object( field, class )
439              
440             Provided with a field aka property name and a class name and this method creates an object.
441              
442             If the object is already instantiated, it returns it.
443              
444             Otherwise, it will attempt to load the given class using B<_load_class> from L<Module::Generic> or return undef and set an error if an error occurred.
445              
446             =head2 _object_type_to_class( type )
447              
448             Provided with a Stripe object type such as I<charge> or I<invoice> or I<customer>, this method will return the equivalent L<Net::API::Stripe> module package name.
449              
450             =head2 _set_get_hash( field, hash )
451              
452             Provided with a field (aka property) name and a hash reference, and this method will call method B<_set_get_hash_as_object> from L<Module::Generic> to create an hash whose properties can be accessed as methods of an object. So:
453              
454             $o->name
455              
456             instead of:
457              
458             $o->{name}
459              
460             =head2 _set_get_number( field, number )
461              
462             Provided with a field (aka property) and a number, this will create a new L<Module::Generic::Number> object for the associated field I<field>
463              
464             =head2 _set_get_object_array( field, class, array reference )
465              
466             Provided with a field (aka property) name, a class (package name) and an array reference, and this method will instantiate an object for each array entry.
467              
468             It returns an array reference for this field
469              
470             =head2 _set_get_object_variant( field, hash or array reference )
471              
472             Provided with a field (aka property) name and an hash or array reference and this method will instantiate an object if the data provided is an hash reference or it will instantiate an array of objects if the data provided is an array reference.
473              
474             =head2 _set_get_scalar_or_object_variant( field, scalar, hash or array reference )
475              
476             Provided with a scalar, an hash reference or an array reference and this will set the value for this field accordingly.
477              
478             If this is just a scalar, the scalar value will be set for the I<field>. If the data is an hash reference or an array reference, the same operation is done as in method B<_set_get_object_variant>
479              
480             =head2 _set_get_uri( field, uri )
481              
482             Provided with a field (aka a property) and an uri and this will create an L<URI> object for this I<field>
483              
484             =head2 _will
485              
486             Calls B<will> from the module L<Module::Generic>
487              
488             =head1 HISTORY
489              
490             =head2 v0.100.0
491              
492             Initial version
493              
494             =head1 AUTHOR
495              
496             Jacques Deguest E<lt>F<jack@deguest.jp>E<gt>
497              
498             =head1 SEE ALSO
499              
500             L<Net::API::Stripe>, L<Module::Generic>, L<Module::Generic::Number>, L<JSON>, L<URI>
501              
502             =head1 COPYRIGHT & LICENSE
503              
504             Copyright (c) 2019-2020 DEGUEST Pte. Ltd.
505              
506             You can use, copy, modify and redistribute this package and associated
507             files under the same terms as Perl itself.
508              
509             =cut