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