X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fhttp_getter%2Fhttp_getter.pl.in;h=e9d1f4a3e04609137ad68b8db5658759be797f81;hb=b077aa16b12755c2bace508154773efc9fa2320c;hp=05c76bd8a55f70b0588c0b4580c89df95431bcf7;hpb=19aa9435df2f489603d764e2a6194e567f571e62;p=helm.git
diff --git a/helm/http_getter/http_getter.pl.in b/helm/http_getter/http_getter.pl.in
index 05c76bd8a..e9d1f4a3e 100755
--- a/helm/http_getter/http_getter.pl.in
+++ b/helm/http_getter/http_getter.pl.in
@@ -63,6 +63,7 @@ $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;
#
@@ -84,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
@@ -117,6 +118,7 @@ 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
@@ -527,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);
@@ -543,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);
@@ -574,9 +583,10 @@ sub finduris { # find uris for cic and theory trees generation
$content .= "\t\n";
$content .= "\t\n";
}
$content .= "\n";
@@ -587,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";
@@ -617,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/, ...
@@ -797,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 {