minidom.c : fixed memory leak

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

diff --git a/helm/http_getter/http_getter.pl.in b/helm/http_getter/http_getter.pl.in
index e301963bcf65af3225a866a54c5a82306fc4cfdd..e06a3a5e2fbd43e6d3f8cc93bfed0131164d3062 100755 (executable)
--- a/helm/http_getter/http_getter.pl.in
+++ b/helm/http_getter/http_getter.pl.in
@@ -83,7 +83,7 @@ $myownurl  =~ s/http:\/\/(.*):(.*)/$1/;
 ($myownurl) = gethostbyname($myownurl);
 $myownurl = "http://".$myownurl.":".$myownport;
 
-tie(%map, 'DB_File', $uris_dbm.".db", O_RDONLY, 0664);
+tie(%map, 'DB_File', $uris_dbm.".db", O_RDWR, 0664);
 print "Please contact me at: <URL:", $myownurl."/", ">\n";
 print "helm_dir: $helm_dir\n";
 print "style_dir: $style_dir\n";
@@ -153,8 +153,30 @@ while (my $c = $d->accept) {
                my $ciccontent = download($patch_dtd,"cic",$cicurl,$cicfilename,$answerformat);
 
                # Answering the client
+              if ($answerformat eq "normal") {
+                answer($c,$ciccontent,"text/xml","");
+               } else {
                 answer($c,$ciccontent,"text/xml","x-gzip");
+               }
             }
+        } elsif ($http_method eq 'GET' and $http_path eq "/register") {
+          my $inputurl = $cgi->param('url');
+          print "Register requested...\n";
+          $map{$inputuri}=$inputurl;
+
+          # Now let's clean the cache
+          my $cicfilename = $inputuri;
+          $cicfilename =~ s/cic:(.*)/$1/;
+          $cicfilename =~ s/theory:(.*)/$1/;
+
+          print "Unlinking ".$helm_dir.$cicfilename.".xml[.gz]\n";
+          unlink ($helm_dir.$cicfilename.".xml");
+          unlink ($helm_dir.$cicfilename.".xml.gz");
+
+          kill(USR1,getppid()); # signal changes to parent
+          untie %map;
+          print "done\n";
+          html_nice_answer($c,"Register done");
         } elsif ($http_method eq 'GET' and $http_path eq "/resolve") {
           my $outputurl = $map{$inputuri};
           $outputurl = "" if (not defined($outputurl));
@@ -311,21 +333,32 @@ sub finduris { # find uris for cic and theory trees generation
  my ($uri,$localpart,$basepart,$dirname,$suffix,$flags,$key);
  my (@itemz,@already_pushed_dir);
  my (%objects,%dirs); # map uris to suffixes' flags
+ #my $debug=1; # for debug
 
  print "FINDURIS, uritype: $uritype, uripattern: $uripattern, ".
-  "format: $format\n\n";
+  "format: $format\n\n" if defined($debug);
  
  if (($uritype eq "cic") or ($uritype eq "theory")) {
    # get info only of one type: cic or theory
   foreach (keys(%map)) { # select matching uris
    $uri = $_;
-   if ($uri =~ /^$uritype:$uripattern\//) {
-    $localpart = $uri;
-    $localpart =~ s/^$uritype:$uripattern\/(.*)/$1/;
+   if ($uri =~ /^$uritype:$uripattern(\/|$|\.)/) {
+    if ($uri =~ /^$uritype:$uripattern\//) { # directory match
+     $localpart = $uri;
+     $localpart =~ s/^$uritype:$uripattern\/(.*)/$1/;
+    } elsif ($uri =~ /^$uritype:$uripattern($|\.)/) { # file match
+     $localpart = $uri;
+     $localpart =~ s/^.*\/([^\/]*)/$1/;
+    } else {
+     die "Internal error, seems that requested match is none of ".
+      "directory match or file match";
+    }
+    print "LOCALPART: $localpart\n" if defined($debug);
 
     if ($localpart =~ /^[^\/]*$/) { # no slash, an OBJECT
      $basepart = $localpart;
-     $basepart =~ s/^([^.]*\.[^.]*)(\.types)?(\.ann)?/$1/; # remove exts .types or
+     $basepart =~ s/^([^.]*\.[^.]*)(\.types)?(\.ann)?/$1/;
+                                              # remove exts .types or
                                               # .types.ann
      $flags = $objects{$basepart}; # get old flags
      if ($localpart =~ /\.ann$/) {
@@ -592,6 +625,9 @@ sub answer {
    unless ($contype eq "");
  $res->push_header("Content-Encoding" => $contenc)
    unless ($contenc eq "");
+ $res->push_header("Cache-Control" => "no-cache");
+ $res->push_header("Pragma" => "no-cache");
+ $res->push_header("Expires" => "0");
  $c->send_response($res);
 }
 
@@ -619,7 +655,7 @@ sub helm_wget {
 
 sub update {
  untie %map;
- tie(%map, 'DB_File', $uris_dbm.".db", O_RDONLY, 0664);
+ tie(%map, 'DB_File', $uris_dbm.".db", O_RDWR, 0664);
 }
 
 sub mk_urls_of_uris {
@@ -667,6 +703,6 @@ sub mk_urls_of_uris {
  }
 
  untie(%urls_of_uris);
- tie(%map, 'DB_File', $uris_dbm.".db", O_RDONLY, 0664);
+ tie(%map, 'DB_File', $uris_dbm.".db", O_RDWR, 0664);
 }