-sub isRdfUri { # return true if the uri is an rdf uri, false otherwise
-# typycal rdf uri:
-# helm:rdf/cic:www.cs.unibo.it/helm/rdf/foo_schema//cic:\
-# /Coq/Init/Logic/True_rec.con.types
-#
-# the format is "helm:rdf/<metadata_tree>:<metadata_scheme>//<xml_file_uri>"
-#
- my ($uri) = @_;
- if ($uri =~ /^helm:rdf(.*):(.*)\/\/(.*)/) {
- return 1;
- } else {
- return 0;
- }
-}
-
-sub resolve { # resolve an uri in a url, work both with standard cic: or theory:
- # uris and rdf uris
- print "RESOLVE subroutine\n";
- my ($uri) = @_;
- print "GIVEN URI: \"$uri\"\n";
- if (isRdfUri ($uri)) { # rdf uri, resolve using rdf db
- print "IS A RDF URI\n";
- print "I WILL RETURN '$rdf_map{$uri}'\n";
- return ($rdf_map{$uri});
- } else { # standard cic: or theory: uri, resolve using std uri db
- print "IS NOT A RDF URI\n";
- print "I WILL RETURN '$xml_map{$uri}'\n";
- return ($xml_map{$uri});
- }
-}
-
-sub getalluris { # get all the keys whose prefix is cic
- my $content = "";
- my ($uri);
- my $debug=1; # for debug
-
- $content .= '<?xml version="1.0" encoding="ISO-8859-1"?>' . "\n";
- $content .= "<!DOCTYPE alluris SYSTEM ";
- $content .= "\"$myownurl/getdtd?uri=alluris.dtd\">" . "\n\n";
- $content .= "<alluris>\n";
- foreach $uri (sort (keys(%xml_map))) { # select matching uris
- if ($uri =~ /^cic:/ && not $uri =~ /.types$/) {
- print "GETALLURI: $uri\n" if defined($debug);
- $content .= "\t<uri value=\"$uri\"/>\n";
- }
- }
- $content .= "</alluris>\n";
- 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 = "";
- my ($uri,$localpart,$basepart,$dirname,$suffix,$flags,$key);
- my (@itemz,@already_pushed_dir);
- my (%objects,%dirs); # map uris to suffixes' flags
- my $debug=1; # for debug
-
- print "FINDURIS, uritype: $uritype, uripattern: $uripattern, ".
- "format: $format\n\n" if defined($debug);
-
- if (($uritype eq "cic") or ($uritype eq "theory")) {
- # get info only of one type: cic or theory
- foreach (keys(%xml_map)) { # select matching uris
- $uri = $_;
- if ($uri =~ /^$uritype:$uripattern(\/|$|\.)/) {
- if ($uri =~ /^$uritype:$uripattern\//) { # directory match
- $localpart = $uri;
- $localpart =~ s/^$uritype:$uripattern\/(.*)/$1/;
- } elsif ($uri =~ /^$uritype:$uripattern($|\.)/) { # file match
- $localpart = $uri;
- $localpart =~ s/^.*\/([^\/]*)/$1/;
- } else {
- die "Internal error, seems that requested match is none of ".
- "directory match or file match";
- }
- print "LOCALPART: $localpart\n" if defined($debug);
-
- if ($localpart =~ /^[^\/]*$/) { # no slash, an OBJECT
- $basepart = $localpart;
- $basepart =~ s/^([^.]*\.[^.]*)(\.types)?(\.ann)?/$1/;
- # remove exts .types or
- # .types.ann
- $flags = $objects{$basepart}; # get old flags
- if ($localpart =~ /\.ann$/) {
- $flags = add_flag("ann","YES",$flags);
- } else {
- $flags = add_flag("ann","NO",$flags);
- }
- if ($localpart =~ /\.types$/) {
- $flags = add_flag("types","YES",$flags);
- } elsif ($localpart =~ /\.types\.ann$/) {
- $flags = add_flag("types","ANN",$flags);
- } else {
- $flags = add_flag("types","NO",$flags);
- }
- $objects{$basepart} = $flags; # save new flags
- } else { # exists at least one slash, a DIR
- ($dirname) = split (/\//, $localpart);
- $dirs{$dirname} = ""; # no flags requirement for dir
- }
- }
- }
- } else {
- die "getter internal error: unsupported uritype: \"$uritype\"";
- }
- # now generate OUTPUT:
- # output will be saved in $content
- if ($format eq "txt") { # TXT output
- foreach $key (sort(keys %dirs)) {
- $content .= "dir, " . $key . "\n";
- }
- foreach $key (sort(keys %objects)) {
- $content .= "object, $key, " . $objects{$key} . "\n";
- }
- } elsif ($format eq "xml") { # XML output
- $content .= '<?xml version="1.0" encoding="ISO-8859-1"?>' . "\n";
- $content .= "<!DOCTYPE ls SYSTEM ";
- $content .= "\"$myownurl/getdtd?uri=ls.dtd\">" . "\n\n";
- $content .= "<ls>\n";
- foreach $key (sort(keys %dirs)) {
- $content .= "\t<section>$key</section>\n";
- }
- foreach $key (sort(keys %objects)) {
- $content .= "\t<object name=\"$key\">\n";
- $flags = $objects{$key};
- $flags =~ s/^<(.*)>$/$1/;
- my ($annflag,$typesflag) = split /,/,$flags;
- $content .= "\t\t<ann value=\"$annflag\" />\n";
- $content .= "\t\t<types value=\"$typesflag\" />\n";
- $content .= "\t</object>\n";
- }
- $content .= "</ls>\n";
- } else { # may not enter this branch
- die "Getter internal error: invalid format received by finduris sub";
- }
- return $content;
-}
-
-sub add_flag {
-# manage string like: "<ann_flag,type_flag>"
-# "ann_flag" may be one of "ann_YES", "ann_NO"
-# "type_flag" may be one of "types_NO", "types_YES", "types_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
- my ($flagtype,$newflag,$str) = @_;
- $str = "<,>" if ($str eq "");
- ($str =~ s/^<(.*,.*)>$/$1/) or die "Internal error: ".
- "wrong string format for flag adding in $str";
- my ($annflag,$typeflag) = split /,/,$str;
- if ($flagtype eq "ann") { # ANN flag handling
- if ($newflag eq "YES") {
- $annflag = "YES";
- } elsif ($newflag eq "NO") {
- $annflag = "NO" unless ($annflag eq "YES");
- } else {
- die "Internal error: annflag must be \"YES\" or \"NO\"";
- }
- } elsif ($flagtype eq "types") { # TYPES flag handling
- if ($newflag eq "ANN") {
- $typeflag = "ANN";
- } elsif ($newflag eq "YES") {
- $typeflag = "YES" unless ($typeflag eq "ANN");
- } elsif ($newflag eq "NO") {
- $typeflag = "NO"
- unless (($typeflag eq "ANN") or ($typeflag eq "YES"));
- } else {
- die "Internal error: typeflag must be \"YES\", \"NO\" or \"ANN\"";
- }
- } else {
- die "Internal error: unsupported flagtype \"$flagtype\"";
- }
- $str = "<$annflag,$typeflag>";
-}