X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fhttp_getter%2Fhttp_getter.pl.in;h=e9d1f4a3e04609137ad68b8db5658759be797f81;hb=5d7d6bd5090f3f82279bef0b93b4b361a5b1d751;hp=c9cac35f2904741994c5b3cc67bdbb34738c7324;hpb=c2ad6c9e76a929cca23276aa0e9dbbfdd1ca469b;p=helm.git
diff --git a/helm/http_getter/http_getter.pl.in b/helm/http_getter/http_getter.pl.in
index c9cac35f2..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
@@ -318,6 +317,14 @@ while (my $c = $d->accept) {
# send back all the keys in xml
print "BASEURI $baseuri, FORMAT $outype\n";
$cont = getalluris();
+ answer($c,$cont,"text/xml","");
+
+ # "/getallrdfuris"
+ } elsif ($http_method eq 'GET' and $http_path eq "/getallrdfuris") {
+ # send back all the keys in xml
+ 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") {
@@ -468,6 +475,30 @@ sub getalluris { # get all the keys whose prefix is cic
return $content;
}
+sub getallrdfuris {
+ my $class = $_[0];
+ my $content = "";
+ my ($uri);
+ my $debug=1; # for debug
+
+ $content .= '' . "\n";
+ $content .= "" . "\n\n";
+ $content .= "\n";
+ foreach $uri (sort (keys(%rdf_map))) {
+ 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;
+}
+
sub finduris { # find uris for cic and theory trees generation
my ($uritype,$uripattern,$format) = @_;
my $content = "";
@@ -498,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);
@@ -514,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);
@@ -545,9 +583,10 @@ sub finduris { # find uris for cic and theory trees generation
$content .= "\t\n";
$content .= "\t\n";
}
$content .= "\n";
@@ -558,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";
@@ -588,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/, ...
@@ -736,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");
@@ -768,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 {