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>.
22 use Carp qw( carp croak );
24 use Module::Load::Conditional qw( can_load );
29 use C4::Log qw( logaction );
32 use Koha::SMS::Providers;
35 use Koha::Notice::Messages;
36 use Koha::Notice::Templates;
37 use Koha::DateUtils qw( dt_from_string output_pref );
38 use Koha::Auth::TwoFactorAuth;
40 use Koha::SMTP::Servers;
41 use Koha::Subscriptions;
43 use constant SERIALIZED_EMAIL_CONTENT_TYPE => 'message/rfc822';
45 our (@ISA, @EXPORT_OK);
51 GetLettersAvailableForALibrary
60 GetMessageTransportTypes
70 C4::Letters - Give functions for Letters management
78 "Letters" is the tool used in Koha to manage informations sent to the patrons and/or the library. This include some cron jobs like
79 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)
81 Letters are managed through "alerts" sent by Koha on some events. All "alert" related functions are in this module too.
83 =head2 GetLetters([$module])
85 $letters = &GetLetters($module);
86 returns informations about letters.
87 if needed, $module filters for letters given module
89 DEPRECATED - You must use Koha::Notice::Templates instead
90 The group by clause is confusing and can lead to issues
96 my $module = $filters->{module};
97 my $code = $filters->{code};
98 my $branchcode = $filters->{branchcode};
99 my $dbh = C4::Context->dbh;
100 my $letters = $dbh->selectall_arrayref(
102 SELECT code, module, name
106 . ( $module ? q| AND module = ?| : q|| )
107 . ( $code ? q| AND code = ?| : q|| )
108 . ( defined $branchcode ? q| AND branchcode = ?| : q|| )
109 . q| GROUP BY code, module, name ORDER BY name|, { Slice => {} }
110 , ( $module ? $module : () )
111 , ( $code ? $code : () )
112 , ( defined $branchcode ? $branchcode : () )
118 =head2 GetLetterTemplates
120 my $letter_templates = GetLetterTemplates(
122 module => 'circulation',
124 branchcode => 'CPL', # '' for default,
128 Return a hashref of letter templates.
132 sub GetLetterTemplates {
135 my $module = $params->{module};
136 my $code = $params->{code};
137 my $branchcode = $params->{branchcode} // '';
138 my $dbh = C4::Context->dbh;
139 return Koha::Notice::Templates->search(
143 branchcode => $branchcode,
145 C4::Context->preference('TranslateNotices')
147 : ( lang => 'default' )
153 =head2 GetLettersAvailableForALibrary
155 my $letters = GetLettersAvailableForALibrary(
157 branchcode => 'CPL', # '' for default
158 module => 'circulation',
162 Return an arrayref of letters, sorted by name.
163 If a specific letter exist for the given branchcode, it will be retrieve.
164 Otherwise the default letter will be.
168 sub GetLettersAvailableForALibrary {
170 my $branchcode = $filters->{branchcode};
171 my $module = $filters->{module};
173 croak "module should be provided" unless $module;
175 my $dbh = C4::Context->dbh;
176 my $default_letters = $dbh->selectall_arrayref(
178 SELECT module, code, branchcode, name
182 . q| AND branchcode = ''|
183 . ( $module ? q| AND module = ?| : q|| )
184 . q| ORDER BY name|, { Slice => {} }
185 , ( $module ? $module : () )
188 my $specific_letters;
190 $specific_letters = $dbh->selectall_arrayref(
192 SELECT module, code, branchcode, name
196 . q| AND branchcode = ?|
197 . ( $module ? q| AND module = ?| : q|| )
198 . q| ORDER BY name|, { Slice => {} }
200 , ( $module ? $module : () )
205 for my $l (@$default_letters) {
206 $letters{ $l->{code} } = $l;
208 for my $l (@$specific_letters) {
209 # Overwrite the default letter with the specific one.
210 $letters{ $l->{code} } = $l;
213 return [ map { $letters{$_} }
214 sort { $letters{$a}->{name} cmp $letters{$b}->{name} }
224 module => 'circulation',
230 Delete the letter. The mtt parameter is facultative.
231 If not given, all templates mathing the other parameters will be removed.
237 my $branchcode = $params->{branchcode};
238 my $module = $params->{module};
239 my $code = $params->{code};
240 my $mtt = $params->{mtt};
241 my $lang = $params->{lang};
242 my $dbh = C4::Context->dbh;
249 . ( $mtt ? q| AND message_transport_type = ?| : q|| )
250 . ( $lang? q| AND lang = ?| : q|| )
251 , undef, $branchcode, $module, $code, ( $mtt ? $mtt : () ), ( $lang ? $lang : () ) );
256 my $err = &SendAlerts($type, $externalid, $letter_code);
259 - $type : the type of alert
260 - $externalid : the id of the "object" to query
261 - $letter_code : the notice template to use
263 C<&SendAlerts> sends an email notice directly to a patron or a vendor.
265 Currently it supports ($type):
266 - claim serial issues (claimissues)
267 - claim acquisition orders (claimacquisition)
268 - send acquisition orders to the vendor (orderacquisition)
269 - notify patrons about newly received serial issues (issue)
270 - notify patrons when their account is created (members)
272 Returns undef or { error => 'message } on failure.
273 Returns true on success.
278 my ( $type, $externalid, $letter_code ) = @_;
279 my $dbh = C4::Context->dbh;
282 if ( $type eq 'issue' ) {
284 # prepare the letter...
285 # search the subscriptionid
288 "SELECT subscriptionid FROM serial WHERE serialid=?");
289 $sth->execute($externalid);
290 my ($subscriptionid) = $sth->fetchrow
291 or warn( "No subscription for '$externalid'" ),
294 # search the biblionumber
297 "SELECT biblionumber FROM subscription WHERE subscriptionid=?");
298 $sth->execute($subscriptionid);
299 my ($biblionumber) = $sth->fetchrow
300 or warn( "No biblionumber for '$subscriptionid'" ),
303 # find the list of subscribers to notify
304 my $subscription = Koha::Subscriptions->find( $subscriptionid );
305 my $subscribers = $subscription->subscribers;
306 while ( my $patron = $subscribers->next ) {
307 my $email = $patron->email or next;
309 # warn "sending issues...";
310 my $userenv = C4::Context->userenv;
311 my $library = $patron->library;
312 my $letter = GetPreparedLetter (
314 letter_code => $letter_code,
315 branchcode => $userenv->{branch},
317 'branches' => $library->branchcode,
318 'biblio' => $biblionumber,
319 'biblioitems' => $biblionumber,
320 'borrowers' => $patron->unblessed,
321 'subscription' => $subscriptionid,
322 'serial' => $externalid,
327 # FIXME: This 'default' behaviour should be moved to Koha::Email
328 my $mail = Koha::Email->create(
331 from => $library->branchemail,
332 reply_to => $library->branchreplyto,
333 sender => $library->branchreturnpath,
334 subject => "" . $letter->{title},
338 if ( $letter->{is_html} ) {
339 $mail->html_body( _wrap_html( $letter->{content}, "" . $letter->{title} ) );
342 $mail->text_body( $letter->{content} );
346 $mail->send_or_die({ transport => $library->smtp_server->transport });
349 # We expect ref($_) eq 'Email::Sender::Failure'
350 $error = $_->message;
356 return { error => $error }
360 elsif ( $type eq 'claimacquisition' or $type eq 'claimissues' or $type eq 'orderacquisition' ) {
362 # prepare the letter...
369 if ( $type eq 'claimacquisition') {
371 SELECT aqorders.*,aqbasket.*,biblio.*,biblioitems.*
373 LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno
374 LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
375 LEFT JOIN biblioitems ON aqorders.biblionumber=biblioitems.biblionumber
376 WHERE aqorders.ordernumber IN (
380 carp "No order selected";
381 return { error => "no_order_selected" };
383 $strsth .= join( ",", ('?') x @$externalid ) . ")";
384 $action = "ACQUISITION CLAIM";
385 $sthorders = $dbh->prepare($strsth);
386 $sthorders->execute( @$externalid );
387 $dataorders = $sthorders->fetchall_arrayref( {} );
390 if ($type eq 'claimissues') {
392 SELECT serial.*,subscription.*, biblio.*, biblioitems.*, aqbooksellers.*,
393 aqbooksellers.id AS booksellerid
395 LEFT JOIN subscription ON serial.subscriptionid=subscription.subscriptionid
396 LEFT JOIN biblio ON serial.biblionumber=biblio.biblionumber
397 LEFT JOIN biblioitems ON serial.biblionumber = biblioitems.biblionumber
398 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id
399 WHERE serial.serialid IN (
403 carp "No issues selected";
404 return { error => "no_issues_selected" };
407 $strsth .= join( ",", ('?') x @$externalid ) . ")";
408 $action = "SERIAL CLAIM";
409 $sthorders = $dbh->prepare($strsth);
410 $sthorders->execute( @$externalid );
411 $dataorders = $sthorders->fetchall_arrayref( {} );
414 if ( $type eq 'orderacquisition') {
415 $basketno = $externalid;
417 SELECT aqorders.*,aqbasket.*,biblio.*,biblioitems.*
419 LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno
420 LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
421 LEFT JOIN biblioitems ON aqorders.biblionumber=biblioitems.biblionumber
422 WHERE aqbasket.basketno = ?
423 AND orderstatus IN ('new','ordered')
426 unless ( $basketno ) {
427 carp "No basketnumber given";
428 return { error => "no_basketno" };
430 $action = "ACQUISITION ORDER";
431 $sthorders = $dbh->prepare($strsth);
432 $sthorders->execute($basketno);
433 $dataorders = $sthorders->fetchall_arrayref( {} );
435 aqorders => [ map { $_->{ordernumber} } @$dataorders ]
439 my $booksellerid = $dataorders->[0]->{booksellerid};
440 my $addressee = $type eq 'claimacquisition' || $type eq 'orderacquisition' ? 'acqprimary' : 'serialsprimary';
443 $dbh->prepare("SELECT * FROM aqcontacts WHERE booksellerid=? AND $type=1 ORDER BY $addressee DESC");
444 $sthcontact->execute( $booksellerid );
445 my $datacontact = $sthcontact->fetchrow_hashref;
449 push @email, $datacontact->{email} if ( $datacontact && $datacontact->{email} );
451 warn "Bookseller $booksellerid without emails";
452 return { error => "no_email" };
455 while ($addlcontact = $sthcontact->fetchrow_hashref) {
456 push @cc, $addlcontact->{email} if ( $addlcontact && $addlcontact->{email} );
459 my $userenv = C4::Context->userenv;
460 my $letter = GetPreparedLetter (
462 letter_code => $letter_code,
463 branchcode => $userenv->{branch},
465 'branches' => $userenv->{branch},
466 'aqbooksellers' => $booksellerid,
467 'aqcontacts' => $datacontact,
468 'aqbasket' => $basketno,
470 repeat => $dataorders,
473 ) or return { error => "no_letter" };
475 # Remove the order tag
476 $letter->{content} =~ s/<order>(.*?)<\/order>/$1/gxms;
479 my $library = Koha::Libraries->find( $userenv->{branch} );
480 my $mail = Koha::Email->create(
482 to => join( ',', @email ),
483 cc => join( ',', @cc ),
486 C4::Context->preference("ClaimsBccCopy")
487 && ( $type eq 'claimacquisition'
488 || $type eq 'claimissues' )
490 ? ( bcc => $userenv->{emailaddress} )
493 from => $library->branchemail
494 || C4::Context->preference('KohaAdminEmailAddress'),
495 subject => "" . $letter->{title},
499 if ( $letter->{is_html} ) {
500 $mail->html_body( _wrap_html( $letter->{content}, "" . $letter->{title} ) );
503 $mail->text_body( "" . $letter->{content} );
507 $mail->send_or_die({ transport => $library->smtp_server->transport });
510 # We expect ref($_) eq 'Email::Sender::Failure'
511 $error = $_->message;
517 return { error => $error }
520 my $log_object = $action eq 'ACQUISITION ORDER' ? $externalid : undef;
521 my $module = $action eq 'ACQUISITION ORDER' ? 'ACQUISITIONS' : 'CLAIMS';
527 . join( ',', @email )
532 ) if C4::Context->preference("ClaimsLog");
535 # If we come here, return an OK status
539 =head2 GetPreparedLetter( %params )
542 module => letter module, mandatory
543 letter_code => letter code, mandatory
544 branchcode => for letter selection, if missing default system letter taken
545 tables => a hashref with table names as keys. Values are either:
546 - a scalar - primary key value
547 - an arrayref - primary key values
548 - a hashref - full record
549 substitute => custom substitution key/value pairs
550 repeat => records to be substituted on consecutive lines:
551 - an arrayref - tries to guess what needs substituting by
552 taking remaining << >> tokensr; not recommended
553 - a hashref token => @tables - replaces <token> << >> << >> </token>
554 subtemplate for each @tables row; table is a hashref as above
555 want_librarian => boolean, if set to true triggers librarian details
556 substitution from the userenv
558 letter fields hashref (title & content useful)
562 sub GetPreparedLetter {
565 my $letter = $params{letter};
566 my $lang = $params{lang} || 'default';
569 my $module = $params{module} or croak "No module";
570 my $letter_code = $params{letter_code} or croak "No letter_code";
571 my $branchcode = $params{branchcode} || '';
572 my $mtt = $params{message_transport_type} || 'email';
574 my $template = Koha::Notice::Templates->find_effective_template(
577 code => $letter_code,
578 branchcode => $branchcode,
579 message_transport_type => $mtt,
584 unless ( $template ) {
585 warn( "No $module $letter_code letter transported by " . $mtt );
589 $letter = $template->unblessed;
590 $letter->{'content-type'} = 'text/html; charset="UTF-8"' if $letter->{is_html};
593 my $objects = $params{objects} || {};
594 my $tables = $params{tables} || {};
595 my $substitute = $params{substitute} || {};
596 my $loops = $params{loops} || {}; # loops is not supported for historical notices syntax
597 my $repeat = $params{repeat};
598 %$tables || %$substitute || $repeat || %$loops || %$objects
599 or carp( "ERROR: nothing to substitute - all of 'objects', 'tables', 'loops' and 'substitute' are empty" ),
601 my $want_librarian = $params{want_librarian};
604 while ( my ($token, $val) = each %$substitute ) {
606 if ( $token eq 'items.content' ) {
607 $val =~ s|\n|<br/>|g if $letter->{is_html};
610 $letter->{title} =~ s/<<$token>>/$val/g;
611 $letter->{content} =~ s/<<$token>>/$val/g;
615 my $OPACBaseURL = C4::Context->preference('OPACBaseURL');
616 $letter->{content} =~ s/<<OPACBaseURL>>/$OPACBaseURL/go;
618 if ($want_librarian) {
619 # parsing librarian name
620 my $userenv = C4::Context->userenv;
621 $letter->{content} =~ s/<<LibrarianFirstname>>/$userenv->{firstname}/go;
622 $letter->{content} =~ s/<<LibrarianSurname>>/$userenv->{surname}/go;
623 $letter->{content} =~ s/<<LibrarianEmailaddress>>/$userenv->{emailaddress}/go;
626 my ($repeat_no_enclosing_tags, $repeat_enclosing_tags);
629 if (ref ($repeat) eq 'ARRAY' ) {
630 $repeat_no_enclosing_tags = $repeat;
632 $repeat_enclosing_tags = $repeat;
636 if ($repeat_enclosing_tags) {
637 while ( my ($tag, $tag_tables) = each %$repeat_enclosing_tags ) {
638 if ( $letter->{content} =~ m!<$tag>(.*)</$tag>!s ) {
641 my %subletter = ( title => '', content => $subcontent );
642 _substitute_tables( \%subletter, $_ );
645 $letter->{content} =~ s!<$tag>.*</$tag>!join( "\n", @lines )!se;
651 _substitute_tables( $letter, $tables );
654 if ($repeat_no_enclosing_tags) {
655 if ( $letter->{content} =~ m/[^\n]*<<.*>>[^\n]*/so ) {
660 $c =~ s/<<count>>/$i/go;
661 foreach my $field ( keys %{$_} ) {
662 $c =~ s/(<<[^\.]+.$field>>)/$_->{$field}/;
666 } @$repeat_no_enclosing_tags;
668 my $replaceby = join( "\n", @lines );
669 $letter->{content} =~ s/\Q$line\E/$replaceby/s;
673 $letter->{content} = _process_tt(
675 content => $letter->{content},
679 substitute => $substitute,
684 $letter->{title} = _process_tt(
686 content => $letter->{title},
690 substitute => $substitute,
695 $letter->{content} =~ s/<<\S*>>//go; #remove any stragglers
700 sub _substitute_tables {
701 my ( $letter, $tables ) = @_;
702 while ( my ($table, $param) = each %$tables ) {
705 my $ref = ref $param;
708 if ($ref && $ref eq 'HASH') {
712 my $sth = _parseletter_sth($table);
714 warn "_parseletter_sth('$table') failed to return a valid sth. No substitution will be done for that table.";
717 $sth->execute( $ref ? @$param : $param );
719 $values = $sth->fetchrow_hashref;
723 _parseletter ( $letter, $table, $values );
727 sub _parseletter_sth {
731 carp "ERROR: _parseletter_sth() called without argument (table)";
734 # NOTE: we used to check whether we had a statement handle cached in
735 # a %handles module-level variable. This was a dumb move and
736 # broke things for the rest of us. prepare_cached is a better
737 # way to cache statement handles anyway.
739 ($table eq 'accountlines' ) ? "SELECT * FROM $table WHERE accountlines_id = ?" :
740 ($table eq 'biblio' ) ? "SELECT * FROM $table WHERE biblionumber = ?" :
741 ($table eq 'biblioitems' ) ? "SELECT * FROM $table WHERE biblionumber = ?" :
742 ($table eq 'tickets' ) ? "SELECT * FROM $table WHERE id = ?" :
743 ($table eq 'ticket_updates' ) ? "SELECT * FROM $table WHERE id = ?" :
744 ($table eq 'credits' ) ? "SELECT * FROM accountlines WHERE accountlines_id = ?" :
745 ($table eq 'debits' ) ? "SELECT * FROM accountlines WHERE accountlines_id = ?" :
746 ($table eq 'items' ) ? "SELECT * FROM $table WHERE itemnumber = ?" :
747 ($table eq 'issues' ) ? "SELECT * FROM $table WHERE itemnumber = ?" :
748 ($table eq 'old_issues' ) ? "SELECT * FROM $table WHERE issue_id = ?" :
749 ($table eq 'reserves' ) ? "SELECT * FROM $table WHERE borrowernumber = ? and biblionumber = ?" :
750 ($table eq 'borrowers' ) ? "SELECT * FROM $table WHERE borrowernumber = ?" :
751 ($table eq 'branches' ) ? "SELECT * FROM $table WHERE branchcode = ?" :
752 ($table eq 'suggestions' ) ? "SELECT * FROM $table WHERE suggestionid = ?" :
753 ($table eq 'aqbooksellers') ? "SELECT * FROM $table WHERE id = ?" :
754 ($table eq 'aqorders' ) ? "SELECT * FROM $table WHERE ordernumber = ?" :
755 ($table eq 'aqbasket' ) ? "SELECT * FROM $table WHERE basketno = ?" :
756 ($table eq 'illrequests' ) ? "SELECT * FROM $table WHERE illrequest_id = ?" :
757 ($table eq 'article_requests') ? "SELECT * FROM $table WHERE id = ?" :
758 ($table eq 'borrower_modifications') ? "SELECT * FROM $table WHERE verification_token = ?" :
759 ($table eq 'subscription') ? "SELECT * FROM $table WHERE subscriptionid = ?" :
760 ($table eq 'serial') ? "SELECT * FROM $table WHERE serialid = ?" :
761 ($table eq 'problem_reports') ? "SELECT * FROM $table WHERE reportid = ?" :
762 ($table eq 'additional_contents' || $table eq 'opac_news') ? "SELECT * FROM additional_contents WHERE idnew = ?" :
763 ($table eq 'recalls') ? "SELECT * FROM $table WHERE recall_id = ?" :
766 warn "ERROR: No _parseletter_sth query for table '$table'";
767 return; # nothing to get
769 unless ($sth = C4::Context->dbh->prepare_cached($query)) {
770 warn "ERROR: Failed to prepare query: '$query'";
773 return $sth; # now cache is populated for that $table
776 =head2 _parseletter($letter, $table, $values)
779 - $letter : a hash to letter fields (title & content useful)
780 - $table : the Koha table to parse.
781 - $values_in : table record hashref
782 parse all fields from a table, and replace values in title & content with the appropriate value
783 (not exported sub, used only internally)
788 my ( $letter, $table, $values_in ) = @_;
790 # Work on a local copy of $values_in (passed by reference) to avoid side effects
791 # in callers ( by changing / formatting values )
792 my $values = $values_in ? { %$values_in } : {};
794 # FIXME Dates formatting must be done in notice's templates
795 if ( $table eq 'borrowers' && $values->{'dateexpiry'} ){
796 $values->{'dateexpiry'} = output_pref({ dt => dt_from_string( $values->{'dateexpiry'} ), dateonly => 1 });
799 if ( $table eq 'reserves' && $values->{'waitingdate'} ) {
800 $values->{'waitingdate'} = output_pref({ dt => dt_from_string( $values->{'waitingdate'} ), dateonly => 1 });
803 if ($letter->{content} && $letter->{content} =~ /<<today>>/) {
804 my $todaysdate = output_pref( dt_from_string() );
805 $letter->{content} =~ s/<<today>>/$todaysdate/go;
808 while ( my ($field, $val) = each %$values ) {
809 $val =~ s/\p{P}$// if $val && $table=~/biblio/;
810 #BZ 9886: Assuming that we want to eliminate ISBD punctuation here
811 #Therefore adding the test on biblio. This includes biblioitems,
812 #but excludes items. Removed unneeded global and lookahead.
814 if ( $table=~/^borrowers$/ && $field=~/^streettype$/ ) {
815 my $av = Koha::AuthorisedValues->search({ category => 'ROADTYPE', authorised_value => $val });
816 $val = $av->count ? $av->next->lib : '';
820 my $replacedby = defined ($val) ? $val : '';
822 and not $replacedby =~ m|9999-12-31|
823 and $replacedby =~ m|^\d{4}-\d{2}-\d{2}( \d{2}:\d{2}:\d{2})?$| )
825 # If the value is XXXX-YY-ZZ[ AA:BB:CC] we assume it is a date
826 my $dateonly = defined $1 ? 0 : 1; #$1 refers to the capture group wrapped in parentheses. In this case, that's the hours, minutes, seconds.
827 my $re_dateonly_filter = qr{ $field( \s* \| \s* dateonly\s*)?>> }xms;
829 for my $letter_field ( qw( title content ) ) {
830 my $filter_string_used = q{};
831 if ( $letter->{ $letter_field } =~ $re_dateonly_filter ) {
832 # We overwrite $dateonly if the filter exists and we have a time in the datetime
833 $filter_string_used = $1 || q{};
834 $dateonly = $1 unless $dateonly;
836 my $replacedby_date = eval {
837 output_pref({ dt => scalar dt_from_string( $replacedby ), dateonly => $dateonly });
839 $replacedby_date //= q{};
841 if ( $letter->{ $letter_field } ) {
842 $letter->{ $letter_field } =~ s/\Q<<$table.$field$filter_string_used>>\E/$replacedby_date/g;
843 $letter->{ $letter_field } =~ s/\Q<<$field$filter_string_used>>\E/$replacedby_date/g;
847 # Other fields replacement
849 for my $letter_field ( qw( title content ) ) {
850 if ( $letter->{ $letter_field } ) {
851 $letter->{ $letter_field } =~ s/<<$table.$field>>/$replacedby/g;
852 $letter->{ $letter_field } =~ s/<<$field>>/$replacedby/g;
858 if ($table eq 'borrowers' && $letter->{content}) {
859 my $patron = Koha::Patrons->find( $values->{borrowernumber} );
861 my $attributes = $patron->extended_attributes;
863 while ( my $attribute = $attributes->next ) {
864 my $code = $attribute->code;
865 my $val = $attribute->description; # FIXME - we always display intranet description here!
866 $val =~ s/\p{P}(?=$)//g if $val;
867 next unless $val gt '';
869 push @{ $attr{$code} }, $val;
871 while ( my ($code, $val_ar) = each %attr ) {
872 my $replacefield = "<<borrower-attribute:$code>>";
873 my $replacedby = join ',', @$val_ar;
874 $letter->{content} =~ s/$replacefield/$replacedby/g;
883 my $success = EnqueueLetter( { letter => $letter,
884 borrowernumber => '12', message_transport_type => 'email' } )
886 Places a letter in the message_queue database table, which will
887 eventually get processed (sent) by the process_message_queue.pl
888 cronjob when it calls SendQueuedMessages.
890 Return message_id on success
893 * letter - required; A letter hashref as returned from GetPreparedLetter
894 * message_transport_type - required; One of the available mtts
895 * borrowernumber - optional if 'to_address' is passed; The borrowernumber of the patron we enqueuing the notice for
896 * to_address - optional if 'borrowernumber' is passed; The destination email address for the notice (defaults to patron->notice_email_address)
897 * from_address - optional; The from address for the notice, defaults to patron->library->from_email_address
898 * reply_address - optional; The reply address for the notice, defaults to patron->library->reply_to
903 my $params = shift or return;
905 return unless exists $params->{'letter'};
906 # return unless exists $params->{'borrowernumber'};
907 return unless exists $params->{'message_transport_type'};
909 my $content = $params->{letter}->{content};
910 $content =~ s/\s+//g if(defined $content);
911 if ( not defined $content or $content eq '' ) {
912 Koha::Logger->get->info("Trying to add an empty message to the message queue");
916 # If we have any attachments we should encode then into the body.
917 if ( $params->{'attachments'} ) {
918 $params->{'letter'} = _add_attachments(
919 { letter => $params->{'letter'},
920 attachments => $params->{'attachments'},
925 my $dbh = C4::Context->dbh();
926 my $statement = << 'ENDSQL';
927 INSERT INTO message_queue
928 ( letter_id, borrowernumber, subject, content, metadata, letter_code, message_transport_type, status, time_queued, to_address, from_address, reply_address, content_type, failure_code )
929 VALUES ( ?, ?, ?, ?, ?, ?, ?, ?, CAST(NOW() AS DATETIME), ?, ?, ?, ?, ? )
932 my $sth = $dbh->prepare($statement);
933 my $result = $sth->execute(
934 $params->{letter}->{id} || undef, # letter.id
935 $params->{'borrowernumber'}, # borrowernumber
936 $params->{'letter'}->{'title'}, # subject
937 $params->{'letter'}->{'content'}, # content
938 $params->{'letter'}->{'metadata'} || '', # metadata
939 $params->{'letter'}->{'code'} || '', # letter_code
940 $params->{'message_transport_type'}, # message_transport_type
942 $params->{'to_address'}, # to_address
943 $params->{'from_address'}, # from_address
944 $params->{'reply_address'}, # reply_address
945 $params->{'letter'}->{'content-type'}, # content_type
946 $params->{'failure_code'} || '', # failure_code
948 return $dbh->last_insert_id(undef,undef,'message_queue', undef);
951 =head2 SendQueuedMessages ([$hashref])
953 my $sent = SendQueuedMessages({
954 letter_code => $letter_code,
955 borrowernumber => $who_letter_is_for,
961 Sends all of the 'pending' items in the message queue, unless
962 parameters are passed.
964 The letter_code, borrowernumber and limit parameters are used
965 to build a parameter set for _get_unsent_messages, thus limiting
966 which pending messages will be processed. They are all optional.
968 The verbose parameter can be used to generate debugging output.
971 Returns number of messages sent.
975 sub SendQueuedMessages {
978 my $which_unsent_messages = {
979 'message_id' => $params->{'message_id'},
980 'limit' => $params->{'limit'} // 0,
981 'borrowernumber' => $params->{'borrowernumber'} // q{},
982 'letter_code' => $params->{'letter_code'} // q{},
983 'message_transport_type' => $params->{'type'} // q{},
984 'where' => $params->{'where'} // q{},
986 my $unsent_messages = _get_unsent_messages( $which_unsent_messages );
987 MESSAGE: foreach my $message ( @$unsent_messages ) {
988 my $message_object = Koha::Notice::Messages->find( $message->{message_id} );
989 # If this fails the database is unwritable and we won't manage to send a message that continues to be marked 'pending'
990 $message_object->make_column_dirty('status');
991 return unless $message_object->store;
993 # warn Data::Dumper->Dump( [ $message ], [ 'message' ] );
994 warn sprintf( 'sending %s message to patron: %s',
995 $message->{'message_transport_type'},
996 $message->{'borrowernumber'} || 'Admin' )
997 if $params->{'verbose'};
998 # This is just begging for subclassing
999 next MESSAGE if ( lc($message->{'message_transport_type'}) eq 'rss' );
1000 if ( lc( $message->{'message_transport_type'} ) eq 'email' ) {
1001 _send_message_by_email( $message, $params->{'username'}, $params->{'password'}, $params->{'method'} );
1003 elsif ( lc( $message->{'message_transport_type'} ) eq 'sms' ) {
1004 if ( C4::Context->preference('SMSSendDriver') eq 'Email' ) {
1005 my $patron = Koha::Patrons->find( $message->{borrowernumber} );
1006 my $sms_provider = Koha::SMS::Providers->find( $patron->sms_provider_id );
1007 unless ( $sms_provider ) {
1008 warn sprintf( "Patron %s has no sms provider id set!", $message->{'borrowernumber'} ) if $params->{'verbose'};
1009 _set_message_status( { message_id => $message->{'message_id'}, status => 'failed' } );
1012 unless ( $patron->smsalertnumber ) {
1013 _set_message_status( { message_id => $message->{'message_id'}, status => 'failed' } );
1014 warn sprintf( "No smsalertnumber found for patron %s!", $message->{'borrowernumber'} ) if $params->{'verbose'};
1017 $message->{to_address} = $patron->smsalertnumber; #Sometime this is set to email - sms should always use smsalertnumber
1018 $message->{to_address} .= '@' . $sms_provider->domain();
1020 # Check for possible from_address override
1021 my $from_address = C4::Context->preference('EmailSMSSendDriverFromAddress');
1022 if ($from_address && $message->{from_address} ne $from_address) {
1023 $message->{from_address} = $from_address;
1024 _update_message_from_address($message->{'message_id'}, $message->{from_address});
1027 _update_message_to_address($message->{'message_id'}, $message->{to_address});
1028 _send_message_by_email( $message, $params->{'username'}, $params->{'password'}, $params->{'method'} );
1030 _send_message_by_sms( $message );
1034 return scalar( @$unsent_messages );
1037 =head2 GetRSSMessages
1039 my $message_list = GetRSSMessages( { limit => 10, borrowernumber => '14' } )
1041 returns a listref of all queued RSS messages for a particular person.
1045 sub GetRSSMessages {
1048 return unless $params;
1049 return unless ref $params;
1050 return unless $params->{'borrowernumber'};
1052 return _get_unsent_messages( { message_transport_type => 'rss',
1053 limit => $params->{'limit'},
1054 borrowernumber => $params->{'borrowernumber'}, } );
1057 =head2 GetPrintMessages
1059 my $message_list = GetPrintMessages( { borrowernumber => $borrowernumber } )
1061 Returns a arrayref of all queued print messages (optionally, for a particular
1066 sub GetPrintMessages {
1067 my $params = shift || {};
1069 return _get_unsent_messages( { message_transport_type => 'print',
1070 borrowernumber => $params->{'borrowernumber'},
1074 =head2 GetQueuedMessages ([$hashref])
1076 my $messages = GetQueuedMessage( { borrowernumber => '123', limit => 20 } );
1078 Fetches a list of messages from the message queue optionally filtered by borrowernumber
1079 and limited to specified limit.
1081 Return is an arrayref of hashes, each has represents a message in the message queue.
1085 sub GetQueuedMessages {
1088 my $dbh = C4::Context->dbh();
1089 my $statement = << 'ENDSQL';
1090 SELECT message_id, borrowernumber, subject, content, message_transport_type, status, time_queued, updated_on, failure_code
1096 if ( exists $params->{'borrowernumber'} ) {
1097 push @whereclauses, ' borrowernumber = ? ';
1098 push @query_params, $params->{'borrowernumber'};
1101 if ( @whereclauses ) {
1102 $statement .= ' WHERE ' . join( 'AND', @whereclauses );
1105 if ( defined $params->{'limit'} ) {
1106 $statement .= ' LIMIT ? ';
1107 push @query_params, $params->{'limit'};
1110 my $sth = $dbh->prepare( $statement );
1111 my $result = $sth->execute( @query_params );
1112 return $sth->fetchall_arrayref({});
1115 =head2 GetMessageTransportTypes
1117 my @mtt = GetMessageTransportTypes();
1119 returns an arrayref of transport types
1123 sub GetMessageTransportTypes {
1124 my $dbh = C4::Context->dbh();
1125 my $mtts = $dbh->selectcol_arrayref("
1126 SELECT message_transport_type
1127 FROM message_transport_types
1128 ORDER BY message_transport_type
1135 my $message = C4::Letters::Message($message_id);
1140 my ( $message_id ) = @_;
1141 return unless $message_id;
1142 my $dbh = C4::Context->dbh;
1143 return $dbh->selectrow_hashref(q|
1144 SELECT message_id, borrowernumber, subject, content, metadata, letter_code, message_transport_type, status, time_queued, updated_on, to_address, from_address, reply_address, content_type, failure_code
1146 WHERE message_id = ?
1147 |, {}, $message_id );
1150 =head2 ResendMessage
1152 Attempt to resend a message which has failed previously.
1154 my $has_been_resent = C4::Letters::ResendMessage($message_id);
1156 Updates the message to 'pending' status so that
1157 it will be resent later on.
1159 returns 1 on success, 0 on failure, undef if no message was found
1164 my $message_id = shift;
1165 return unless $message_id;
1167 my $message = GetMessage( $message_id );
1168 return unless $message;
1170 if ( $message->{status} ne 'pending' ) {
1171 $rv = C4::Letters::_set_message_status({
1172 message_id => $message_id,
1173 status => 'pending',
1175 $rv = $rv > 0? 1: 0;
1176 # Clear destination email address to force address update
1177 _update_message_to_address( $message_id, undef ) if $rv &&
1178 $message->{message_transport_type} eq 'email';
1183 =head2 _add_attachements
1185 _add_attachments({ letter => $letter, attachments => $attachments });
1188 letter - the standard letter hashref
1189 attachments - listref of attachments. each attachment is a hashref of:
1190 type - the mime type, like 'text/plain'
1191 content - the actual attachment
1192 filename - the name of the attachment.
1194 returns your letter object, with the content updated.
1195 This routine picks the I<content> of I<letter> and generates a MIME
1196 email, attaching the passed I<attachments> using Koha::Email. The
1197 content is replaced by the string representation of the MIME object,
1198 and the content-type is updated for later handling.
1202 sub _add_attachments {
1205 my $letter = $params->{letter};
1206 my $attachments = $params->{attachments};
1207 return $letter unless @$attachments;
1209 my $message = Koha::Email->new;
1211 if ( $letter->{is_html} ) {
1212 $message->html_body( _wrap_html( $letter->{content}, $letter->{title} ) );
1215 $message->text_body( $letter->{content} );
1218 foreach my $attachment ( @$attachments ) {
1220 Encode::encode( "UTF-8", $attachment->{content} ),
1221 content_type => $attachment->{type} || 'application/octet-stream',
1222 name => $attachment->{filename},
1223 disposition => 'attachment',
1227 $letter->{'content-type'} = SERIALIZED_EMAIL_CONTENT_TYPE;
1228 $letter->{content} = $message->as_string;
1234 =head2 _get_unsent_messages
1236 This function's parameter hash reference takes the following
1237 optional named parameters:
1238 message_transport_type: method of message sending (e.g. email, sms, etc.)
1239 Can be a single string, or an arrayref of strings
1240 borrowernumber : who the message is to be sent
1241 letter_code : type of message being sent (e.g. PASSWORD_RESET)
1242 Can be a single string, or an arrayref of strings
1243 message_id : the message_id of the message. In that case the sub will return only 1 result
1244 limit : maximum number of messages to send
1246 This function returns an array of matching hash referenced rows from
1247 message_queue with some borrower information added.
1251 sub _get_unsent_messages {
1254 my $dbh = C4::Context->dbh();
1256 SELECT mq.message_id, mq.borrowernumber, mq.subject, mq.content, mq.message_transport_type, mq.status, mq.time_queued, mq.from_address, mq.reply_address, mq.to_address, mq.content_type, b.branchcode, mq.letter_code, mq.failure_code
1257 FROM message_queue mq
1258 LEFT JOIN borrowers b ON b.borrowernumber = mq.borrowernumber
1262 my @query_params = ('pending');
1263 if ( ref $params ) {
1264 if ( $params->{'borrowernumber'} ) {
1265 $statement .= ' AND mq.borrowernumber = ? ';
1266 push @query_params, $params->{'borrowernumber'};
1268 if ( $params->{'letter_code'} ) {
1269 my @letter_codes = ref $params->{'letter_code'} eq "ARRAY" ? @{$params->{'letter_code'}} : $params->{'letter_code'};
1270 if ( @letter_codes ) {
1271 my $q = join( ",", ("?") x @letter_codes );
1272 $statement .= " AND mq.letter_code IN ( $q ) ";
1273 push @query_params, @letter_codes;
1276 if ( $params->{'message_transport_type'} ) {
1277 my @types = ref $params->{'message_transport_type'} eq "ARRAY" ? @{$params->{'message_transport_type'}} : $params->{'message_transport_type'};
1279 my $q = join( ",", ("?") x @types );
1280 $statement .= " AND message_transport_type IN ( $q ) ";
1281 push @query_params, @types;
1284 if ( $params->{message_id} ) {
1285 $statement .= ' AND message_id = ?';
1286 push @query_params, $params->{message_id};
1288 if ( $params->{where} ) {
1289 $statement .= " AND $params->{where} ";
1291 if ( $params->{'limit'} ) {
1292 $statement .= ' limit ? ';
1293 push @query_params, $params->{'limit'};
1297 my $sth = $dbh->prepare( $statement );
1298 my $result = $sth->execute( @query_params );
1299 return $sth->fetchall_arrayref({});
1302 sub _send_message_by_email {
1303 my $message = shift or return;
1304 my ($username, $password, $method) = @_;
1306 my $patron = Koha::Patrons->find( $message->{borrowernumber} );
1307 my $to_address = $message->{'to_address'};
1308 unless ($to_address) {
1310 warn "FAIL: No 'to_address' and INVALID borrowernumber ($message->{borrowernumber})";
1311 _set_message_status(
1313 message_id => $message->{'message_id'},
1315 failure_code => 'INVALID_BORNUMBER'
1320 $to_address = $patron->notice_email_address;
1321 unless ($to_address) {
1322 # warn "FAIL: No 'to_address' and no email for " . ($member->{surname} ||'') . ", borrowernumber ($message->{borrowernumber})";
1323 # warning too verbose for this more common case?
1324 _set_message_status(
1326 message_id => $message->{'message_id'},
1328 failure_code => 'NO_EMAIL'
1335 my $subject = $message->{'subject'};
1337 my $content = $message->{'content'};
1338 my $content_type = $message->{'content_type'} || 'text/plain; charset="UTF-8"';
1339 my $is_html = $content_type =~ m/html/io;
1341 my $branch_email = undef;
1342 my $branch_replyto = undef;
1343 my $branch_returnpath = undef;
1347 $library = $patron->library;
1348 $branch_email = $library->from_email_address;
1349 $branch_replyto = $library->branchreplyto;
1350 $branch_returnpath = $library->branchreturnpath;
1353 # NOTE: Patron may not be defined above so branch_email may be undefined still
1354 # so we need to fallback to KohaAdminEmailAddress as a last resort.
1356 $message->{'from_address'}
1358 || C4::Context->preference('KohaAdminEmailAddress');
1359 if( !$from_address ) {
1360 _set_message_status(
1362 message_id => $message->{'message_id'},
1364 failure_code => 'NO_FROM',
1376 C4::Context->preference('NoticeBcc')
1377 ? ( bcc => C4::Context->preference('NoticeBcc') )
1380 from => $from_address,
1381 reply_to => $message->{'reply_address'} || $branch_replyto,
1382 sender => $branch_returnpath,
1383 subject => "" . $message->{subject}
1386 if ( $message->{'content_type'} && $message->{'content_type'} eq SERIALIZED_EMAIL_CONTENT_TYPE ) {
1388 # The message has been previously composed as a valid MIME object
1389 # and serialized as a string on the DB
1390 $email = Koha::Email->new_from_string($content);
1391 $email->create($params);
1393 $email = Koha::Email->create($params);
1395 $email->html_body( _wrap_html( $content, $subject ) );
1397 $email->text_body($content);
1402 if ( ref($_) eq 'Koha::Exceptions::BadParameter' ) {
1403 _set_message_status(
1405 message_id => $message->{'message_id'},
1407 failure_code => "INVALID_EMAIL:".$_->parameter
1411 _set_message_status(
1413 message_id => $message->{'message_id'},
1415 failure_code => 'UNKNOWN_ERROR'
1421 return unless $email;
1425 $smtp_server = $library->smtp_server;
1428 $smtp_server = Koha::SMTP::Servers->get_default;
1434 sasl_username => $username,
1435 sasl_password => $password,
1440 # if initial message address was empty, coming here means that a to address was found and
1441 # queue should be updated; same if to address was overriden by Koha::Email->create
1442 _update_message_to_address( $message->{'message_id'}, $email->email->header('To') )
1443 if !$message->{to_address}
1444 || $message->{to_address} ne $email->email->header('To');
1447 $email->send_or_die({ transport => $smtp_server->transport });
1449 _set_message_status(
1451 message_id => $message->{'message_id'},
1459 _set_message_status(
1461 message_id => $message->{'message_id'},
1463 failure_code => 'SENDMAIL'
1467 carp "$Mail::Sendmail::error";
1473 my ($content, $title) = @_;
1475 my $css = C4::Context->preference("NoticeCSS") || '';
1476 $css = qq{<link rel="stylesheet" type="text/css" href="$css">} if $css;
1478 <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
1479 "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
1480 <html lang="en" xml:lang="en" xmlns="http://www.w3.org/1999/xhtml">
1482 <title>$title</title>
1483 <meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
1494 my ( $message ) = @_;
1495 my $dbh = C4::Context->dbh;
1496 my $count = $dbh->selectrow_array(q|
1499 WHERE message_transport_type = ?
1500 AND borrowernumber = ?
1502 AND CAST(updated_on AS date) = CAST(NOW() AS date)
1505 |, {}, $message->{message_transport_type}, $message->{borrowernumber}, $message->{letter_code}, $message->{content} );
1509 sub _send_message_by_sms {
1510 my $message = shift or return;
1511 my $patron = Koha::Patrons->find( $message->{borrowernumber} );
1512 _update_message_to_address($message->{message_id}, $patron->smsalertnumber) if $patron;
1514 unless ( $patron and $patron->smsalertnumber ) {
1515 _set_message_status( { message_id => $message->{'message_id'},
1517 failure_code => 'MISSING_SMS' } );
1521 if ( _is_duplicate( $message ) ) {
1522 _set_message_status(
1524 message_id => $message->{'message_id'},
1526 failure_code => 'DUPLICATE_MESSAGE'
1532 my $success = C4::SMS->send_sms(
1534 destination => $patron->smsalertnumber,
1535 message => $message->{'content'},
1540 _set_message_status(
1542 message_id => $message->{'message_id'},
1549 _set_message_status(
1551 message_id => $message->{'message_id'},
1553 failure_code => 'NO_NOTES'
1561 sub _update_message_to_address {
1563 my $dbh = C4::Context->dbh();
1564 $dbh->do('UPDATE message_queue SET to_address=? WHERE message_id=?',undef,($to,$id));
1567 sub _update_message_from_address {
1568 my ($message_id, $from_address) = @_;
1569 my $dbh = C4::Context->dbh();
1570 $dbh->do('UPDATE message_queue SET from_address = ? WHERE message_id = ?', undef, ($from_address, $message_id));
1573 sub _set_message_status {
1574 my $params = shift or return;
1576 foreach my $required_parameter ( qw( message_id status ) ) {
1577 return unless exists $params->{ $required_parameter };
1580 my $dbh = C4::Context->dbh();
1581 my $statement = 'UPDATE message_queue SET status= ?, failure_code= ? WHERE message_id = ?';
1582 my $sth = $dbh->prepare( $statement );
1583 my $result = $sth->execute( $params->{'status'},
1584 $params->{'failure_code'} || '',
1585 $params->{'message_id'} );
1590 my ( $params ) = @_;
1592 my $content = $params->{content};
1593 my $tables = $params->{tables};
1594 my $loops = $params->{loops};
1595 my $objects = $params->{objects} || {};
1596 my $substitute = $params->{substitute} || {};
1597 my $lang = defined($params->{lang}) && $params->{lang} ne 'default' ? $params->{lang} : 'en';
1598 my ($theme, $availablethemes);
1600 my $htdocs = C4::Context->config('intrahtdocs');
1601 ($theme, $lang, $availablethemes)= C4::Templates::availablethemes( $htdocs, 'about.tt', 'intranet', $lang);
1603 foreach (@$availablethemes) {
1604 push @includes, "$htdocs/$_/$lang/includes";
1605 push @includes, "$htdocs/$_/en/includes" unless $lang eq 'en';
1608 my $use_template_cache = C4::Context->config('template_cache_dir') && defined $ENV{GATEWAY_INTERFACE};
1609 my $template = Template->new(
1613 PLUGIN_BASE => 'Koha::Template::Plugin',
1614 COMPILE_EXT => $use_template_cache ? '.ttc' : '',
1615 COMPILE_DIR => $use_template_cache ? C4::Context->config('template_cache_dir') : '',
1616 INCLUDE_PATH => \@includes,
1618 ENCODING => 'UTF-8',
1620 ) or die Template->error();
1622 my $tt_params = { %{ _get_tt_params( $tables ) }, %{ _get_tt_params( $loops, 'is_a_loop' ) }, %$substitute, %$objects };
1624 $content = add_tt_filters( $content );
1625 $content = qq|[% USE KohaDates %][% USE Remove_MARC_punctuation %]$content|;
1628 my $schema = Koha::Database->new->schema;
1630 my $processed = try {
1631 $template->process( \$content, $tt_params, \$output );
1634 $schema->txn_rollback;
1636 croak "ERROR PROCESSING TEMPLATE: " . $template->error() unless $processed;
1641 sub _get_tt_params {
1642 my ($tables, $is_a_loop) = @_;
1648 article_requests => {
1649 module => 'Koha::ArticleRequests',
1650 singular => 'article_request',
1651 plural => 'article_requests',
1655 module => 'Koha::Acquisition::Baskets',
1656 singular => 'basket',
1657 plural => 'baskets',
1661 module => 'Koha::Acquisition::Booksellers',
1662 singular => 'bookseller',
1663 plural => 'booksellers',
1667 module => 'Koha::Biblios',
1668 singular => 'biblio',
1669 plural => 'biblios',
1670 pk => 'biblionumber',
1673 module => 'Koha::Biblioitems',
1674 singular => 'biblioitem',
1675 plural => 'biblioitems',
1676 pk => 'biblioitemnumber',
1679 module => 'Koha::Patrons',
1680 singular => 'borrower',
1681 plural => 'borrowers',
1682 pk => 'borrowernumber',
1685 module => 'Koha::Libraries',
1686 singular => 'branch',
1687 plural => 'branches',
1691 module => 'Koha::Account::Lines',
1692 singular => 'credit',
1693 plural => 'credits',
1694 pk => 'accountlines_id',
1697 module => 'Koha::Account::Lines',
1698 singular => 'debit',
1700 pk => 'accountlines_id',
1703 module => 'Koha::Items',
1708 additional_contents => {
1709 module => 'Koha::AdditionalContents',
1710 singular => 'additional_content',
1711 plural => 'additional_contents',
1715 module => 'Koha::AdditionalContents',
1721 module => 'Koha::Acquisition::Orders',
1722 singular => 'order',
1724 pk => 'ordernumber',
1727 module => 'Koha::Holds',
1733 module => 'Koha::Serials',
1734 singular => 'serial',
1735 plural => 'serials',
1739 module => 'Koha::Subscriptions',
1740 singular => 'subscription',
1741 plural => 'subscriptions',
1742 pk => 'subscriptionid',
1745 module => 'Koha::Suggestions',
1746 singular => 'suggestion',
1747 plural => 'suggestions',
1748 pk => 'suggestionid',
1751 module => 'Koha::Tickets',
1752 singular => 'ticket',
1753 plural => 'tickets',
1757 module => 'Koha::Ticket::Updates',
1758 singular => 'ticket_update',
1759 plural => 'ticket_updates',
1763 module => 'Koha::Checkouts',
1764 singular => 'checkout',
1765 plural => 'checkouts',
1769 module => 'Koha::Old::Checkouts',
1770 singular => 'old_checkout',
1771 plural => 'old_checkouts',
1775 module => 'Koha::Checkouts',
1776 singular => 'overdue',
1777 plural => 'overdues',
1780 borrower_modifications => {
1781 module => 'Koha::Patron::Modifications',
1782 singular => 'patron_modification',
1783 plural => 'patron_modifications',
1784 fk => 'verification_token',
1787 module => 'Koha::Illrequests',
1788 singular => 'illrequest',
1789 plural => 'illrequests',
1790 pk => 'illrequest_id'
1794 foreach my $table ( keys %$tables ) {
1795 next unless $config->{$table};
1797 my $ref = ref( $tables->{$table} ) || q{};
1798 my $module = $config->{$table}->{module};
1800 if ( can_load( modules => { $module => undef } ) ) {
1801 my $pk = $config->{$table}->{pk};
1802 my $fk = $config->{$table}->{fk};
1805 my $values = $tables->{$table} || [];
1806 unless ( ref( $values ) eq 'ARRAY' ) {
1807 croak "ERROR processing table $table. Wrong API call.";
1809 my $key = $pk ? $pk : $fk;
1810 # $key does not come from user input
1811 my $objects = $module->search(
1812 { $key => $values },
1814 # We want to retrieve the data in the same order
1816 # field is a MySQLism, but they are no other way to do it
1817 # To be generic we could do it in perl, but we will need to fetch
1818 # all the data then order them
1819 @$values ? ( order_by => \[ "field($key, " . join( ', ', @$values ) . ")" ] ) : ()
1822 $params->{ $config->{$table}->{plural} } = $objects;
1824 elsif ( $ref eq q{} || $ref eq 'HASH' ) {
1825 my $id = ref $ref eq 'HASH' ? $tables->{$table}->{$pk} : $tables->{$table};
1827 if ( $fk ) { # Using a foreign key for lookup
1828 if ( ref( $fk ) eq 'ARRAY' ) { # Foreign key is multi-column
1830 foreach my $key ( @$fk ) {
1831 $search->{$key} = $id->{$key};
1833 $object = $module->search( $search )->last();
1834 } else { # Foreign key is single column
1835 $object = $module->search( { $fk => $id } )->last();
1837 } else { # using the table's primary key for lookup
1838 $object = $module->find($id);
1840 $params->{ $config->{$table}->{singular} } = $object;
1842 else { # $ref eq 'ARRAY'
1844 if ( @{ $tables->{$table} } == 1 ) { # Param is a single key
1845 $object = $module->search( { $pk => $tables->{$table} } )->last();
1847 else { # Params are mutliple foreign keys
1848 croak "Multiple foreign keys (table $table) should be passed using an hashref";
1850 $params->{ $config->{$table}->{singular} } = $object;
1854 croak "ERROR LOADING MODULE $module: $Module::Load::Conditional::ERROR";
1858 $params->{today} = output_pref({ dt => dt_from_string, dateformat => 'iso' });
1863 =head3 add_tt_filters
1865 $content = add_tt_filters( $content );
1867 Add TT filters to some specific fields if needed.
1869 For now we only add the Remove_MARC_punctuation TT filter to biblio and biblioitem fields
1873 sub add_tt_filters {
1874 my ( $content ) = @_;
1875 $content =~ s|\[%\s*biblio\.(.*?)\s*%\]|[% biblio.$1 \| \$Remove_MARC_punctuation %]|gxms;
1876 $content =~ s|\[%\s*biblioitem\.(.*?)\s*%\]|[% biblioitem.$1 \| \$Remove_MARC_punctuation %]|gxms;
1880 =head2 get_item_content
1882 my $item = Koha::Items->find(...)->unblessed;
1883 my @item_content_fields = qw( date_due title barcode author itemnumber );
1884 my $item_content = C4::Letters::get_item_content({
1886 item_content_fields => \@item_content_fields
1889 This function generates a tab-separated list of values for the passed item. Dates
1890 are formatted following the current setup.
1894 sub get_item_content {
1895 my ( $params ) = @_;
1896 my $item = $params->{item};
1897 my $dateonly = $params->{dateonly} || 0;
1898 my $item_content_fields = $params->{item_content_fields} || [];
1900 return unless $item;
1902 my @item_info = map {
1906 { dt => dt_from_string( $item->{$_} ), dateonly => $dateonly } );
1910 } @$item_content_fields;
1911 return join( "\t", @item_info ) . "\n";