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