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>.
27 use YAML qw(LoadFile);
38 'po-file=s' => \$po_file,
39 'dump-pot' => \$dump_pot,
41 ) or die 'Error in command line arguments';
44 my $basename = basename($0);
47 $basename [--po-file FILE] [--force]
51 This script adds new fields and subfields for biblio and authority, new
52 authority types and new authorised values, for UNIMARC IFLA update
59 PO file containing translations
62 Print a POT file containing all translatable strings and exit
65 Force updating existing data
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");
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 = {};
87 $translations->{''} = Locale::PO->new(
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},
103 for my $tag (@tags) {
104 $translations->{$tag->{liblibrarian}} = Locale::PO->new(
105 -msgid => $tag->{liblibrarian},
109 for my $subfield (@subfields) {
110 $translations->{$subfield->{liblibrarian}} = Locale::PO->new(
111 -msgid => $subfield->{liblibrarian},
115 for my $authtype (@$authtypes) {
116 $translations->{$authtype->{authtypetext}} = Locale::PO->new(
117 -msgid => $authtype->{authtypetext},
121 for my $authtag (@authtags) {
122 $translations->{$authtag->{liblibrarian}} = Locale::PO->new(
123 -msgid => $authtag->{liblibrarian},
127 for my $authsubfield (@authsubfields) {
128 $translations->{$authsubfield->{liblibrarian}} = Locale::PO->new(
129 -msgid => $authsubfield->{liblibrarian},
134 Locale::PO->save_file_fromhash("$Bin/language/template.pot", $translations, 'utf8');
140 $translations = Locale::PO->load_file_ashash($po_file, 'utf8');
146 my $quoted_string = Locale::PO->quote($string);
147 unless (exists $translations->{$quoted_string} and $translations->{$quoted_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,
181 say "Authorised value already exists ($category, $value)";
183 say "Force mode is active, updating authorised value ($category, $value)";
184 $av->update($authorised_value);
189 my $cat = $authorised_value_category_rs->find($category);
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});
213 say "Field already exists: " . $tag->{tagfield};
215 say "Force mode is active, updating field " . $tag->{tagfield};
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});
236 say sprintf('Subfield already exists: %s$%s', $subfield->{tagfield}, $subfield->{tagsubfield});
238 say sprintf('Force mode is active, updating subfield %s$%s', $subfield->{tagfield}, $subfield->{tagsubfield});
240 # Do not modify the tab of existing subfield
241 my %values = %$subfield;
244 $mss->update(\%values);
249 say sprintf('Adding subfield %s$%s', $subfield->{tagfield}, $subfield->{tagsubfield});
250 $marc_subfield_structure_rs->create($subfield);
253 for my $authtype (@$authtypes) {
254 $authtype->{authtypetext} = t($authtype->{authtypetext});
256 my $at = $auth_type_rs->find($authtype->{authtypecode});
258 say "Authority type already exists: " . $authtype->{authtypecode};
260 say "Force mode is active, updating authority type " . $authtype->{authtypecode};
261 $at->update($authtype);
266 say "Adding authority type " . $authtype->{authtypecode};
267 $auth_type_rs->create($authtype);
270 my $authtag_defaults = $defaults->{authtag};
271 for my $authtag (@authtags) {
272 foreach my $key (keys %$authtag_defaults) {
273 unless (exists $authtag->{$key}) {
274 $authtag->{$key} = $authtag_defaults->{$key};
277 $authtag->{liblibrarian} = t($authtag->{liblibrarian});
279 my $ats = $auth_tag_structure_rs->find($authtag->{authtypecode}, $authtag->{tagfield});
281 say sprintf('Auth field already exists: %s (%s)', $authtag->{tagfield}, $authtag->{authtypecode});
283 say sprintf('Force mode is active, updating auth field %s (%s)', $authtag->{tagfield}, $authtag->{authtypecode});
284 $ats->update($authtag);
289 say sprintf('Adding auth field %s (%s)', $authtag->{tagfield}, $authtag->{authtypecode});
290 $auth_tag_structure_rs->create($authtag);
293 my $authsubfield_defaults = $defaults->{authsubfield};
294 for my $authsubfield (@authsubfields) {
295 foreach my $key (keys %$authsubfield_defaults) {
296 unless (exists $authsubfield->{$key}) {
297 $authsubfield->{$key} = $authsubfield_defaults->{$key};
300 $authsubfield->{liblibrarian} = t($authsubfield->{liblibrarian});
302 my $ass = $auth_subfield_structure_rs->find($authsubfield->{authtypecode}, $authsubfield->{tagfield}, $authsubfield->{tagsubfield});
304 say sprintf('Auth subfield already exists: %s$%s (%s)', $authsubfield->{tagfield}, $authsubfield->{tagsubfield}, $authsubfield->{authtypecode});
306 say sprintf('Force mode is active, updating auth subfield %s$%s (%s)', $authsubfield->{tagfield}, $authsubfield->{tagsubfield}, $authsubfield->{authtypecode});
308 # Do not modify the tab of existing subfield
309 my %values = %$authsubfield;
312 $ass->update(\%values);
317 say sprintf('Adding auth subfield %s$%s (%s)', $authsubfield->{tagfield}, $authsubfield->{tagsubfield}, $authsubfield->{authtypecode});
318 $auth_subfield_structure_rs->create($authsubfield);