WebSVN – wimsdev – Diff – /trunk/wims/public_html/bases/sys/taxonomy/taxo.pl

 sub underscore { my ($a)=@_ ; $a=~ s/\_/ /g ; $a; }
 ## hack for suffix
 sub suffix { my ($a)=@_ ; $a=~ s/(e|s|l|r)\b//; $a; }
 sub count { my ($file)=@_ ;
- my $refcount={};
+  my $refcount={};
   open INC, "$file";
   while (<INC>){
-   if (/^(.*):(.*)/) { my @L=split(' ', $2) ; $refcount->{$1}=$#L+1 }
+    if (/^(.*):(.*)/) { my @L=split(' ', $2) ; $refcount->{$1}=$#L+1 }
   };
   close INC;
   $refcount
+}
 if ($option) {
- my $refcount= count("$moduledir/A.$LANG");
+  my $refcount= count("$moduledir/A.$LANG");
- ## initialisation, will not change
+  ## initialisation, will not change
- my %refw = hashdomain('domain/domain') ; my $refw=\%refw;
+  my %refw = hashdomain('domain/domain') ; my $refw=\%refw;
- my %titw = treate_dict ("domain/domain.$LANG"); my $titw=\%titw;
+  my %titw = treate_dict ("domain/domain.$LANG"); my $titw=\%titw;
- my (%Next); for my $a (keys %{$refw->{'next'}}) { $Next{$a}=$refw->{'next'}{$a}; }
+  my (%Next); for my $a (keys %{$refw->{'next'}}) { $Next{$a}=$refw->{'next'}{$a}; }
- my $Tw;
+  my $Tw;
- for my $taxo (split(',',$Next{'domain'})){
+  for my $taxo (split(',',$Next{'domain'})){
-   if ( !(defined $titw{$taxo})) { $titw{$taxo}=$taxo} ;
+    if ( !(defined $titw{$taxo})) { $titw{$taxo}=$taxo} ;
-   $Tw = "!! This file is generated by taxo.pl. Do not modify directly.\n!set lang_exists=yes\n"
+    $Tw = "!! This file is generated by taxo.pl. Do not modify directly.\n!set lang_exists=yes\n"
-     . '<a class="wims_button float_right" onclick="treeToggleAll(\'#tree_'.$taxo.'\');">$name_fold</a>'
+      . '<a class="wims_button float_right" onclick="treeToggleAll(\'#tree_'.$taxo.'\');">$name_fold</a>'
-     . "\n!set title= $titw{$taxo}\n<h2>$titw{$taxo}<\/h2>\n"
+      . "\n!set title= $titw{$taxo}\n<h2>$titw{$taxo}<\/h2>\n"
-     . '<ul id="tree_' .$taxo.'" class="tree">';
+      . '<ul id="tree_' .$taxo.'" class="tree">';
-  One ($Next{$taxo}, $refcount, $taxo, $taxo);
+    One ($Next{$taxo}, $refcount, $taxo, $taxo);
-  $Tw .= "\n</ul>";
+    $Tw .= "\n</ul>";
-  sub One { my ($t, $refcount, $taxo, $chemin) = @_;
+    sub One { my ($t, $refcount, $taxo, $chemin) = @_;
-    return if (!$t);
+      return if (!$t);
-    for my $tt (split(',', $t)) {
+      for my $tt (split(',', $t)) {
-      $Tw .= "<li \n".
+        $Tw .= "<li \n".
-      "!if $tt notitemof \$parm\n".
+        "!if $tt notitemof \$parm\n".
-      " class=\"closed\"\n".
+        " class=\"closed\"\n".
-      "!endif\n".
+        "!endif\n".
-      ">\n";
+        ">\n";
-      my $tt0=$titw->{$tt};
+        my $tt0=$titw->{$tt};
-      if(!$tt0) { $tt0=$tt ; # print $tt ."\n" ;
+        if(!$tt0) { $tt0=$tt ; # print $tt ."\n" ;
-      };
+        };
-      my $chemin1 .= "$chemin,$tt" ;
+        my $chemin1 .= "$chemin,$tt" ;
-      my $cc='';
+        my $cc='';
-      my $tt1=underscore($tt);
+        my $tt1=underscore($tt);
-      my $T;
+        my $T;
-      if(defined($refcount->{$tt1})) {  $T=$refcount->{$tt1}}
+        if(defined($refcount->{$tt1})) {  $T=$refcount->{$tt1}}
-        else { if (defined($refcount->{suffix($tt1)})) { $T= $refcount->{suffix($tt1)}}};
+          else { if (defined($refcount->{suffix($tt1)})) { $T= $refcount->{suffix($tt1)}}};
-      if ($T) { $cc="<sup class=\"pastille taxo_nb_elem\">". $T."</sup>" };
+        if ($T) { $cc="<sup class=\"pastille taxo_nb_elem\">". $T."</sup>" };
-      $Tw .= "<span class=\"tree_icon\" id=\"$tt\">$tt0</span><span class=\"small hidden\">($tt)</span>$cc\n"
+        $Tw .= "<span class=\"tree_icon\" id=\"$tt\">$tt0</span><span class=\"small hidden\">($tt)</span>$cc\n"
-          . "!set key=$tt0\n";
+            . "!set key=$tt0\n";
-     # if ($T) {$Tw .= '!href $search_addr&parm=' . "$tt&browse_parm=$chemin1 &#128270; \$wims_name_search\n";}
+        # if ($T) {$Tw .= '!href $search_addr&parm=' . "$tt&browse_parm=$chemin1 &#128270; \$wims_name_search\n";}
-      $Tw .= '!href $search_addr&parm=' . "$tt&browse_parm=$chemin1 &#128270; \$wims_name_search\n";
+        $Tw .= '!href $search_addr&parm=' . "$tt&browse_parm=$chemin1 &#128270; \$wims_name_search\n";
-      $Tw .=  "<ul id=\"list_$tt\">";
+        $Tw .=  "<ul id=\"list_$tt\">";
-      One($Next{$tt}, $refcount,$taxo, $chemin1);
+        One($Next{$tt}, $refcount,$taxo, $chemin1);
-      $Tw .= "\n</ul>";
+        $Tw .= "\n</ul>";
+      }
+      $Tw .= "\n</li>";
+    }
-    $Tw .= "\n</li>";
- }
- out("$outputtaxo/taxo/$taxo.phtml.$LANG", $Tw);
+    out("$outputtaxo/taxo/$taxo.phtml.$LANG", $Tw);
- }
+  }
- exit;
+  exit;
+}
 ####
 ## will not be modified in the subroutines
 ## LANG here must be a language for the moment
 my %titsheet = treate_dict ("$sheetdir/index/tit.$LANG"); my $titsheet=\%titsheet;
 for my $l ('K','1','2','3','4','5','6','7','HS') { push @list, "$ccsstitle$l" }
 taxonomy ('commoncore', 'commoncore', $LANG, '_','_',@list);
 sub taxonomy { my ($taxo, $taxo2, $lang, $sep1, $sep2, @list ) = @_ ;
-   my $vu={}; my $ref; my $desctaxo;
+  my $vu={}; my $ref; my $desctaxo;
-   my ($title, $desc, $tit) = hashtaxo("$ddir/$taxo.$lang", $sep1, $sep2);
+  my ($title, $desc, $tit) = hashtaxo("$ddir/$taxo.$lang", $sep1, $sep2);
-   my @title_ = split(',', $title);
+  my @title_ = split(',', $title);
-   ($title,$desctaxo)=@title_;
+  ($title,$desctaxo)=@title_;
-   if (!(defined $desctaxo)) { $desctaxo='' };
+  if (!(defined $desctaxo)) { $desctaxo='' };
-   if ($module) { $ref=hashresultat("$indexdir/$taxo2","$indexdir/$taxo2" . "_sheet", $tit); }
+  if ($module) { $ref=hashresultat("$indexdir/$taxo2","$indexdir/$taxo2" . "_sheet", $tit); }
-   my ($T);
+  my ($T);
-   $T = "!! This file is generated by taxo.pl. Do not modify directly.\n!set lang_exists=yes\n";
+  $T = "!! This file is generated by taxo.pl. Do not modify directly.\n!set lang_exists=yes\n";
-   $T .= '<a class="wims_button float_right" onclick="treeToggleAll(\'#tree_'.$taxo.'\');">$name_fold</a>';
+  $T .= '<a class="wims_button float_right" onclick="treeToggleAll(\'#tree_'.$taxo.'\');">$name_fold</a>';
-   $T .= "\n!set title=$title\n!set desctaxo=$desctaxo\n<h2>$title<\/h2>\n";
+  $T .= "\n!set title=$title\n!set desctaxo=$desctaxo\n<h2>$title<\/h2>\n";
-   $T .= '<ul id="tree_'.$taxo.'" class="tree">';
+  $T .= '<ul id="tree_'.$taxo.'" class="tree">';
-   if (!@list) { @list=sort keys %{$desc} };
+  if (!@list) { @list=sort keys %{$desc} };
-   for my $a (@list) { $T .= one($a, $taxo, $desc, $tit, $ref, $vu); };
+  for my $a (@list) { $T .= one($a, $taxo, $desc, $tit, $ref, $vu); };
-   $T .= "</ul>";
+  $T .= "</ul>";
-   if (!$module) {
+  if (!$module) {
-     $T .= "<input type=\"radio\" name=\"taxon_$taxo\" id=\"empty\" value=\"\"/> $joker";
+    $T .= "<input type=\"radio\" name=\"taxon_$taxo\" id=\"empty\" value=\"\"/> $joker";
-   }
+  }
-   $T .= "<div class=\"wims_credits\">";
+  $T .= "<div class=\"wims_credits\">";
-   $T .= " <strong>\$wims_name_credits:</strong> <a href=\"$desctaxo\" target=\"_blank\">$desctaxo</a>";
+  $T .= " <strong>\$wims_name_credits:</strong> <a href=\"$desctaxo\" target=\"_blank\">$desctaxo</a>";
-   $T .= "</div>";
+  $T .= "</div>";
-   $T .= "<!-- Reload dynamic tree display -->";
+  $T .= "<!-- Reload dynamic tree display -->";
-   $T .= "<script type=\"text/javascript\" >";
+  $T .= "<script type=\"text/javascript\" >";
-   $T .= "autoInit_trees();";
+  $T .= "autoInit_trees();";
-   $T .= "</script>";
+  $T .= "</script>";
-   out("$outputtaxo/$taxo.phtml.$lang", $T);
+  out("$outputtaxo/$taxo.phtml.$lang", $T);
 }
 sub one {my ($a, $taxo, $desc, $tit, $ref, $vu)=@_;
   return "" if (defined($vu->{$a}));
   $vu->{$a} = 1;
   my @prec=split('_',$a); my $prec0=join('_',@prec[0..$#prec-1]);
   my $amod = $a;
   my $T = '<li class="closed">';
   if (!$tit->{$a}) { print "warning $a has no title" ; $tit->{$a}=$a};
   if (!$ref->{'total'}{$a}) { $ref->{'total'}{$a}=0 } ;
   if (!$ref->{'totalexo'}{$a}) { $ref->{'totalexo'}{$a}=0 } ;
   if (!$module) {
-       $T .= "<input type=\"radio\" name=\"taxon_$taxo\" id=\"$amod\" value=\"$amod\"/>"
+    $T .= "<input type=\"radio\" name=\"taxon_$taxo\" id=\"$amod\" value=\"$amod\"/>"
           . "<label for=\"$amod\">$tit->{$a}</label><span class=\"small hidden\">($a)</span>";
   } else {
     $T .= "<span class=\"tree_icon\" id=\"$amod\">$tit->{$a}</span><span class=\"small hidden\">($a)</span> ";
     if ($ref->{'total'}{$a} >0){
       $T .= "<sup class=\"pastille taxo_nb_modules\">".$ref->{'total'}{$a}." \$name_M</sup>";
+    }
     if ($ref->{'totalexo'}{$a} >0){
       $T .= "<sup class=\"pastille taxo_nb_exo\">".$ref->{'totalexo'}{$a}." \$name_X</sup>";
     }
   }
   if ($ref->{'text'}{$a} || $desc->{$a}){
     $T .="<ul id=\"list_$amod\">";
     if ($ref->{'text'}{$a}){ $T .= $ref->{'text'}{$a}; }
     if ($ref->{'sheet'}{$a}){ $T .= $ref->{'sheet'}{$a}; }
     if ($desc->{$a}) {
 sub hashtaxo { my ($file, $sep1, $sep2)=@_;
   my (%desc, %tit, $title);
   open IN, "$file";
   while (<IN>) {
-##la premiere ligne est le titre !
+    ##la premiere ligne est le titre !
     if (!$title) { $title=$_; next}
     my ($t0,$t1) = split(":", $_);
     my @index = split("$sep1", $t0);
     my $cnt = $#index;
     foreach my $a (2..$cnt) {
     my @ligne=split(':', $_);
     next if (!$ligne[0]);
     my @aa=sortuniq(split(',', $ligne[1]));
     my $cnt0=$#aa+1;
     my $cntexo=0;
     for my $a (@aa) {
       chomp $a;
       my $b = $a; $b =~ s!/!~!g;
       if (!defined($addr{$a})) {print "warning: module $a does not exist on the server\n"; next};
       if (!$titmodule->{$addr{$a}}) { print "$a\n" ; $titmodule->{$a}=$a};
       my $bb= ($titmodule->{$addr{$a}}) ? $titmodule->{$addr{$a}} . "<span class=\"small hidden\">($b)</span>": $b;
     $ref{'total'}{$ligne[0]}=0;
     $ref{'totalexo'}{$ligne[0]}=0;
+  }
   close IN;
   if (-e "$filesheet") {
-   open IN, "$filesheet";
+    open IN, "$filesheet";
-   while (<IN>){
+    while (<IN>){
-    my @ligne=split(':', $_);
+      my @ligne=split(':', $_);
-    next if (!$ligne[0]);
+      next if (!$ligne[0]);
-    my @aa=sortuniq(split(',', $ligne[1]));
+      my @aa=sortuniq(split(',', $ligne[1]));
-    my $cnt0=$#aa+1;
+      my $cnt0=$#aa+1;
-    for my $a (@aa) {
+      for my $a (@aa) {
-      chomp $a;
+        chomp $a;
-      my $b = canonify($a);
+        my $b = canonify($a);
-      if($titsheet->{$b}) { $b = $titsheet->{$b} . "<span class=\"small hidden\">($b)</span>" } else { $b =~ s!/!~!g;}
+        if($titsheet->{$b}) { $b = $titsheet->{$b} . "<span class=\"small hidden\">($b)</span>" } else { $b =~ s!/!~!g;}
-      $ref{'sheet'}{$ligne[0]} .="<li class=\"taxo_module\">\n"
+        $ref{'sheet'}{$ligne[0]} .="<li class=\"taxo_module\">\n"
-   . "!href target=wims_internal module=adm/sheet\&+job=read\&+sh=$a $b\n</li>";
+    .  "!href target=wims_internal module=adm/sheet\&+job=read\&+sh=$a $b\n</li>";
+      }
-   $ref{'numsheet'}{$ligne[0]}=$cnt0;
+      $ref{'numsheet'}{$ligne[0]}=$cnt0;
-   }
+    }
+  }
-   my @modlist=sortuniq(keys %{$tit});
+  my @modlist=sortuniq(keys %{$tit});
-   for my $id (@modlist) {
+  for my $id (@modlist) {
-     my @ok = grep {/^${id}_/} @modlist;
+    my @ok = grep {/^${id}_/} @modlist;
-     push @ok, $id;
+    push @ok, $id;
-     for my $c (@ok) {
+    for my $c (@ok) {
       if (!$ref{'num'}{$c}){ $ref{'num'}{$c}=0};
       if (!$ref{'numexo'}{$c}){ $ref{'numexo'}{$c}=0};
       if (!$ref{'numsheet'}{$c}){ $ref{'numsheet'}{$c}=0};
-       $ref{'total'}{$id} += $ref{'num'}{$c} + $ref{'numsheet'}{$c} ;
+      $ref{'total'}{$id} += $ref{'num'}{$c} + $ref{'numsheet'}{$c} ;
-       $ref{'totalexo'}{$id} += $ref{'numexo'}{$c} ;
+      $ref{'totalexo'}{$id} += $ref{'numexo'}{$c} ;
-     }
+    }
-   }
-   \%ref;
+    \%ref;
-}
+  }

Subversion Repositories wimsdev

(root)/trunk/wims/public_html/bases/sys/taxonomy/taxo.pl – Rev 11931 → 13646