Subversion Repositories wimsdev

Rev

Rev 16933 | 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 lib '/var/lib/wims/public_html/bases/sys';
  7. use lib ".";
  8. use search ('out', 'sortuniq', 'hashdomain', 'treate_accent', 'treate_dict');
  9.  
  10. my $dir='../../../log/classes/';
  11. my $dirdomain='domain';
  12. ## list of all domains in domain/domain
  13. my %ref= ();
  14. my $ref=\%ref;
  15. my @list=listclass();
  16. my $dirout="../class";
  17. $ref=refclass(@list);
  18. my @Key = ('supervisor','domain','level','lang','institution','description','addr','keywords','title', 'information');
  19. my @Lang= ('fr','en','it','nl');
  20. my %T = ('version' => 'version',
  21. 'lang' => 'language',
  22. 'description' => 'title',
  23. 'supervisor' => 'author',
  24. 'institution' => 'description',
  25. 'level' => 'level',
  26. 'information' => 'information',
  27. );
  28. my %keywords=();
  29.  
  30. for my $key (@Key) {
  31.   my $text='';
  32.   for my $cl (@list) {
  33.     $text .=  "$cl:";
  34.     $text .= $ref{$cl}{$key} if ($ref{$cl}{$key});
  35.     $text .= "\n";
  36.   };
  37.   out("$dirout/$T{$key}",join("\n",sort( split("\n", $text)))) if ($T{$key});
  38. }
  39. for my $l (@Lang) { my $text='';
  40.   my %dom = treate_dict ("$dirdomain/domain.$l");
  41.   my $dom = \%dom;
  42.   for my $cl (@list) {
  43.     next if (!($ref{$cl}{'lang'} =~ /$l/));
  44.     next if (!$ref{$cl}{'keywords'});
  45.     $ref{$cl}{'keywords'}=lc(treate_accent($ref{$cl}{'keywords'}));
  46.     for my $k (sortuniq(split(', *',$ref{$cl}{'keywords'}))) {
  47.       $k =treate_accent($k);
  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.     for my $k (split(',',$ref{$cl}{'domain'})) {
  54.       if ($keywords{$k}) { $keywords{$k} .= " " . $cl  } else { $keywords{$k} = $cl};
  55.        next if !($dom{$k});
  56.        my $d=lc(treate_accent($dom{$k}));
  57.       if ($keywords{$d}) { $keywords{$d} .= " " . $cl  } else { $keywords{$d} = $cl};
  58.   }
  59.  }
  60.    while ( my ($key, $value) = each (%keywords) ) {
  61.      my $v = join(" ", sortuniq(split(" ",$value)));
  62.      $text .= "$key:$v\n";
  63.    }
  64.    $text =~ s / +(\w+:)/ $1/g;
  65.    out("$dirout/$l", join("\n", sortuniq(split("\n",$text))));
  66. }
  67.  
  68. ###############################
  69. sub refclass { my @L=@_;
  70.   for my $cl (@L) {
  71.     open IN, "$dir/$cl/.def";
  72.     while(<IN>) {
  73.     if ($_ =~ /!set class_(\w+)=\s*(.*)/) {
  74.     my $f = $1; my $r= $2;
  75.      if ($f =~ /\blevel/) {
  76.         $r=~ s/ //g;
  77.         if( $r) { $ref{$cl}{$f}= "level" . join(', level', split(',',$r));}
  78.        }
  79.        else { $ref{$cl}{$1}=$2;}}
  80.        }
  81.     close IN;
  82.   }
  83. }
  84.  
  85. sub listclass {
  86.  my @L= ();
  87.  for my $cl (glob("$dir/*")) {
  88.    $cl=~s /$dir\///;
  89.    push @L, $cl if (!($cl =~ /[A-Z]+/) && $cl < 10000);
  90.   }
  91.   @L
  92. }
  93.