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
|
|
1070
|
use strict; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
35
|
|
18
|
1
|
|
|
1
|
|
6
|
use parent qw( Net::API::Telegram::Generic ); |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
6
|
|
19
|
1
|
|
|
1
|
|
59
|
use File::Basename; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
86
|
|
20
|
1
|
|
|
1
|
|
567
|
use File::Copy (); |
|
1
|
|
|
|
|
2778
|
|
|
1
|
|
|
|
|
28
|
|
21
|
1
|
|
|
1
|
|
8
|
use Cwd (); |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
18
|
|
22
|
1
|
|
|
1
|
|
622
|
use File::Type; |
|
1
|
|
|
|
|
10109
|
|
|
1
|
|
|
|
|
53
|
|
23
|
1
|
|
|
1
|
|
8
|
use Scalar::Util; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
59
|
|
24
|
1
|
|
|
1
|
|
1334
|
our( $VERSION ) = '0.1'; |
25
|
1
|
|
|
1
|
|
7
|
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
|
|
|
|
|
|
|
|