Bug 18309: UNIMARC update from IFLA - authority (fr) (FAM)
[koha.git] / C4 / Creators / Lib.pm
blobc16a2c81a6f25ca83f966a5d171835bcb16a3572
1 package C4::Creators::Lib;
3 # Copyright 2009 Foundations Bible College.
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 strict;
21 use warnings;
23 use autouse 'Data::Dumper' => qw(Dumper);
25 use C4::Context;
26 use C4::Debug;
28 BEGIN {
29 use base qw(Exporter);
30 our @EXPORT = qw(get_all_templates
31 get_all_layouts
32 get_all_profiles
33 get_all_image_names
34 get_batch_summary
35 get_label_summary
36 get_card_summary
37 get_barcode_types
38 get_label_types
39 get_font_types
40 get_text_justification_types
41 get_output_formats
42 get_table_names
43 get_unit_values
44 html_table
48 =head1 NAME
50 C4::Creators::Lib
52 =cut
54 =head1 FUNCTIONS
56 =cut
58 #=head2 C4::Creators::Lib::_SELECT()
60 # This function returns a recordset upon success and 1 upon failure. Errors are logged to the Apache log.
62 # examples:
64 # my $field_value = _SELECT(field_name, table_name, condition);
66 #=cut
68 sub _SELECT {
69 my @params = @_;
70 my $fieldname = _add_backtics($params[0]);
71 my $query = "SELECT $fieldname FROM $params[1]";
72 $params[2] ? $query .= " WHERE $params[2];" : $query .= ';';
73 my $sth = C4::Context->dbh->prepare($query);
74 # $sth->{'TraceLevel'} = 3;
75 $sth->execute();
76 if ($sth->err) {
77 warn sprintf('Database returned the following error: %s', $sth->errstr);
78 return 1;
80 my $record_set = [];
81 while (my $row = $sth->fetchrow_hashref()) {
82 push(@$record_set, $row);
84 return $record_set;
87 sub _add_backtics {
88 my ( @args ) = @_;
89 s/(?:^|\b)(\w+)(?:\b|$)/`$1`/g for @args;
90 # Too bad that we need to correct a few exceptions: aggregate functions
91 my @aggregates = ( 'COUNT', 'MAX', 'MIN', 'SUM' ); # add when needed..
92 foreach my $aggr (@aggregates) {
93 s/`$aggr`\(/$aggr\(/gi for @args;
95 # And correct aliases
96 s/(`|\))\s+`AS`\s+`/$1 AS `/gi for @args;
97 return wantarray ? @args : $args[0];
100 my $barcode_types = [
101 {type => 'CODE39', name => 'Code 39', desc => 'Translates the characters 0-9, A-Z, \'-\', \'*\', \'+\', \'$\', \'%\', \'/\', \'.\' and \' \' to a barcode pattern.', selected => 0},
102 {type => 'CODE39MOD', name => 'Code 39 + Modulo43', desc => 'Translates the characters 0-9, A-Z, \'-\', \'*\', \'+\', \'$\', \'%\', \'/\', \'.\' and \' \' to a barcode pattern. Encodes Mod 43 checksum.', selected => 0},
103 {type => 'CODE39MOD10', name => 'Code 39 + Modulo10', desc => 'Translates the characters 0-9, A-Z, \'-\', \'*\', \'+\', \'$\', \'%\', \'/\', \'.\' and \' \' to a barcode pattern. Encodes Mod 10 checksum.', selected => 0},
104 {type => 'COOP2OF5', name => 'COOP2of5', desc => 'Creates COOP2of5 barcodes from a string consisting of the numeric characters 0-9', selected => 0},
105 {type => 'EAN13', name => 'EAN13', desc => 'Creates EAN13 barcodes from a string of 12 or 13 digits. The check number (the 13:th digit) is calculated if not supplied.', selected => 0},
106 # {type => 'EAN8', name => 'EAN8', desc => 'Translates a string of 7 or 8 digits to EAN8 barcodes. The check number (the 8:th digit) is calculated if not supplied.', selected => 0},
107 # {type => 'IATA2of5', name => 'IATA2of5', desc => 'Creates IATA2of5 barcodes from a string consisting of the numeric characters 0-9', selected => 0},
108 {type => 'INDUSTRIAL2OF5', name => 'Industrial2of5', desc => 'Creates Industrial2of5 barcodes from a string consisting of the numeric characters 0-9', selected => 0},
109 # {type => 'ITF', name => 'Interleaved2of5', desc => 'Translates the characters 0-9 to a barcodes. These barcodes could also be called 'Interleaved2of5'.', selected => 0},
110 # {type => 'MATRIX2OF5', name => 'Matrix2of5', desc => 'Creates Matrix2of5 barcodes from a string consisting of the numeric characters 0-9', selected => 0},
111 # {type => 'NW7', name => 'NW7', desc => 'Creates a NW7 barcodes from a string consisting of the numeric characters 0-9', selected => 0},
112 # {type => 'UPCA', name => 'UPCA', desc => 'Translates a string of 11 or 12 digits to UPCA barcodes. The check number (the 12:th digit) is calculated if not supplied.', selected => 0},
113 # {type => 'UPCE', name => 'UPCE', desc => 'Translates a string of 6, 7 or 8 digits to UPCE barcodes. If the string is 6 digits long, '0' is added first in the string. The check number (the 8:th digit) is calculated if not supplied.', selected => 0},
116 my $label_types = [
117 {type => 'BIB', name => 'Biblio', desc => 'Only the bibliographic data is printed.', selected => 0},
118 {type => 'BARBIB', name => 'Barcode/Biblio', desc => 'Barcode proceeds bibliographic data.', selected => 0},
119 {type => 'BIBBAR', name => 'Biblio/Barcode', desc => 'Bibliographic data proceeds barcode.', selected => 0},
120 {type => 'ALT', name => 'Alternating', desc => 'Barcode and bibliographic data are printed on alternating labels.', selected => 0},
121 {type => 'BAR', name => 'Barcode', desc => 'Only the barcode is printed.', selected => 0},
124 my $font_types = [
125 {type => 'TR', name => 'Times-Roman', selected => 0},
126 {type => 'TB', name => 'Times-Bold', selected => 0},
127 {type => 'TI', name => 'Times-Italic', selected => 0},
128 {type => 'TBI', name => 'Times-Bold-Italic', selected => 0},
129 {type => 'C', name => 'Courier', selected => 0},
130 {type => 'CB', name => 'Courier-Bold', selected => 0},
131 {type => 'CO', name => 'Courier-Oblique', selected => 0},
132 {type => 'CBO', name => 'Courier-Bold-Oblique', selected => 0},
133 {type => 'H', name => 'Helvetica', selected => 0},
134 {type => 'HO', name => 'Helvetica-Oblique', selected => 0},
135 {type => 'HB', name => 'Helvetica-Bold', selected => 0},
136 {type => 'HBO', name => 'Helvetica-Bold-Oblique', selected => 0},
139 my $text_justification_types = [
140 {type => 'L', name => 'Left', selected => 0},
141 {type => 'C', name => 'Center', selected => 0},
142 {type => 'R', name => 'Right', selected => 0},
143 # {type => 'F', name => 'Full', selected => 0},
146 my $unit_values = [
147 {type => 'POINT', desc => 'PostScript Points', value => 1, selected => 0},
148 {type => 'AGATE', desc => 'Adobe Agates', value => 5.1428571, selected => 0},
149 {type => 'INCH', desc => 'US Inches', value => 72, selected => 0},
150 {type => 'MM', desc => 'SI Millimeters', value => 2.83464567, selected => 0},
151 {type => 'CM', desc => 'SI Centimeters', value => 28.3464567, selected => 0},
154 my $output_formats = [
155 {type => 'pdf', desc => 'PDF File'},
156 {type => 'csv', desc => 'CSV File'},
159 sub _build_query {
160 my ( $params, $table ) = @_;
161 my @fields = exists $params->{fields} ? _add_backtics( @{ $params->{fields} } ) : ('*');
162 my $query = "SELECT " . join(', ', @fields ) . " FROM $table";
163 my @where_args;
164 if ( exists $params->{filters} ) {
165 $query .= ' WHERE 1 ';
166 while ( my ( $field, $values ) = each %{ $params->{filters} } ) {
167 if ( ref( $values ) ) {
168 $query .= " AND `$field` IN ( " . ( ('?,') x (@$values-1) ) . "? ) "; # a comma separates elements in a list...
169 push @where_args, @$values;
170 } else {
171 $query .= " AND `$field` = ? ";
172 push @where_args, $values;
176 $query .= (exists $params->{orderby} ? " ORDER BY $params->{orderby} " : '');
177 return ( $query, @where_args );
180 =head2 C4::Creators::Lib::get_all_templates()
182 my $templates = get_all_templates();
184 This function returns a reference to a hash containing all templates upon success and 1 upon failure. Errors are logged to the Apache log.
186 =cut
188 sub get_all_templates {
189 my ( $params ) = @_;
190 my @templates = ();
191 my ( $query, @where_args ) = _build_query( $params, 'creator_templates' );
192 my $sth = C4::Context->dbh->prepare($query);
193 $sth->execute( @where_args );
194 if ($sth->err) {
195 warn sprintf('Database returned the following error: %s', $sth->errstr);
196 return -1;
198 ADD_TEMPLATES:
199 while (my $template = $sth->fetchrow_hashref) {
200 push(@templates, $template);
202 return \@templates;
205 =head2 C4::Creators::Lib::get_all_layouts()
207 my $layouts = get_all_layouts();
209 This function returns a reference to a hash containing all layouts upon success and 1 upon failure. Errors are logged to the Apache log.
211 =cut
213 sub get_all_layouts {
214 my ( $params ) = @_;
215 my @layouts = ();
216 my ( $query, @where_args ) = _build_query( $params, 'creator_layouts' );
217 my $sth = C4::Context->dbh->prepare($query);
218 $sth->execute( @where_args );
219 if ($sth->err) {
220 warn sprintf('Database returned the following error: %s', $sth->errstr);
221 return -1;
223 ADD_LAYOUTS:
224 while (my $layout = $sth->fetchrow_hashref) {
225 push(@layouts, $layout);
227 return \@layouts;
230 =head2 C4::Creators::Lib::get_all_profiles()
232 my $profiles = get_all_profiles();
234 my $profiles = get_all_profiles({ fields => [@fields], filters => { filters => [$value1, $value2] } });
236 This function returns an arrayref whose elements are hashes containing all profiles upon success and 1 upon failure. Errors are logged
237 to the Apache log. Two parameters are accepted. The first limits the field(s) returned. This parameter should be string of comma separted
238 fields. ie. "field_1, field_2, ...field_n" The second limits the records returned based on a string containing a valud SQL 'WHERE' filter.
240 NOTE: Do not pass in the keyword 'WHERE.'
242 =cut
244 sub get_all_profiles {
245 my ( $params ) = @_;
246 my @profiles = ();
247 my ( $query, @where_args ) = _build_query( $params, 'printers_profile' );
248 my $sth = C4::Context->dbh->prepare($query);
249 $sth->execute( @where_args );
250 if ($sth->err) {
251 warn sprintf('Database returned the following error: %s', $sth->errstr);
252 return -1;
254 ADD_PROFILES:
255 while (my $profile = $sth->fetchrow_hashref) {
256 push(@profiles, $profile);
258 return \@profiles;
261 =head2 C4::Creators::Lib::get_all_image_names()
263 =cut
265 sub get_all_image_names {
266 my $image_names = [];
267 my $query = "SELECT image_name FROM creator_images";
268 my $sth = C4::Context->dbh->prepare($query);
269 # $sth->{'TraceLevel'} = 3 if $debug;
270 $sth->execute();
271 if ($sth->err) {
272 warn sprintf('Database returned the following error: %s', $sth->errstr);
273 return -1;
275 grep {push @$image_names, {type => $$_[0], name => $$_[0], selected => 0}} @{$sth->fetchall_arrayref([0])};
276 return $image_names;
279 =head2 C4::Creators::Lib::get_batch_summary()
281 my $batches = get_batch_summary();
283 my $batches = get_batch_summary(filter => filter_string);
285 This function returns an arrayref whose elements are hashes containing the batch_ids of current batches along with the item count
286 for each batch upon success and 1 upon failure. Item counts are stored under the key '_item_count' Errors are logged to the Apache log.
287 One parameter is accepted which limits the records returned based on a string containing a valud SQL 'WHERE' filter.
289 NOTE: Do not pass in the keyword 'WHERE.'
291 =cut
293 sub get_batch_summary {
294 my ( $params ) = @_;
295 my @batches = ();
296 $params->{fields} = ['batch_id', 'description', 'count(batch_id) as _item_count'];
297 my ( $query, @where_args ) = _build_query( $params, 'creator_batches' );
298 $query .= " GROUP BY batch_id, description";
299 my $sth = C4::Context->dbh->prepare($query);
300 $sth->execute( @where_args );
301 if ($sth->err) {
302 warn sprintf('Database returned the following error on attempted SELECT: %s', $sth->errstr);
303 return -1;
305 while (my $batch = $sth->fetchrow_hashref) {
306 push(@batches, $batch);
308 return \@batches;
311 =head2 C4::Creators::Lib::get_label_summary()
313 my $labels = get_label_summary();
315 my $labels = get_label_summary(items => @item_list);
317 This function returns an arrayref whose elements are hashes containing the label_ids of current labels along with the item count
318 for each label upon success and 1 upon failure. Item counts are stored under the key '_item_count' Errors are logged to the Apache log.
319 One parameter is accepted which limits the records returned based on a string containing a valud SQL 'WHERE' filter.
321 NOTE: Do not pass in the keyword 'WHERE.'
323 =cut
325 sub get_label_summary {
326 my %params = @_;
327 my $label_number = 0;
328 my @label_summaries = ();
329 my $query = " SELECT b.title, b.author, bi.itemtype, i.barcode, i.itemcallnumber, i.biblionumber, i.itype
330 FROM creator_batches AS c LEFT JOIN items AS i ON (c.item_number=i.itemnumber)
331 LEFT JOIN biblioitems AS bi ON (i.biblioitemnumber=bi.biblioitemnumber)
332 LEFT JOIN biblio AS b ON (bi.biblionumber=b.biblionumber)
333 WHERE itemnumber=? AND batch_id=?;
335 my $sth = C4::Context->dbh->prepare($query);
336 foreach my $item (@{$params{'items'}}) {
337 $label_number++;
338 $sth->execute($item->{'item_number'}, $params{'batch_id'});
339 if ($sth->err) {
340 warn sprintf('Database returned the following error on attempted SELECT: %s', $sth->errstr);
341 return -1;
343 my $record = $sth->fetchrow_hashref;
344 my $label_summary;
345 $label_summary->{'_label_number'} = $label_number;
346 $record->{'author'} =~ s/[^\.|\w]$// if $record->{'author'}; # strip off ugly trailing chars... but not periods or word chars
347 $record->{'title'} =~ s/\W*$//; # strip off ugly trailing chars
348 # FIXME contructing staff interface URLs should be done *much* higher up the stack - for the most part, C4 module code
349 # should not know that it's part of a web app
350 $record->{'title'} = '<a href="/cgi-bin/koha/catalogue/detail.pl?biblionumber=' . $record->{'biblionumber'} . '"> ' . $record->{'title'} . '</a>';
351 $label_summary->{'_summary'} = $record->{'title'} . " | " . ($record->{'author'} ? $record->{'author'} : 'N/A');
352 $label_summary->{'_item_type'} = C4::Context->preference("item-level_itypes") ? $record->{'itype'} : $record->{'itemtype'};
353 $label_summary->{'_barcode'} = $record->{'barcode'};
354 $label_summary->{'_item_number'} = $item->{'item_number'};
355 $label_summary->{'_item_cn'} = $record->{'itemcallnumber'};
356 $label_summary->{'_label_id'} = $item->{'label_id'};
357 push (@label_summaries, $label_summary);
359 return \@label_summaries;
362 =head2 C4::Creators::Lib::get_card_summary()
364 my $cards = get_card_summary();
366 my $cards = get_card_summary(items => @item_list);
368 This function returns an arrayref whose elements are hashes containing the label_ids of current cards along with the item count
369 for each card upon success and 1 upon failure. Item counts are stored under the key '_item_count' Errors are logged to the Apache log.
370 One parameter is accepted which limits the records returned based on a string containing a valud SQL 'WHERE' filter.
372 NOTE: Do not pass in the keyword 'WHERE.'
374 =cut
376 sub get_card_summary {
377 my %params = @_;
378 my $card_number = 0;
379 my @card_summaries = ();
380 my $query = "SELECT CONCAT_WS(', ', surname, firstname) AS name, cardnumber FROM borrowers WHERE borrowernumber=?;";
381 my $sth = C4::Context->dbh->prepare($query);
382 foreach my $item (@{$params{'items'}}) {
383 $card_number++;
384 $sth->execute($item->{'borrower_number'});
385 if ($sth->err) {
386 warn sprintf('Database returned the following error on attempted SELECT: %s', $sth->errstr);
387 return -1;
389 my $record = $sth->fetchrow_hashref;
390 my $card_summary->{'_card_number'} = $card_number;
391 $card_summary->{'_summary'} = $record->{'name'};
392 $card_summary->{'borrowernumber'} = $item->{'borrower_number'};
393 $card_summary->{'_label_id'} = $item->{'label_id'};
394 push (@card_summaries, $card_summary);
396 return \@card_summaries;
399 =head2 C4::Creators::Lib::get_barcode_types()
401 my $barcode_types = get_barcode_types();
403 This function returns a reference to an array of hashes containing all barcode types along with their name and description.
405 =cut
407 sub get_barcode_types {
408 return $barcode_types;
411 =head2 C4::Creators::Lib::get_label_types()
413 my $label_types = get_label_types();
415 This function returns a reference to an array of hashes containing all label types along with their name and description.
417 =cut
419 sub get_label_types {
420 return $label_types;
423 =head2 C4::Creators::Lib::get_font_types()
425 my $font_types = get_font_types();
427 This function returns a reference to an array of hashes containing all font types along with their name and description.
429 =cut
431 sub get_font_types {
432 return $font_types;
435 =head2 C4::Creators::Lib::get_text_justification_types()
437 my $text_justification_types = get_text_justification_types();
439 This function returns a reference to an array of hashes containing all text justification types along with their name and description.
441 =cut
443 sub get_text_justification_types {
444 return $text_justification_types;
447 =head2 C4::Creators::Lib::get_unit_values()
449 my $unit_values = get_unit_values();
451 This function returns a reference to an array of hashes containing all unit types along with their description and multiplier.
452 NOTE: All units are relative to a PostScript Point.
453 There are 72 PS points to the inch.
455 =cut
457 sub get_unit_values {
458 return $unit_values;
461 =head2 C4::Creators::Lib::get_output_formats()
463 my $label_output_formats = get_output_formats();
465 This function returns a reference to an array of hashes containing all label output formats along with their description.
467 =cut
469 sub get_output_formats {
470 return $output_formats;
474 =head2 C4::Creators::Lib::get_table_names($search_term)
476 Return an arrayref of an array containing the table names which contain the supplied search term.
478 =cut
480 sub get_table_names {
481 my $search_term = shift;
482 my $dbh = C4::Context->dbh();
483 my $table_names = [];
484 my $sth = $dbh->table_info(undef,undef,"%$search_term%");
485 while (my $info = $sth->fetchrow_hashref()){
486 push (@$table_names, $info->{'TABLE_NAME'});
488 return $table_names;
491 =head2 C4::Creators::Lib::html_table()
493 This function returns an arrayref of an array of hashes contianing the supplied data formatted suitably to
494 be passed off as a template parameter and used to build an html table.
496 my $table = html_table(header_fields, array_of_row_data);
497 $template->param(
498 table_loop => $table,
501 html example:
503 <table>
504 [% FOREACH table_loo IN table_loop %]
505 [% IF ( table_loo.header_fields ) %]
506 <tr>
507 [% FOREACH header_field IN table_loo.header_fields %]
508 <th>[% header_field.field_label %]</th>
509 [% END %]
510 </tr>
511 [% ELSE %]
512 <tr>
513 [% FOREACH text_field IN table_loo.text_fields %]
514 [% IF ( text_field.select_field ) %]
515 <td><input type="checkbox" name="action" value="[% text_field.field_value %]"></td>
516 [% ELSE %]
517 <td>[% text_field.field_value %]</td>
518 [% END %]
519 [% END %]
520 </tr>
521 [% END %]
522 [% END %]
523 </table>
525 =cut
527 sub html_table {
528 my $headers = shift;
529 my $data = shift;
530 return undef if scalar(@$data) == 0; # no need to generate a table if there is not data to display
531 my $table = [];
532 my $fields = [];
533 my @table_columns = ();
534 my ($row_index, $col_index) = (0,0);
535 my $cols = 0; # number of columns to wrap on
536 my $field_count = 0;
537 my $select_value = undef;
538 my $link_field = undef;
539 POPULATE_HEADER:
540 foreach my $header (@$headers) {
541 my @key = keys %$header;
542 if ($key[0] eq 'select' ) {
543 push (@table_columns, $key[0]);
544 $$fields[$col_index] = {hidden => 0, select_field => 0, field_name => ($key[0]), field_label => $header->{$key[0]}{'label'}};
545 # do special formatting stuff....
546 $select_value = $header->{$key[0]}{'value'};
548 else {
549 # do special formatting stuff....
550 $link_field->{$key[0]} = ($header->{$key[0]}{'link_field'} == 1 ? 1 : 0);
551 push (@table_columns, $key[0]);
552 $$fields[$col_index] = {hidden => 0, select_field => 0, field_name => ($key[0]), field_label => $header->{$key[0]}{'label'}};
554 $field_count++;
555 $col_index++;
557 $$table[$row_index] = {header_fields => $fields};
558 $cols = $col_index;
559 $field_count *= scalar(@$data); # total fields to be displayed in the table
560 $col_index = 0;
561 $row_index++;
562 $fields = [];
563 POPULATE_TABLE:
564 foreach my $db_row (@$data) {
565 POPULATE_ROW:
566 foreach my $table_column (@table_columns) {
567 if (grep {$table_column eq $_} keys %$db_row) {
568 $$fields[$col_index] = {hidden => 0, link_field => $link_field->{$table_column}, select_field => 0, field_name => ($table_column . "_tbl"), field_value => $db_row->{$table_column}};
569 $col_index++;
570 next POPULATE_ROW;
572 elsif ($table_column =~ m/^_((.*)_(.*$))/) { # this a special case
573 my $table_name = get_table_names('creator_'.$2); #Bug 14143 fix to remove ambiguity with table 'club_template_enrollment_fields'
574 my $record_set = _SELECT($1, @$table_name[0], $2 . "_id = " . $db_row->{$2 . "_id"});
575 $$fields[$col_index] = {hidden => 0, link_field => $link_field->{$table_column}, select_field => 0, field_name => ($table_column . "_tbl"), field_value => $$record_set[0]{$1}};
576 $col_index++;
577 next POPULATE_ROW;
579 elsif ($table_column eq 'select' ) {
580 $$fields[$col_index] = {hidden => 0, select_field => 1, field_name => 'select', field_value => $db_row->{$select_value}};
583 $$table[$row_index] = {text_fields => $fields};
584 $col_index = 0;
585 $row_index++;
586 $fields = [];
588 return $table;
592 __END__
594 =head1 AUTHOR
596 Chris Nighswonger <cnighswonger AT foundations DOT edu>
598 =cut