Mercurial > repos > fgiacomoni > downloader_bank_hmdb

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

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
master branch Updating with tag :CI_COMMIT_TAG - - Fxx
author fgiacomoni
date Wed, 30 Nov 2022 16:14:27 +0000
parents 7c9269bded0e
children
comparison
equal deleted inserted replaced
1:4373f936111d 2:be504ccbc41c
54 bless($self) ; 54 bless($self) ;
55 return $self ; 55 return $self ;
56 } 56 }
57 ### END of SUB 57 ### END of SUB
58 58
59 =head2 METHOD checkHttpUrl
60
61 ## Description : check if a http url exists or not and warn/die
62 ## Input : $url
63 ## Output : $warn
64 ## Usage : my ( $warn ) = checkHttpUrl ( $url ) ;
65
66 =cut
67 ## START of SUB
68 sub checkHttpUrl {
69 ## Retrieve Values
70 my $self = shift ;
71 my ( $url ) = @_;
72 my ( $warn ) = ( undef ) ;
73
74 my $ua = new LWP::UserAgent;
75
76 ## just make different not existing/time out
77 $ua->timeout(10);
78
79 if ($ua->head($url)) {
80 print "\t$url DOES EXIST\n";
81 } else {
82 croak "\t$url DOES not exist or timeout\n";;
83 }
84
85
86 return ($warn) ;
87 }
88 ### END of SUB
89
59 =head2 METHOD getHttpFileVersion 90 =head2 METHOD getHttpFileVersion
60 91
61 ## Description : fetch the version of a file from its http header 92 ## Description : fetch the version of a file from its http header
62 ## Input : $url 93 ## Input : $url
63 ## Output : $version 94 ## Output : $version
72 103
73 my ( $version ) = undef ; 104 my ( $version ) = undef ;
74 105
75 # based on https://stackoverflow.com/questions/36903905/extract-headers-from-http-request-in-perl 106 # based on https://stackoverflow.com/questions/36903905/extract-headers-from-http-request-in-perl
76 my $ua = new LWP::UserAgent; 107 my $ua = new LWP::UserAgent;
108 $ua->agent("Mozilla/5.0 (Macintosh; Intel Mac OS X 10.11; rv:64.0) Gecko/20100101 Firefox/64.0");
109 $ua->from('franck.giacomoni@inrae.fr');
110 $ua->ssl_opts(timeout => 100, verify_hostname => 0);
111
77 my $result = $ua->head($url); 112 my $result = $ua->head($url);
78 113
79 for my $header_name ($result->header_field_names) { 114 for my $header_name ($result->header_field_names) {
80 115
81 if ($header_name eq 'Last-Modified') { 116 if ( ($header_name eq 'Last-Modified') or ($header_name eq 'last-Modified') or ($header_name eq 'last-Modified') ) {
82 # print $result->header($header_name)."\n"; 117 # print $result->header($header_name)."\n";
83 if ($result->header($header_name) =~/[a-z|A-Z]+,\s(.*)\s[0-9]+:[0-9]+:[0-9]+\s[a-z|A-Z]+$/) { 118 if ($result->header($header_name) =~/[a-z|A-Z]+,\s(.*)\s[0-9]+:[0-9]+:[0-9]+\s[a-z|A-Z]+$/) {
84 $version = $1 ; 119 $version = $1 ;
85 120
86 #version format is DD Month(3letters) YYYY (as "09 Jul 2018") 121 #version format is DD Month(3letters) YYYY (as "09 Jul 2018")
93 } 128 }
94 } 129 }
95 else { 130 else {
96 next ; 131 next ;
97 } 132 }
98 # print $version ; 133 # print "\tVERSION IS: $version\n" ;
99 } 134 }
100 135
136 if (!$version) {
137 croak "\t /!\\ the current version of the db is not findable !!"
138 }
139
101 return($version) ; 140 return($version) ;
102 } 141 }
103 ## END of SUB 142 ## END of SUB
104 143
105 =head2 METHOD getHttpFile 144 =head2 METHOD getHttpFile
114 sub getHttpFile { 153 sub getHttpFile {
115 ## Retrieve Values 154 ## Retrieve Values
116 my $self = shift ; 155 my $self = shift ;
117 my ( $url, $fileNameToGet ) = @_ ; 156 my ( $url, $fileNameToGet ) = @_ ;
118 157
119 my ( $fileName ) = undef ; 158 my $hstatus = 404 ; # default
120 159
121 if ( (defined $url ) and (defined $fileNameToGet ) ) { 160 if ( (defined $url ) and (defined $fileNameToGet ) ) {
122 my $ua = LWP::UserAgent->new(); 161 my $ua = LWP::UserAgent->new();
123 my $hstatus = getstore ($url, $fileNameToGet); 162 $ua->agent("Mozilla/5.0 (Macintosh; Intel Mac OS X 10.11; rv:64.0) Gecko/20100101 Firefox/64.0");
163 $ua->from('franck.giacomoni@inrae.fr');
164 $ua->ssl_opts(timeout => 100, verify_hostname => 0);
165
166 # my $hstatus = getstore ($url, $fileNameToGet);
167
168 my $response = $ua->get($url);
169
170 if ($response->is_error) {
171 $hstatus = $response->status_line ;
172 print "\t\t$hstatus: ", status_message($hstatus), "\n";
173 carp $response->status_line, "\n";
174 }
175 else {
176 $hstatus = $response->status_line ;
177 }
178
179 open my $fh, '>', $fileNameToGet or die $!;
180 binmode $fh;
181 print $fh $response->decoded_content;
124 182
125 if($hstatus != HTTP_OK) { 183 # if($hstatus != HTTP_OK) {
126 print "$hstatus: ", status_message($hstatus), "\n"; 184 # print "\t\t$hstatus: ", status_message($hstatus), "\n";
127 } 185 # }
128 186 #
129 if (!-e $fileNameToGet) { 187 if (!-e $fileNameToGet) {
130 croak "None file (should be $fileNameToGet) was download from the given url($url)\n" ; 188 carp "None file (should be $fileNameToGet) was download from the given url($url)\n" ;
131 } 189 }
132 } 190 }
133 191
134 return(1) ; 192 return($hstatus) ;
135 } 193 }
136 ## END of SUB 194 ## END of SUB
137 195
138 =head2 METHOD unzipFile 196 =head2 METHOD unzipFile
139 197