"'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;
# </move_to_conf_file>
#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
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
# 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") {
return $content;
}
+sub getallrdfuris {
+ my $class = $_[0];
+ my $content = "";
+ my ($uri);
+ my $debug=1; # for debug
+
+ $content .= '<?xml version="1.0" encoding="ISO-8859-1"?>' . "\n";
+ $content .= "<!DOCTYPE allrdfuris SYSTEM ";
+ $content .= "\"$myownurl/getdtd?uri=alluris.dtd\">" . "\n\n";
+ $content .= "<allrdfuris>\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<uri value=\"$uri\"/>\n";
+ }
+ }
+ $content .= "</allrdfuris>\n";
+ return $content;
+}
+
sub finduris { # find uris for cic and theory trees generation
my ($uritype,$uripattern,$format) = @_;
my $content = "";
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);
} 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);
$content .= "\t<object name=\"$key\">\n";
$flags = $objects{$key};
$flags =~ s/^<(.*)>$/$1/;
- my ($annflag,$typesflag) = split /,/,$flags;
+ my ($annflag,$typesflag,$bodyflag) = split /,/,$flags;
$content .= "\t\t<ann value=\"$annflag\" />\n";
$content .= "\t\t<types value=\"$typesflag\" />\n";
+ $content .= "\t\t<body value=\"$bodyflag\" />\n";
$content .= "\t</object>\n";
}
$content .= "</ls>\n";
}
sub add_flag {
-# manage string like: "<ann_flag,type_flag>"
+# manage string like: "<ann_flag,type_flag,body_flag>"
# "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";
} 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/, ...
# $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");
$res->push_header("Pragma" => "no-cache");
$res->push_header("Expires" => "0");
$c->send_response($res);
+ $c->force_last_request();
}
sub html_nice_answer {
projects / helm.git / blobdiff