Mercurial > repos > fgiacomoni > downloader_bank_hmdb
diff lib/utils.pm @ 0:7c9269bded0e draft
Init repository for [downloader_bank_hmdb]
author | fgiacomoni |
---|---|
date | Tue, 14 Jan 2020 05:21:23 -0500 |
parents | |
children | be504ccbc41c |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lib/utils.pm Tue Jan 14 05:21:23 2020 -0500 @@ -0,0 +1,256 @@ +package utils ; + +use strict; +use warnings ; +use Exporter ; +use Carp ; + +use Data::Dumper ; +use LWP::UserAgent ; +use LWP::Simple ; +use HTTP::Status qw(:constants :is status_message); +use Archive::Zip ; +use IO::Uncompress::Gunzip qw(gunzip $GunzipError) ; + +use vars qw($VERSION @ISA @EXPORT %EXPORT_TAGS); + +our $VERSION = "1.0"; +our @ISA = qw(Exporter); +our @EXPORT = qw( getHttpFileVersion getHttpFile unzipFile ); +our %EXPORT_TAGS = ( ALL => [qw( getHttpFileVersion getHttpFile unzipFile )] ); + +=head1 NAME + +My::Module - An example module + +=head1 SYNOPSIS + + use My::Module; + my $object = My::Module->new(); + print $object->as_string; + +=head1 DESCRIPTION + +This module does not really exist, it +was made for the sole purpose of +demonstrating how POD works. + +=head1 METHODS + +Methods are : + +=head2 METHOD new + + ## Description : new + ## Input : $self + ## Ouput : bless $self ; + ## Usage : new() ; + +=cut + +sub new { + ## Variables + my $self={}; + bless($self) ; + return $self ; +} +### END of SUB + +=head2 METHOD getHttpFileVersion + + ## Description : fetch the version of a file from its http header + ## Input : $url + ## Output : $version + ## Usage : $version= getHttpFileVersion($url) ; + +=cut +## START of SUB +sub getHttpFileVersion { + ## Retrieve Values + my $self = shift ; + my ( $url ) = @_ ; + + my ( $version ) = undef ; + + # based on https://stackoverflow.com/questions/36903905/extract-headers-from-http-request-in-perl + my $ua = new LWP::UserAgent; + my $result = $ua->head($url); + + for my $header_name ($result->header_field_names) { + + if ($header_name eq 'Last-Modified') { +# print $result->header($header_name)."\n"; + if ($result->header($header_name) =~/[a-z|A-Z]+,\s(.*)\s[0-9]+:[0-9]+:[0-9]+\s[a-z|A-Z]+$/) { + $version = $1 ; + + #version format is DD Month(3letters) YYYY (as "09 Jul 2018") + if ($version =~/([0-9]+)\s([a-z|A-Z]+)\s([0-9]+)/) { + $version = 'v'.$3.$2.$1 ; + } + else{ + warn "the current version format - DD Month(3letters) YYYY - doesn't match with template" ; + } + } + } + else { + next ; + } +# print $version ; + } + + return($version) ; +} +## END of SUB + +=head2 METHOD getHttpFile + + ## Description : fetch a file from http + ## Input : $url, $filename + ## Output : $file + ## Usage : $file= getHttpFile($url, $filename) ; + +=cut +## START of SUB +sub getHttpFile { + ## Retrieve Values + my $self = shift ; + my ( $url, $fileNameToGet ) = @_ ; + + my ( $fileName ) = undef ; + + if ( (defined $url ) and (defined $fileNameToGet ) ) { + my $ua = LWP::UserAgent->new(); + my $hstatus = getstore ($url, $fileNameToGet); + + if($hstatus != HTTP_OK) { + print "$hstatus: ", status_message($hstatus), "\n"; + } + + if (!-e $fileNameToGet) { + croak "None file (should be $fileNameToGet) was download from the given url($url)\n" ; + } + } + + return(1) ; +} +## END of SUB + +=head2 METHOD unzipFile + + ## Description : unzip a wanted file from a zip archive + ## Input : $archive, $filePath, $fileName + ## Output : 1 + ## Usage : unzipFile($archive, $filePath, $fileName) ; + +=cut +sub unzipFile { + ## Retrieve Values + my $self = shift ; + my ($archive, $filePath, $fileName) = @_ ; + + my $zip = Archive::Zip->new($archive); + + if ( (defined $fileName) and (defined $filePath) ) { + + foreach my $file ($zip->members) { + next unless ($file->fileName eq $fileName); + $file->extractToFileNamed($filePath); + } + + croak "There was a problem extracting $fileName from $archive" unless (-e $filePath); + } + else { + croak "the given filePath or the filename are undef\n" ; + } + + return 1; +} +## END of SUB + +=head2 METHOD gunzipFile + + ## Description : unzip a wanted file from a zip archive + ## Input : $archive, $filePath, $fileName + ## Output : 1 + ## Usage : gunzipFile($archive, $filePath, $fileName) ; + +=cut +sub gunzipFile { + ## Retrieve Values + my $self = shift ; + my ($archive, $filePath, $fileName) = @_ ; + + if ( (defined $fileName) and (defined $filePath) ) { + + gunzip $archive => $filePath + or die "gunzip failed: $GunzipError\n"; + } + else { + croak "the given filePath or the filename are undef\n" ; + } + + return 1; +} +## END of SUB + + +=head2 METHOD cleanUnzip + + ## Description : clean zip file if the unzip is successfully run + ## Input : $archive, $filePath + ## Output : 1 + ## Usage : unzipFile($archive, $want, $dir) ; + +=cut +sub cleanUnzip { + ## Retrieve Values + my $self = shift ; + my ($archive, $filePath ) = @_ ; + + if ( (defined $archive) and (defined $filePath) ) { + + croak "There was a problem extracting $filePath from $archive" unless (-e $filePath); + unlink $archive ; + } + else { + croak "Given filePath or the archive are undef\n" ; + } + + return 1; +} +## END of SUB + +1 ; + + +__END__ + +=head1 SUPPORT + +You can find documentation for this module with the perldoc command. + + perldoc XXX.pm + +=head1 Exports + +=over 4 + +=item :ALL is ... + +=back + +=head1 AUTHOR + +Franck Giacomoni E<lt>franck.giacomoni@clermont.inra.frE<gt> + +=head1 LICENSE + +This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. + +=head1 VERSION + +version 1 : xx / xx / 201x + +version 2 : ?? + +=cut \ No newline at end of file