Rev 11930 | Details | Compare with Previous | Last modification | View Log | RSS feed
| Rev | Author | Line No. | Line |
|---|---|---|---|
| 11931 | schaersvoo | 1 | #!/usr/bin/perl |
| 7724 | bpr | 2 | ### script for generating from the data of log/referencement |
| 3 | ### some files which can be exploited by the search engine. |
||
| 4 | ### for the moment, this is not launched by wims, only manually |
||
| 5 | use warnings; |
||
| 6 | use strict; |
||
| 7 | my $lang='fr'; |
||
| 8 | my $T=''; |
||
| 9 | my %hash=(); |
||
| 10 | my $hash=\%hash; |
||
| 11 | my @base=("log/referencement"); |
||
| 12 | my $dirout="public_html/bases/classification/src"; |
||
| 7726 | bpr | 13 | for my $dir (@base) { |
| 14 | for my $f (glob("$dir/*/*/*/*")) { |
||
| 7724 | bpr | 15 | my @f1=split('/', $f); |
| 16 | my $id="$f1[2]/$f1[3]/$f1[4]\&exo=$f1[5]"; |
||
| 17 | open (IN, "$f"); |
||
| 18 | while (<IN>) { |
||
| 19 | my ($t0, $t1) = split ("=",$_) ; |
||
| 20 | $t0=~ s/!set ref_//; |
||
| 21 | my @T2= split(";", $t1); |
||
| 22 | for my $a (@T2) { |
||
| 23 | my @b=split(',',$a); |
||
| 24 | my $b1=$b[0]; my $b2=$b[-1]; $b2=~ s/\n//; |
||
| 25 | if (($b2) && $b2 >= 1) { |
||
| 7975 | bpr | 26 | if ($hash{$t0}{$id}) { $hash{$t0}{$id}.= "," . $b1 } |
| 7724 | bpr | 27 | else { $hash{$t0}{$id}= $b1}; |
| 28 | } |
||
| 7726 | bpr | 29 | } |
| 7724 | bpr | 30 | } |
| 31 | } |
||
| 32 | } |
||
| 33 | |||
| 34 | for my $taxo (keys %hash) { |
||
| 35 | my $T=''; |
||
| 36 | for my $id (keys %{$hash{$taxo}}) { |
||
| 37 | $T .= "$id:" . join(',', sortuniq ( split(',',$hash{$taxo}{$id}))) . "\n" |
||
| 38 | } |
||
| 39 | out("$dirout/$taxo" . '_exo',$T); |
||
| 40 | } |
||
| 41 | |||
| 42 | sub out { my ($bloc, $text) = @_; |
||
| 43 | open (OUT, ">$bloc") ; |
||
| 44 | print OUT $text ; close OUT; |
||
| 45 | } |
||
| 46 | |||
| 47 | sub sortuniq { |
||
| 48 | return if !(@_) ; |
||
| 49 | my $prev = "not $_[0]"; |
||
| 50 | grep { $_ ne $prev && ($prev = $_, 1) } sort @_; |
||
| 51 | } |