File Coverage

blib/lib/Net/API/Stripe/Generic.pm
Criterion Covered Total %
statement 19 195 9.7
branch 0 90 0.0
condition 0 50 0.0
subroutine 7 26 26.9
pod 4 4 100.0
total 30 365 8.2


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