Rev 6951 | Rev 6959 | 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; |
||
| 6519 | bpr | 6 | use search ('out', 'sortuniq', 'hashdomain', 'treate_accent', 'treate_domainfile'); |
| 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); |
||
| 6519 | bpr | 16 | my @Key = ('supervisor','domain','level','lang','institution','description','addr','keywords','title'); |
| 6464 | bpr | 17 | my @Lang= ('fr','en','it','nl') ; |
| 18 | my %T = ('version' => 'version', |
||
| 19 | 'lang' => 'language', |
||
| 6956 | bpr | 20 | 'description' => 'description', |
| 6464 | bpr | 21 | 'supervisor' => 'author', |
| 6956 | bpr | 22 | 'institution' => 'title', |
| 6464 | bpr | 23 | 'level' => 'level', |
| 24 | ); |
||
| 25 | my %keywords=(); |
||
| 26 | |||
| 27 | for my $key (@Key) { |
||
| 28 | my $text=''; |
||
| 29 | for my $cl (@list) { |
||
| 30 | $text .= "$cl:"; |
||
| 31 | $text .= $ref{$cl}{$key} if ($ref{$cl}{$key}); |
||
| 32 | $text .= "\n"; |
||
| 33 | }; |
||
| 34 | out("$dirout/$T{$key}",join("\n",sort( split("\n", $text)))) if ($T{$key}) ; |
||
| 35 | } |
||
| 36 | for my $l (@Lang) { my $text=''; |
||
| 6519 | bpr | 37 | my %dom = treate_domainfile ("$dirdomain/domain.$l"); |
| 38 | my $dom = \%dom; |
||
| 6464 | bpr | 39 | for my $cl (@list) { |
| 40 | next if (!($ref{$cl}{'lang'} =~ /$l/)) ; |
||
| 6519 | bpr | 41 | next if (!$ref{$cl}{'keywords'}); |
| 42 | $ref{$cl}{'keywords'}=lc(treate_accent($ref{$cl}{'keywords'})); |
||
| 43 | for my $k (sortuniq(split(', *',$ref{$cl}{'keywords'}))) { |
||
| 44 | $k =treate_accent($k); |
||
| 6464 | bpr | 45 | if ($keywords{$k}) { $keywords{$k} .= " " . $cl } else { $keywords{$k} = $cl}; |
| 46 | } |
||
| 47 | for my $k (split(',',$ref{$cl}{'domain'})) { |
||
| 48 | if ($keywords{$k}) { $keywords{$k} .= " " . $cl } else { $keywords{$k} = $cl}; |
||
| 6519 | bpr | 49 | next if !($dom{$k}); |
| 50 | my $d=lc(treate_accent($dom{$k})); |
||
| 51 | if ($keywords{$d}) { $keywords{$d} .= " " . $cl } else { $keywords{$d} = $cl}; |
||
| 52 | } |
||
| 6464 | bpr | 53 | } |
| 54 | while ( my ($key, $value) = each (%keywords) ) { |
||
| 6951 | bpr | 55 | my $v = join(" ", sortuniq(split(" ",$value))); |
| 56 | $text .= "$key:$v\n" ; |
||
| 6464 | bpr | 57 | } |
| 6951 | bpr | 58 | $text =~ s / +(\w+:)/ $1/g; |
| 6465 | bpr | 59 | out("$dirout/$l", join("\n", sortuniq(split("\n",$text)))); |
| 6464 | bpr | 60 | } |
| 61 | |||
| 6519 | bpr | 62 | ############################### |
| 6464 | bpr | 63 | sub refclass { my @L=@_ ; |
| 64 | for my $cl (@L) { |
||
| 65 | open IN, "$dir/$cl/.def"; |
||
| 66 | while(<IN>) { |
||
| 6465 | bpr | 67 | if ($_ =~ /!set class_(\w+)=\s*(.*)/) { $ref{$cl}{$1}=$2 ;}} |
| 6464 | bpr | 68 | close IN; |
| 69 | } |
||
| 70 | } |
||
| 71 | |||
| 72 | sub listclass { |
||
| 73 | my @L= () ; |
||
| 74 | for my $cl (glob("$dir/*")) { |
||
| 75 | $cl=~s /$dir\/// ; |
||
| 76 | push @L, $cl if (!($cl =~ /[A-Z]+/) && $cl < 10000) ; |
||
| 77 | } |
||
| 78 | @L |
||
| 79 | } |