Subversion Repositories wimsdev

Rev

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

Rev Author Line No. Line
11931 schaersvoo 1
#!/usr/bin/perl
7710 bpr 2
use strict "vars";
3
use strict "subs";
8974 bpr 4
use search ('hashdomain', 'treate_dict', 'sortuniq', 'out', 'canonify', 'reverse_dic', 'treate_language');
7710 bpr 5
 
7709 bpr 6
use locale;
7
use warnings;
8575 bpr 8
my $LANG='fr';
7709 bpr 9
## leave simple quotes
10
my $joker='$wims_name_erase';
8590 bpr 11
my $outputtaxo='../../modules/';
7713 bpr 12
my $ddir='taxonomy';
8575 bpr 13
my $indexdir="../classification";
8633 bpr 14
my $sheetdir="../sheet";
8685 bpr 15
my $moduledir="../site";
8635 bpr 16
my ($module,$option)=('','');
7709 bpr 17
while ($_ = shift (@ARGV))
18
{
19
  last if (!/^--/);
7710 bpr 20
  if (/^--lang=(.*)$/) { $LANG = $1; }
21
  elsif (/^--joker=(.*)$/) { $joker = $1; }
8578 bpr 22
  elsif (/^--module=(.*)$/) { $module = $1; }
8618 bpr 23
  elsif (/^--option=(.*)$/) { $option = $1; }
8590 bpr 24
  elsif (/^--output=(.*)$/) { $outputtaxo = "$outputtaxo/$1"; }
7709 bpr 25
}
7700 bpr 26
 
8974 bpr 27
exit if (!(grep {$_ eq $LANG} treate_language()));
28
 
8618 bpr 29
#### wims keywords
8887 bpr 30
sub underscore { my ($a)=@_ ; $a=~ s/\_/ /g ; $a; }
9070 bpr 31
## hack for suffix
9205 bpr 32
sub suffix { my ($a)=@_ ; $a=~ s/(e|s|l|r)\b//; $a; }
9070 bpr 33
 
8887 bpr 34
sub count { my ($file)=@_ ;
13646 bpr 35
  my $refcount={};
8887 bpr 36
  open INC, "$file";
37
  while (<INC>){
13646 bpr 38
    if (/^(.*):(.*)/) { my @L=split(' ', $2) ; $refcount->{$1}=$#L+1 }
8887 bpr 39
  };
40
  close INC;
41
  $refcount
42
}
8995 bpr 43
 
8618 bpr 44
if ($option) {
13646 bpr 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}; }
8887 bpr 50
 
13646 bpr 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>";
8618 bpr 60
 
13646 bpr 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>";
8887 bpr 88
    }
13646 bpr 89
    out("$outputtaxo/taxo/$taxo.phtml.$LANG", $Tw);
90
  }
91
  exit;
8618 bpr 92
}
93
####
8886 bpr 94
## will not be modified in the subroutines
8974 bpr 95
## LANG here must be a language for the moment
8650 bpr 96
my %titsheet = treate_dict ("$sheetdir/index/tit.$LANG"); my $titsheet=\%titsheet;
8685 bpr 97
my %addr = reverse_dic ("$moduledir/addr"); my $addr=\%addr;
8884 bpr 98
my %titmodule = treate_dict ("$moduledir/title");my $titmodule=\%titmodule;
9294 bpr 99
my %filetoread=('mathematics'=> 'unisciel',
100
'physics'=> 'unisciel',
101
'biology'=> 'unisciel',
102
'chemistry'=> 'unisciel',
103
'informatics' => 'unisciel',
104
'ecogestion' => 'ecogestion',
9295 bpr 105
'geoscience' => 'unisciel',
9294 bpr 106
);
8886 bpr 107
 
8990 bpr 108
for my $t (glob("$ddir/*.$LANG")) {
109
  $t =~ s,$ddir\/,,g;
110
  my @t_=split('\.',$t); next if !($t_[1] eq $LANG);
9290 bpr 111
  next if $t_[0] eq 'commoncore';
9294 bpr 112
  taxonomy($t_[0], $filetoread{$t_[0]}, $LANG, '_','_');
8990 bpr 113
}
7710 bpr 114
 
8886 bpr 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" }
7700 bpr 118
 
9294 bpr 119
taxonomy ('commoncore', 'commoncore', $LANG, '_','_',@list);
8886 bpr 120
 
9294 bpr 121
sub taxonomy { my ($taxo, $taxo2, $lang, $sep1, $sep2, @list ) = @_ ;
13646 bpr 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>";
9307 obado 146
 
13646 bpr 147
  out("$outputtaxo/$taxo.phtml.$lang", $T);
7700 bpr 148
}
149
 
8575 bpr 150
 
8884 bpr 151
sub one {my ($a, $taxo, $desc, $tit, $ref, $vu)=@_;
152
  return "" if (defined($vu->{$a}));
8943 bpr 153
  $vu->{$a} = 1;
8575 bpr 154
  my @prec=split('_',$a); my $prec0=join('_',@prec[0..$#prec-1]);
8884 bpr 155
  my $amod = $a;
156
  my $T = '<li class="closed">';
8974 bpr 157
  if (!$tit->{$a}) { print "warning $a has no title" ; $tit->{$a}=$a};
8575 bpr 158
  if (!$ref->{'total'}{$a}) { $ref->{'total'}{$a}=0 } ;
9065 bpr 159
  if (!$ref->{'totalexo'}{$a}) { $ref->{'totalexo'}{$a}=0 } ;
8590 bpr 160
  if (!$module) {
13646 bpr 161
    $T .= "<input type=\"radio\" name=\"taxon_$taxo\" id=\"$amod\" value=\"$amod\"/>"
9290 bpr 162
          . "<label for=\"$amod\">$tit->{$a}</label><span class=\"small hidden\">($a)</span>";
8590 bpr 163
  } else {
9290 bpr 164
    $T .= "<span class=\"tree_icon\" id=\"$amod\">$tit->{$a}</span><span class=\"small hidden\">($a)</span> ";
8590 bpr 165
    if ($ref->{'total'}{$a} >0){
9081 obado 166
      $T .= "<sup class=\"pastille taxo_nb_modules\">".$ref->{'total'}{$a}." \$name_M</sup>";
8587 obado 167
    }
9065 bpr 168
    if ($ref->{'totalexo'}{$a} >0){
9081 obado 169
      $T .= "<sup class=\"pastille taxo_nb_exo\">".$ref->{'totalexo'}{$a}." \$name_X</sup>";
9065 bpr 170
    }
8594 obado 171
  }
8884 bpr 172
  if ($ref->{'text'}{$a} || $desc->{$a}){
8594 obado 173
    $T .="<ul id=\"list_$amod\">";
9357 bpr 174
    if ($ref->{'text'}{$a}){ $T .= $ref->{'text'}{$a}; }
175
    if ($ref->{'sheet'}{$a}){ $T .= $ref->{'sheet'}{$a}; }
8884 bpr 176
    if ($desc->{$a}) {
177
      for my $b (sortuniq (split ',', $desc->{$a})) { $T .= one($b, $taxo, $desc, $tit, $ref, $vu) };
8594 obado 178
    }
9290 bpr 179
    $T .= "</ul>";
7710 bpr 180
  }
9296 bpr 181
  $T . "</li>\n";
7700 bpr 182
}
183
 
184
sub hashtaxo { my ($file, $sep1, $sep2)=@_;
8884 bpr 185
  my (%desc, %tit, $title);
7710 bpr 186
  open IN, "$file";
187
  while (<IN>) {
13646 bpr 188
    ##la premiere ligne est le titre !
7710 bpr 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]) . ",";
7709 bpr 195
    }
9130 bpr 196
    if ($t1) { $t1 =~ s/\n//; $tit{$t0} = $t1;}
7709 bpr 197
  }
7710 bpr 198
  close IN;
8884 bpr 199
  ($title, \%desc, \%tit)
7700 bpr 200
}
201
 
8884 bpr 202
sub hashresultat { my ($file, $filesheet, $tit)=@_;
203
  my %ref;
8575 bpr 204
  open IN, "$file";
205
  while (<IN>){
206
    my @ligne=split(':', $_);
207
    next if (!$ligne[0]);
8630 bpr 208
    my @aa=sortuniq(split(',', $ligne[1]));
8575 bpr 209
    my $cnt0=$#aa+1;
9065 bpr 210
    my $cntexo=0;
8575 bpr 211
    for my $a (@aa) {
212
      chomp $a;
213
      my $b = $a; $b =~ s!/!~!g;
8943 bpr 214
      if (!defined($addr{$a})) {print "warning: module $a does not exist on the server\n"; next};
8884 bpr 215
      if (!$titmodule->{$addr{$a}}) { print "$a\n" ; $titmodule->{$a}=$a};
9066 bpr 216
      my $bb= ($titmodule->{$addr{$a}}) ? $titmodule->{$addr{$a}} . "<span class=\"small hidden\">($b)</span>": $b;
9285 obado 217
      my @exo; my $nb=1; my %exos_dic;
8619 bpr 218
      if (-e "../../modules/$a/Extitles") {
9285 obado 219
        %exos_dic=treate_dict("../../modules/$a/Extitles");
220
        @exo= values %exos_dic;
9066 bpr 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;
8884 bpr 234
        $ref{'text'}{$ligne[0]} .="<li class=\"taxo_module closed\">\n" .
9066 bpr 235
        "<span class=\"tree_icon\">$bb</span>"
9081 obado 236
        . ($nb>1?"<sup class=\"pastille taxo_nb_exo\">$nb \$name_X</sup>":"" )
9066 bpr 237
        . "\n!set wims_ref_class=wims_button\n".
8906 obado 238
        "!href target=wims_internal module=$a &rArr;\n" .
9285 obado 239
        '<ul class="smaller">';
240
        foreach my $exo_id (keys %exos_dic) {
9307 obado 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>";
9285 obado 243
        }
244
        $ref{'text'}{$ligne[0]} .="</ul></li>\n";
9066 bpr 245
        $cntexo += $nb ;
8770 obado 246
      }
247
      else {
8884 bpr 248
        $ref{'text'}{$ligne[0]} .="<li class=\"taxo_module\">\n" .
9066 bpr 249
        "!href target=wims_internal module=$a $bb\n"
250
        . ($nb>1?"<sup class=\"taxo_nb_exo\">$nb</sup>":"" )
9296 bpr 251
        . "</li>\n";
9066 bpr 252
        $cntexo += $nb ;
8770 obado 253
      }
8575 bpr 254
    }
8884 bpr 255
    $ref{'num'}{$ligne[0]}=$cnt0;
9065 bpr 256
    $ref{'numexo'}{$ligne[0]}=$cntexo;
8884 bpr 257
    $ref{'total'}{$ligne[0]}=0;
9065 bpr 258
    $ref{'totalexo'}{$ligne[0]}=0;
8575 bpr 259
  }
8633 bpr 260
  close IN;
261
  if (-e "$filesheet") {
13646 bpr 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>";
8633 bpr 274
      }
13646 bpr 275
      $ref{'numsheet'}{$ligne[0]}=$cnt0;
276
    }
8633 bpr 277
  }
13646 bpr 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) {
8884 bpr 283
      if (!$ref{'num'}{$c}){ $ref{'num'}{$c}=0};
9065 bpr 284
      if (!$ref{'numexo'}{$c}){ $ref{'numexo'}{$c}=0};
8884 bpr 285
      if (!$ref{'numsheet'}{$c}){ $ref{'numsheet'}{$c}=0};
13646 bpr 286
      $ref{'total'}{$id} += $ref{'num'}{$c} + $ref{'numsheet'}{$c} ;
287
      $ref{'totalexo'}{$id} += $ref{'numexo'}{$c} ;
288
    }
289
    \%ref;
290
  }