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 🔎 \$wims_name_search\n";} |
||
82 | $Tw .= '!href $search_addr&parm=' . "$tt&browse_parm=$chemin1 🔎 \$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 ⇒\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 | } |