Mercurial > repos > fgiacomoni > downloader_bank_hmdb
view lib/utils.pm @ 1:4373f936111d draft
" master branch Updating with tag :CI_COMMIT_TAG - - Fxx"
author | fgiacomoni |
---|---|
date | Tue, 21 Jan 2020 16:09:45 -0500 |
parents | 7c9269bded0e |
children | be504ccbc41c |
line wrap: on
line source
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