Much more modularity and some buf fixed in http_getter.pl

[helm.git] / helm / interface / http_getter / http_getter.pl

diff --git a/helm/interface/http_getter/http_getter.pl b/helm/interface/http_getter/http_getter.pl
index 4ad35848075ef78c44c230b1c5c4e8ceb6f227b1..d534e90b262b87b1ce5926eff20aeca66597f71a 100755 (executable)
--- a/helm/interface/http_getter/http_getter.pl
+++ b/helm/interface/http_getter/http_getter.pl
@@ -1,9 +1,15 @@
 #!/usr/bin/perl
 
+# First of all, let's load HELM configuration
+use Env;
+my $HELM_CONFIGURATION_PREFIX = $ENV{"HELM_CONFIGURATION_PREFIX"};
+my $HELM_CONFIGURATION_PATH =
+ $HELM_CONFIGURATION_PREFIX."/local/lib/helm/configuration.pl";
 # next require defines: $helm_dir, $html_link
-# LUCA - 12 sep 2000
-# require "/usr/lib/helm/configuration.pl";
-require "/home/cadet/sacerdot/local/lib/helm/configuration.pl";
+require $HELM_CONFIGURATION_PATH;
+
+
+
 use HTTP::Daemon;
 use HTTP::Status;
 use HTTP::Request;
@@ -12,9 +18,10 @@ use DB_File;
 
 my $cont = "";
 my $d = new HTTP::Daemon LocalPort => 8081;
-tie(%map, 'DB_File', 'urls_of_uris.db', O_RDONLY, 0664);
+tie(%map, 'DB_File', $uris_dbm.".db", O_RDONLY, 0664);
 print "Please contact me at: <URL:", $d->url, ">\n";
 print "helm_dir: $helm_dir\n";
+print "urls_of_uris.db: $uris_dbm.db\n";
 $SIG{CHLD} = "IGNORE"; # do not accumulate defunct processes
 while (my $c = $d->accept) {
  if (fork() == 0) {
@@ -49,7 +56,8 @@ while (my $c = $d->accept) {
                $response = $ua->request($request, \&callback);
                
                print "Storing file\n";
-               open(FD, $filename);
+               mkdirs($filename);
+               open(FD, ">".$filename);
                print FD $cont;
                close(FD);
 
@@ -89,7 +97,8 @@ while (my $c = $d->accept) {
                $response = $ua->request($request, \&callback);
                
                print "Storing file for the annotation\n";
-               open(FD, $filename);
+               mkdirs($filename);
+               open(FD, ">".$filename);
                print FD $cont;
                close(FD);
             }
@@ -111,7 +120,8 @@ while (my $c = $d->accept) {
                   $response = $ua->request($request, \&callback);
                
                   print "Storing file for the file to annotate\n";
-                  open(FD, $filename_target);
+                  mkdirs($filename_target);
+                  open(FD, ">".$filename_target);
                   print FD $cont;
                   close(FD);
                }
@@ -170,7 +180,8 @@ EOT
                $response = $ua->request($request, \&callback);
                
                print "Storing file for the types\n";
-               open(FD, $filename);
+               mkdirs($filename);
+               open(FD, ">".$filename);
                print FD $cont;
                close(FD);
             }
@@ -193,7 +204,8 @@ EOT
                   $response = $ua->request($request, \&callback);
                
                   print "Storing file for the file to type\n";
-                  open(FD, $filename_target);
+                  mkdirs($filename_target);
+                  open(FD, ">".$filename_target);
                   print FD $cont;
                   close(FD);
                }
@@ -270,3 +282,18 @@ sub callback
  my ($data) = @_;
  $cont .= $data;
 }
+
+# Does not raise errors if could not create dirs/files
+
+# Too much powerful: creates even /home, /home/users/, ...
+sub mkdirs
+{
+ my ($pathname) = @_;
+ my @dirs = split /\//,$pathname;
+ my $tmp;
+ foreach $dir (@dirs) {
+  $tmp = ((defined($tmp)) ?  $tmp = $tmp."\/".$dir : "");
+  mkdir($tmp,0777);
+ }
+ rmdir($tmp);
+}