Bug 20434: Update UNIMARC framework - script

Test plan:
1. Take a look at files in misc/migration_tools/ifla/data. It
   contains all data that will be inserted into Koha. Its content is
   based on the previous patches.
2. Run the script misc/migration_tools/ifla/update.pl and verify
   that it effectively added the new fields, subfields, authorised
   values and authority types.
3. Run the script again and see that it doesn't update existing fields
4. Run with --force and verify that it update existing fields (you can
   modify unimarc_ifla.yml to see changes)
5. Run with --force --po-file misc/migration_tools/ifla/language/fr.po
   and verify that the labels are now in french

There is a POT file in misc/migration_tools/ifla/language/template.pot,
use it to create PO files for other languages.

Signed-off-by: Sonia BOUIS <sonia.bouis@univ-lyon3.fr>
Signed-off-by: Alex Arnaud <alex.arnaud@biblibre.com>
Signed-off-by: Martin Renvoize <martin.renvoize@ptfs-europe.com>

diff --git a/misc/migration_tools/ifla/update.pl b/misc/migration_tools/ifla/update.pl
new file mode 100755 (executable)
index 0000000..b736bf8
--- /dev/null
+++ b/misc/migration_tools/ifla/update.pl
@@ -0,0 +1,309 @@
+#!/usr/bin/env perl
+
+# Copyright 2018 BibLibre
+#
+# This file is part of Koha.
+#
+# Koha is free software; you can redistribute it and/or modify it
+# under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
+#
+# Koha is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with Koha; if not, see <http://www.gnu.org/licenses>.
+
+use Modern::Perl;
+
+use Date::Format;
+use File::Basename;
+use FindBin qw($Bin);
+use Getopt::Long;
+use Locale::PO;
+use YAML qw(LoadFile);
+use utf8;
+
+use Koha::Database;
+
+my $help;
+my $po_file;
+my $dump_pot;
+my $force;
+GetOptions(
+    'help' => \$help,
+    'po-file=s' => \$po_file,
+    'dump-pot' => \$dump_pot,
+    'force' => \$force,
+) or die 'Error in command line arguments';
+
+if ($help) {
+    my $basename = basename($0);
+    say <<"EOT";
+Usage:
+    $basename [--po-file FILE] [--force]
+    $basename --dump-pot
+    $basename --help
+
+This script adds new fields and subfields for biblio and authority, new
+authority types and new authorised values, for UNIMARC IFLA update
+
+Options:
+    --help
+        Display this help
+
+    --po-file FILE
+        PO file containing translations
+
+    --dump-pot
+        Print a POT file containing all translatable strings and exit
+
+    --force
+        Force updating existing data
+EOT
+
+    exit 0;
+}
+
+my $defaults = LoadFile("$Bin/data/defaults.yml");
+my $authorised_values = LoadFile("$Bin/data/authorised_values.yml");
+my $authtypes = LoadFile("$Bin/data/authtypes.yml");
+my @authtags;
+my @authsubfields;
+for my $authfw (qw(default CLASS CO EXP FAM GENRE_FORM NP NTEXP NTWORK PA PERS PUB SAUTTIT SNC SNG TM TU WORK)) {
+    my $file = LoadFile("$Bin/data/auth/$authfw.yml");
+    push @authtags, @{ $file->{authtags} };
+    push @authsubfields, @{ $file->{authsubfields} };
+}
+my $biblio = LoadFile("$Bin/data/biblio/default.yml");
+my @tags = @{ $biblio->{tags} };
+my @subfields = @{ $biblio->{subfields} };
+
+my $translations = {};
+if ($dump_pot) {
+    $translations->{''} = new Locale::PO(
+        -msgid => '',
+        -msgstr => "Project-Id-Version: Koha\n" .
+            "POT-Creation-Date: " . time2str('%Y-%m-%d %R%z', time) . "\n" .
+            "MIME-Version: 1.0\n" .
+            "Content-Type: text/plain; charset=UTF-8\n" .
+            "Content-Transfer-Encoding: 8bit\n",
+    );
+    while (my ($category, $values) = each %$authorised_values) {
+        foreach my $authorised_value (@$values) {
+            $translations->{$authorised_value->{lib}} = new Locale::PO(
+                -msgid => $authorised_value->{lib},
+                -msgstr => '',
+            );
+        }
+    }
+    for my $tag (@tags) {
+        $translations->{$tag->{liblibrarian}} = new Locale::PO(
+            -msgid => $tag->{liblibrarian},
+            -msgstr => '',
+        );
+    }
+    for my $subfield (@subfields) {
+        $translations->{$subfield->{liblibrarian}} = new Locale::PO(
+            -msgid => $subfield->{liblibrarian},
+            -msgstr => '',
+        );
+    }
+    for my $authtype (@$authtypes) {
+        $translations->{$authtype->{authtypetext}} = new Locale::PO(
+            -msgid => $authtype->{authtypetext},
+            -msgstr => '',
+        );
+    }
+    for my $authtag (@authtags) {
+        $translations->{$authtag->{liblibrarian}} = new Locale::PO(
+            -msgid => $authtag->{liblibrarian},
+            -msgstr => '',
+        );
+    }
+    for my $authsubfield (@authsubfields) {
+        $translations->{$authsubfield->{liblibrarian}} = new Locale::PO(
+            -msgid => $authsubfield->{liblibrarian},
+            -msgstr => '',
+        );;
+    }
+
+    Locale::PO->save_file_fromhash("$Bin/language/template.pot", $translations, 'utf8');
+
+    exit 0;
+}
+
+if ($po_file) {
+    $translations = Locale::PO->load_file_ashash($po_file, 'utf8');
+}
+
+sub t {
+    my ($string) = @_;
+
+    my $quoted_string = Locale::PO->quote($string);
+    unless (exists $translations->{$quoted_string} and $translations->{$quoted_string}) {
+        return $string;
+    }
+
+    return Locale::PO->dequote($translations->{$quoted_string}->msgstr);
+}
+
+
+my $schema = Koha::Database->new()->schema();
+my $authorised_value_rs = $schema->resultset('AuthorisedValue');
+my $authorised_value_category_rs = $schema->resultset('AuthorisedValueCategory');
+my $marc_tag_structure_rs = $schema->resultset('MarcTagStructure');
+my $marc_subfield_structure_rs = $schema->resultset('MarcSubfieldStructure');
+my $auth_type_rs = $schema->resultset('AuthType');
+my $auth_tag_structure_rs = $schema->resultset('AuthTagStructure');
+my $auth_subfield_structure_rs = $schema->resultset('AuthSubfieldStructure');
+
+my $av_defaults = $defaults->{av};
+while (my ($category, $values) = each %$authorised_values) {
+    foreach my $authorised_value (@$values) {
+        foreach my $key (keys %$av_defaults) {
+            unless (exists $authorised_value->{$key}) {
+                $authorised_value->{$key} = $av_defaults->{$key};
+            }
+        }
+        $authorised_value->{category} = $category;
+        $authorised_value->{lib} = t($authorised_value->{lib});
+
+        my $value = $authorised_value->{authorised_value};
+        my $av = $authorised_value_rs->find({
+            category => $category,
+            authorised_value => $value,
+        });
+        if ($av) {
+            say "Authorised value already exists ($category, $value)";
+            if ($force) {
+                say "Force mode is active, updating authorised value ($category, $value)";
+                $av->update($authorised_value);
+            }
+            next;
+        }
+
+        my $cat = $authorised_value_category_rs->find($category);
+        if (!$cat) {
+            say "Adding authorised value category $category";
+            $authorised_value_category_rs->create({
+                category_name => $category,
+            });
+        }
+
+        say "Adding authorised value ($category, $value)";
+        $authorised_value_rs->create($authorised_value);
+    }
+}
+
+my $tag_defaults = $defaults->{tag};
+for my $tag (@tags) {
+    foreach my $key (keys %$tag_defaults) {
+        unless (exists $tag->{$key}) {
+            $tag->{$key} = $tag_defaults->{$key};
+        }
+    }
+    $tag->{liblibrarian} = t($tag->{liblibrarian});
+
+    my $mts = $marc_tag_structure_rs->find('', $tag->{tagfield});
+    if ($mts) {
+        say "Field already exists: " . $tag->{tagfield};
+        if ($force) {
+            say "Force mode is active, updating field " . $tag->{tagfield};
+            $mts->update($tag);
+        }
+        next;
+    }
+
+    say "Adding field " . $tag->{tagfield};
+    $marc_tag_structure_rs->create($tag);
+}
+
+my $subfield_defaults = $defaults->{subfield};
+for my $subfield (@subfields) {
+    foreach my $key (keys %$subfield_defaults) {
+        unless (exists $subfield->{$key}) {
+            $subfield->{$key} = $subfield_defaults->{$key};
+        }
+    }
+    $subfield->{liblibrarian} = t($subfield->{liblibrarian});
+
+    my $mss = $marc_subfield_structure_rs->find('', $subfield->{tagfield}, $subfield->{tagsubfield});
+    if ($mss) {
+        say sprintf('Subfield already exists: %s$%s', $subfield->{tagfield}, $subfield->{tagsubfield});
+        if ($force) {
+            say sprintf('Force mode is active, updating subfield %s$%s', $subfield->{tagfield}, $subfield->{tagsubfield});
+            $mss->update($subfield);
+        }
+        next;
+    }
+
+    say sprintf('Adding subfield %s$%s', $subfield->{tagfield}, $subfield->{tagsubfield});
+    $marc_subfield_structure_rs->create($subfield);
+}
+
+for my $authtype (@$authtypes) {
+    $authtype->{authtypetext} = t($authtype->{authtypetext});
+
+    my $at = $auth_type_rs->find($authtype->{authtypecode});
+    if ($at) {
+        say "Authority type already exists: " . $authtype->{authtypecode};
+        if ($force) {
+            say "Force mode is active, updating authority type " . $authtype->{authtypecode};
+            $at->update($authtype);
+        }
+        next;
+    }
+
+    say "Adding authority type " . $authtype->{authtypecode};
+    $auth_type_rs->create($authtype);
+}
+
+my $authtag_defaults = $defaults->{authtag};
+for my $authtag (@authtags) {
+    foreach my $key (keys %$authtag_defaults) {
+        unless (exists $authtag->{$key}) {
+            $authtag->{$key} = $authtag_defaults->{$key};
+        }
+    }
+    $authtag->{liblibrarian} = t($authtag->{liblibrarian});
+
+    my $ats = $auth_tag_structure_rs->find($authtag->{authtypecode}, $authtag->{tagfield});
+    if ($ats) {
+        say sprintf('Auth field already exists: %s (%s)', $authtag->{tagfield}, $authtag->{authtypecode});
+        if ($force) {
+            say sprintf('Force mode is active, updating auth field %s (%s)', $authtag->{tagfield}, $authtag->{authtypecode});
+            $ats->update($authtag);
+        }
+        next;
+    }
+
+    say sprintf('Adding auth field %s (%s)', $authtag->{tagfield}, $authtag->{authtypecode});
+    $auth_tag_structure_rs->create($authtag);
+}
+
+my $authsubfield_defaults = $defaults->{authsubfield};
+for my $authsubfield (@authsubfields) {
+    foreach my $key (keys %$authsubfield_defaults) {
+        unless (exists $authsubfield->{$key}) {
+            $authsubfield->{$key} = $authsubfield_defaults->{$key};
+        }
+    }
+    $authsubfield->{liblibrarian} = t($authsubfield->{liblibrarian});
+
+    my $ass = $auth_subfield_structure_rs->find($authsubfield->{authtypecode}, $authsubfield->{tagfield}, $authsubfield->{tagsubfield});
+    if ($ass) {
+        say sprintf('Auth subfield already exists: %s$%s (%s)', $authsubfield->{tagfield}, $authsubfield->{tagsubfield}, $authsubfield->{authtypecode});
+        if ($force) {
+            say sprintf('Force mode is active, updating auth subfield %s$%s (%s)', $authsubfield->{tagfield}, $authsubfield->{tagsubfield}, $authsubfield->{authtypecode});
+            $ass->update($authsubfield);
+        }
+        next;
+    }
+
+    say sprintf('Adding auth subfield %s$%s (%s)', $authsubfield->{tagfield}, $authsubfield->{tagsubfield}, $authsubfield->{authtypecode});
+    $auth_subfield_structure_rs->create($authsubfield);
+}