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