"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 }