Subversion Repositories wimsdev

Rev

Rev 11931 | Rev 13647 | Go to most recent revision | Blame | Compare with Previous | Last modification | View Log | RSS feed

  1. #!/usr/bin/perl
  2. use strict "vars";
  3. use strict "subs";
  4. use search ('hashdomain', 'treate_dict', 'sortuniq', 'out', 'canonify', 'reverse_dic', 'treate_language');
  5.  
  6. use locale;
  7. use warnings;
  8. my $LANG='fr';
  9. ## leave simple quotes
  10. my $joker='$wims_name_erase';
  11. my $outputtaxo='../../modules/';
  12. my $ddir='taxonomy';
  13. my $indexdir="../classification";
  14. my $sheetdir="../sheet";
  15. my $moduledir="../site";
  16. my ($module,$option)=('','');
  17. while ($_ = shift (@ARGV))
  18. {
  19.   last if (!/^--/);
  20.   if (/^--lang=(.*)$/) { $LANG = $1; }
  21.   elsif (/^--joker=(.*)$/) { $joker = $1; }
  22.   elsif (/^--module=(.*)$/) { $module = $1; }
  23.   elsif (/^--option=(.*)$/) { $option = $1; }
  24.   elsif (/^--output=(.*)$/) { $outputtaxo = "$outputtaxo/$1"; }
  25. }
  26.  
  27. exit if (!(grep {$_ eq $LANG} treate_language()));
  28.  
  29. #### wims keywords
  30. sub underscore { my ($a)=@_ ; $a=~ s/\_/ /g ; $a; }
  31. ## hack for suffix
  32. sub suffix { my ($a)=@_ ; $a=~ s/(e|s|l|r)\b//; $a; }
  33.  
  34. sub count { my ($file)=@_ ;
  35.   my $refcount={};
  36.   open INC, "$file";
  37.   while (<INC>){
  38.     if (/^(.*):(.*)/) { my @L=split(' ', $2) ; $refcount->{$1}=$#L+1 }
  39.   };
  40.   close INC;
  41.   $refcount
  42. }
  43.  
  44. if ($option) {
  45.   my $refcount= count("$moduledir/A.$LANG");
  46.   ## initialisation, will not change
  47.   my %refw = hashdomain('domain/domain') ; my $refw=\%refw;
  48.   my %titw = treate_dict ("domain/domain.$LANG"); my $titw=\%titw;
  49.   my (%Next); for my $a (keys %{$refw->{'next'}}) { $Next{$a}=$refw->{'next'}{$a}; }
  50.  
  51.   my $Tw;
  52.   for my $taxo (split(',',$Next{'domain'})){
  53.     if ( !(defined $titw{$taxo})) { $titw{$taxo}=$taxo} ;
  54.     $Tw = "!! This file is generated by taxo.pl. Do not modify directly.\n!set lang_exists=yes\n"
  55.       . '<a class="wims_button float_right" onclick="treeToggleAll(\'#tree_'.$taxo.'\');">$name_fold</a>'
  56.       . "\n!set title= $titw{$taxo}\n<h2>$titw{$taxo}<\/h2>\n"
  57.       . '<ul id="tree_' .$taxo.'" class="tree">';
  58.     One ($Next{$taxo}, $refcount, $taxo, $taxo);
  59.     $Tw .= "\n</ul>";
  60.  
  61.     sub One { my ($t, $refcount, $taxo, $chemin) = @_;
  62.       return if (!$t);
  63.       for my $tt (split(',', $t)) {
  64.         $Tw .= "<li \n".
  65.         "!if $tt notitemof \$parm\n".
  66.         " class=\"closed\"\n".
  67.         "!endif\n".
  68.         ">\n";
  69.         my $tt0=$titw->{$tt};
  70.         if(!$tt0) { $tt0=$tt ; # print $tt ."\n" ;
  71.         };
  72.         my $chemin1 .= "$chemin,$tt" ;
  73.         my $cc='';
  74.         my $tt1=underscore($tt);
  75.         my $T;
  76.         if(defined($refcount->{$tt1})) {  $T=$refcount->{$tt1}}
  77.           else { if (defined($refcount->{suffix($tt1)})) { $T= $refcount->{suffix($tt1)}}};
  78.         if ($T) { $cc="<sup class=\"pastille taxo_nb_elem\">". $T."</sup>" };
  79.         $Tw .= "<span class=\"tree_icon\" id=\"$tt\">$tt0</span><span class=\"small hidden\">($tt)</span>$cc\n"
  80.             . "!set key=$tt0\n";
  81.         # if ($T) {$Tw .= '!href $search_addr&parm=' . "$tt&browse_parm=$chemin1 &#128270; \$wims_name_search\n";}
  82.         $Tw .= '!href $search_addr&parm=' . "$tt&browse_parm=$chemin1 &#128270; \$wims_name_search\n";
  83.         $Tw .=  "<ul id=\"list_$tt\">";
  84.         One($Next{$tt}, $refcount,$taxo, $chemin1);
  85.         $Tw .= "\n</ul>";
  86.       }
  87.       $Tw .= "\n</li>";
  88.     }
  89.     out("$outputtaxo/taxo/$taxo.phtml.$LANG", $Tw);
  90.   }
  91.   exit;
  92. }
  93. ####
  94. ## will not be modified in the subroutines
  95. ## LANG here must be a language for the moment
  96. my %titsheet = treate_dict ("$sheetdir/index/tit.$LANG"); my $titsheet=\%titsheet;
  97. my %addr = reverse_dic ("$moduledir/addr"); my $addr=\%addr;
  98. my %titmodule = treate_dict ("$moduledir/title");my $titmodule=\%titmodule;
  99. my %filetoread=('mathematics'=> 'unisciel',
  100. 'physics'=> 'unisciel',
  101. 'biology'=> 'unisciel',
  102. 'chemistry'=> 'unisciel',
  103. 'informatics' => 'unisciel',
  104. 'ecogestion' => 'ecogestion',
  105. 'geoscience' => 'unisciel',
  106. );
  107.  
  108. for my $t (glob("$ddir/*.$LANG")) {
  109.   $t =~ s,$ddir\/,,g;
  110.   my @t_=split('\.',$t); next if !($t_[1] eq $LANG);
  111.   next if $t_[0] eq 'commoncore';
  112.   taxonomy($t_[0], $filetoread{$t_[0]}, $LANG, '_','_');
  113. }
  114.  
  115. ## impose order in the list
  116. my $ccsstitle='CCSS.Math.Content_'; my @list=();
  117. for my $l ('K','1','2','3','4','5','6','7','HS') { push @list, "$ccsstitle$l" }
  118.  
  119. taxonomy ('commoncore', 'commoncore', $LANG, '_','_',@list);
  120.  
  121. sub taxonomy { my ($taxo, $taxo2, $lang, $sep1, $sep2, @list ) = @_ ;
  122.   my $vu={}; my $ref; my $desctaxo;
  123.   my ($title, $desc, $tit) = hashtaxo("$ddir/$taxo.$lang", $sep1, $sep2);
  124.   my @title_ = split(',', $title);
  125.   ($title,$desctaxo)=@title_;
  126.   if (!(defined $desctaxo)) { $desctaxo='' };
  127.   if ($module) { $ref=hashresultat("$indexdir/$taxo2","$indexdir/$taxo2" . "_sheet", $tit); }
  128.   my ($T);
  129.   $T = "!! This file is generated by taxo.pl. Do not modify directly.\n!set lang_exists=yes\n";
  130.   $T .= '<a class="wims_button float_right" onclick="treeToggleAll(\'#tree_'.$taxo.'\');">$name_fold</a>';
  131.   $T .= "\n!set title=$title\n!set desctaxo=$desctaxo\n<h2>$title<\/h2>\n";
  132.   $T .= '<ul id="tree_'.$taxo.'" class="tree">';
  133.   if (!@list) { @list=sort keys %{$desc} };
  134.   for my $a (@list) { $T .= one($a, $taxo, $desc, $tit, $ref, $vu); };
  135.   $T .= "</ul>";
  136.   if (!$module) {
  137.     $T .= "<input type=\"radio\" name=\"taxon_$taxo\" id=\"empty\" value=\"\"/> $joker";
  138.   }
  139.   $T .= "<div class=\"wims_credits\">";
  140.   $T .= " <strong>\$wims_name_credits:</strong> <a href=\"$desctaxo\" target=\"_blank\">$desctaxo</a>";
  141.   $T .= "</div>";
  142.   $T .= "<!-- Reload dynamic tree display -->";
  143.   $T .= "<script type=\"text/javascript\" >";
  144.   $T .= "autoInit_trees();";
  145.   $T .= "</script>";
  146.  
  147.   out("$outputtaxo/$taxo.phtml.$lang", $T);
  148. }
  149.  
  150.  
  151. sub one {my ($a, $taxo, $desc, $tit, $ref, $vu)=@_;
  152.   return "" if (defined($vu->{$a}));
  153.   $vu->{$a} = 1;
  154.   my @prec=split('_',$a); my $prec0=join('_',@prec[0..$#prec-1]);
  155.   my $amod = $a;
  156.   my $T = '<li class="closed">';
  157.   if (!$tit->{$a}) { print "warning $a has no title" ; $tit->{$a}=$a};
  158.   if (!$ref->{'total'}{$a}) { $ref->{'total'}{$a}=0 } ;
  159.   if (!$ref->{'totalexo'}{$a}) { $ref->{'totalexo'}{$a}=0 } ;
  160.   if (!$module) {
  161.     $T .= "<input type=\"radio\" name=\"taxon_$taxo\" id=\"$amod\" value=\"$amod\"/>"
  162.           . "<label for=\"$amod\">$tit->{$a}</label><span class=\"small hidden\">($a)</span>";
  163.   } else {
  164.     $T .= "<span class=\"tree_icon\" id=\"$amod\">$tit->{$a}</span><span class=\"small hidden\">($a)</span> ";
  165.     if ($ref->{'total'}{$a} >0){
  166.       $T .= "<sup class=\"pastille taxo_nb_modules\">".$ref->{'total'}{$a}." \$name_M</sup>";
  167.     }
  168.     if ($ref->{'totalexo'}{$a} >0){
  169.       $T .= "<sup class=\"pastille taxo_nb_exo\">".$ref->{'totalexo'}{$a}." \$name_X</sup>";
  170.     }
  171.   }
  172.   if ($ref->{'text'}{$a} || $desc->{$a}){
  173.     $T .="<ul id=\"list_$amod\">";
  174.     if ($ref->{'text'}{$a}){ $T .= $ref->{'text'}{$a}; }
  175.     if ($ref->{'sheet'}{$a}){ $T .= $ref->{'sheet'}{$a}; }
  176.     if ($desc->{$a}) {
  177.       for my $b (sortuniq (split ',', $desc->{$a})) { $T .= one($b, $taxo, $desc, $tit, $ref, $vu) };
  178.     }
  179.     $T .= "</ul>";
  180.   }
  181.   $T . "</li>\n";
  182. }
  183.  
  184. sub hashtaxo { my ($file, $sep1, $sep2)=@_;
  185.   my (%desc, %tit, $title);
  186.   open IN, "$file";
  187.   while (<IN>) {
  188.     ##la premiere ligne est le titre !
  189.     if (!$title) { $title=$_; next}
  190.     my ($t0,$t1) = split(":", $_);
  191.     my @index = split("$sep1", $t0);
  192.     my $cnt = $#index;
  193.     foreach my $a (2..$cnt) {
  194.       $desc{join($sep2, @index[0..$a-1])} .= join($sep2, @index[0..$a]) . ",";
  195.     }
  196.     if ($t1) { $t1 =~ s/\n//; $tit{$t0} = $t1;}
  197.   }
  198.   close IN;
  199.   ($title, \%desc, \%tit)
  200. }
  201.  
  202. sub hashresultat { my ($file, $filesheet, $tit)=@_;
  203.   my %ref;
  204.   open IN, "$file";
  205.   while (<IN>){
  206.     my @ligne=split(':', $_);
  207.     next if (!$ligne[0]);
  208.     my @aa=sortuniq(split(',', $ligne[1]));
  209.     my $cnt0=$#aa+1;
  210.     my $cntexo=0;
  211.     for my $a (@aa) {
  212.       chomp $a;
  213.       my $b = $a; $b =~ s!/!~!g;
  214.       if (!defined($addr{$a})) {print "warning: module $a does not exist on the server\n"; next};
  215.       if (!$titmodule->{$addr{$a}}) { print "$a\n" ; $titmodule->{$a}=$a};
  216.       my $bb= ($titmodule->{$addr{$a}}) ? $titmodule->{$addr{$a}} . "<span class=\"small hidden\">($b)</span>": $b;
  217.       my @exo; my $nb=1; my %exos_dic;
  218.       if (-e "../../modules/$a/Extitles") {
  219.         %exos_dic=treate_dict("../../modules/$a/Extitles");
  220.         @exo= values %exos_dic;
  221.         $nb=$#exo;
  222.       };
  223.       ##jmevers test
  224.       open INN, "../../modules/$a/INDEX";
  225.       my $testjm=0;
  226.       while (<INN>) { $testjm=1 if ($_=~ /authors\/jm.evers\/proc\/var.def/);} close INN;
  227.       if ($testjm){
  228.          my @nbexo=`ls ../../modules/$a/exos/exo*`;
  229.          $nb=$#nbexo+1;
  230.         ###TODO; creer @exo comme dans le cas OEF (liste des titres des exos)
  231.       }
  232.       if (@exo) {
  233.         $nb=$#exo+1;
  234.         $ref{'text'}{$ligne[0]} .="<li class=\"taxo_module closed\">\n" .
  235.         "<span class=\"tree_icon\">$bb</span>"
  236.         . ($nb>1?"<sup class=\"pastille taxo_nb_exo\">$nb \$name_X</sup>":"" )
  237.         . "\n!set wims_ref_class=wims_button\n".
  238.         "!href target=wims_internal module=$a &rArr;\n" .
  239.         '<ul class="smaller">';
  240.         foreach my $exo_id (keys %exos_dic) {
  241.           $ref{'text'}{$ligne[0]} .='<li rel="'.$exo_id.'">'.$exos_dic{$exo_id}."</li>\n";
  242.           #$ref{'text'}{$ligne[0]} .='<li>'.$exos_dic{$exo_id}."</li>";
  243.         }
  244.         $ref{'text'}{$ligne[0]} .="</ul></li>\n";
  245.         $cntexo += $nb ;
  246.       }
  247.       else {
  248.         $ref{'text'}{$ligne[0]} .="<li class=\"taxo_module\">\n" .
  249.         "!href target=wims_internal module=$a $bb\n"
  250.         . ($nb>1?"<sup class=\"taxo_nb_exo\">$nb</sup>":"" )
  251.         . "</li>\n";
  252.         $cntexo += $nb ;
  253.       }
  254.     }
  255.     $ref{'num'}{$ligne[0]}=$cnt0;
  256.     $ref{'numexo'}{$ligne[0]}=$cntexo;
  257.     $ref{'total'}{$ligne[0]}=0;
  258.     $ref{'totalexo'}{$ligne[0]}=0;
  259.   }
  260.   close IN;
  261.   if (-e "$filesheet") {
  262.     open IN, "$filesheet";
  263.     while (<IN>){
  264.       my @ligne=split(':', $_);
  265.       next if (!$ligne[0]);
  266.       my @aa=sortuniq(split(',', $ligne[1]));
  267.       my $cnt0=$#aa+1;
  268.       for my $a (@aa) {
  269.         chomp $a;
  270.         my $b = canonify($a);
  271.         if($titsheet->{$b}) { $b = $titsheet->{$b} . "<span class=\"small hidden\">($b)</span>" } else { $b =~ s!/!~!g;}
  272.         $ref{'sheet'}{$ligne[0]} .="<li class=\"taxo_module\">\n"
  273.     .  "!href target=wims_internal module=adm/sheet\&+job=read\&+sh=$a $b\n</li>";
  274.       }
  275.       $ref{'numsheet'}{$ligne[0]}=$cnt0;
  276.     }
  277.   }
  278.   my @modlist=sortuniq(keys %{$tit});
  279.   for my $id (@modlist) {
  280.     my @ok = grep {/^${id}_/} @modlist;
  281.     push @ok, $id;
  282.     for my $c (@ok) {
  283.       if (!$ref{'num'}{$c}){ $ref{'num'}{$c}=0};
  284.       if (!$ref{'numexo'}{$c}){ $ref{'numexo'}{$c}=0};
  285.       if (!$ref{'numsheet'}{$c}){ $ref{'numsheet'}{$c}=0};
  286.       $ref{'total'}{$id} += $ref{'num'}{$c} + $ref{'numsheet'}{$c} ;
  287.       $ref{'totalexo'}{$id} += $ref{'numexo'}{$c} ;
  288.     }
  289.     \%ref;
  290.   }
  291.