misc/migration_tools/buildLANG.pl

   1 #!/usr/bin/perl
   2 # script that rebuild thesaurus from biblio table.
   3
   4 # delete  FROM  `marc_subfield_table`  WHERE tag =  "606" AND subfieldcode = 9;
   5 use strict;
   6
   7 # Koha modules used
   8 # use MARC::File::USMARC;
   9 # use MARC::Record;
  10 # use MARC::Batch;
  11 use C4::Context;
  12 use C4::Biblio;
  13 use C4::AuthoritiesMarc;
  14 use Time::HiRes qw(gettimeofday);
  15
  16 use Getopt::Long;
  17 my ( $fields, $number,$language) = ('',0);
  18 my ($version, $verbose, $test_parameter, $field,$delete,$subfields);
  19 GetOptions(
  20     'h' => \$version,
  21     'd' => \$delete,
  22     't' => \$test_parameter,
  23     's:s' => \$fields,
  24     'v' => \$verbose,
  25         'l:s' => \$language,
  26 );
  27
  28 if ($version or !$fields) {
  29         print <<EOF
  30 Small script to recreate the LANG list in authorised values from existing langs in the catalogue.
  31 This script is useful when you migrate your datas with bulkmarcimport.pl as it populates parameters tables that are not modified by bulkmarcimport.
  32
  33 parameters :
  34 \th : this version/help screen
  35 \ts : the field or field list where the lang codes are stored.
  36 \td : delete every entry of LANG category before doing work.
  37 \tl : the language of the language list (fr or en for instance)
  38
  39 The table is populated with iso codes and meaning (in french).
  40 If the complete language name is unknown, the code is used instead and you will be warned by the script
  41
  42 SAMPLES :
  43  ./buildLANG -d -s "('101a','101b')"
  44 EOF
  45 ;#
  46 exit;
  47 }
  48
  49 my %codesiso;
  50
  51 %codesiso = (
  52         'eng' => 'english',
  53         'fre' => 'french'
  54         );
  55
  56 %codesiso = (
  57         'mis' => 'diverses',
  58         'und' => 'inconnue',
  59         'mul' => 'multilingue',
  60         'ger' => 'allemand',
  61         'eng' => 'anglais',
  62         'ara' => 'arabe',
  63         'arm' => 'arménien',
  64         'baq' => 'basque',
  65         'ber' => 'berbere',
  66         'bre' => 'breton',
  67         'bul' => 'bulgare',
  68         'cat' => 'catalan',
  69         'chi' => 'chinois',
  70         'cro' => 'croate',
  71         'dan' => 'danois',
  72         'spa' => 'espagnol',
  73         'esp' => 'espéranto',
  74         'fin' => 'finnois',
  75         'fra' => 'français ancien',
  76         'fre' => 'français',
  77         'wel' => 'gallois',
  78         'grc' => 'grec classique',
  79         'gre' => 'grec moderne',
  80         'heb' => 'hébreu',
  81         'hun' => 'hongrois',
  82         'ita' => 'italien',
  83         'jap' => 'japonais',
  84         'lat' => 'latin',
  85         'dut' => 'néerlandais',
  86         'nor' => 'norvégien',
  87         'pol' => 'polonais',
  88         'por' => 'portugais',
  89         'rum' => 'roumain',
  90         'rus' => 'russe',
  91         'ser' => 'serbe',
  92         'swe' => 'suedois',
  93         'cze' => 'tchèque',
  94         'tur' => 'turc',
  95         'ukr' => 'ukraine',
  96         'slo' => 'slovène',
  97         'scr' => 'serbo-croate',
  98         ) if $language eq 'fr';
  99
 100 my $dbh = C4::Context->dbh;
 101 if ($delete) {
 102         print "deleting lang list\n";
 103         $dbh->do("delete from authorised_values where category='LANG'");
 104 }
 105
 106 if ($test_parameter) {
 107         print "TESTING MODE ONLY\n    DOING NOTHING\n===============\n";
 108 }
 109 my $starttime = gettimeofday;
 110
 111 my $sth = $dbh->prepare("SELECT DISTINCT subfieldvalue FROM marc_subfield_table WHERE tag + subfieldcode IN $fields order by subfieldvalue");
 112
 113 $sth->execute;
 114 my $i=1;
 115
 116 print "=========================\n";
 117 my $sth2 = $dbh->prepare("insert into authorised_values (category, authorised_value, lib) values (?,?,?)");
 118 while (my ($langue) = $sth->fetchrow) {
 119         $sth2->execute('LANG',$langue,$langue?$codesiso{$langue}:$langue);
 120         print "lang : $langue is unknown is iso list\n" unless $codesiso{$langue};
 121 }
 122 print "=========================\n";