File Coverage

blib/lib/Net/API/Telegram/InputFile.pm
Criterion Covered Total %
statement 25 90 27.7
branch 0 60 0.0
condition 0 14 0.0
subroutine 9 16 56.2
pod 4 7 57.1
total 38 187 20.3


line stmt bran cond sub pod time code
1             # -*- perl -*-
2             ##----------------------------------------------------------------------------
3             ## Telegram API - ~/lib/Net/API/Telegram/InputFile.pm
4             ## Version 0.1
5             ## Copyright(c) 2019 Jacques Deguest
6             ## Author: Jacques Deguest <jack@deguest.jp>
7             ## Created 2019/05/29
8             ## Modified 2019/10/31
9             ## All rights reserved
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::Telegram::InputFile;
15             BEGIN
16 0           {
17 1     1   866 use strict;
  1         2  
  1         29  
18 1     1   4 use parent qw( Net::API::Telegram::Generic );
  1         2  
  1         5  
19 1     1   49 use File::Basename;
  1         2  
  1         77  
20 1     1   459 use File::Copy ();
  1         2015  
  1         22  
21 1     1   6 use Cwd ();
  1         2  
  1         15  
22 1     1   522 use File::Type;
  1         7343  
  1         51  
23 1     1   9 use Scalar::Util;
  1         2  
  1         57  
24 1     1   959 our( $VERSION ) = '0.1';
25 1     1   6 use Devel::Confess;
  1         3  
  1         9  
26             };
27              
28             sub init
29             {
30 0     0 1   my $self = shift( @_ );
31 0           my $init = shift( @_ );
32 0 0         return( $self->error( sprintf( "Wrong number of parameters. I found %d, but am expecting an odd number.", scalar( @_ ) ) ) ) if( !( scalar( @_ ) % 2 ) );
33 0   0       my $this = shift( @_ ) || return( $self->error( "No file content or file path was provided." ) );
34 0           $self->SUPER::init( $init );
35 0           $self->{content} = '';
36 0           $self->{file} = '';
37 0           $self->{filename} = '';
38 0 0         if( ref( $this ) eq 'SCALAR' )
    0          
39             {
40 0           $self->{content} = $$this;
41             }
42             elsif( Scalar::Util::blessed( $this ) )
43             {
44 0 0         return( $self->error( "Do not know what to do with this object \"", ref( $this ), "\". If an object is provided, it should be a Net::API::Telegram::InputFile object." ) ) if( !$this->isa( 'Net::API::Telegram::InputFile' ) );
45 0 0         $self->{content} = $this->{content} if( $this->{content} );
46 0 0         $self->{file} = $this->{file} if( $this->{file} );
47 0 0         $self->{filename} = $this->{filenme} if( $this->{filename} );
48 0 0 0       return( $self->error( "The object provided has no file name or file content." ) ) if( !$this->{file} && !length( $this->{content} ) );
49             }
50             else
51             {
52 0           $self->{file} = $this;
53             }
54 0           return( $self );
55             }
56              
57             sub content
58             {
59 0     0 1   my $self = shift( @_ );
60 0 0         if( @_ )
61             {
62 0           $self->{content} = shift( @_ );
63             }
64 0 0         return( $self->{content} ) if( length( $self->{content} ) );
65 0 0         if( $self->{file} )
66             {
67 0   0       my $ct = $self->_load_file( $self->{file} ) || return( $self->error( "Unable to load file \"$self->{file}\": $!" ) );
68 0           $self->{content} = $ct;
69 0           return( $ct );
70             }
71 0           return;
72             }
73              
74             sub file
75             {
76 0     0 1   my $self = shift( @_ );
77 0 0         if( @_ )
78             {
79 0           my $file = shift( @_ );
80 0 0         return( $self->error( "File provided \"$file\" does not exist." ) ) if( !-e( $file ) );
81 0 0         return( $self->error( "File provided \"$file\" is empty." ) ) if( !-z( $file ) );
82 0 0         return( $self->error( "File provided \"$file\" is not a file." ) ) if( !-f( $file ) );
83 0 0         return( $self->error( "File provided \"$file\" is not readable." ) ) if( !-r( $file ) );
84 0           my( $dir, $base, $suffix ) = File::Basename::fileparse( $file, qr/\.[^\.]+$/ );
85 0 0         $self->{filename} = "${base}${suffix}" if( !length( $self->{filename} ) );
86 0           $self->{file} = $file;
87             }
88 0           return( $self->{file} );
89             }
90              
91 0     0 0   sub filename { return( shift->_set_get( 'filename', @_ ) ); }
92              
93             sub length
94             {
95 0     0 0   my $self = shift( @_ );
96 0 0         return( length( $self->{content} ) ) if( $self->{content} );
97 0 0         return( -s( $self->{file} ) ) if( $self->{file} );
98 0           return( 0 );
99             }
100              
101             sub save_as
102             {
103 0     0 1   my $self = shift( @_ );
104 0   0       my $path = shift( @_ ) || return( $self->error( "No file path to save as was provided." ) );
105 0           $path = Cwd::abs_path( $path );
106 0 0 0       return( $self->error( "No file or file content set to save." ) ) if( !$self->{file} && !length( $self->{content} ) );
107 0           my( $dir, $base, $suffix ) = File::Basename::fileparse( $path, qr/\.[^\.]+$/ );
108 0 0         return( $self->error( "File directory \"$path\" does not exist." ) ) if( !-e( $dir ) );
109 0 0         return( $self->error( "File directory \"$path\" exists, but it is not a directory." ) ) if( !-d( $dir ) );
110 0 0         return( $self->error( "File directory \"$path\" is not accessible. Not enoug permission to enter it." ) ) if( !-x( $dir ) );
111 0 0         if( $self->{content} )
    0          
112             {
113 0   0       my $fh = IO::File->new( ">$path" ) || return( $self->error( "Unable to open file \"$path\" in write mode: $!" ) );
114 0           $fh->binmode;
115 0           $fh->autoflush( 1 );
116 0 0         $fh->print( $self->{content} ) || return( $self->error( sprintf( "Unable to write %d bytes of data into file \"$path\": $!", length( $self->{content} ) ) ) );
117 0           $fh->close;
118             }
119             elsif( $self->{file} )
120             {
121 0 0         return( $self->error( "Source and target file \"$path\" are identical." ) ) if( $path eq $self->{file} );
122 0 0         File::Copy::copy( $self->{file}, $path ) ||
123             return( $self->error( "Unable to copy file \"$self->{file}\" to \"$path\": #!" ) );
124             }
125             }
126              
127             sub type
128             {
129 0     0 0   my $self = shift( @_ );
130 0           my $t = File::Type->new;
131 0 0         if( $self->{content} )
    0          
132             {
133 0           return( $t->mime_type( $self->{content} ) );
134             }
135             elsif( $self->{file} )
136             {
137 0           return( $t->mime_type( $self->{file} ) );
138             }
139             else
140             {
141             ## Return empty, not undef
142 0           return( '' );
143             }
144             }
145              
146             1;
147              
148             __END__
149              
150             =encoding utf-8
151              
152             =head1 NAME
153              
154             Net::API::Telegram::InputFile - The contents of a file to be uploaded
155              
156             =head1 SYNOPSIS
157              
158             my $msg = Net::API::Telegram::InputFile->new( %data ) ||
159             die( Net::API::Telegram::InputFile->error, "\n" );
160              
161             =head1 DESCRIPTION
162              
163             L<Net::API::Telegram::InputFile> is a Telegram Message Object as defined here L<https://core.telegram.org/bots/api#inputfile>
164              
165             =head1 METHODS
166              
167             =over 4
168              
169             =item B<new>( {INIT HASH REF}, SCALAR REF | FILE PATH, %PARAMETERS )
170              
171             B<new>() will create a new object for the package, pass any argument it might receive
172             to the special standard routine B<init> that I<must> exist.
173             It takes one mandatory parameter which is either a scalar for raw data or a file path.
174              
175             Then it returns what returns B<init>().
176              
177             The valid parameters are as follow. Methods available here are also parameters to the B<new> method.
178              
179             =over 8
180              
181             =item * I<verbose>
182              
183             =item * I<debug>
184              
185             =back
186              
187             =item B<content>( [ DATA ] )
188              
189             Set or get the raw data for this object.
190              
191             If no data was set, but a I<file> was set then this will read the file and return its content.
192              
193             It returns the current content set.
194              
195             =item B<file>( [ FILE PATH ] )
196              
197             Set or get the file path of the file for this object.
198              
199             This method will perform some basic sanitary checks on the accessibility of the given file path, and its permissions and return error if the file has problems.
200              
201             It returns the current file set.
202              
203             =item B<save_as>( FILE PATH )
204              
205             Given a file path, this method will save the content of the file in this object to the specified file path.
206              
207             Before doing so, this method will perform some sanity check on the parent directory to ensure the action can actually be done. It will return an error if problems were found.
208              
209             =back
210              
211             =head1 COPYRIGHT
212              
213             Copyright (c) 2000-2019 DEGUEST Pte. Ltd.
214              
215             =head1 CREDITS
216              
217             Jacques Deguest E<lt>F<jack@deguest.jp>E<gt>
218              
219             =head1 SEE ALSO
220              
221             L<Net::API::Telegram>
222              
223             =cut
224