File Coverage

lib/HTTP/Promise/Body/Form/Field.pm
Criterion Covered Total %
statement 51 71 71.8
branch 18 44 40.9
condition 10 34 29.4
subroutine 12 14 85.7
pod 7 9 77.7
total 98 172 56.9


line stmt bran cond sub pod time code
1             ##----------------------------------------------------------------------------
2             ## Asynchronous HTTP Request and Promise - ~/lib/HTTP/Promise/Body/Form/Field.pm
3             ## Version v0.1.0
4             ## Copyright(c) 2022 DEGUEST Pte. Ltd.
5             ## Author: Jacques Deguest <jack@deguest.jp>
6             ## Created 2022/06/13
7             ## Modified 2022/06/13
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 HTTP::Promise::Body::Form::Field;
15             BEGIN
16             {
17 3     3   2800 use strict;
  3         14  
  3         105  
18 3     3   21 use warnings;
  3         6  
  3         95  
19 3     3   18 use parent qw( Module::Generic );
  3         13  
  3         19  
20 3     3   229 use vars qw( $VERSION $EXCEPTION_CLASS );
  3         6  
  3         222  
21 3     3   17 our $EXCEPTION_CLASS = 'HTTP::Promise::Exception';
22 3         2661 our $VERSION = 'v0.1.0';
23             };
24              
25             sub init
26             {
27 5     5 1 2678 my $self = shift( @_ );
28 5         45 my $opts = $self->_get_args_as_hash( @_ );
29 5         864 $self->{name} = undef;
30 5 50 33     90 return( $self->error( "No field name was provided." ) ) if( !exists( $opts->{name} ) || !defined( $opts->{name} ) || !length( $opts->{name} ) );
      33        
31 5         19 my( $headers, $body );
32 5 50       41 if( exists( $opts->{headers} ) )
33             {
34 5 100 33     53 if( $self->_is_a( $opts->{headers} => 'HTTP::Promise::Headers' ) )
    50          
35             {
36 4         154 $headers = $opts->{headers};
37             }
38             elsif( exists( $opts->{headers} ) && $self->_is_array( $opts->{headers} ) )
39             {
40 1 50       102 $self->_load_class( 'HTTP::Promise::Headers' ) || return( $self->pass_error );
41 1         78 $headers = HTTP::Promise::Headers->new( @{$opts->{headers}} );
  1         35  
42 1 50       8 return( $self->pass_error( HTTP::Promise::Headers->error ) ) if( !defined( $headers ) );
43             }
44             else
45             {
46 0         0 return( $self->error( "Unsupported data type '", ref( $opts->{headers} ), "' for field name $opts->{name}" ) );
47             }
48 5         34 delete( $opts->{headers} );
49             }
50             else
51             {
52 0 0       0 $self->_load_class( 'HTTP::Promise::Headers' ) || return( $self->pass_error );
53 0         0 $headers = HTTP::Promise::Headers->new;
54             }
55            
56 5 100 66     61 if( exists( $opts->{file} ) && $opts->{file} )
    50          
    50          
57             {
58 1 50       9 $self->_load_class( 'HTTP::Promise::Body' ) || return( $self->pass_error );
59 1   50     59 $body = HTTP::Promise::Body::File->new( $opts->{file} ) ||
60             return( $self->pass_error( HTTP::Promise::Body::File->error ) );
61 1         71 delete( @$opts{qw( body file value )} );
62             }
63             elsif( exists( $opts->{value} ) )
64             {
65 0 0       0 $self->_load_class( 'HTTP::Promise::Body' ) || return( $self->pass_error );
66 0   0     0 $body = HTTP::Promise::Body::Scalar->new( $opts->{value} ) ||
67             return( $self->pass_error( HTTP::Promise::Body::Scalar->error ) );
68 0         0 delete( @$opts{qw( body file value )} );
69             }
70             elsif( exists( $opts->{body} ) )
71             {
72 4 50 33     16 if( $self->_is_a( 'HTTP::Promise::Body' ) )
    50 33        
    50          
73             {
74 0         0 $body = $opts->{body};
75             }
76             elsif( $self->_is_a( $opts->{body} => 'Module::Generic::File' ) )
77             {
78 0 0       0 $self->_load_class( 'HTTP::Promise::Body' ) || return( $self->pass_error );
79 0   0     0 $body = HTTP::Promise::Body::File->new( $opts->{body} ) ||
80             return( $self->pass_error( HTTP::Promise::Body::File->error ) );
81             }
82             elsif( !ref( $opts->{body} ) ||
83             $self->_is_scalar( $opts->{body} ) ||
84             overload::Method( $opts->{body} => '""' ) )
85             {
86 4 50       202 $self->_load_class( 'HTTP::Promise::Body' ) || return( $self->pass_error );
87 4   50     166 $body = HTTP::Promise::Body::Scalar->new( $opts->{body} ) ||
88             return( $self->pass_error( HTTP::Promise::Body::Scalar->error ) );
89             }
90             else
91             {
92 0         0 return( $self->error( "Unsupported data '", ref( $opts->{body} ), "' for field name '$opts->{name}'" ) );
93             }
94 4         9 delete( $opts->{body} );
95             }
96             else
97             {
98 0 0       0 $self->_load_class( 'HTTP::Promise::Body' ) || return( $self->pass_error );
99 0         0 $body = HTTP::Promise::Body::Scalar->new;
100             }
101 5         27 $self->{body} = $body;
102 5         21 $self->{headers} = $headers;
103 5         21 $self->{_init_strict_use_sub} = 1;
104 5         28 $self->{_exception_class} = $EXCEPTION_CLASS;
105 5 50       49 $self->SUPER::init( $opts ) || return( $self->pass_error );
106 5         4446 return( $self );
107             }
108              
109 14     14 1 164673 sub body { return( shift->_set_get_object_without_init( 'body', [qw( HTTP::Promise::Body HTTP::Promise::Body::Form )], @_ ) ); }
110              
111             sub is_body_on_file
112             {
113 0     0 1 0 my $self = shift( @_ );
114 0         0 my $body = $self->body;
115 0 0 0     0 return(0) if( !$body || $body->is_empty );
116 0         0 return( $self->_is_a( $body => 'HTTP::Promise::Body::File' ) );
117             }
118              
119             sub is_body_in_memory
120             {
121 0     0 1 0 my $self = shift( @_ );
122 0         0 my $body = $self->body;
123 0 0 0     0 return(0) if( !$body || $body->is_empty );
124 0         0 return( $self->_is_a( $body => 'HTTP::Promise::Body::Scalar' ) );
125             }
126              
127 8     8 1 38385 sub headers { return( shift->_set_get_object_without_init( 'headers', 'HTTP::Promise::Headers', @_ ) ); }
128              
129 11     11 1 6557 sub name { return( shift->_set_get_scalar_as_object( 'name', @_ ) ); }
130              
131             sub value
132             {
133 2     2 1 1142 my $self = shift( @_ );
134 2   50     5 my $body = $self->body || return( $self->error( "No body is set for this field '$self->{name}'" ) );
135 2         9 my $data = $body->as_string( @_ );
136 2 50       53 return( $self->pass_error( $body->error ) ) if( !defined( $data ) );
137 2         10 return( $data );
138             }
139              
140             # NOTE: sub FREEZE is inherited
141              
142 1     1 0 225 sub STORABLE_freeze { CORE::return( CORE::shift->FREEZE( @_ ) ); }
143              
144 1     1 0 134 sub STORABLE_thaw { CORE::return( CORE::shift->THAW( @_ ) ); }
145              
146             # NOTE: sub THAW is inherited
147              
148             1;
149             # NOTE: POD
150             __END__
151              
152             =encoding utf-8
153              
154             =head1 NAME
155              
156             HTTP::Promise::Body::Form::Field - HTTP Form Field Class
157              
158             =head1 SYNOPSIS
159              
160             use HTTP::Promise::Body::Form::Field;
161             my $f = HTTP::Promise::Body::Form::Field->new(
162             name => 'picture',
163             file => '/some/where/image.png',
164             headers => [ conten_type => 'image/png' ],
165             );
166              
167             my $f = HTTP::Promise::Body::Form::Field->new(
168             name => 'picture',
169             # Module::Generic::File or HTTP::Promise::Body::File object are ok
170             file => $file_object,
171             headers => [ conten_type => 'image/png' ],
172             );
173              
174             my $f = HTTP::Promise::Body::Form::Field->new(
175             name => 'fullname',
176             body => "John Doe",
177             );
178              
179             my $f = HTTP::Promise::Body::Form::Field->new(
180             name => 'fullname',
181             body => \$some_content,
182             );
183              
184             my $f = HTTP::Promise::Body::Form::Field->new(
185             name => 'fullname',
186             # HTTP::Promise::Body::Scalar object is ok too
187             body => $body_object,
188             );
189              
190             =head1 VERSION
191              
192             v0.1.0
193              
194             =head1 DESCRIPTION
195              
196             This class represents a form field. This is used primarily in conjonction with L<HTTP::Promise::Body::Form::Data>
197              
198             =head1 METHODS
199              
200             =head2 body
201              
202             Sets or gets the field L<body object|HTTP::Promise::Body>.
203              
204             =head2 headers
205              
206             Sets or gets an L<headers object|HTTP::Promise::Headers>
207              
208             =head2 is_body_in_memory
209              
210             Returns true if the field body is an L<HTTP::Promise::Body::Scalar> object, false otherwise.
211              
212             =head2 is_body_on_file
213              
214             Returns true if the field body is an L<HTTP::Promise::Body::File> object, false otherwise.
215              
216             =head2 name
217              
218             Sets or gets the field name as a L<scalar object|Module::Generic::Scalar>
219              
220             =head2 value
221              
222             This retrieves the field data as a new L<scalar object|Module::Generic::Scalar>, regardless if it the field C<body> is in memory or on file.
223              
224             Whatever argument is provided, is passed through to L<HTTP::Promise::Body/as_string>
225              
226             =head1 AUTHOR
227              
228             Jacques Deguest E<lt>F<jack@deguest.jp>E<gt>
229              
230             =head1 SEE ALSO
231              
232             L<HTTP::Promise>, L<HTTP::Promise::Request>, L<HTTP::Promise::Response>, L<HTTP::Promise::Message>, L<HTTP::Promise::Entity>, L<HTTP::Promise::Headers>, L<HTTP::Promise::Body>, L<HTTP::Promise::Body::Form>, L<HTTP::Promise::Body::Form::Data>, L<HTTP::Promise::Body::Form::Field>, L<HTTP::Promise::Status>, L<HTTP::Promise::MIME>, L<HTTP::Promise::Parser>, L<HTTP::Promise::IO>, L<HTTP::Promise::Stream>, L<HTTP::Promise::Exception>
233              
234             =head1 COPYRIGHT & LICENSE
235              
236             Copyright(c) 2022 DEGUEST Pte. Ltd.
237              
238             All rights reserved.
239              
240             This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
241              
242             =cut