Added "format" support to /getciconly method.

Format may be one of "gz" or "normal", it sets the format of the returned
file either gzipped or uncompressed data.
"format" parameter may also be omitted.

diff --git a/helm/http_getter/http_getter.pl.in b/helm/http_getter/http_getter.pl.in
index 9c59641f92358d261be009c997667a1c84fd7541..44001955c7570652434640874f17bc1fd6ddefec 100755 (executable)
--- a/helm/http_getter/http_getter.pl.in
+++ b/helm/http_getter/http_getter.pl.in
@@ -97,19 +97,26 @@ while (my $c = $d->accept) {
     while (my $r = $c->get_request) {
         #CSC: mancano i controlli di sicurezza
         
-        my $inputuri = uri_unescape($r->url); 
-        $inputuri =~ s/^[^?]*\?uri=(.*)/$1/;
-        print "\nRequest: ".$r->url."\n\n";
         my $http_method = $r->method;
         my $http_path = $r->url->path;
         my $http_query = uri_unescape($r->url->query);
         my $cgi = new CGI("$http_query");
+        my $inputuri = $cgi->param('uri');
+        print "\nRequest: ".$r->url."\n\n";
 
        print "\nUnescaped query: ".$http_query."\n";
 
         if ($http_method eq 'GET' and $http_path eq "/getciconly") {
             # finds the uri, url and filename
             my $cicuri = $inputuri;
+            my $answerformat = $cgi->param('format');
+            $answerformat = "" if (not defined($answerformat));
+
+            if (($answerformat ne "gz") and ($answerformat ne "normal")
+               and ($answerformat ne "")) {
+             die "Wrong output format: $answerformat, must be 'normal' ".
+                 "or 'gz'\n";
+            }
 
             my $cicfilename = $cicuri;
             $cicfilename =~ s/cic:(.*)/$1/;
@@ -134,110 +141,12 @@ while (my $c = $d->accept) {
                print_request("cic",$cicuri,$cicurl,$cicfilename);
 
                # Retrieves the file
-               my $ciccontent = download(0,"cic",$cicurl,$cicfilename);
+               my $ciccontent = download(0,"cic",$cicurl,$cicfilename,$answerformat);
 
                # Answering the client
                answer($c,$ciccontent);
             }
-        } elsif ($http_method eq 'GET' and $http_path eq "/get") {
-            # finds the uris, urls and filenames
-            my $cicuri = $inputuri,
-               $typesuri = $inputuri,
-               $annuri = $inputuri;
-            my $annsuffix;
-            if ($inputuri =~ /\.types$/) {
-               $cicuri    =~ s/(.*)\.types$/$1/;
-               undef($annuri);
-            } elsif ($inputuri =~ /\.types\.ann$/) {
-               $cicuri    =~ s/(.*)\.types\.ann$/$1/;
-               $typesuri  =~ s/(.*)\.ann$/$1/;
-               $annsuffix = ".types.ann";
-            } elsif ($inputuri =~ /\.ann$/) {
-               $cicuri  =~ s/(.*)\.ann$/$1/;
-               undef($typesuri);
-               $annsuffix = ".ann";
-            } else {
-               undef($typesuri);
-               undef($annuri);
-            }
-
-            my $cicfilename = $cicuri;
-            $cicfilename =~ s/cic:(.*)/$1/;
-            $cicfilename =~ s/theory:(.*)/$1/;
-            $cicfilename = $helm_dir.$cicfilename;
-
-            my $cicurl   = $map{$cicuri};
-            my $typesurl = $map{$typesuri} if (defined($typesuri));
-            my $annurl   = $map{$annuri}  if (defined($annuri));
-            my ($cicext, $typesext, $annext);
-            if ($cicurl =~ /\.xml$/) { # normal file
-             $cicext = ".xml";
-            } elsif ($cicurl =~ /\.xml\.gz$/) { # gzipped file
-             $cicext = ".xml.gz";
-            } else {
-             die "unexpected extension in url: $cicurl;".
-             "might be '.xml' or '.xml.gz'";
-            }
-            if (defined($typesuri)) { # extension selection for types file
-             if ($typesurl =~ /\.xml$/) { # normal file
-              $typesext = ".types.xml";
-             } elsif ($typesurl =~ /\.xml\.gz$/) { # gzipped file
-              $typesext = ".types.xml.gz";
-             } else {
-              die "unexpected extension in url: $typesurl;".
-              "might be '.xml' or '.xml.gz'";
-             }
-            }
-            if (defined($annuri)) { # extension selection for annotation file
-             if ($annurl =~ /\.xml$/) { # normal file
-              $annext = ".xml";
-             } elsif ($annurl =~ /\.xml\.gz$/) { # gzipped file
-              $annext = ".xml.gz";
-             } else {
-              die "unexpected extension in url: $annurl".
-              "might be '.xml' or '.xml.gz'";
-             }
-            }
-            my $typesfilename = $cicfilename.$typesext if $typesuri;
-            my $annfilename  = $cicfilename.$annsuffix.$annext if $annuri;
-            $cicfilename .= $cicext;
-
-            if (!defined($cicurl) ||
-               (!defined($typesurl) && $typesuri) ||
-               (!defined($annuri) && $annuri))
-            {
-             print "\nNOT FOUND!!!!!\n";
-             $c->send_error(RC_NOT_FOUND)
-            } else {
-               print_request("cic",$cicuri,$cicurl,$cicfilename);
-               print_request("types",$typesuri,$typesurl,$typesfilename)
-                if ($typesuri);
-               print_request("ann",$annuri,$annurl,$annfilename)
-                if ($annuri);
- 
-               # Retrieves the files
-
-               my $ciccontent = download(1,"cic",$cicurl,$cicfilename);
-               my $typescontent =
-                download(1,"types",$typesurl,$typesfilename) if ($typesuri);
-               my $anncontent =
-                download(1,"ann",$annurl,$annfilename) if ($annuri);
- 
-               # Merging the files together
- 
-               my $merged = <<EOT;
-<?xml version="1.0" encoding="UTF-8"?>
-<cicxml uri="$cicuri">
-$ciccontent
-$typescontent
-$anncontent
-</cicxml>
-EOT
-
-               # Answering the client
-               answer($c,$merged);
-            }
-         } elsif ($http_method eq 'GET' and $http_path eq "/getdtd") {
+        } elsif ($http_method eq 'GET' and $http_path eq "/getdtd") {
             my $filename = $inputuri;
             $filename = $dtd_dir."/".$filename;
             print "DTD: $inputuri ==> ($filename)\n";
@@ -537,7 +446,7 @@ sub gzip {  # gzip the content argument and save it to filename argument
 
 sub download
 {
- my ($remove_headers,$str,$url,$filename) = @_;
+ my ($remove_headers,$str,$url,$filename,$format) = @_;
  my ($gz, $buffer);
 
  #my $debug=1; # for DEBUG only
@@ -574,52 +483,51 @@ sub download
    ."must end with '.gz' or '.xml.gz'\n";
   }
  } else { # download file from net
-    print "Downloading the $str file\n"; # download file
-    my $ua = LWP::UserAgent->new;
-    my $request = HTTP::Request->new(GET => "$url");
-    my $response = $ua->request($request, \&callback);
-               
-    # cache retrieved file to disk
-# <ZACK/> TODO: inefficent, I haven't yet undestood how to deflate
-#    in memory gzipped file, without call "gzopen"
- print "Storing the $str file\n";
- print "Making dirs ...\n" if (defined($debug));
- mkdirs($filename);
- print "Opening tmp file for writing ...\n" if (defined($debug));
- open(FD, ">".$filename.".tmp") or die "Cannot open $filename.tmp\n";
- print "Writing on tmp file ...\n" if (defined($debug));
- print FD $cont;
- print "Closing tmp file ...\n" if (defined($debug));
- close(FD);
-
- # handle cache conversion normal->gzipped or gzipped->normal as user choice
- print "cachemode:$cachemode, resourcetype:$resourcetype\n" if (defined($debug));
- if (($cachemode eq 'normal') and ($resourcetype eq 'normal')) {
-   # cache the file as is
-  rename "$filename.tmp", $filename; 
- } elsif (($cachemode eq 'gzipped') and ($resourcetype eq 'gzipped')) {
-   # cache the file as is
-   # and update the $cont variabile with deflated content
-  rename "$filename.tmp", $filename; 
-  $cont = gunzip($filename);
- } elsif (($cachemode eq 'normal') and ($resourcetype eq 'gzipped')) {
-   # deflate cache entry
-   # and update $cont
-  open(FD, "> $basefname") or die "cannot open $basefname\n";
-  $cont = gunzip($filename.".tmp");
-  print FD $cont;
-  close(FD);
-  unlink "$filename.tmp"; # delete old gzipped file
- } elsif (($cachemode eq 'gzipped') and ($resourcetype eq 'normal')) {
-   # compress cache entry
-  print "gzipping ...\n" if (defined($debug));
-  gzip($cont, $basefname.".gz");
-  unlink "$filename.tmp"; # delete old uncompressed file
- } else {
-  die "Internal error, unsopported cachemode, resourcetype couple\n";
- }
- # $cont now contained uncompressed data
+   print "Downloading the $str file\n"; # download file
+   my $ua = LWP::UserAgent->new;
+   my $request = HTTP::Request->new(GET => "$url");
+   my $response = $ua->request($request, \&callback);
+   
+   # cache retrieved file to disk
+   # <ZACK/> TODO: inefficent, I haven't yet undestood how to deflate
+   #    in memory gzipped file, without call "gzopen"
+   print "Storing the $str file\n";
+   print "Making dirs ...\n" if (defined($debug));
+   mkdirs($filename);
+   print "Opening tmp file for writing ...\n" if (defined($debug));
+   open(FD, ">".$filename.".tmp") or die "Cannot open $filename.tmp\n";
+   print "Writing on tmp file ...\n" if (defined($debug));
+   print FD $cont;
+   print "Closing tmp file ...\n" if (defined($debug));
+   close(FD);
 
+   # handle cache conversion normal->gzipped or gzipped->normal as user choice
+   print "cachemode:$cachemode, resourcetype:$resourcetype\n" if (defined($debug));
+   if (($cachemode eq 'normal') and ($resourcetype eq 'normal')) {
+     # cache the file as is
+    rename "$filename.tmp", $filename; 
+   } elsif (($cachemode eq 'gzipped') and ($resourcetype eq 'gzipped')) {
+     # cache the file as is
+     # and update the $cont variabile with deflated content
+    rename "$filename.tmp", $filename; 
+    $cont = gunzip($filename);
+   } elsif (($cachemode eq 'normal') and ($resourcetype eq 'gzipped')) {
+     # deflate cache entry
+     # and update $cont
+    open(FD, "> $basefname") or die "cannot open $basefname\n";
+    $cont = gunzip($filename.".tmp");
+    print FD $cont;
+    close(FD);
+    unlink "$filename.tmp"; # delete old gzipped file
+   } elsif (($cachemode eq 'gzipped') and ($resourcetype eq 'normal')) {
+     # compress cache entry
+    print "gzipping ...\n" if (defined($debug));
+    gzip($cont, $basefname.".gz");
+    unlink "$filename.tmp"; # delete old uncompressed file
+   } else {
+    die "Internal error, unsopported cachemode, resourcetype couple\n";
+   }
+   # $cont now contained uncompressed data
  }
  if ($remove_headers) {
     $cont =~ s/<\?xml [^?]*\?>//sg;
@@ -627,6 +535,19 @@ sub download
  } else {
     $cont =~ s/DOCTYPE (.*) SYSTEM\s+"http:\/\/www.cs.unibo.it\/helm\/dtd\//DOCTYPE $1 SYSTEM "$myownurl\/getdtd?uri=/g;
  }
+ if ($format eq "gz") {
+  gzip($cont,"$basefname.tmp");
+  open (TMP, "< $basefname.tmp")
+   or die "Can't open tempfile: $filename.tmp, exiting!\n";
+  $cont = "";
+  while(<TMP>) {
+   $cont .= $_;
+  }
+  close TMP;
+  unlink ($basefname . ".tmp") or
+   die "cannot unlink temporary file: $basefname.tmp\n";
+ }
+
  return $cont;
 }