3 # Copyright 2000-2002 Katipo Communications
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>.
24 use Date::Calc qw( Add_Delta_Days );
28 use Module::Load::Conditional qw(can_load);
31 use C4::Members::Attributes qw(GetBorrowerAttributes);
36 use Koha::SMS::Providers;
39 use Koha::DateUtils qw( format_sqldatetime dt_from_string );
42 use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
48 &GetLetters &GetLettersAvailableForALibrary &GetLetterTemplates &DelLetter &GetPreparedLetter &GetWrappedLetter &addalert &getalert &delalert &findrelatedto &SendAlerts &GetPrintMessages &GetMessageTransportTypes
54 C4::Letters - Give functions for Letters management
62 "Letters" is the tool used in Koha to manage informations sent to the patrons and/or the library. This include some cron jobs like
63 late issues, as well as other tasks like sending a mail to users that have subscribed to a "serial issue alert" (= being warned every time a new issue has arrived at the library)
65 Letters are managed through "alerts" sent by Koha on some events. All "alert" related functions are in this module too.
67 =head2 GetLetters([$module])
69 $letters = &GetLetters($module);
70 returns informations about letters.
71 if needed, $module filters for letters given module
73 DEPRECATED - You must use Koha::Notice::Templates instead
74 The group by clause is confusing and can lead to issues
80 my $module = $filters->{module};
81 my $code = $filters->{code};
82 my $branchcode = $filters->{branchcode};
83 my $dbh = C4::Context->dbh;
84 my $letters = $dbh->selectall_arrayref(
86 SELECT code, module, name
90 . ( $module ? q| AND module = ?| : q|| )
91 . ( $code ? q| AND code = ?| : q|| )
92 . ( defined $branchcode ? q| AND branchcode = ?| : q|| )
93 . q| GROUP BY code, module, name ORDER BY name|, { Slice => {} }
94 , ( $module ? $module : () )
95 , ( $code ? $code : () )
96 , ( defined $branchcode ? $branchcode : () )
102 =head2 GetLetterTemplates
104 my $letter_templates = GetLetterTemplates(
106 module => 'circulation',
108 branchcode => 'CPL', # '' for default,
112 Return a hashref of letter templates.
116 sub GetLetterTemplates {
119 my $module = $params->{module};
120 my $code = $params->{code};
121 my $branchcode = $params->{branchcode} // '';
122 my $dbh = C4::Context->dbh;
123 my $letters = $dbh->selectall_arrayref(
125 SELECT module, code, branchcode, name, is_html, title, content, message_transport_type, lang
132 , $module, $code, $branchcode
138 =head2 GetLettersAvailableForALibrary
140 my $letters = GetLettersAvailableForALibrary(
142 branchcode => 'CPL', # '' for default
143 module => 'circulation',
147 Return an arrayref of letters, sorted by name.
148 If a specific letter exist for the given branchcode, it will be retrieve.
149 Otherwise the default letter will be.
153 sub GetLettersAvailableForALibrary {
155 my $branchcode = $filters->{branchcode};
156 my $module = $filters->{module};
158 croak "module should be provided" unless $module;
160 my $dbh = C4::Context->dbh;
161 my $default_letters = $dbh->selectall_arrayref(
163 SELECT module, code, branchcode, name
167 . q| AND branchcode = ''|
168 . ( $module ? q| AND module = ?| : q|| )
169 . q| ORDER BY name|, { Slice => {} }
170 , ( $module ? $module : () )
173 my $specific_letters;
175 $specific_letters = $dbh->selectall_arrayref(
177 SELECT module, code, branchcode, name
181 . q| AND branchcode = ?|
182 . ( $module ? q| AND module = ?| : q|| )
183 . q| ORDER BY name|, { Slice => {} }
185 , ( $module ? $module : () )
190 for my $l (@$default_letters) {
191 $letters{ $l->{code} } = $l;
193 for my $l (@$specific_letters) {
194 # Overwrite the default letter with the specific one.
195 $letters{ $l->{code} } = $l;
198 return [ map { $letters{$_} }
199 sort { $letters{$a}->{name} cmp $letters{$b}->{name} }
205 my ( $module, $code, $branchcode, $message_transport_type, $lang) = @_;
206 $message_transport_type //= '%';
207 $lang = 'default' unless( $lang && C4::Context->preference('TranslateNotices') );
210 my $only_my_library = C4::Context->only_my_library;
211 if ( $only_my_library and $branchcode ) {
212 $branchcode = C4::Context::mybranch();
216 my $dbh = C4::Context->dbh;
217 my $sth = $dbh->prepare(q{
220 WHERE module=? AND code=? AND (branchcode = ? OR branchcode = '')
221 AND message_transport_type LIKE ?
223 ORDER BY branchcode DESC LIMIT 1
225 $sth->execute( $module, $code, $branchcode, $message_transport_type, $lang );
226 my $line = $sth->fetchrow_hashref
228 $line->{'content-type'} = 'text/html; charset="UTF-8"' if $line->{is_html};
238 module => 'circulation',
244 Delete the letter. The mtt parameter is facultative.
245 If not given, all templates mathing the other parameters will be removed.
251 my $branchcode = $params->{branchcode};
252 my $module = $params->{module};
253 my $code = $params->{code};
254 my $mtt = $params->{mtt};
255 my $lang = $params->{lang};
256 my $dbh = C4::Context->dbh;
263 . ( $mtt ? q| AND message_transport_type = ?| : q|| )
264 . ( $lang? q| AND lang = ?| : q|| )
265 , undef, $branchcode, $module, $code, ( $mtt ? $mtt : () ), ( $lang ? $lang : () ) );
268 =head2 addalert ($borrowernumber, $type, $externalid)
271 - $borrowernumber : the number of the borrower subscribing to the alert
272 - $type : the type of alert.
273 - $externalid : the primary key of the object to put alert on. For issues, the alert is made on subscriptionid.
275 create an alert and return the alertid (primary key)
280 my ( $borrowernumber, $type, $externalid ) = @_;
281 my $dbh = C4::Context->dbh;
284 "insert into alert (borrowernumber, type, externalid) values (?,?,?)");
285 $sth->execute( $borrowernumber, $type, $externalid );
287 # get the alert number newly created and return it
288 my $alertid = $dbh->{'mysql_insertid'};
292 =head2 delalert ($alertid)
295 - alertid : the alert id
301 my $alertid = shift or die "delalert() called without valid argument (alertid)"; # it's gonna die anyway.
302 $debug and warn "delalert: deleting alertid $alertid";
303 my $sth = C4::Context->dbh->prepare("delete from alert where alertid=?");
304 $sth->execute($alertid);
307 =head2 getalert ([$borrowernumber], [$type], [$externalid])
310 - $borrowernumber : the number of the borrower subscribing to the alert
311 - $type : the type of alert.
312 - $externalid : the primary key of the object to put alert on. For issues, the alert is made on subscriptionid.
313 all parameters NON mandatory. If a parameter is omitted, the query is done without the corresponding parameter. For example, without $externalid, returns all alerts for a borrower on a topic.
318 my ( $borrowernumber, $type, $externalid ) = @_;
319 my $dbh = C4::Context->dbh;
320 my $query = "SELECT a.*, b.branchcode FROM alert a JOIN borrowers b USING(borrowernumber) WHERE 1";
322 if ($borrowernumber and $borrowernumber =~ /^\d+$/) {
323 $query .= " AND borrowernumber=?";
324 push @bind, $borrowernumber;
327 $query .= " AND type=?";
331 $query .= " AND externalid=?";
332 push @bind, $externalid;
334 my $sth = $dbh->prepare($query);
335 $sth->execute(@bind);
336 return $sth->fetchall_arrayref({});
339 =head2 findrelatedto($type, $externalid)
342 - $type : the type of alert
343 - $externalid : the id of the "object" to query
345 In the table alert, a "id" is stored in the externalid field. This "id" is related to another table, depending on the type of the alert.
346 When type=issue, the id is related to a subscriptionid and this sub returns the name of the biblio.
351 # When type=virtual, the id is related to a virtual shelf and this sub returns the name of the sub
354 my $type = shift or return;
355 my $externalid = shift or return;
356 my $q = ($type eq 'issue' ) ?
357 "select title as result from subscription left join biblio on subscription.biblionumber=biblio.biblionumber where subscriptionid=?" :
358 ($type eq 'borrower') ?
359 "select concat(firstname,' ',surname) from borrowers where borrowernumber=?" : undef;
361 warn "findrelatedto(): Illegal type '$type'";
364 my $sth = C4::Context->dbh->prepare($q);
365 $sth->execute($externalid);
366 my ($result) = $sth->fetchrow;
372 my $err = &SendAlerts($type, $externalid, $letter_code);
375 - $type : the type of alert
376 - $externalid : the id of the "object" to query
377 - $letter_code : the notice template to use
379 C<&SendAlerts> sends an email notice directly to a patron or a vendor.
381 Currently it supports ($type):
382 - claim serial issues (claimissues)
383 - claim acquisition orders (claimacquisition)
384 - send acquisition orders to the vendor (orderacquisition)
385 - notify patrons about newly received serial issues (issue)
386 - notify patrons when their account is created (members)
388 Returns undef or { error => 'message } on failure.
389 Returns true on success.
394 my ( $type, $externalid, $letter_code ) = @_;
395 my $dbh = C4::Context->dbh;
396 if ( $type eq 'issue' ) {
398 # prepare the letter...
399 # search the subscriptionid
402 "SELECT subscriptionid FROM serial WHERE serialid=?");
403 $sth->execute($externalid);
404 my ($subscriptionid) = $sth->fetchrow
405 or warn( "No subscription for '$externalid'" ),
408 # search the biblionumber
411 "SELECT biblionumber FROM subscription WHERE subscriptionid=?");
412 $sth->execute($subscriptionid);
413 my ($biblionumber) = $sth->fetchrow
414 or warn( "No biblionumber for '$subscriptionid'" ),
418 # find the list of borrowers to alert
419 my $alerts = getalert( '', 'issue', $subscriptionid );
421 my $patron = Koha::Patrons->find( $_->{borrowernumber} );
422 next unless $patron; # Just in case
423 my $email = $patron->email or next;
425 # warn "sending issues...";
426 my $userenv = C4::Context->userenv;
427 my $library = Koha::Libraries->find( $_->{branchcode} );
428 my $letter = GetPreparedLetter (
430 letter_code => $letter_code,
431 branchcode => $userenv->{branch},
433 'branches' => $_->{branchcode},
434 'biblio' => $biblionumber,
435 'biblioitems' => $biblionumber,
436 'borrowers' => $patron->unblessed,
437 'subscription' => $subscriptionid,
438 'serial' => $externalid,
444 my $message = Koha::Email->new();
445 my %mail = $message->create_message_headers(
448 from => $library->branchemail,
449 replyto => $library->branchreplyto,
450 sender => $library->branchreturnpath,
451 subject => Encode::encode( "UTF-8", "" . $letter->{title} ),
452 message => $letter->{'is_html'}
453 ? _wrap_html( Encode::encode( "UTF-8", $letter->{'content'} ),
454 Encode::encode( "UTF-8", "" . $letter->{'title'} ))
455 : Encode::encode( "UTF-8", "" . $letter->{'content'} ),
456 contenttype => $letter->{'is_html'}
457 ? 'text/html; charset="utf-8"'
458 : 'text/plain; charset="utf-8"',
461 unless( sendmail(%mail) ) {
462 carp $Mail::Sendmail::error;
463 return { error => $Mail::Sendmail::error };
467 elsif ( $type eq 'claimacquisition' or $type eq 'claimissues' or $type eq 'orderacquisition' ) {
469 # prepare the letter...
474 if ( $type eq 'claimacquisition') {
476 SELECT aqorders.*,aqbasket.*,biblio.*,biblioitems.*
478 LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno
479 LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
480 LEFT JOIN biblioitems ON aqorders.biblionumber=biblioitems.biblionumber
481 WHERE aqorders.ordernumber IN (
485 carp "No order selected";
486 return { error => "no_order_selected" };
488 $strsth .= join( ",", ('?') x @$externalid ) . ")";
489 $action = "ACQUISITION CLAIM";
490 $sthorders = $dbh->prepare($strsth);
491 $sthorders->execute( @$externalid );
492 $dataorders = $sthorders->fetchall_arrayref( {} );
495 if ($type eq 'claimissues') {
497 SELECT serial.*,subscription.*, biblio.*, aqbooksellers.*,
498 aqbooksellers.id AS booksellerid
500 LEFT JOIN subscription ON serial.subscriptionid=subscription.subscriptionid
501 LEFT JOIN biblio ON serial.biblionumber=biblio.biblionumber
502 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id
503 WHERE serial.serialid IN (
507 carp "No Order selected";
508 return { error => "no_order_selected" };
511 $strsth .= join( ",", ('?') x @$externalid ) . ")";
512 $action = "CLAIM ISSUE";
513 $sthorders = $dbh->prepare($strsth);
514 $sthorders->execute( @$externalid );
515 $dataorders = $sthorders->fetchall_arrayref( {} );
518 if ( $type eq 'orderacquisition') {
520 SELECT aqorders.*,aqbasket.*,biblio.*,biblioitems.*
522 LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno
523 LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
524 LEFT JOIN biblioitems ON aqorders.biblionumber=biblioitems.biblionumber
525 WHERE aqbasket.basketno = ?
526 AND orderstatus IN ('new','ordered')
530 carp "No basketnumber given";
531 return { error => "no_basketno" };
533 $action = "ACQUISITION ORDER";
534 $sthorders = $dbh->prepare($strsth);
535 $sthorders->execute($externalid);
536 $dataorders = $sthorders->fetchall_arrayref( {} );
540 $dbh->prepare("select * from aqbooksellers where id=?");
541 $sthbookseller->execute( $dataorders->[0]->{booksellerid} );
542 my $databookseller = $sthbookseller->fetchrow_hashref;
544 my $addressee = $type eq 'claimacquisition' || $type eq 'orderacquisition' ? 'acqprimary' : 'serialsprimary';
547 $dbh->prepare("SELECT * FROM aqcontacts WHERE booksellerid=? AND $type=1 ORDER BY $addressee DESC");
548 $sthcontact->execute( $dataorders->[0]->{booksellerid} );
549 my $datacontact = $sthcontact->fetchrow_hashref;
553 push @email, $databookseller->{bookselleremail} if $databookseller->{bookselleremail};
554 push @email, $datacontact->{email} if ( $datacontact && $datacontact->{email} );
556 warn "Bookseller $dataorders->[0]->{booksellerid} without emails";
557 return { error => "no_email" };
560 while ($addlcontact = $sthcontact->fetchrow_hashref) {
561 push @cc, $addlcontact->{email} if ( $addlcontact && $addlcontact->{email} );
564 my $userenv = C4::Context->userenv;
565 my $letter = GetPreparedLetter (
567 letter_code => $letter_code,
568 branchcode => $userenv->{branch},
570 'branches' => $userenv->{branch},
571 'aqbooksellers' => $databookseller,
572 'aqcontacts' => $datacontact,
574 repeat => $dataorders,
576 ) or return { error => "no_letter" };
578 # Remove the order tag
579 $letter->{content} =~ s/<order>(.*?)<\/order>/$1/gxms;
582 my $library = Koha::Libraries->find( $userenv->{branch} );
584 To => join( ',', @email),
585 Cc => join( ',', @cc),
586 From => $library->branchemail || C4::Context->preference('KohaAdminEmailAddress'),
587 Subject => Encode::encode( "UTF-8", "" . $letter->{title} ),
588 Message => $letter->{'is_html'}
589 ? _wrap_html( Encode::encode( "UTF-8", $letter->{'content'} ),
590 Encode::encode( "UTF-8", "" . $letter->{'title'} ))
591 : Encode::encode( "UTF-8", "" . $letter->{'content'} ),
592 'Content-Type' => $letter->{'is_html'}
593 ? 'text/html; charset="utf-8"'
594 : 'text/plain; charset="utf-8"',
597 if ($type eq 'claimacquisition' || $type eq 'claimissues' ) {
598 $mail{'Reply-to'} = C4::Context->preference('ReplytoDefault')
599 if C4::Context->preference('ReplytoDefault');
600 $mail{'Sender'} = C4::Context->preference('ReturnpathDefault')
601 if C4::Context->preference('ReturnpathDefault');
602 $mail{'Bcc'} = $userenv->{emailaddress}
603 if C4::Context->preference("ClaimsBccCopy");
606 unless ( sendmail(%mail) ) {
607 carp $Mail::Sendmail::error;
608 return { error => $Mail::Sendmail::error };
616 . join( ',', @email )
621 ) if C4::Context->preference("LetterLog");
623 # send an "account details" notice to a newly created user
624 elsif ( $type eq 'members' ) {
625 my $library = Koha::Libraries->find( $externalid->{branchcode} )->unblessed;
626 my $letter = GetPreparedLetter (
628 letter_code => $letter_code,
629 branchcode => $externalid->{'branchcode'},
631 'branches' => $library,
632 'borrowers' => $externalid->{'borrowernumber'},
634 substitute => { 'borrowers.password' => $externalid->{'password'} },
637 return { error => "no_email" } unless $externalid->{'emailaddr'};
638 my $email = Koha::Email->new();
639 my %mail = $email->create_message_headers(
641 to => $externalid->{'emailaddr'},
642 from => $library->{branchemail},
643 replyto => $library->{branchreplyto},
644 sender => $library->{branchreturnpath},
645 subject => Encode::encode( "UTF-8", "" . $letter->{'title'} ),
646 message => $letter->{'is_html'}
647 ? _wrap_html( Encode::encode( "UTF-8", $letter->{'content'} ),
648 Encode::encode( "UTF-8", "" . $letter->{'title'} ) )
649 : Encode::encode( "UTF-8", "" . $letter->{'content'} ),
650 contenttype => $letter->{'is_html'}
651 ? 'text/html; charset="utf-8"'
652 : 'text/plain; charset="utf-8"',
655 unless( sendmail(%mail) ) {
656 carp $Mail::Sendmail::error;
657 return { error => $Mail::Sendmail::error };
661 # If we come here, return an OK status
665 =head2 GetPreparedLetter( %params )
668 module => letter module, mandatory
669 letter_code => letter code, mandatory
670 branchcode => for letter selection, if missing default system letter taken
671 tables => a hashref with table names as keys. Values are either:
672 - a scalar - primary key value
673 - an arrayref - primary key values
674 - a hashref - full record
675 substitute => custom substitution key/value pairs
676 repeat => records to be substituted on consecutive lines:
677 - an arrayref - tries to guess what needs substituting by
678 taking remaining << >> tokensr; not recommended
679 - a hashref token => @tables - replaces <token> << >> << >> </token>
680 subtemplate for each @tables row; table is a hashref as above
681 want_librarian => boolean, if set to true triggers librarian details
682 substitution from the userenv
684 letter fields hashref (title & content useful)
688 sub GetPreparedLetter {
691 my $module = $params{module} or croak "No module";
692 my $letter_code = $params{letter_code} or croak "No letter_code";
693 my $branchcode = $params{branchcode} || '';
694 my $mtt = $params{message_transport_type} || 'email';
695 my $lang = $params{lang} || 'default';
697 my $letter = getletter( $module, $letter_code, $branchcode, $mtt, $lang );
700 $letter = getletter( $module, $letter_code, $branchcode, $mtt, 'default' )
701 or warn( "No $module $letter_code letter transported by " . $mtt ),
705 my $tables = $params{tables} || {};
706 my $substitute = $params{substitute} || {};
707 my $loops = $params{loops} || {}; # loops is not supported for historical notices syntax
708 my $repeat = $params{repeat};
709 %$tables || %$substitute || $repeat || %$loops
710 or carp( "ERROR: nothing to substitute - both 'tables', 'loops' and 'substitute' are empty" ),
712 my $want_librarian = $params{want_librarian};
715 while ( my ($token, $val) = each %$substitute ) {
716 if ( $token eq 'items.content' ) {
717 $val =~ s|\n|<br/>|g if $letter->{is_html};
720 $letter->{title} =~ s/<<$token>>/$val/g;
721 $letter->{content} =~ s/<<$token>>/$val/g;
725 my $OPACBaseURL = C4::Context->preference('OPACBaseURL');
726 $letter->{content} =~ s/<<OPACBaseURL>>/$OPACBaseURL/go;
728 if ($want_librarian) {
729 # parsing librarian name
730 my $userenv = C4::Context->userenv;
731 $letter->{content} =~ s/<<LibrarianFirstname>>/$userenv->{firstname}/go;
732 $letter->{content} =~ s/<<LibrarianSurname>>/$userenv->{surname}/go;
733 $letter->{content} =~ s/<<LibrarianEmailaddress>>/$userenv->{emailaddress}/go;
736 my ($repeat_no_enclosing_tags, $repeat_enclosing_tags);
739 if (ref ($repeat) eq 'ARRAY' ) {
740 $repeat_no_enclosing_tags = $repeat;
742 $repeat_enclosing_tags = $repeat;
746 if ($repeat_enclosing_tags) {
747 while ( my ($tag, $tag_tables) = each %$repeat_enclosing_tags ) {
748 if ( $letter->{content} =~ m!<$tag>(.*)</$tag>!s ) {
751 my %subletter = ( title => '', content => $subcontent );
752 _substitute_tables( \%subletter, $_ );
755 $letter->{content} =~ s!<$tag>.*</$tag>!join( "\n", @lines )!se;
761 _substitute_tables( $letter, $tables );
764 if ($repeat_no_enclosing_tags) {
765 if ( $letter->{content} =~ m/[^\n]*<<.*>>[^\n]*/so ) {
770 $c =~ s/<<count>>/$i/go;
771 foreach my $field ( keys %{$_} ) {
772 $c =~ s/(<<[^\.]+.$field>>)/$_->{$field}/;
776 } @$repeat_no_enclosing_tags;
778 my $replaceby = join( "\n", @lines );
779 $letter->{content} =~ s/\Q$line\E/$replaceby/s;
783 $letter->{content} = _process_tt(
785 content => $letter->{content},
788 substitute => $substitute,
792 $letter->{content} =~ s/<<\S*>>//go; #remove any stragglers
797 sub _substitute_tables {
798 my ( $letter, $tables ) = @_;
799 while ( my ($table, $param) = each %$tables ) {
802 my $ref = ref $param;
805 if ($ref && $ref eq 'HASH') {
809 my $sth = _parseletter_sth($table);
811 warn "_parseletter_sth('$table') failed to return a valid sth. No substitution will be done for that table.";
814 $sth->execute( $ref ? @$param : $param );
816 $values = $sth->fetchrow_hashref;
820 _parseletter ( $letter, $table, $values );
824 sub _parseletter_sth {
828 carp "ERROR: _parseletter_sth() called without argument (table)";
831 # NOTE: we used to check whether we had a statement handle cached in
832 # a %handles module-level variable. This was a dumb move and
833 # broke things for the rest of us. prepare_cached is a better
834 # way to cache statement handles anyway.
836 ($table eq 'biblio' ) ? "SELECT * FROM $table WHERE biblionumber = ?" :
837 ($table eq 'biblioitems' ) ? "SELECT * FROM $table WHERE biblionumber = ?" :
838 ($table eq 'items' ) ? "SELECT * FROM $table WHERE itemnumber = ?" :
839 ($table eq 'issues' ) ? "SELECT * FROM $table WHERE itemnumber = ?" :
840 ($table eq 'old_issues' ) ? "SELECT * FROM $table WHERE itemnumber = ? ORDER BY timestamp DESC LIMIT 1" :
841 ($table eq 'reserves' ) ? "SELECT * FROM $table WHERE borrowernumber = ? and biblionumber = ?" :
842 ($table eq 'borrowers' ) ? "SELECT * FROM $table WHERE borrowernumber = ?" :
843 ($table eq 'branches' ) ? "SELECT * FROM $table WHERE branchcode = ?" :
844 ($table eq 'suggestions' ) ? "SELECT * FROM $table WHERE suggestionid = ?" :
845 ($table eq 'aqbooksellers') ? "SELECT * FROM $table WHERE id = ?" :
846 ($table eq 'aqorders' ) ? "SELECT * FROM $table WHERE ordernumber = ?" :
847 ($table eq 'opac_news' ) ? "SELECT * FROM $table WHERE idnew = ?" :
848 ($table eq 'article_requests') ? "SELECT * FROM $table WHERE id = ?" :
849 ($table eq 'borrower_modifications') ? "SELECT * FROM $table WHERE verification_token = ?" :
850 ($table eq 'subscription') ? "SELECT * FROM $table WHERE subscriptionid = ?" :
851 ($table eq 'serial') ? "SELECT * FROM $table WHERE serialid = ?" :
854 warn "ERROR: No _parseletter_sth query for table '$table'";
855 return; # nothing to get
857 unless ($sth = C4::Context->dbh->prepare_cached($query)) {
858 warn "ERROR: Failed to prepare query: '$query'";
861 return $sth; # now cache is populated for that $table
864 =head2 _parseletter($letter, $table, $values)
867 - $letter : a hash to letter fields (title & content useful)
868 - $table : the Koha table to parse.
869 - $values_in : table record hashref
870 parse all fields from a table, and replace values in title & content with the appropriate value
871 (not exported sub, used only internally)
876 my ( $letter, $table, $values_in ) = @_;
878 # Work on a local copy of $values_in (passed by reference) to avoid side effects
879 # in callers ( by changing / formatting values )
880 my $values = $values_in ? { %$values_in } : {};
882 if ( $table eq 'borrowers' && $values->{'dateexpiry'} ){
883 $values->{'dateexpiry'} = format_sqldatetime( $values->{'dateexpiry'} );
886 if ( $table eq 'reserves' && $values->{'waitingdate'} ) {
887 $values->{'waitingdate'} = output_pref({ dt => dt_from_string( $values->{'waitingdate'} ), dateonly => 1 });
890 if ($letter->{content} && $letter->{content} =~ /<<today>>/) {
891 my $todaysdate = output_pref( DateTime->now() );
892 $letter->{content} =~ s/<<today>>/$todaysdate/go;
895 while ( my ($field, $val) = each %$values ) {
896 $val =~ s/\p{P}$// if $val && $table=~/biblio/;
897 #BZ 9886: Assuming that we want to eliminate ISBD punctuation here
898 #Therefore adding the test on biblio. This includes biblioitems,
899 #but excludes items. Removed unneeded global and lookahead.
901 if ( $table=~/^borrowers$/ && $field=~/^streettype$/ ) {
902 my $av = Koha::AuthorisedValues->search({ category => 'ROADTYPE', authorised_value => $val });
903 $val = $av->count ? $av->next->lib : '';
907 my $replacedby = defined ($val) ? $val : '';
909 and not $replacedby =~ m|0000-00-00|
910 and not $replacedby =~ m|9999-12-31|
911 and $replacedby =~ m|^\d{4}-\d{2}-\d{2}( \d{2}:\d{2}:\d{2})?$| )
913 # If the value is XXXX-YY-ZZ[ AA:BB:CC] we assume it is a date
914 my $dateonly = defined $1 ? 0 : 1; #$1 refers to the capture group wrapped in parentheses. In this case, that's the hours, minutes, seconds.
915 my $re_dateonly_filter = qr{ $field( \s* \| \s* dateonly\s*)?>> }xms;
917 for my $letter_field ( qw( title content ) ) {
918 my $filter_string_used = q{};
919 if ( $letter->{ $letter_field } =~ $re_dateonly_filter ) {
920 # We overwrite $dateonly if the filter exists and we have a time in the datetime
921 $filter_string_used = $1 || q{};
922 $dateonly = $1 unless $dateonly;
924 my $replacedby_date = eval {
925 output_pref({ dt => dt_from_string( $replacedby ), dateonly => $dateonly });
928 if ( $letter->{ $letter_field } ) {
929 $letter->{ $letter_field } =~ s/\Q<<$table.$field$filter_string_used>>\E/$replacedby_date/g;
930 $letter->{ $letter_field } =~ s/\Q<<$field$filter_string_used>>\E/$replacedby_date/g;
934 # Other fields replacement
936 for my $letter_field ( qw( title content ) ) {
937 if ( $letter->{ $letter_field } ) {
938 $letter->{ $letter_field } =~ s/<<$table.$field>>/$replacedby/g;
939 $letter->{ $letter_field } =~ s/<<$field>>/$replacedby/g;
945 if ($table eq 'borrowers' && $letter->{content}) {
946 if ( my $attributes = GetBorrowerAttributes($values->{borrowernumber}) ) {
948 foreach (@$attributes) {
949 my $code = $_->{code};
950 my $val = $_->{value_description} || $_->{value};
951 $val =~ s/\p{P}(?=$)//g if $val;
952 next unless $val gt '';
954 push @{ $attr{$code} }, $val;
956 while ( my ($code, $val_ar) = each %attr ) {
957 my $replacefield = "<<borrower-attribute:$code>>";
958 my $replacedby = join ',', @$val_ar;
959 $letter->{content} =~ s/$replacefield/$replacedby/g;
968 my $success = EnqueueLetter( { letter => $letter,
969 borrowernumber => '12', message_transport_type => 'email' } )
971 places a letter in the message_queue database table, which will
972 eventually get processed (sent) by the process_message_queue.pl
973 cronjob when it calls SendQueuedMessages.
975 return message_id on success
980 my $params = shift or return;
982 return unless exists $params->{'letter'};
983 # return unless exists $params->{'borrowernumber'};
984 return unless exists $params->{'message_transport_type'};
986 my $content = $params->{letter}->{content};
987 $content =~ s/\s+//g if(defined $content);
988 if ( not defined $content or $content eq '' ) {
989 warn "Trying to add an empty message to the message queue" if $debug;
993 # If we have any attachments we should encode then into the body.
994 if ( $params->{'attachments'} ) {
995 $params->{'letter'} = _add_attachments(
996 { letter => $params->{'letter'},
997 attachments => $params->{'attachments'},
998 message => MIME::Lite->new( Type => 'multipart/mixed' ),
1003 my $dbh = C4::Context->dbh();
1004 my $statement = << 'ENDSQL';
1005 INSERT INTO message_queue
1006 ( borrowernumber, subject, content, metadata, letter_code, message_transport_type, status, time_queued, to_address, from_address, content_type )
1008 ( ?, ?, ?, ?, ?, ?, ?, NOW(), ?, ?, ? )
1011 my $sth = $dbh->prepare($statement);
1012 my $result = $sth->execute(
1013 $params->{'borrowernumber'}, # borrowernumber
1014 $params->{'letter'}->{'title'}, # subject
1015 $params->{'letter'}->{'content'}, # content
1016 $params->{'letter'}->{'metadata'} || '', # metadata
1017 $params->{'letter'}->{'code'} || '', # letter_code
1018 $params->{'message_transport_type'}, # message_transport_type
1020 $params->{'to_address'}, # to_address
1021 $params->{'from_address'}, # from_address
1022 $params->{'letter'}->{'content-type'}, # content_type
1024 return $dbh->last_insert_id(undef,undef,'message_queue', undef);
1027 =head2 SendQueuedMessages ([$hashref])
1029 my $sent = SendQueuedMessages({ verbose => 1, limit => 50 });
1031 Sends all of the 'pending' items in the message queue, unless the optional
1032 limit parameter is passed too. The verbose parameter is also optional.
1034 Returns number of messages sent.
1038 sub SendQueuedMessages {
1041 my $which_unsent_messages = {
1042 'limit' => $params->{'limit'} // 0,
1043 'borrowernumber' => $params->{'borrowernumber'} // q{},
1044 'letter_code' => $params->{'letter_code'} // q{},
1046 my $unsent_messages = _get_unsent_messages( $which_unsent_messages );
1047 MESSAGE: foreach my $message ( @$unsent_messages ) {
1048 # warn Data::Dumper->Dump( [ $message ], [ 'message' ] );
1049 warn sprintf( 'sending %s message to patron: %s',
1050 $message->{'message_transport_type'},
1051 $message->{'borrowernumber'} || 'Admin' )
1052 if $params->{'verbose'} or $debug;
1053 # This is just begging for subclassing
1054 next MESSAGE if ( lc($message->{'message_transport_type'}) eq 'rss' );
1055 if ( lc( $message->{'message_transport_type'} ) eq 'email' ) {
1056 _send_message_by_email( $message, $params->{'username'}, $params->{'password'}, $params->{'method'} );
1058 elsif ( lc( $message->{'message_transport_type'} ) eq 'sms' ) {
1059 if ( C4::Context->preference('SMSSendDriver') eq 'Email' ) {
1060 my $patron = Koha::Patrons->find( $message->{borrowernumber} );
1061 my $sms_provider = Koha::SMS::Providers->find( $patron->sms_provider_id );
1062 unless ( $sms_provider ) {
1063 warn sprintf( "Patron %s has no sms provider id set!", $message->{'borrowernumber'} ) if $params->{'verbose'} or $debug;
1064 _set_message_status( { message_id => $message->{'message_id'}, status => 'failed' } );
1067 unless ( $patron->smsalertnumber ) {
1068 _set_message_status( { message_id => $message->{'message_id'}, status => 'failed' } );
1069 warn sprintf( "No smsalertnumber found for patron %s!", $message->{'borrowernumber'} ) if $params->{'verbose'} or $debug;
1072 $message->{to_address} = $patron->smsalertnumber; #Sometime this is set to email - sms should always use smsalertnumber
1073 $message->{to_address} .= '@' . $sms_provider->domain();
1074 _update_message_to_address($message->{'message_id'},$message->{to_address});
1075 _send_message_by_email( $message, $params->{'username'}, $params->{'password'}, $params->{'method'} );
1077 _send_message_by_sms( $message );
1081 return scalar( @$unsent_messages );
1084 =head2 GetRSSMessages
1086 my $message_list = GetRSSMessages( { limit => 10, borrowernumber => '14' } )
1088 returns a listref of all queued RSS messages for a particular person.
1092 sub GetRSSMessages {
1095 return unless $params;
1096 return unless ref $params;
1097 return unless $params->{'borrowernumber'};
1099 return _get_unsent_messages( { message_transport_type => 'rss',
1100 limit => $params->{'limit'},
1101 borrowernumber => $params->{'borrowernumber'}, } );
1104 =head2 GetPrintMessages
1106 my $message_list = GetPrintMessages( { borrowernumber => $borrowernumber } )
1108 Returns a arrayref of all queued print messages (optionally, for a particular
1113 sub GetPrintMessages {
1114 my $params = shift || {};
1116 return _get_unsent_messages( { message_transport_type => 'print',
1117 borrowernumber => $params->{'borrowernumber'},
1121 =head2 GetQueuedMessages ([$hashref])
1123 my $messages = GetQueuedMessage( { borrowernumber => '123', limit => 20 } );
1125 fetches messages out of the message queue.
1128 list of hashes, each has represents a message in the message queue.
1132 sub GetQueuedMessages {
1135 my $dbh = C4::Context->dbh();
1136 my $statement = << 'ENDSQL';
1137 SELECT message_id, borrowernumber, subject, content, message_transport_type, status, time_queued
1143 if ( exists $params->{'borrowernumber'} ) {
1144 push @whereclauses, ' borrowernumber = ? ';
1145 push @query_params, $params->{'borrowernumber'};
1148 if ( @whereclauses ) {
1149 $statement .= ' WHERE ' . join( 'AND', @whereclauses );
1152 if ( defined $params->{'limit'} ) {
1153 $statement .= ' LIMIT ? ';
1154 push @query_params, $params->{'limit'};
1157 my $sth = $dbh->prepare( $statement );
1158 my $result = $sth->execute( @query_params );
1159 return $sth->fetchall_arrayref({});
1162 =head2 GetMessageTransportTypes
1164 my @mtt = GetMessageTransportTypes();
1166 returns an arrayref of transport types
1170 sub GetMessageTransportTypes {
1171 my $dbh = C4::Context->dbh();
1172 my $mtts = $dbh->selectcol_arrayref("
1173 SELECT message_transport_type
1174 FROM message_transport_types
1175 ORDER BY message_transport_type
1182 my $message = C4::Letters::Message($message_id);
1187 my ( $message_id ) = @_;
1188 return unless $message_id;
1189 my $dbh = C4::Context->dbh;
1190 return $dbh->selectrow_hashref(q|
1191 SELECT message_id, borrowernumber, subject, content, metadata, letter_code, message_transport_type, status, time_queued, to_address, from_address, content_type
1193 WHERE message_id = ?
1194 |, {}, $message_id );
1197 =head2 ResendMessage
1199 Attempt to resend a message which has failed previously.
1201 my $has_been_resent = C4::Letters::ResendMessage($message_id);
1203 Updates the message to 'pending' status so that
1204 it will be resent later on.
1206 returns 1 on success, 0 on failure, undef if no message was found
1211 my $message_id = shift;
1212 return unless $message_id;
1214 my $message = GetMessage( $message_id );
1215 return unless $message;
1217 if ( $message->{status} ne 'pending' ) {
1218 $rv = C4::Letters::_set_message_status({
1219 message_id => $message_id,
1220 status => 'pending',
1222 $rv = $rv > 0? 1: 0;
1223 # Clear destination email address to force address update
1224 _update_message_to_address( $message_id, undef ) if $rv &&
1225 $message->{message_transport_type} eq 'email';
1230 =head2 _add_attachements
1233 letter - the standard letter hashref
1234 attachments - listref of attachments. each attachment is a hashref of:
1235 type - the mime type, like 'text/plain'
1236 content - the actual attachment
1237 filename - the name of the attachment.
1238 message - a MIME::Lite object to attach these to.
1240 returns your letter object, with the content updated.
1244 sub _add_attachments {
1247 my $letter = $params->{'letter'};
1248 my $attachments = $params->{'attachments'};
1249 return $letter unless @$attachments;
1250 my $message = $params->{'message'};
1252 # First, we have to put the body in as the first attachment
1254 Type => $letter->{'content-type'} || 'TEXT',
1255 Data => $letter->{'is_html'}
1256 ? _wrap_html($letter->{'content'}, $letter->{'title'})
1257 : $letter->{'content'},
1260 foreach my $attachment ( @$attachments ) {
1262 Type => $attachment->{'type'},
1263 Data => $attachment->{'content'},
1264 Filename => $attachment->{'filename'},
1267 # we're forcing list context here to get the header, not the count back from grep.
1268 ( $letter->{'content-type'} ) = grep( /^Content-Type:/, split( /\n/, $params->{'message'}->header_as_string ) );
1269 $letter->{'content-type'} =~ s/^Content-Type:\s+//;
1270 $letter->{'content'} = $message->body_as_string;
1276 sub _get_unsent_messages {
1279 my $dbh = C4::Context->dbh();
1281 SELECT mq.message_id, mq.borrowernumber, mq.subject, mq.content, mq.message_transport_type, mq.status, mq.time_queued, mq.from_address, mq.to_address, mq.content_type, b.branchcode, mq.letter_code
1282 FROM message_queue mq
1283 LEFT JOIN borrowers b ON b.borrowernumber = mq.borrowernumber
1287 my @query_params = ('pending');
1288 if ( ref $params ) {
1289 if ( $params->{'message_transport_type'} ) {
1290 $statement .= ' AND mq.message_transport_type = ? ';
1291 push @query_params, $params->{'message_transport_type'};
1293 if ( $params->{'borrowernumber'} ) {
1294 $statement .= ' AND mq.borrowernumber = ? ';
1295 push @query_params, $params->{'borrowernumber'};
1297 if ( $params->{'letter_code'} ) {
1298 $statement .= ' AND mq.letter_code = ? ';
1299 push @query_params, $params->{'letter_code'};
1301 if ( $params->{'limit'} ) {
1302 $statement .= ' limit ? ';
1303 push @query_params, $params->{'limit'};
1307 $debug and warn "_get_unsent_messages SQL: $statement";
1308 $debug and warn "_get_unsent_messages params: " . join(',',@query_params);
1309 my $sth = $dbh->prepare( $statement );
1310 my $result = $sth->execute( @query_params );
1311 return $sth->fetchall_arrayref({});
1314 sub _send_message_by_email {
1315 my $message = shift or return;
1316 my ($username, $password, $method) = @_;
1318 my $patron = Koha::Patrons->find( $message->{borrowernumber} );
1319 my $to_address = $message->{'to_address'};
1320 unless ($to_address) {
1322 warn "FAIL: No 'to_address' and INVALID borrowernumber ($message->{borrowernumber})";
1323 _set_message_status( { message_id => $message->{'message_id'},
1324 status => 'failed' } );
1327 $to_address = $patron->notice_email_address;
1328 unless ($to_address) {
1329 # warn "FAIL: No 'to_address' and no email for " . ($member->{surname} ||'') . ", borrowernumber ($message->{borrowernumber})";
1330 # warning too verbose for this more common case?
1331 _set_message_status( { message_id => $message->{'message_id'},
1332 status => 'failed' } );
1337 my $utf8 = decode('MIME-Header', $message->{'subject'} );
1338 $message->{subject}= encode('MIME-Header', $utf8);
1339 my $subject = encode('UTF-8', $message->{'subject'});
1340 my $content = encode('UTF-8', $message->{'content'});
1341 my $content_type = $message->{'content_type'} || 'text/plain; charset="UTF-8"';
1342 my $is_html = $content_type =~ m/html/io;
1343 my $branch_email = undef;
1344 my $branch_replyto = undef;
1345 my $branch_returnpath = undef;
1347 my $library = $patron->library;
1348 $branch_email = $library->branchemail;
1349 $branch_replyto = $library->branchreplyto;
1350 $branch_returnpath = $library->branchreturnpath;
1352 my $email = Koha::Email->new();
1353 my %sendmail_params = $email->create_message_headers(
1356 from => $message->{'from_address'} || $branch_email,
1357 replyto => $branch_replyto,
1358 sender => $branch_returnpath,
1359 subject => $subject,
1360 message => $is_html ? _wrap_html( $content, $subject ) : $content,
1361 contenttype => $content_type
1365 $sendmail_params{'Auth'} = {user => $username, pass => $password, method => $method} if $username;
1366 if ( my $bcc = C4::Context->preference('NoticeBcc') ) {
1367 $sendmail_params{ Bcc } = $bcc;
1370 _update_message_to_address($message->{'message_id'},$to_address) unless $message->{to_address}; #if initial message address was empty, coming here means that a to address was found and queue should be updated
1372 if ( sendmail( %sendmail_params ) ) {
1373 _set_message_status( { message_id => $message->{'message_id'},
1374 status => 'sent' } );
1377 _set_message_status( { message_id => $message->{'message_id'},
1378 status => 'failed' } );
1379 carp $Mail::Sendmail::error;
1385 my ($content, $title) = @_;
1387 my $css = C4::Context->preference("NoticeCSS") || '';
1388 $css = qq{<link rel="stylesheet" type="text/css" href="$css">} if $css;
1390 <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
1391 "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
1392 <html lang="en" xml:lang="en" xmlns="http://www.w3.org/1999/xhtml">
1394 <title>$title</title>
1395 <meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
1406 my ( $message ) = @_;
1407 my $dbh = C4::Context->dbh;
1408 my $count = $dbh->selectrow_array(q|
1411 WHERE message_transport_type = ?
1412 AND borrowernumber = ?
1414 AND CAST(time_queued AS date) = CAST(NOW() AS date)
1417 |, {}, $message->{message_transport_type}, $message->{borrowernumber}, $message->{letter_code}, $message->{content} );
1421 sub _send_message_by_sms {
1422 my $message = shift or return;
1423 my $patron = Koha::Patrons->find( $message->{borrowernumber} );
1425 unless ( $patron and $patron->smsalertnumber ) {
1426 _set_message_status( { message_id => $message->{'message_id'},
1427 status => 'failed' } );
1431 if ( _is_duplicate( $message ) ) {
1432 _set_message_status( { message_id => $message->{'message_id'},
1433 status => 'failed' } );
1437 my $success = C4::SMS->send_sms( { destination => $patron->smsalertnumber,
1438 message => $message->{'content'},
1440 _set_message_status( { message_id => $message->{'message_id'},
1441 status => ($success ? 'sent' : 'failed') } );
1445 sub _update_message_to_address {
1447 my $dbh = C4::Context->dbh();
1448 $dbh->do('UPDATE message_queue SET to_address=? WHERE message_id=?',undef,($to,$id));
1451 sub _set_message_status {
1452 my $params = shift or return;
1454 foreach my $required_parameter ( qw( message_id status ) ) {
1455 return unless exists $params->{ $required_parameter };
1458 my $dbh = C4::Context->dbh();
1459 my $statement = 'UPDATE message_queue SET status= ? WHERE message_id = ?';
1460 my $sth = $dbh->prepare( $statement );
1461 my $result = $sth->execute( $params->{'status'},
1462 $params->{'message_id'} );
1467 my ( $params ) = @_;
1469 my $content = $params->{content};
1470 my $tables = $params->{tables};
1471 my $loops = $params->{loops};
1472 my $substitute = $params->{substitute} || {};
1474 my $use_template_cache = C4::Context->config('template_cache_dir') && defined $ENV{GATEWAY_INTERFACE};
1475 my $template = Template->new(
1479 PLUGIN_BASE => 'Koha::Template::Plugin',
1480 COMPILE_EXT => $use_template_cache ? '.ttc' : '',
1481 COMPILE_DIR => $use_template_cache ? C4::Context->config('template_cache_dir') : '',
1483 ENCODING => 'UTF-8',
1485 ) or die Template->error();
1487 my $tt_params = { %{ _get_tt_params( $tables ) }, %{ _get_tt_params( $loops, 'is_a_loop' ) }, %$substitute };
1489 $content = qq|[% USE KohaDates %]$content|;
1492 $template->process( \$content, $tt_params, \$output ) || croak "ERROR PROCESSING TEMPLATE: " . $template->error();
1497 sub _get_tt_params {
1498 my ($tables, $is_a_loop) = @_;
1504 article_requests => {
1505 module => 'Koha::ArticleRequests',
1506 singular => 'article_request',
1507 plural => 'article_requests',
1511 module => 'Koha::Biblios',
1512 singular => 'biblio',
1513 plural => 'biblios',
1514 pk => 'biblionumber',
1517 module => 'Koha::Patrons',
1518 singular => 'borrower',
1519 plural => 'borrowers',
1520 pk => 'borrowernumber',
1523 module => 'Koha::Libraries',
1524 singular => 'branch',
1525 plural => 'branches',
1529 module => 'Koha::Items',
1535 module => 'Koha::News',
1541 module => 'Koha::Acquisition::Orders',
1542 singular => 'order',
1544 pk => 'ordernumber',
1547 module => 'Koha::Holds',
1550 fk => [ 'borrowernumber', 'biblionumber' ],
1553 module => 'Koha::Serials',
1554 singular => 'serial',
1555 plural => 'serials',
1559 module => 'Koha::Subscriptions',
1560 singular => 'subscription',
1561 plural => 'subscriptions',
1562 pk => 'subscriptionid',
1565 module => 'Koha::Suggestions',
1566 singular => 'suggestion',
1567 plural => 'suggestions',
1568 pk => 'suggestionid',
1571 module => 'Koha::Checkouts',
1572 singular => 'checkout',
1573 plural => 'checkouts',
1577 module => 'Koha::Old::Checkouts',
1578 singular => 'old_checkout',
1579 plural => 'old_checkouts',
1583 module => 'Koha::Checkouts',
1584 singular => 'overdue',
1585 plural => 'overdues',
1588 borrower_modifications => {
1589 module => 'Koha::Patron::Modifications',
1590 singular => 'patron_modification',
1591 plural => 'patron_modifications',
1592 fk => 'verification_token',
1596 foreach my $table ( keys %$tables ) {
1597 next unless $config->{$table};
1599 my $ref = ref( $tables->{$table} ) || q{};
1600 my $module = $config->{$table}->{module};
1602 if ( can_load( modules => { $module => undef } ) ) {
1603 my $pk = $config->{$table}->{pk};
1604 my $fk = $config->{$table}->{fk};
1607 my $values = $tables->{$table} || [];
1608 unless ( ref( $values ) eq 'ARRAY' ) {
1609 croak "ERROR processing table $table. Wrong API call.";
1611 my $key = $pk ? $pk : $fk;
1612 # $key does not come from user input
1613 my $objects = $module->search(
1614 { $key => $values },
1616 # We want to retrieve the data in the same order
1618 # field is a MySQLism, but they are no other way to do it
1619 # To be generic we could do it in perl, but we will need to fetch
1620 # all the data then order them
1621 @$values ? ( order_by => \[ "field($key, " . join( ', ', @$values ) . ")" ] ) : ()
1624 $params->{ $config->{$table}->{plural} } = $objects;
1626 elsif ( $ref eq q{} || $ref eq 'HASH' ) {
1627 my $id = ref $ref eq 'HASH' ? $tables->{$table}->{$pk} : $tables->{$table};
1629 if ( $fk ) { # Using a foreign key for lookup
1630 if ( ref( $fk ) eq 'ARRAY' ) { # Foreign key is multi-column
1632 foreach my $key ( @$fk ) {
1633 $search->{$key} = $id->{$key};
1635 $object = $module->search( $search )->last();
1636 } else { # Foreign key is single column
1637 $object = $module->search( { $fk => $id } )->last();
1639 } else { # using the table's primary key for lookup
1640 $object = $module->find($id);
1642 $params->{ $config->{$table}->{singular} } = $object;
1644 else { # $ref eq 'ARRAY'
1646 if ( @{ $tables->{$table} } == 1 ) { # Param is a single key
1647 $object = $module->search( { $pk => $tables->{$table} } )->last();
1649 else { # Params are mutliple foreign keys
1650 croak "Multiple foreign keys (table $table) should be passed using an hashref";
1652 $params->{ $config->{$table}->{singular} } = $object;
1656 croak "ERROR LOADING MODULE $module: $Module::Load::Conditional::ERROR";
1660 $params->{today} = output_pref({ dt => dt_from_string, dateformat => 'iso' });
1665 =head2 get_item_content
1667 my $item = Koha::Items->find(...)->unblessed;
1668 my @item_content_fields = qw( date_due title barcode author itemnumber );
1669 my $item_content = C4::Letters::get_item_content({
1671 item_content_fields => \@item_content_fields
1674 This function generates a tab-separated list of values for the passed item. Dates
1675 are formatted following the current setup.
1679 sub get_item_content {
1680 my ( $params ) = @_;
1681 my $item = $params->{item};
1682 my $dateonly = $params->{dateonly} || 0;
1683 my $item_content_fields = $params->{item_content_fields} || [];
1685 return unless $item;
1687 my @item_info = map {
1691 { dt => dt_from_string( $item->{$_} ), dateonly => $dateonly } );
1695 } @$item_content_fields;
1696 return join( "\t", @item_info ) . "\n";