"Fossies" - the Fresh Open Source Software Archive

Member "koha-19.11.15/misc/migration_tools/ifla/update.pl" (23 Feb 2021, 10320 Bytes) of package /linux/misc/koha-19.11.15.tar.gz:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Perl source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file. For more information about "update.pl" see the Fossies "Dox" file reference documentation and the last Fossies "Diffs" side-by-side code changes report: 20.05.06_vs_20.11.00.

    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 qw(LoadFile);
   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 = LoadFile("$Bin/data/defaults.yml");
   72 my $authorised_values = LoadFile("$Bin/data/authorised_values.yml");
   73 my $authtypes = 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 = LoadFile("$Bin/data/auth/$authfw.yml");
   78     push @authtags, @{ $file->{authtags} };
   79     push @authsubfields, @{ $file->{authsubfields} };
   80 }
   81 my $biblio = 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->{''} = new Locale::PO(
   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}} = new Locale::PO(
   98                 -msgid => $authorised_value->{lib},
   99                 -msgstr => '',
  100             );
  101         }
  102     }
  103     for my $tag (@tags) {
  104         $translations->{$tag->{liblibrarian}} = new Locale::PO(
  105             -msgid => $tag->{liblibrarian},
  106             -msgstr => '',
  107         );
  108     }
  109     for my $subfield (@subfields) {
  110         $translations->{$subfield->{liblibrarian}} = new Locale::PO(
  111             -msgid => $subfield->{liblibrarian},
  112             -msgstr => '',
  113         );
  114     }
  115     for my $authtype (@$authtypes) {
  116         $translations->{$authtype->{authtypetext}} = new Locale::PO(
  117             -msgid => $authtype->{authtypetext},
  118             -msgstr => '',
  119         );
  120     }
  121     for my $authtag (@authtags) {
  122         $translations->{$authtag->{liblibrarian}} = new Locale::PO(
  123             -msgid => $authtag->{liblibrarian},
  124             -msgstr => '',
  125         );
  126     }
  127     for my $authsubfield (@authsubfields) {
  128         $translations->{$authsubfield->{liblibrarian}} = new Locale::PO(
  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 $subfield_defaults = $defaults->{subfield};
  226 for my $subfield (@subfields) {
  227     foreach my $key (keys %$subfield_defaults) {
  228         unless (exists $subfield->{$key}) {
  229             $subfield->{$key} = $subfield_defaults->{$key};
  230         }
  231     }
  232     $subfield->{liblibrarian} = t($subfield->{liblibrarian});
  233 
  234     my $mss = $marc_subfield_structure_rs->find('', $subfield->{tagfield}, $subfield->{tagsubfield});
  235     if ($mss) {
  236         say sprintf('Subfield already exists: %s$%s', $subfield->{tagfield}, $subfield->{tagsubfield});
  237         if ($force) {
  238             say sprintf('Force mode is active, updating subfield %s$%s', $subfield->{tagfield}, $subfield->{tagsubfield});
  239             $mss->update($subfield);
  240         }
  241         next;
  242     }
  243 
  244     say sprintf('Adding subfield %s$%s', $subfield->{tagfield}, $subfield->{tagsubfield});
  245     $marc_subfield_structure_rs->create($subfield);
  246 }
  247 
  248 for my $authtype (@$authtypes) {
  249     $authtype->{authtypetext} = t($authtype->{authtypetext});
  250 
  251     my $at = $auth_type_rs->find($authtype->{authtypecode});
  252     if ($at) {
  253         say "Authority type already exists: " . $authtype->{authtypecode};
  254         if ($force) {
  255             say "Force mode is active, updating authority type " . $authtype->{authtypecode};
  256             $at->update($authtype);
  257         }
  258         next;
  259     }
  260 
  261     say "Adding authority type " . $authtype->{authtypecode};
  262     $auth_type_rs->create($authtype);
  263 }
  264 
  265 my $authtag_defaults = $defaults->{authtag};
  266 for my $authtag (@authtags) {
  267     foreach my $key (keys %$authtag_defaults) {
  268         unless (exists $authtag->{$key}) {
  269             $authtag->{$key} = $authtag_defaults->{$key};
  270         }
  271     }
  272     $authtag->{liblibrarian} = t($authtag->{liblibrarian});
  273 
  274     my $ats = $auth_tag_structure_rs->find($authtag->{authtypecode}, $authtag->{tagfield});
  275     if ($ats) {
  276         say sprintf('Auth field already exists: %s (%s)', $authtag->{tagfield}, $authtag->{authtypecode});
  277         if ($force) {
  278             say sprintf('Force mode is active, updating auth field %s (%s)', $authtag->{tagfield}, $authtag->{authtypecode});
  279             $ats->update($authtag);
  280         }
  281         next;
  282     }
  283 
  284     say sprintf('Adding auth field %s (%s)', $authtag->{tagfield}, $authtag->{authtypecode});
  285     $auth_tag_structure_rs->create($authtag);
  286 }
  287 
  288 my $authsubfield_defaults = $defaults->{authsubfield};
  289 for my $authsubfield (@authsubfields) {
  290     foreach my $key (keys %$authsubfield_defaults) {
  291         unless (exists $authsubfield->{$key}) {
  292             $authsubfield->{$key} = $authsubfield_defaults->{$key};
  293         }
  294     }
  295     $authsubfield->{liblibrarian} = t($authsubfield->{liblibrarian});
  296 
  297     my $ass = $auth_subfield_structure_rs->find($authsubfield->{authtypecode}, $authsubfield->{tagfield}, $authsubfield->{tagsubfield});
  298     if ($ass) {
  299         say sprintf('Auth subfield already exists: %s$%s (%s)', $authsubfield->{tagfield}, $authsubfield->{tagsubfield}, $authsubfield->{authtypecode});
  300         if ($force) {
  301             say sprintf('Force mode is active, updating auth subfield %s$%s (%s)', $authsubfield->{tagfield}, $authsubfield->{tagsubfield}, $authsubfield->{authtypecode});
  302             $ass->update($authsubfield);
  303         }
  304         next;
  305     }
  306 
  307     say sprintf('Adding auth subfield %s$%s (%s)', $authsubfield->{tagfield}, $authsubfield->{tagsubfield}, $authsubfield->{authtypecode});
  308     $auth_subfield_structure_rs->create($authsubfield);
  309 }