Rev 6985 | Rev 9875 | Go to most recent revision | Details | Compare with Previous | Last modification | View Log | RSS feed
| Rev | Author | Line No. | Line |
|---|---|---|---|
| 6464 | bpr | 1 | #!/usr/bin/perl |
| 2 | ##example classes |
||
| 3 | |||
| 4 | use warnings; |
||
| 5 | use strict; |
||
| 7016 | bpr | 6 | use search ('out', 'sortuniq', 'hashdomain', 'treate_accent', 'treate_dict'); |
| 6464 | bpr | 7 | |
| 8 | my $dir='../../../log/classes/'; |
||
| 6519 | bpr | 9 | my $dirdomain='domain'; |
| 6464 | bpr | 10 | ## list of all domains in domain/domain |
| 11 | my %ref= (); |
||
| 12 | my $ref=\%ref; |
||
| 13 | my @list=listclass(); |
||
| 14 | my $dirout="../class"; |
||
| 15 | $ref=refclass(@list); |
||
| 6967 | bpr | 16 | my @Key = ('supervisor','domain','level','lang','institution','description','addr','keywords','title', 'information'); |
| 6464 | bpr | 17 | my @Lang= ('fr','en','it','nl') ; |
| 18 | my %T = ('version' => 'version', |
||
| 19 | 'lang' => 'language', |
||
| 6959 | bpr | 20 | 'description' => 'title', |
| 6464 | bpr | 21 | 'supervisor' => 'author', |
| 6959 | bpr | 22 | 'institution' => 'description', |
| 6464 | bpr | 23 | 'level' => 'level', |
| 6967 | bpr | 24 | 'information' => 'information', |
| 6464 | bpr | 25 | ); |
| 26 | my %keywords=(); |
||
| 27 | |||
| 28 | for my $key (@Key) { |
||
| 29 | my $text=''; |
||
| 30 | for my $cl (@list) { |
||
| 31 | $text .= "$cl:"; |
||
| 32 | $text .= $ref{$cl}{$key} if ($ref{$cl}{$key}); |
||
| 33 | $text .= "\n"; |
||
| 34 | }; |
||
| 35 | out("$dirout/$T{$key}",join("\n",sort( split("\n", $text)))) if ($T{$key}) ; |
||
| 36 | } |
||
| 37 | for my $l (@Lang) { my $text=''; |
||
| 7016 | bpr | 38 | my %dom = treate_dict ("$dirdomain/domain.$l"); |
| 6519 | bpr | 39 | my $dom = \%dom; |
| 6464 | bpr | 40 | for my $cl (@list) { |
| 41 | next if (!($ref{$cl}{'lang'} =~ /$l/)) ; |
||
| 6519 | bpr | 42 | next if (!$ref{$cl}{'keywords'}); |
| 43 | $ref{$cl}{'keywords'}=lc(treate_accent($ref{$cl}{'keywords'})); |
||
| 44 | for my $k (sortuniq(split(', *',$ref{$cl}{'keywords'}))) { |
||
| 45 | $k =treate_accent($k); |
||
| 6464 | bpr | 46 | if ($keywords{$k}) { $keywords{$k} .= " " . $cl } else { $keywords{$k} = $cl}; |
| 47 | } |
||
| 48 | for my $k (split(',',$ref{$cl}{'domain'})) { |
||
| 49 | if ($keywords{$k}) { $keywords{$k} .= " " . $cl } else { $keywords{$k} = $cl}; |
||
| 6519 | bpr | 50 | next if !($dom{$k}); |
| 51 | my $d=lc(treate_accent($dom{$k})); |
||
| 52 | if ($keywords{$d}) { $keywords{$d} .= " " . $cl } else { $keywords{$d} = $cl}; |
||
| 53 | } |
||
| 6464 | bpr | 54 | } |
| 55 | while ( my ($key, $value) = each (%keywords) ) { |
||
| 6951 | bpr | 56 | my $v = join(" ", sortuniq(split(" ",$value))); |
| 57 | $text .= "$key:$v\n" ; |
||
| 6464 | bpr | 58 | } |
| 6951 | bpr | 59 | $text =~ s / +(\w+:)/ $1/g; |
| 6465 | bpr | 60 | out("$dirout/$l", join("\n", sortuniq(split("\n",$text)))); |
| 6464 | bpr | 61 | } |
| 62 | |||
| 6519 | bpr | 63 | ############################### |
| 6464 | bpr | 64 | sub refclass { my @L=@_ ; |
| 65 | for my $cl (@L) { |
||
| 66 | open IN, "$dir/$cl/.def"; |
||
| 67 | while(<IN>) { |
||
| 6985 | bpr | 68 | if ($_ =~ /!set class_(\w+)=\s*(.*)/) { |
| 69 | my $f = $1; my $r= $2 ; |
||
| 70 | if ($f =~ /\blevel/) { |
||
| 71 | $r=~ s/ //g; |
||
| 72 | if( $r) { $ref{$cl}{$f}= "level" . join(', level', split(',',$r)) ;} |
||
| 73 | } |
||
| 74 | else { $ref{$cl}{$1}=$2 ;}} |
||
| 75 | } |
||
| 6464 | bpr | 76 | close IN; |
| 77 | } |
||
| 78 | } |
||
| 79 | |||
| 80 | sub listclass { |
||
| 81 | my @L= () ; |
||
| 82 | for my $cl (glob("$dir/*")) { |
||
| 83 | $cl=~s /$dir\/// ; |
||
| 84 | push @L, $cl if (!($cl =~ /[A-Z]+/) && $cl < 10000) ; |
||
| 85 | } |
||
| 86 | @L |
||
| 87 | } |