Mercurial > repos > fgiacomoni > downloader_bank_hmdb

comparison lib/utils.pm @ 0:7c9269bded0e draft

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Init repository for [downloader_bank_hmdb]
author fgiacomoni
date Tue, 14 Jan 2020 05:21:23 -0500
parents
children be504ccbc41c
comparison
equal deleted inserted replaced
-1:000000000000 0:7c9269bded0e
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