Subversion Repositories wimsdev

Rev

Rev 6471 | Rev 6956 | Go to most recent revision | Blame | Compare with Previous | Last modification | View Log | RSS feed

  1. #!/usr/bin/perl
  2. ##example classes
  3.  
  4. use warnings;
  5. use strict;
  6. use search ('out', 'sortuniq', 'hashdomain', 'treate_accent', 'treate_domainfile');
  7.  
  8. my $dir='../../../log/classes/';
  9. my $dirdomain='domain';
  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);
  16. my @Key = ('supervisor','domain','level','lang','institution','description','addr','keywords','title');
  17. my @Lang= ('fr','en','it','nl') ;
  18. my %T = ('version' => 'version',
  19. 'lang' => 'language',
  20. 'institution' => 'description',
  21. 'supervisor' => 'author',
  22. 'description' => 'title',
  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='';
  37.   my %dom = treate_domainfile ("$dirdomain/domain.$l");
  38.   my $dom = \%dom;
  39.   for my $cl (@list) {
  40.     next if (!($ref{$cl}{'lang'} =~ /$l/)) ;
  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);
  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};
  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.   }
  53.  }
  54.    while ( my ($key, $value) = each (%keywords) ) {
  55.      $text .= "$key:$value\n" ;
  56.    }
  57.    $text =~ s / +(\w+:)/$1/g;
  58.    out("$dirout/$l", join("\n", sortuniq(split("\n",$text))));
  59. }
  60.  
  61. ###############################
  62. sub refclass { my @L=@_ ;
  63.   for my $cl (@L) {
  64.     open IN, "$dir/$cl/.def";
  65.     while(<IN>) {
  66.     if ($_ =~ /!set class_(\w+)=\s*(.*)/) { $ref{$cl}{$1}=$2 ;}}
  67.     close IN;
  68.   }
  69. }
  70.  
  71. sub listclass {
  72.  my @L= () ;
  73.  for my $cl (glob("$dir/*")) {
  74.    $cl=~s /$dir\/// ;
  75.    push @L, $cl if (!($cl =~ /[A-Z]+/) && $cl < 10000) ;
  76.   }
  77.   @L
  78. }
  79.