Added ordering in ann and types flags

diff --git a/helm/http_getter/http_getter.pl.in b/helm/http_getter/http_getter.pl.in
index 0f9c0a1094756a40a7aee2bb0b4e10fc5a926cf5..e73d9f9878689b039352916e90b29a0abcfcd303 100755 (executable)
--- a/helm/http_getter/http_getter.pl.in
+++ b/helm/http_getter/http_getter.pl.in
@@ -379,16 +379,16 @@ sub finduris { # find uris for cic and theory trees generation
                                               # .types.ann
      $flags = $objects{$basepart}; # get old flags
      if ($localpart =~ /\.ann$/) {
-      $flags = add_flag("ann_YES",$flags);
+      $flags = add_flag("ann","YES",$flags);
      } else {
-      $flags = add_flag("ann_NO",$flags);
+      $flags = add_flag("ann","NO",$flags);
      }
      if ($localpart =~ /\.types$/) {
-      $flags = add_flag("types_YES",$flags);
+      $flags = add_flag("types","YES",$flags);
      } elsif ($localpart =~ /\.types\.ann$/) {
-      $flags = add_flag("types_ANN",$flags);
+      $flags = add_flag("types","ANN",$flags);
      } else {
-      $flags = add_flag("types_NO",$flags);
+      $flags = add_flag("types","NO",$flags);
      }
      $objects{$basepart} = $flags; # save new flags
     } else { # exists at least one slash, a DIR
@@ -407,32 +407,20 @@ sub finduris { # find uris for cic and theory trees generation
    $content .= "dir, " . $key . "\n";
   }
   foreach $key (sort(keys %objects)) {
-   $content .= "object, $key, (" . $objects{$key} . ")\n";
+   $content .= "object, $key, " . $objects{$key} . "\n";
   }
  } elsif ($format eq "xml") {
-
-# output sample:
-# <ls>
-# <section>pippo</section>
-# <section>pluto</section>
-# <object name="qui">
-#  <ann />
-#  <types />
-# </object>
-# <object name="quo">
-#  <conn />
-# </object>
-# </ls>
-
   $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";
-   foreach (split /,/, $objects{$key}) { # loop on flags
-    $content .= "\t\t<$_ />\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";
@@ -443,18 +431,40 @@ sub finduris { # find uris for cic and theory trees generation
 }
 
 sub add_flag {
-# for handle strings of flag, like "flag1,flag2,flag3"
-# add a flag to a string and return the new string
-# if the flag already exists, it is not added
- my ($flag,$str) = @_;
- if ($str =~ /^\w+(,\w+)*$/) { # strings of the form word,word,word,..
-  $str .= ",$flag" if ($str !~ /$flag/);
- } elsif ($str eq "") {
-  $str = $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, malformed string: \"$str\" for flag adding";
+  die "Internal error: unsupported flagtype \"$flagtype\"";
  }
- return $str;
+ $str = "<$annflag,$typeflag>";
 }
 
 #CSC: Too much powerful: creates even /home, /home/users/, ...