Bug 25898: Prohibit indirect object notation
[koha.git] / misc / migration_tools / ifla / update.pl
blob6f84cdc74bc82ccabf1180a148b55b6a92ef1276
1 #!/usr/bin/env perl
3 # Copyright 2018 BibLibre
5 # This file is part of Koha.
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.
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.
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>.
20 use Modern::Perl;
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;
30 use Koha::Database;
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';
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
51 This script adds new fields and subfields for biblio and authority, new
52 authority types and new authorised values, for UNIMARC IFLA update
54 Options:
55 --help
56 Display this help
58 --po-file FILE
59 PO file containing translations
61 --dump-pot
62 Print a POT file containing all translatable strings and exit
64 --force
65 Force updating existing data
66 EOT
68 exit 0;
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} };
81 my $biblio = LoadFile("$Bin/data/biblio/default.yml");
82 my @tags = @{ $biblio->{tags} };
83 my @subfields = @{ $biblio->{subfields} };
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",
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 => '',
103 for my $tag (@tags) {
104 $translations->{$tag->{liblibrarian}} = Locale::PO->new(
105 -msgid => $tag->{liblibrarian},
106 -msgstr => '',
109 for my $subfield (@subfields) {
110 $translations->{$subfield->{liblibrarian}} = Locale::PO->new(
111 -msgid => $subfield->{liblibrarian},
112 -msgstr => '',
115 for my $authtype (@$authtypes) {
116 $translations->{$authtype->{authtypetext}} = Locale::PO->new(
117 -msgid => $authtype->{authtypetext},
118 -msgstr => '',
121 for my $authtag (@authtags) {
122 $translations->{$authtag->{liblibrarian}} = Locale::PO->new(
123 -msgid => $authtag->{liblibrarian},
124 -msgstr => '',
127 for my $authsubfield (@authsubfields) {
128 $translations->{$authsubfield->{liblibrarian}} = Locale::PO->new(
129 -msgid => $authsubfield->{liblibrarian},
130 -msgstr => '',
134 Locale::PO->save_file_fromhash("$Bin/language/template.pot", $translations, 'utf8');
136 exit 0;
139 if ($po_file) {
140 $translations = Locale::PO->load_file_ashash($po_file, 'utf8');
143 sub t {
144 my ($string) = @_;
146 my $quoted_string = Locale::PO->quote($string);
147 unless (exists $translations->{$quoted_string} and $translations->{$quoted_string}) {
148 return $string;
151 return Locale::PO->dequote($translations->{$quoted_string}->msgstr);
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');
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};
172 $authorised_value->{category} = $category;
173 $authorised_value->{lib} = t($authorised_value->{lib});
175 my $value = $authorised_value->{authorised_value};
176 my $av = $authorised_value_rs->find({
177 category => $category,
178 authorised_value => $value,
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);
186 next;
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,
197 say "Adding authorised value ($category, $value)";
198 $authorised_value_rs->create($authorised_value);
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};
209 $tag->{liblibrarian} = t($tag->{liblibrarian});
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);
218 next;
221 say "Adding field " . $tag->{tagfield};
222 $marc_tag_structure_rs->create($tag);
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};
232 $subfield->{liblibrarian} = t($subfield->{liblibrarian});
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);
241 next;
244 say sprintf('Adding subfield %s$%s', $subfield->{tagfield}, $subfield->{tagsubfield});
245 $marc_subfield_structure_rs->create($subfield);
248 for my $authtype (@$authtypes) {
249 $authtype->{authtypetext} = t($authtype->{authtypetext});
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);
258 next;
261 say "Adding authority type " . $authtype->{authtypecode};
262 $auth_type_rs->create($authtype);
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};
272 $authtag->{liblibrarian} = t($authtag->{liblibrarian});
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);
281 next;
284 say sprintf('Adding auth field %s (%s)', $authtag->{tagfield}, $authtag->{authtypecode});
285 $auth_tag_structure_rs->create($authtag);
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};
295 $authsubfield->{liblibrarian} = t($authsubfield->{liblibrarian});
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);
304 next;
307 say sprintf('Adding auth subfield %s$%s (%s)', $authsubfield->{tagfield}, $authsubfield->{tagsubfield}, $authsubfield->{authtypecode});
308 $auth_subfield_structure_rs->create($authsubfield);