|
0
|
1 package utils ;
|
|
|
2
|
|
|
3 use strict;
|
|
|
4 use warnings ;
|
|
|
5 use Exporter ;
|
|
|
6 use Carp ;
|
|
|
7
|
|
|
8 use Data::Dumper ;
|
|
|
9 use LWP::UserAgent ;
|
|
|
10 use LWP::Simple ;
|
|
|
11 use HTTP::Status qw(:constants :is status_message);
|
|
|
12 use Archive::Zip ;
|
|
|
13 use IO::Uncompress::Gunzip qw(gunzip $GunzipError) ;
|
|
|
14
|
|
|
15 use vars qw($VERSION @ISA @EXPORT %EXPORT_TAGS);
|
|
|
16
|
|
|
17 our $VERSION = "1.0";
|
|
|
18 our @ISA = qw(Exporter);
|
|
|
19 our @EXPORT = qw( getHttpFileVersion getHttpFile unzipFile );
|
|
|
20 our %EXPORT_TAGS = ( ALL => [qw( getHttpFileVersion getHttpFile unzipFile )] );
|
|
|
21
|
|
|
22 =head1 NAME
|
|
|
23
|
|
|
24 My::Module - An example module
|
|
|
25
|
|
|
26 =head1 SYNOPSIS
|
|
|
27
|
|
|
28 use My::Module;
|
|
|
29 my $object = My::Module->new();
|
|
|
30 print $object->as_string;
|
|
|
31
|
|
|
32 =head1 DESCRIPTION
|
|
|
33
|
|
|
34 This module does not really exist, it
|
|
|
35 was made for the sole purpose of
|
|
|
36 demonstrating how POD works.
|
|
|
37
|
|
|
38 =head1 METHODS
|
|
|
39
|
|
|
40 Methods are :
|
|
|
41
|
|
|
42 =head2 METHOD new
|
|
|
43
|
|
|
44 ## Description : new
|
|
|
45 ## Input : $self
|
|
|
46 ## Ouput : bless $self ;
|
|
|
47 ## Usage : new() ;
|
|
|
48
|
|
|
49 =cut
|
|
|
50
|
|
|
51 sub new {
|
|
|
52 ## Variables
|
|
|
53 my $self={};
|
|
|
54 bless($self) ;
|
|
|
55 return $self ;
|
|
|
56 }
|
|
|
57 ### END of SUB
|
|
|
58
|
|
|
59 =head2 METHOD getHttpFileVersion
|
|
|
60
|
|
|
61 ## Description : fetch the version of a file from its http header
|
|
|
62 ## Input : $url
|
|
|
63 ## Output : $version
|
|
|
64 ## Usage : $version= getHttpFileVersion($url) ;
|
|
|
65
|
|
|
66 =cut
|
|
|
67 ## START of SUB
|
|
|
68 sub getHttpFileVersion {
|
|
|
69 ## Retrieve Values
|
|
|
70 my $self = shift ;
|
|
|
71 my ( $url ) = @_ ;
|
|
|
72
|
|
|
73 my ( $version ) = undef ;
|
|
|
74
|
|
|
75 # based on https://stackoverflow.com/questions/36903905/extract-headers-from-http-request-in-perl
|
|
|
76 my $ua = new LWP::UserAgent;
|
|
|
77 my $result = $ua->head($url);
|
|
|
78
|
|
|
79 for my $header_name ($result->header_field_names) {
|
|
|
80
|
|
|
81 if ($header_name eq 'Last-Modified') {
|
|
|
82 # print $result->header($header_name)."\n";
|
|
|
83 if ($result->header($header_name) =~/[a-z|A-Z]+,\s(.*)\s[0-9]+:[0-9]+:[0-9]+\s[a-z|A-Z]+$/) {
|
|
|
84 $version = $1 ;
|
|
|
85
|
|
|
86 #version format is DD Month(3letters) YYYY (as "09 Jul 2018")
|
|
|
87 if ($version =~/([0-9]+)\s([a-z|A-Z]+)\s([0-9]+)/) {
|
|
|
88 $version = 'v'.$3.$2.$1 ;
|
|
|
89 }
|
|
|
90 else{
|
|
|
91 warn "the current version format - DD Month(3letters) YYYY - doesn't match with template" ;
|
|
|
92 }
|
|
|
93 }
|
|
|
94 }
|
|
|
95 else {
|
|
|
96 next ;
|
|
|
97 }
|
|
|
98 # print $version ;
|
|
|
99 }
|
|
|
100
|
|
|
101 return($version) ;
|
|
|
102 }
|
|
|
103 ## END of SUB
|
|
|
104
|
|
|
105 =head2 METHOD getHttpFile
|
|
|
106
|
|
|
107 ## Description : fetch a file from http
|
|
|
108 ## Input : $url, $filename
|
|
|
109 ## Output : $file
|
|
|
110 ## Usage : $file= getHttpFile($url, $filename) ;
|
|
|
111
|
|
|
112 =cut
|
|
|
113 ## START of SUB
|
|
|
114 sub getHttpFile {
|
|
|
115 ## Retrieve Values
|
|
|
116 my $self = shift ;
|
|
|
117 my ( $url, $fileNameToGet ) = @_ ;
|
|
|
118
|
|
|
119 my ( $fileName ) = undef ;
|
|
|
120
|
|
|
121 if ( (defined $url ) and (defined $fileNameToGet ) ) {
|
|
|
122 my $ua = LWP::UserAgent->new();
|
|
|
123 my $hstatus = getstore ($url, $fileNameToGet);
|
|
|
124
|
|
|
125 if($hstatus != HTTP_OK) {
|
|
|
126 print "$hstatus: ", status_message($hstatus), "\n";
|
|
|
127 }
|
|
|
128
|
|
|
129 if (!-e $fileNameToGet) {
|
|
|
130 croak "None file (should be $fileNameToGet) was download from the given url($url)\n" ;
|
|
|
131 }
|
|
|
132 }
|
|
|
133
|
|
|
134 return(1) ;
|
|
|
135 }
|
|
|
136 ## END of SUB
|
|
|
137
|
|
|
138 =head2 METHOD unzipFile
|
|
|
139
|
|
|
140 ## Description : unzip a wanted file from a zip archive
|
|
|
141 ## Input : $archive, $filePath, $fileName
|
|
|
142 ## Output : 1
|
|
|
143 ## Usage : unzipFile($archive, $filePath, $fileName) ;
|
|
|
144
|
|
|
145 =cut
|
|
|
146 sub unzipFile {
|
|
|
147 ## Retrieve Values
|
|
|
148 my $self = shift ;
|
|
|
149 my ($archive, $filePath, $fileName) = @_ ;
|
|
|
150
|
|
|
151 my $zip = Archive::Zip->new($archive);
|
|
|
152
|
|
|
153 if ( (defined $fileName) and (defined $filePath) ) {
|
|
|
154
|
|
|
155 foreach my $file ($zip->members) {
|
|
|
156 next unless ($file->fileName eq $fileName);
|
|
|
157 $file->extractToFileNamed($filePath);
|
|
|
158 }
|
|
|
159
|
|
|
160 croak "There was a problem extracting $fileName from $archive" unless (-e $filePath);
|
|
|
161 }
|
|
|
162 else {
|
|
|
163 croak "the given filePath or the filename are undef\n" ;
|
|
|
164 }
|
|
|
165
|
|
|
166 return 1;
|
|
|
167 }
|
|
|
168 ## END of SUB
|
|
|
169
|
|
|
170 =head2 METHOD gunzipFile
|
|
|
171
|
|
|
172 ## Description : unzip a wanted file from a zip archive
|
|
|
173 ## Input : $archive, $filePath, $fileName
|
|
|
174 ## Output : 1
|
|
|
175 ## Usage : gunzipFile($archive, $filePath, $fileName) ;
|
|
|
176
|
|
|
177 =cut
|
|
|
178 sub gunzipFile {
|
|
|
179 ## Retrieve Values
|
|
|
180 my $self = shift ;
|
|
|
181 my ($archive, $filePath, $fileName) = @_ ;
|
|
|
182
|
|
|
183 if ( (defined $fileName) and (defined $filePath) ) {
|
|
|
184
|
|
|
185 gunzip $archive => $filePath
|
|
|
186 or die "gunzip failed: $GunzipError\n";
|
|
|
187 }
|
|
|
188 else {
|
|
|
189 croak "the given filePath or the filename are undef\n" ;
|
|
|
190 }
|
|
|
191
|
|
|
192 return 1;
|
|
|
193 }
|
|
|
194 ## END of SUB
|
|
|
195
|
|
|
196
|
|
|
197 =head2 METHOD cleanUnzip
|
|
|
198
|
|
|
199 ## Description : clean zip file if the unzip is successfully run
|
|
|
200 ## Input : $archive, $filePath
|
|
|
201 ## Output : 1
|
|
|
202 ## Usage : unzipFile($archive, $want, $dir) ;
|
|
|
203
|
|
|
204 =cut
|
|
|
205 sub cleanUnzip {
|
|
|
206 ## Retrieve Values
|
|
|
207 my $self = shift ;
|
|
|
208 my ($archive, $filePath ) = @_ ;
|
|
|
209
|
|
|
210 if ( (defined $archive) and (defined $filePath) ) {
|
|
|
211
|
|
|
212 croak "There was a problem extracting $filePath from $archive" unless (-e $filePath);
|
|
|
213 unlink $archive ;
|
|
|
214 }
|
|
|
215 else {
|
|
|
216 croak "Given filePath or the archive are undef\n" ;
|
|
|
217 }
|
|
|
218
|
|
|
219 return 1;
|
|
|
220 }
|
|
|
221 ## END of SUB
|
|
|
222
|
|
|
223 1 ;
|
|
|
224
|
|
|
225
|
|
|
226 __END__
|
|
|
227
|
|
|
228 =head1 SUPPORT
|
|
|
229
|
|
|
230 You can find documentation for this module with the perldoc command.
|
|
|
231
|
|
|
232 perldoc XXX.pm
|
|
|
233
|
|
|
234 =head1 Exports
|
|
|
235
|
|
|
236 =over 4
|
|
|
237
|
|
|
238 =item :ALL is ...
|
|
|
239
|
|
|
240 =back
|
|
|
241
|
|
|
242 =head1 AUTHOR
|
|
|
243
|
|
|
244 Franck Giacomoni E<lt>franck.giacomoni@clermont.inra.frE<gt>
|
|
|
245
|
|
|
246 =head1 LICENSE
|
|
|
247
|
|
|
248 This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
|
|
|
249
|
|
|
250 =head1 VERSION
|
|
|
251
|
|
|
252 version 1 : xx / xx / 201x
|
|
|
253
|
|
|
254 version 2 : ??
|
|
|
255
|
|
|
256 =cut |
