view lib/utils.pm @ 2:be504ccbc41c draft default tip

master branch Updating with tag :CI_COMMIT_TAG - - Fxx

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 checkHttpUrl

	## Description : check if a http url exists or not and warn/die
	## Input : $url
	## Output : $warn
	## Usage : my ( $warn ) = checkHttpUrl ( $url ) ;
	
=cut
## START of SUB
sub checkHttpUrl {
    ## Retrieve Values
    my $self = shift ;
    my ( $url ) = @_;
    my ( $warn ) = ( undef ) ;
    
    my $ua = new LWP::UserAgent;
    
    ## just make different not existing/time out
    $ua->timeout(10);
	
	if ($ua->head($url)) {
		print "\t$url DOES EXIST\n";
	} else {
		croak "\t$url DOES not exist or timeout\n";;
	}
	
    
    return ($warn) ;
}
### 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;
	$ua->agent("Mozilla/5.0 (Macintosh; Intel Mac OS X 10.11; rv:64.0) Gecko/20100101 Firefox/64.0");
    $ua->from('[e-mail]');
    $ua->ssl_opts(timeout => 100, verify_hostname => 0);
    
	my $result = $ua->head($url);
	
	for my $header_name ($result->header_field_names) {
		
		if ( ($header_name eq 'Last-Modified') or ($header_name eq 'last-Modified') or ($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 "\tVERSION IS: $version\n" ;
	}
	
	if (!$version) {
		croak "\t /!\\ the current version of the db is not findable !!"
	}
	
    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 $hstatus = 404 ; # default
    
    if ( (defined $url ) and (defined $fileNameToGet ) ) {
    	my $ua = LWP::UserAgent->new();
    	$ua->agent("Mozilla/5.0 (Macintosh; Intel Mac OS X 10.11; rv:64.0) Gecko/20100101 Firefox/64.0");
    	$ua->from('[e-mail]');
    	$ua->ssl_opts(timeout => 100, verify_hostname => 0);
    	
#    	my $hstatus =  getstore ($url, $fileNameToGet);

		my $response = $ua->get($url);
		
		if ($response->is_error) {
			$hstatus = $response->status_line ;
			print "\t\t$hstatus: ", status_message($hstatus), "\n";
		  	carp $response->status_line, "\n";
		}
		else {
			$hstatus = $response->status_line ;
		}
		
		open my $fh, '>', $fileNameToGet or die $!;
		binmode $fh;
		print $fh $response->decoded_content;
			
#		if($hstatus != HTTP_OK) {
#			print "\t\t$hstatus: ", status_message($hstatus), "\n";
#		}
#			
		if (!-e $fileNameToGet) {
			carp "None file (should be $fileNameToGet) was download from the given url($url)\n" ;
		}
    }

    return($hstatus) ;
}
## 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>[e-mail]<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