new version of ls,

now meet the specifications ?????

diff --git a/helm/http_getter/http_getter.pl.in b/helm/http_getter/http_getter.pl.in
index 0c1dacac52b8789220df401984f6730beef98d0e..0f9c0a1094756a40a7aee2bb0b4e10fc5a926cf5 100755 (executable)
--- a/helm/http_getter/http_getter.pl.in
+++ b/helm/http_getter/http_getter.pl.in
@@ -314,8 +314,6 @@ EOT
             $uritype = "cic";
            } elsif ($baseuri =~ /^theory:/) {
             $uritype = "theory";
-           } elsif ($baseuri =~ /^\*:/) {
-            $uritype = "any";
            } else {
             $uritype = "invalid";
            }
@@ -360,8 +358,9 @@ EOT
 sub finduris { # find uris for cic and theory trees generation
  my ($uritype,$uripattern,$format) = @_;
  my $content = "";
- my ($uri,$localpart,$dirname);
+ my ($uri,$localpart,$basepart,$dirname,$suffix,$flags,$key);
  my (@itemz,@already_pushed_dir);
+ my (%objects,%dirs); # map uris to suffixes' flags
 
  print "FINDURIS, uritype: $uritype, uripattern: $uripattern, ".
   "format: $format\n\n";
@@ -373,49 +372,91 @@ sub finduris { # find uris for cic and theory trees generation
    if ($uri =~ /^$uritype:$uripattern\//) {
     $localpart = $uri;
     $localpart =~ s/^$uritype:$uripattern\/(.*)/$1/;
-    if ($localpart =~ /^[^\/]*$/) { # no slash, i.e. no dir
-     push @itemz, "object," . $localpart;
-    } else { # exists at least one slash, i.e. a dir
+
+    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);
-     push @itemz, "dir," . $dirname;
-     #print "LOCALPART $localpart, DIRNAME $dirname\n"; #DEBUG
+     $dirs{$dirname} = ""; # no flags requirement for dir
     }
    }
   }
- } elsif ($uritype eq "any") { # get info for both cic and theory
-  foreach (keys(%map)) {
-   $uri = $_;
-  }
  } else {
   die "getter internal error: unsupported uritype: \"$uritype\"";
  }
- @itemz = sort @itemz; # sort itemz and remove duplicates
- my $lastitem = "";
- if ($format eq "txt") { #now generate output
-  foreach (@itemz) {
-   next if ($_ eq $last);
-   $content .= ($_ . "\n");
-   $last = $_;
+                            # now generate OUTPUT:
+                            # output will be saved in $content
+ if ($format eq "txt") { 
+  foreach $key (sort(keys %dirs)) {
+   $content .= "dir, " . $key . "\n";
+  }
+  foreach $key (sort(keys %objects)) {
+   $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 (@itemz) {
-   next if ($_ eq $last);
-   $last = $_;
-   ($itemtype,$itemdata) = split(/,/, $_);
-   if ($itemtype eq "object") {
-    $content .= "<object type=\"$uritype\">$itemdata</object>\n";
-   } elsif ($itemtype eq "dir") {
-    $content .= "<section>$itemdata</section>\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";
    }
+   $content .= "\t</object>\n";
   }
-  $content .= "</ls>\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 {
+# 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;
+ } else {
+  die "Internal error, malformed string: \"$str\" for flag adding";
+ }
+ return $str;
+}
+
 #CSC: Too much powerful: creates even /home, /home/users/, ...
 #CSC: Does not raise errors if could not create dirs/files
 sub mkdirs