File Coverage

blib/lib/Net/API/Telegram/InputFile.pm
Criterion Covered Total %
statement 22 86 25.5
branch 0 60 0.0
condition 0 14 0.0
subroutine 8 15 53.3
pod 6 7 85.7
total 36 182 19.7


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