X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;ds=sidebyside;f=helm%2Fhttp_getter%2Fhttp_getter.pl.in;h=e9d1f4a3e04609137ad68b8db5658759be797f81;hb=698e42d972248fcfe069dcc8f751b258ff9dac11;hp=0acf0ca348df80d45be4121810a657d0b02d8822;hpb=7a77e2728c1ddd4ad0f4fe75747de04d84a5ca4d;p=helm.git
diff --git a/helm/http_getter/http_getter.pl.in b/helm/http_getter/http_getter.pl.in
index 0acf0ca34..e9d1f4a3e 100755
--- a/helm/http_getter/http_getter.pl.in
+++ b/helm/http_getter/http_getter.pl.in
@@ -55,18 +55,15 @@ if (($cachemode ne 'gzipped') and ($cachemode ne 'normal')) {
"'normal' or 'gzipped'\n";
}
-my $helm_rdf_dir = $ENV{'HTTP_GETTER_RDF_DIR'} ||
- "/usr/local/helm/rdf_library";
-my $rdf_dbm = $ENV{'HTTP_GETTER_RDF_DBM'} ||
- "/usr/local/helm/rdf_urls_of_uris.db";
-my $xslt_dbm = $ENV{'HTTP_GETTER_XSLT_DBM'} ||
- "/usr/local/helm/xslt_urls_of_uris.db";
-my $rdf_indexname = $ENV{'HTTP_GETTER_RDF_INDEXNAME'} ||
- "rdf_index.txt";
-my $xslt_indexname = $ENV{'HTTP_GETTER_XSLT_INDEXNAME'} ||
- "xslt_index.txt";
+$helm_rdf_dir = $ENV{'HTTP_GETTER_RDF_DIR'} || $helm_rdf_dir;
+$rdf_dbm = $ENV{'HTTP_GETTER_RDF_DBM'} || $rdf_dbm;
+$xslt_dbm = $ENV{'HTTP_GETTER_XSLT_DBM'} || $xslt_dbm;
+$rdf_indexname = $ENV{'HTTP_GETTER_RDF_INDEXNAME'} || $rdf_indexname;
+$xslt_indexname = $ENV{'HTTP_GETTER_XSLT_INDEXNAME'} || $xslt_indexname;
$servers_file = $ENV{'HTTP_GETTER_SERVERS_FILE'} || $servers_file;
$uris_dbm = $ENV{'HTTP_GETTER_URIS_DBM'} || $uris_dbm;
+$dtdbaseurl = $ENV{'HTTP_GETTER_DTD_BASE_URL'} || $dtdbaseurl;
+$getterport = $ENV{'HTTP_GETTER_PORT'} || $getterport;
#
@@ -88,8 +85,8 @@ use URI::Escape;
#CSC: ==> non e' robusto
#CSC: altra roba da sistemare segnata con CSC
-my $d = new HTTP::Daemon LocalPort => 8081
- or die "Error: port 8081 not available.";
+my $d = new HTTP::Daemon LocalPort => $getterport
+ or die "Error: port $getterport not available.";
my $myownurl = $d->url;
# Let's patch the returned URL
@@ -120,6 +117,8 @@ print "cache mode: $cachemode\n";
print "indexname: $indexname\n";
print "rdf_indexname: $rdf_indexname\n";
print "xslt_indexname: $xslt_indexname\n";
+print "dtdbaseurl: $dtdbaseurl\n";
+print "getterport: $getterport\n";
print "\n";
$SIG{CHLD} = "IGNORE"; # do not accumulate defunct processes
@@ -323,8 +322,9 @@ while (my $c = $d->accept) {
# "/getallrdfuris"
} elsif ($http_method eq 'GET' and $http_path eq "/getallrdfuris") {
# send back all the keys in xml
- print "BASEURI $baseuri, FORMAT $outype\n";
- $cont = getallrdfuris();
+ my $class = $cgi->param('class');
+ print "BASEURI $baseuri, FORMAT $outype, CLASS $class\n";
+ $cont = getallrdfuris($class);
answer($c,$cont,"text/xml","");
} elsif ($http_method eq 'GET' and $http_path eq "/ls") {
@@ -476,6 +476,7 @@ sub getalluris { # get all the keys whose prefix is cic
}
sub getallrdfuris {
+ my $class = $_[0];
my $content = "";
my ($uri);
my $debug=1; # for debug
@@ -485,8 +486,14 @@ sub getallrdfuris {
$content .= "\"$myownurl/getdtd?uri=alluris.dtd\">" . "\n\n";
$content .= "\n";
foreach $uri (sort (keys(%rdf_map))) {
- print "GETALLRDFURI: $uri\n" if defined($debug);
- $content .= "\t\n";
+ if ($class eq "forward" &&
+ $uri =~ /^helm:rdf:www.cs.unibo.it\/helm\/rdf\/forward/
+ ||
+ $class eq "backward" &&
+ $uri =~ /^helm:rdf:www.cs.unibo.it\/helm\/rdf\/backward/) {
+ print "GETALLRDFURI: $uri\n" if defined($debug);
+ $content .= "\t\n";
+ }
}
$content .= "\n";
return $content;
@@ -522,9 +529,9 @@ sub finduris { # find uris for cic and theory trees generation
if ($localpart =~ /^[^\/]*$/) { # no slash, an OBJECT
$basepart = $localpart;
- $basepart =~ s/^([^.]*\.[^.]*)(\.types)?(\.ann)?/$1/;
- # remove exts .types or
- # .types.ann
+ $basepart =~ s/^([^.]*\.[^.]*)((\.body)|(\.types))?(\.ann)?/$1/;
+ # remove exts .types, .body,
+ # .types.ann or .body.ann
$flags = $objects{$basepart}; # get old flags
if ($localpart =~ /\.ann$/) {
$flags = add_flag("ann","YES",$flags);
@@ -538,6 +545,13 @@ sub finduris { # find uris for cic and theory trees generation
} else {
$flags = add_flag("types","NO",$flags);
}
+ if ($localpart =~ /\.body$/) {
+ $flags = add_flag("body","YES",$flags);
+ } elsif ($localpart =~ /\.body\.ann$/) {
+ $flags = add_flag("body","ANN",$flags);
+ } else {
+ $flags = add_flag("body","NO",$flags);
+ }
$objects{$basepart} = $flags; # save new flags
} else { # exists at least one slash, a DIR
($dirname) = split (/\//, $localpart);
@@ -569,9 +583,10 @@ sub finduris { # find uris for cic and theory trees generation
$content .= "\t\n";
$content .= "\t\n";
}
$content .= "\n";
@@ -582,17 +597,18 @@ sub finduris { # find uris for cic and theory trees generation
}
sub add_flag {
-# manage string like: ""
+# manage string like: ""
# "ann_flag" may be one of "ann_YES", "ann_NO"
# "type_flag" may be one of "types_NO", "types_YES", "types_ANN"
+# "body_flag" may be one of "body_NO", "body_YES", "body_ANN"
# when adding a flag the max between the current flag and the new flag
-# is taken, the orders are ann_NO < ann_YES and types_NO < types_YES <
-# types_ANN
+# is taken, the orders are ann_NO < ann_YES, types_NO < types_YES <
+# types_ANN and body_NO < body_YES < body_ANN
my ($flagtype,$newflag,$str) = @_;
- $str = "<,>" if ($str eq "");
- ($str =~ s/^<(.*,.*)>$/$1/) or die "Internal error: ".
+ $str = "<,,>" if ($str eq "");
+ ($str =~ s/^<(.*,.*,.*)>$/$1/) or die "Internal error: ".
"wrong string format for flag adding in $str";
- my ($annflag,$typeflag) = split /,/,$str;
+ my ($annflag,$typeflag,$bodyflag) = split /,/,$str;
if ($flagtype eq "ann") { # ANN flag handling
if ($newflag eq "YES") {
$annflag = "YES";
@@ -612,10 +628,21 @@ sub add_flag {
} else {
die "Internal error: typeflag must be \"YES\", \"NO\" or \"ANN\"";
}
+ } elsif ($flagtype eq "body") { # BODY flag handling
+ if ($newflag eq "ANN") {
+ $bodyflag = "ANN";
+ } elsif ($newflag eq "YES") {
+ $bodyflag = "YES" unless ($bodyflag eq "ANN");
+ } elsif ($newflag eq "NO") {
+ $bodyflag = "NO"
+ unless (($bodyflag eq "ANN") or ($bodyflag eq "YES"));
+ } else {
+ die "Internal error: typeflag must be \"YES\", \"NO\" or \"ANN\"";
+ }
} else {
die "Internal error: unsupported flagtype \"$flagtype\"";
}
- $str = "<$annflag,$typeflag>";
+ $str = "<$annflag,$typeflag,$bodyflag>";
}
#CSC: Too much powerful: creates even /home, /home/users/, ...
@@ -760,7 +787,7 @@ sub download {
# $cont now contained uncompressed data
}
if ($patch_dtd eq "yes") {
- $cont =~ s/DOCTYPE (.*) SYSTEM\s+"http:\/\/www.cs.unibo.it\/helm\/dtd\//DOCTYPE $1 SYSTEM "$myownurl\/getdtd?uri=/g;
+ $cont =~ s/DOCTYPE (.*) SYSTEM\s+"$dtdbaseurl\//DOCTYPE $1 SYSTEM "$myownurl\/getdtd?uri=/g;
}
if ($format eq "gz") {
gzip($cont,"$basefname.tmp");
@@ -792,6 +819,7 @@ sub answer {
$res->push_header("Pragma" => "no-cache");
$res->push_header("Expires" => "0");
$c->send_response($res);
+ $c->force_last_request();
}
sub html_nice_answer {