Mercurial > repos > fgiacomoni > downloader_bank_hmdb
diff lib/utils.pm @ 2:be504ccbc41c draft default tip
master branch Updating with tag :CI_COMMIT_TAG - - Fxx
author | fgiacomoni |
---|---|
date | Wed, 30 Nov 2022 16:14:27 +0000 |
parents | 7c9269bded0e |
children |
line wrap: on
line diff
--- a/lib/utils.pm Tue Jan 21 16:09:45 2020 -0500 +++ b/lib/utils.pm Wed Nov 30 16:14:27 2022 +0000 @@ -56,6 +56,37 @@ } ### 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 @@ -74,11 +105,15 @@ # 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('franck.giacomoni@inrae.fr'); + $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') { + 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 ; @@ -95,9 +130,13 @@ else { next ; } -# print $version ; +# print "\tVERSION IS: $version\n" ; } - + + if (!$version) { + croak "\t /!\\ the current version of the db is not findable !!" + } + return($version) ; } ## END of SUB @@ -116,22 +155,41 @@ my $self = shift ; my ( $url, $fileNameToGet ) = @_ ; - my ( $fileName ) = undef ; + my $hstatus = 404 ; # default if ( (defined $url ) and (defined $fileNameToGet ) ) { my $ua = LWP::UserAgent->new(); - my $hstatus = getstore ($url, $fileNameToGet); + $ua->agent("Mozilla/5.0 (Macintosh; Intel Mac OS X 10.11; rv:64.0) Gecko/20100101 Firefox/64.0"); + $ua->from('franck.giacomoni@inrae.fr'); + $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 "$hstatus: ", status_message($hstatus), "\n"; - } - +# if($hstatus != HTTP_OK) { +# print "\t\t$hstatus: ", status_message($hstatus), "\n"; +# } +# if (!-e $fileNameToGet) { - croak "None file (should be $fileNameToGet) was download from the given url($url)\n" ; + carp "None file (should be $fileNameToGet) was download from the given url($url)\n" ; } } - return(1) ; + return($hstatus) ; } ## END of SUB