koha-dev.rot13.org Git - srvgit/blob - misc/migration_tools/ifla/update.pl

   1 #!/usr/bin/env perl
   2
   3 # Copyright 2018 BibLibre
   4 #
   5 # This file is part of Koha.
   6 #
   7 # Koha is free software; you can redistribute it and/or modify it
   8 # under the terms of the GNU General Public License as published by
   9 # the Free Software Foundation; either version 3 of the License, or
  10 # (at your option) any later version.
  11 #
  12 # Koha is distributed in the hope that it will be useful, but
  13 # WITHOUT ANY WARRANTY; without even the implied warranty of
  14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  15 # GNU General Public License for more details.
  16 #
  17 # You should have received a copy of the GNU General Public License
  18 # along with Koha; if not, see <http://www.gnu.org/licenses>.
  19
  20 use Modern::Perl;
  21
  22 use Date::Format;
  23 use File::Basename;
  24 use FindBin qw($Bin);
  25 use Getopt::Long;
  26 use Locale::PO;
  27 use YAML::XS;
  28 use utf8;
  29
  30 use Koha::Database;
  31
  32 my $help;
  33 my $po_file;
  34 my $dump_pot;
  35 my $force;
  36 GetOptions(
  37     'help' => \$help,
  38     'po-file=s' => \$po_file,
  39     'dump-pot' => \$dump_pot,
  40     'force' => \$force,
  41 ) or die 'Error in command line arguments';
  42
  43 if ($help) {
  44     my $basename = basename($0);
  45     say <<"EOT";
  46 Usage:
  47     $basename [--po-file FILE] [--force]
  48     $basename --dump-pot
  49     $basename --help
  50
  51 This script adds new fields and subfields for biblio and authority, new
  52 authority types and new authorised values, for UNIMARC IFLA update
  53
  54 Options:
  55     --help
  56         Display this help
  57
  58     --po-file FILE
  59         PO file containing translations
  60
  61     --dump-pot
  62         Print a POT file containing all translatable strings and exit
  63
  64     --force
  65         Force updating existing data
  66 EOT
  67
  68     exit 0;
  69 }
  70
  71 my $defaults = YAML::XS::LoadFile("$Bin/data/defaults.yml");
  72 my $authorised_values = YAML::XS::LoadFile("$Bin/data/authorised_values.yml");
  73 my $authtypes = YAML::XS::LoadFile("$Bin/data/authtypes.yml");
  74 my @authtags;
  75 my @authsubfields;
  76 for my $authfw (qw(default CLASS CO EXP FAM GENRE_FORM NP NTEXP NTWORK PA PERS PUB SAUTTIT SNC SNG TM TU WORK)) {
  77     my $file = YAML::XS::LoadFile("$Bin/data/auth/$authfw.yml");
  78     push @authtags, @{ $file->{authtags} };
  79     push @authsubfields, @{ $file->{authsubfields} };
  80 }
  81 my $biblio = YAML::XS::LoadFile("$Bin/data/biblio/default.yml");
  82 my @tags = @{ $biblio->{tags} };
  83 my @subfields = @{ $biblio->{subfields} };
  84
  85 my $translations = {};
  86 if ($dump_pot) {
  87     $translations->{''} = Locale::PO->new(
  88         -msgid => '',
  89         -msgstr => "Project-Id-Version: Koha\n" .
  90             "POT-Creation-Date: " . time2str('%Y-%m-%d %R%z', time) . "\n" .
  91             "MIME-Version: 1.0\n" .
  92             "Content-Type: text/plain; charset=UTF-8\n" .
  93             "Content-Transfer-Encoding: 8bit\n",
  94     );
  95     while (my ($category, $values) = each %$authorised_values) {
  96         foreach my $authorised_value (@$values) {
  97             $translations->{$authorised_value->{lib}} = Locale::PO->new(
  98                 -msgid => $authorised_value->{lib},
  99                 -msgstr => '',
 100             );
 101         }
 102     }
 103     for my $tag (@tags) {
 104         $translations->{$tag->{liblibrarian}} = Locale::PO->new(
 105             -msgid => $tag->{liblibrarian},
 106             -msgstr => '',
 107         );
 108     }
 109     for my $subfield (@subfields) {
 110         $translations->{$subfield->{liblibrarian}} = Locale::PO->new(
 111             -msgid => $subfield->{liblibrarian},
 112             -msgstr => '',
 113         );
 114     }
 115     for my $authtype (@$authtypes) {
 116         $translations->{$authtype->{authtypetext}} = Locale::PO->new(
 117             -msgid => $authtype->{authtypetext},
 118             -msgstr => '',
 119         );
 120     }
 121     for my $authtag (@authtags) {
 122         $translations->{$authtag->{liblibrarian}} = Locale::PO->new(
 123             -msgid => $authtag->{liblibrarian},
 124             -msgstr => '',
 125         );
 126     }
 127     for my $authsubfield (@authsubfields) {
 128         $translations->{$authsubfield->{liblibrarian}} = Locale::PO->new(
 129             -msgid => $authsubfield->{liblibrarian},
 130             -msgstr => '',
 131         );;
 132     }
 133
 134     Locale::PO->save_file_fromhash("$Bin/language/template.pot", $translations, 'utf8');
 135
 136     exit 0;
 137 }
 138
 139 if ($po_file) {
 140     $translations = Locale::PO->load_file_ashash($po_file, 'utf8');
 141 }
 142
 143 sub t {
 144     my ($string) = @_;
 145
 146     my $quoted_string = Locale::PO->quote($string);
 147     unless (exists $translations->{$quoted_string} and $translations->{$quoted_string}) {
 148         return $string;
 149     }
 150
 151     return Locale::PO->dequote($translations->{$quoted_string}->msgstr);
 152 }
 153
 154
 155 my $schema = Koha::Database->new()->schema();
 156 my $authorised_value_rs = $schema->resultset('AuthorisedValue');
 157 my $authorised_value_category_rs = $schema->resultset('AuthorisedValueCategory');
 158 my $marc_tag_structure_rs = $schema->resultset('MarcTagStructure');
 159 my $marc_subfield_structure_rs = $schema->resultset('MarcSubfieldStructure');
 160 my $auth_type_rs = $schema->resultset('AuthType');
 161 my $auth_tag_structure_rs = $schema->resultset('AuthTagStructure');
 162 my $auth_subfield_structure_rs = $schema->resultset('AuthSubfieldStructure');
 163
 164 my $av_defaults = $defaults->{av};
 165 while (my ($category, $values) = each %$authorised_values) {
 166     foreach my $authorised_value (@$values) {
 167         foreach my $key (keys %$av_defaults) {
 168             unless (exists $authorised_value->{$key}) {
 169                 $authorised_value->{$key} = $av_defaults->{$key};
 170             }
 171         }
 172         $authorised_value->{category} = $category;
 173         $authorised_value->{lib} = t($authorised_value->{lib});
 174
 175         my $value = $authorised_value->{authorised_value};
 176         my $av = $authorised_value_rs->find({
 177             category => $category,
 178             authorised_value => $value,
 179         });
 180         if ($av) {
 181             say "Authorised value already exists ($category, $value)";
 182             if ($force) {
 183                 say "Force mode is active, updating authorised value ($category, $value)";
 184                 $av->update($authorised_value);
 185             }
 186             next;
 187         }
 188
 189         my $cat = $authorised_value_category_rs->find($category);
 190         if (!$cat) {
 191             say "Adding authorised value category $category";
 192             $authorised_value_category_rs->create({
 193                 category_name => $category,
 194             });
 195         }
 196
 197         say "Adding authorised value ($category, $value)";
 198         $authorised_value_rs->create($authorised_value);
 199     }
 200 }
 201
 202 my $tag_defaults = $defaults->{tag};
 203 for my $tag (@tags) {
 204     foreach my $key (keys %$tag_defaults) {
 205         unless (exists $tag->{$key}) {
 206             $tag->{$key} = $tag_defaults->{$key};
 207         }
 208     }
 209     $tag->{liblibrarian} = t($tag->{liblibrarian});
 210
 211     my $mts = $marc_tag_structure_rs->find('', $tag->{tagfield});
 212     if ($mts) {
 213         say "Field already exists: " . $tag->{tagfield};
 214         if ($force) {
 215             say "Force mode is active, updating field " . $tag->{tagfield};
 216             $mts->update($tag);
 217         }
 218         next;
 219     }
 220
 221     say "Adding field " . $tag->{tagfield};
 222     $marc_tag_structure_rs->create($tag);
 223 }
 224
 225 my @mss = $marc_subfield_structure_rs->search({ frameworkcode => '' });
 226 my %tab_for_field;
 227 foreach my $mss (@mss) {
 228     next if $mss->tab < 0;
 229     next if exists $tab_for_field{$mss->tagfield};
 230     $tab_for_field{$mss->tagfield} = $mss->tab;
 231 }
 232
 233 my $subfield_defaults = $defaults->{subfield};
 234 for my $subfield (@subfields) {
 235     foreach my $key (keys %$subfield_defaults) {
 236         unless (exists $subfield->{$key}) {
 237             $subfield->{$key} = $subfield_defaults->{$key};
 238         }
 239     }
 240     $subfield->{liblibrarian} = t($subfield->{liblibrarian});
 241
 242     # If other subfields exist in this field, use the same tab
 243     if (exists $tab_for_field{$subfield->{tagfield}}) {
 244         $subfield->{tab} = $tab_for_field{$subfield->{tagfield}};
 245     }
 246
 247     my $mss = $marc_subfield_structure_rs->find('', $subfield->{tagfield}, $subfield->{tagsubfield});
 248     if ($mss) {
 249         say sprintf('Subfield already exists: %s$%s', $subfield->{tagfield}, $subfield->{tagsubfield});
 250         if ($force) {
 251             say sprintf('Force mode is active, updating subfield %s$%s', $subfield->{tagfield}, $subfield->{tagsubfield});
 252
 253             # Do not modify the tab of existing subfield
 254             my %values = %$subfield;
 255             delete $values{tab};
 256
 257             $mss->update(\%values);
 258         }
 259         next;
 260     }
 261
 262     say sprintf('Adding subfield %s$%s', $subfield->{tagfield}, $subfield->{tagsubfield});
 263     $marc_subfield_structure_rs->create($subfield);
 264 }
 265
 266 for my $authtype (@$authtypes) {
 267     $authtype->{authtypetext} = t($authtype->{authtypetext});
 268
 269     my $at = $auth_type_rs->find($authtype->{authtypecode});
 270     if ($at) {
 271         say "Authority type already exists: " . $authtype->{authtypecode};
 272         if ($force) {
 273             say "Force mode is active, updating authority type " . $authtype->{authtypecode};
 274             $at->update($authtype);
 275         }
 276         next;
 277     }
 278
 279     say "Adding authority type " . $authtype->{authtypecode};
 280     $auth_type_rs->create($authtype);
 281 }
 282
 283 my $authtag_defaults = $defaults->{authtag};
 284 for my $authtag (@authtags) {
 285     foreach my $key (keys %$authtag_defaults) {
 286         unless (exists $authtag->{$key}) {
 287             $authtag->{$key} = $authtag_defaults->{$key};
 288         }
 289     }
 290     $authtag->{liblibrarian} = t($authtag->{liblibrarian});
 291
 292     my $ats = $auth_tag_structure_rs->find($authtag->{authtypecode}, $authtag->{tagfield});
 293     if ($ats) {
 294         say sprintf('Auth field already exists: %s (%s)', $authtag->{tagfield}, $authtag->{authtypecode});
 295         if ($force) {
 296             say sprintf('Force mode is active, updating auth field %s (%s)', $authtag->{tagfield}, $authtag->{authtypecode});
 297             $ats->update($authtag);
 298         }
 299         next;
 300     }
 301
 302     say sprintf('Adding auth field %s (%s)', $authtag->{tagfield}, $authtag->{authtypecode});
 303     $auth_tag_structure_rs->create($authtag);
 304 }
 305
 306 my @ass = $auth_subfield_structure_rs->search();
 307 my %tab_for_authfield;
 308 foreach my $ass (@ass) {
 309     my $authtypecode = $ass->get_column('authtypecode');
 310     $tab_for_authfield{$authtypecode} //= {};
 311
 312     next if $ass->tab < 0;
 313     next if exists $tab_for_authfield{$authtypecode}->{$ass->tagfield};
 314
 315     $tab_for_authfield{$authtypecode}->{$ass->tagfield} = $ass->tab;
 316 }
 317
 318 my $authsubfield_defaults = $defaults->{authsubfield};
 319 for my $authsubfield (@authsubfields) {
 320     foreach my $key (keys %$authsubfield_defaults) {
 321         unless (exists $authsubfield->{$key}) {
 322             $authsubfield->{$key} = $authsubfield_defaults->{$key};
 323         }
 324     }
 325     $authsubfield->{liblibrarian} = t($authsubfield->{liblibrarian});
 326
 327     # If other subfields exist in this field, use the same tab
 328     if (exists $tab_for_authfield{$authsubfield->{authtypecode}}->{$authsubfield->{tagfield}}) {
 329         $authsubfield->{tab} = $tab_for_authfield{$authsubfield->{authtypecode}}->{$authsubfield->{tagfield}};
 330     }
 331
 332     my $ass = $auth_subfield_structure_rs->find($authsubfield->{authtypecode}, $authsubfield->{tagfield}, $authsubfield->{tagsubfield});
 333     if ($ass) {
 334         say sprintf('Auth subfield already exists: %s$%s (%s)', $authsubfield->{tagfield}, $authsubfield->{tagsubfield}, $authsubfield->{authtypecode});
 335         if ($force) {
 336             say sprintf('Force mode is active, updating auth subfield %s$%s (%s)', $authsubfield->{tagfield}, $authsubfield->{tagsubfield}, $authsubfield->{authtypecode});
 337
 338             # Do not modify the tab of existing subfield
 339             my %values = %$authsubfield;
 340             delete $values{tab};
 341
 342             $ass->update(\%values);
 343         }
 344         next;
 345     }
 346
 347     say sprintf('Adding auth subfield %s$%s (%s)', $authsubfield->{tagfield}, $authsubfield->{tagsubfield}, $authsubfield->{authtypecode});
 348     $auth_subfield_structure_rs->create($authsubfield);
 349 }