Rev 7016 | Rev 11479 | Go to most recent revision | Show entire file | Ignore whitespace | Details | Blame | Last modification | View Log | RSS feed
Rev 7016 | Rev 9875 | ||
---|---|---|---|
Line 12... | Line 12... | ||
12 | my $ref=\%ref; |
12 | my $ref=\%ref; |
13 | my @list=listclass(); |
13 | my @list=listclass(); |
14 | my $dirout="../class"; |
14 | my $dirout="../class"; |
15 | $ref=refclass(@list); |
15 | $ref=refclass(@list); |
16 | my @Key = ('supervisor','domain','level','lang','institution','description','addr','keywords','title', 'information'); |
16 | my @Key = ('supervisor','domain','level','lang','institution','description','addr','keywords','title', 'information'); |
17 | my @Lang= ('fr','en','it','nl') |
17 | my @Lang= ('fr','en','it','nl'); |
18 | my %T = ('version' => 'version', |
18 | my %T = ('version' => 'version', |
19 | 'lang' => 'language', |
19 | 'lang' => 'language', |
20 | 'description' => 'title', |
20 | 'description' => 'title', |
21 | 'supervisor' => 'author', |
21 | 'supervisor' => 'author', |
22 | 'institution' => 'description', |
22 | 'institution' => 'description', |
Line 26... | Line 26... | ||
26 | my %keywords=(); |
26 | my %keywords=(); |
27 | 27 | ||
28 | for my $key (@Key) { |
28 | for my $key (@Key) { |
29 | my $text=''; |
29 | my $text=''; |
30 | for my $cl (@list) { |
30 | for my $cl (@list) { |
31 | $text .= "$cl:"; |
31 | $text .= "$cl:"; |
32 | $text .= $ref{$cl}{$key} if ($ref{$cl}{$key}); |
32 | $text .= $ref{$cl}{$key} if ($ref{$cl}{$key}); |
33 | $text .= "\n"; |
33 | $text .= "\n"; |
34 | }; |
34 | }; |
35 | out("$dirout/$T{$key}",join("\n",sort( split("\n", $text)))) if ($T{$key}) |
35 | out("$dirout/$T{$key}",join("\n",sort( split("\n", $text)))) if ($T{$key}); |
36 | } |
36 | } |
37 | for my $l (@Lang) { my $text=''; |
37 | for my $l (@Lang) { my $text=''; |
38 | my %dom = treate_dict ("$dirdomain/domain.$l"); |
38 | my %dom = treate_dict ("$dirdomain/domain.$l"); |
39 | my $dom = \%dom; |
39 | my $dom = \%dom; |
40 | for my $cl (@list) { |
40 | for my $cl (@list) { |
41 | next if (!($ref{$cl}{'lang'} =~ /$l/)) |
41 | next if (!($ref{$cl}{'lang'} =~ /$l/)); |
42 | next if (!$ref{$cl}{'keywords'}); |
42 | next if (!$ref{$cl}{'keywords'}); |
43 | $ref{$cl}{'keywords'}=lc(treate_accent($ref{$cl}{'keywords'})); |
43 | $ref{$cl}{'keywords'}=lc(treate_accent($ref{$cl}{'keywords'})); |
44 | for my $k (sortuniq(split(', *',$ref{$cl}{'keywords'}))) { |
44 | for my $k (sortuniq(split(', *',$ref{$cl}{'keywords'}))) { |
45 | $k =treate_accent($k); |
45 | $k =treate_accent($k); |
46 | if ($keywords{$k}) { $keywords{$k} .= " " . $cl } else { $keywords{$k} = $cl}; |
46 | if ($keywords{$k}) { $keywords{$k} .= " " . $cl } else { $keywords{$k} = $cl}; |
- | 47 | next if !($dom{$k}); |
|
- | 48 | my $d=lc(treate_accent($dom{$k})); |
|
- | 49 | if ($keywords{$d}) { $keywords{$d} .= " " . $cl } else { $keywords{$d} = $cl}; |
|
47 | } |
50 | } |
48 | for my $k (split(',',$ref{$cl}{'domain'})) { |
51 | for my $k (split(',',$ref{$cl}{'domain'})) { |
49 | if ($keywords{$k}) { $keywords{$k} .= " " . $cl } else { $keywords{$k} = $cl}; |
52 | if ($keywords{$k}) { $keywords{$k} .= " " . $cl } else { $keywords{$k} = $cl}; |
50 | next if !($dom{$k}); |
53 | next if !($dom{$k}); |
51 | my $d=lc(treate_accent($dom{$k})); |
54 | my $d=lc(treate_accent($dom{$k})); |
52 | if ($keywords{$d}) { $keywords{$d} .= " " . $cl } else { $keywords{$d} = $cl}; |
55 | if ($keywords{$d}) { $keywords{$d} .= " " . $cl } else { $keywords{$d} = $cl}; |
53 | } |
56 | } |
54 | } |
57 | } |
55 | while ( my ($key, $value) = each (%keywords) ) { |
58 | while ( my ($key, $value) = each (%keywords) ) { |
56 | my $v = join(" ", sortuniq(split(" ",$value))); |
59 | my $v = join(" ", sortuniq(split(" ",$value))); |
57 | $text .= "$key:$v\n" |
60 | $text .= "$key:$v\n"; |
58 | } |
61 | } |
59 | $text =~ s / +(\w+:)/ $1/g; |
62 | $text =~ s / +(\w+:)/ $1/g; |
60 | out("$dirout/$l", join("\n", sortuniq(split("\n",$text)))); |
63 | out("$dirout/$l", join("\n", sortuniq(split("\n",$text)))); |
61 | } |
64 | } |
62 | 65 | ||
63 | ############################### |
66 | ############################### |
64 | sub refclass { my @L=@_ |
67 | sub refclass { my @L=@_; |
65 | for my $cl (@L) { |
68 | for my $cl (@L) { |
66 | open IN, "$dir/$cl/.def"; |
69 | open IN, "$dir/$cl/.def"; |
67 | while(<IN>) { |
70 | while(<IN>) { |
68 | if ($_ =~ /!set class_(\w+)=\s*(.*)/) { |
71 | if ($_ =~ /!set class_(\w+)=\s*(.*)/) { |
69 | my $f = $1; my $r= $2 |
72 | my $f = $1; my $r= $2; |
70 | if ($f =~ /\blevel/) { |
73 | if ($f =~ /\blevel/) { |
71 | $r=~ s/ //g; |
74 | $r=~ s/ //g; |
72 | if( $r) { $ref{$cl}{$f}= "level" . join(', level', split(',',$r)) |
75 | if( $r) { $ref{$cl}{$f}= "level" . join(', level', split(',',$r));} |
73 | } |
76 | } |
74 | else { $ref{$cl}{$1}=$2 |
77 | else { $ref{$cl}{$1}=$2;}} |
75 | } |
78 | } |
76 | close IN; |
79 | close IN; |
77 | } |
80 | } |
78 | } |
81 | } |
79 | 82 | ||
80 | sub listclass { |
83 | sub listclass { |
81 | my @L= () |
84 | my @L= (); |
82 | for my $cl (glob("$dir/*")) { |
85 | for my $cl (glob("$dir/*")) { |
83 | $cl=~s /$dir\/// |
86 | $cl=~s /$dir\///; |
84 | push @L, $cl if (!($cl =~ /[A-Z]+/) && $cl < 10000) |
87 | push @L, $cl if (!($cl =~ /[A-Z]+/) && $cl < 10000); |
85 | } |
88 | } |
86 | @L |
89 | @L |
87 | } |
90 | } |