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 );
28 use C4::Log qw( logaction );
32 use Koha::Auth::TwoFactorAuth;
33 use Koha::DateUtils qw( dt_from_string output_pref );
36 use Koha::Notice::Messages;
37 use Koha::Notice::Templates;
38 use Koha::Notice::Util;
40 use Koha::SMS::Providers;
41 use Koha::SMTP::Servers;
42 use Koha::Subscriptions;
44 use constant SERIALIZED_EMAIL_CONTENT_TYPE => 'message/rfc822';
46 our (@ISA, @EXPORT_OK);
52 GetLettersAvailableForALibrary
61 GetMessageTransportTypes
69 our $domain_limits = {};
73 C4::Letters - Give functions for Letters management
81 "Letters" is the tool used in Koha to manage informations sent to the patrons and/or the library. This include some cron jobs like
82 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)
84 Letters are managed through "alerts" sent by Koha on some events. All "alert" related functions are in this module too.
86 =head2 GetLetters([$module])
88 $letters = &GetLetters($module);
89 returns informations about letters.
90 if needed, $module filters for letters given module
92 DEPRECATED - You must use Koha::Notice::Templates instead
93 The group by clause is confusing and can lead to issues
99 my $module = $filters->{module};
100 my $code = $filters->{code};
101 my $branchcode = $filters->{branchcode};
102 my $dbh = C4::Context->dbh;
103 my $letters = $dbh->selectall_arrayref(
105 SELECT code, module, name
109 . ( $module ? q| AND module = ?| : q|| )
110 . ( $code ? q| AND code = ?| : q|| )
111 . ( defined $branchcode ? q| AND branchcode = ?| : q|| )
112 . q| GROUP BY code, module, name ORDER BY name|, { Slice => {} }
113 , ( $module ? $module : () )
114 , ( $code ? $code : () )
115 , ( defined $branchcode ? $branchcode : () )
121 =head2 GetLetterTemplates
123 my $letter_templates = GetLetterTemplates(
125 module => 'circulation',
127 branchcode => 'CPL', # '' for default,
131 Return a hashref of letter templates.
135 sub GetLetterTemplates {
138 my $module = $params->{module};
139 my $code = $params->{code};
140 my $branchcode = $params->{branchcode} // '';
141 my $dbh = C4::Context->dbh;
142 return Koha::Notice::Templates->search(
146 branchcode => $branchcode,
148 C4::Context->preference('TranslateNotices')
150 : ( lang => 'default' )
156 =head2 GetLettersAvailableForALibrary
158 my $letters = GetLettersAvailableForALibrary(
160 branchcode => 'CPL', # '' for default
161 module => 'circulation',
165 Return an arrayref of letters, sorted by name.
166 If a specific letter exist for the given branchcode, it will be retrieve.
167 Otherwise the default letter will be.
171 sub GetLettersAvailableForALibrary {
173 my $branchcode = $filters->{branchcode};
174 my $module = $filters->{module};
176 croak "module should be provided" unless $module;
178 my $dbh = C4::Context->dbh;
179 my $default_letters = $dbh->selectall_arrayref(
181 SELECT module, code, branchcode, name
185 . q| AND branchcode = ''|
186 . ( $module ? q| AND module = ?| : q|| )
187 . q| ORDER BY name|, { Slice => {} }
188 , ( $module ? $module : () )
191 my $specific_letters;
193 $specific_letters = $dbh->selectall_arrayref(
195 SELECT module, code, branchcode, name
199 . q| AND branchcode = ?|
200 . ( $module ? q| AND module = ?| : q|| )
201 . q| ORDER BY name|, { Slice => {} }
203 , ( $module ? $module : () )
208 for my $l (@$default_letters) {
209 $letters{ $l->{code} } = $l;
211 for my $l (@$specific_letters) {
212 # Overwrite the default letter with the specific one.
213 $letters{ $l->{code} } = $l;
216 return [ map { $letters{$_} }
217 sort { $letters{$a}->{name} cmp $letters{$b}->{name} }
227 module => 'circulation',
233 Delete the letter. The mtt parameter is facultative.
234 If not given, all templates mathing the other parameters will be removed.
240 my $branchcode = $params->{branchcode};
241 my $module = $params->{module};
242 my $code = $params->{code};
243 my $mtt = $params->{mtt};
244 my $lang = $params->{lang};
245 my $dbh = C4::Context->dbh;
252 . ( $mtt ? q| AND message_transport_type = ?| : q|| )
253 . ( $lang? q| AND lang = ?| : q|| )
254 , undef, $branchcode, $module, $code, ( $mtt ? $mtt : () ), ( $lang ? $lang : () ) );
259 my $err = &SendAlerts($type, $externalid, $letter_code);
262 - $type : the type of alert
263 - $externalid : the id of the "object" to query
264 - $letter_code : the notice template to use
266 C<&SendAlerts> sends an email notice directly to a patron or a vendor.
268 Currently it supports ($type):
269 - claim serial issues (claimissues)
270 - claim acquisition orders (claimacquisition)
271 - send acquisition orders to the vendor (orderacquisition)
272 - notify patrons about newly received serial issues (issue)
273 - notify patrons when their account is created (members)
275 Returns undef or { error => 'message } on failure.
276 Returns true on success.
281 my ( $type, $externalid, $letter_code ) = @_;
282 my $dbh = C4::Context->dbh;
285 if ( $type eq 'issue' ) {
287 # prepare the letter...
288 # search the subscriptionid
291 "SELECT subscriptionid FROM serial WHERE serialid=?");
292 $sth->execute($externalid);
293 my ($subscriptionid) = $sth->fetchrow
294 or warn( "No subscription for '$externalid'" ),
297 # search the biblionumber
300 "SELECT biblionumber FROM subscription WHERE subscriptionid=?");
301 $sth->execute($subscriptionid);
302 my ($biblionumber) = $sth->fetchrow
303 or warn( "No biblionumber for '$subscriptionid'" ),
306 # find the list of subscribers to notify
307 my $subscription = Koha::Subscriptions->find( $subscriptionid );
308 my $subscribers = $subscription->subscribers;
309 while ( my $patron = $subscribers->next ) {
310 my $email = $patron->email or next;
312 # warn "sending issues...";
313 my $userenv = C4::Context->userenv;
314 my $library = $patron->library;
315 my $letter = GetPreparedLetter (
317 letter_code => $letter_code,
318 branchcode => $userenv->{branch},
320 'branches' => $library->branchcode,
321 'biblio' => $biblionumber,
322 'biblioitems' => $biblionumber,
323 'borrowers' => $patron->unblessed,
324 'subscription' => $subscriptionid,
325 'serial' => $externalid,
330 # FIXME: This 'default' behaviour should be moved to Koha::Email
331 my $mail = Koha::Email->create(
334 from => $library->branchemail,
335 reply_to => $library->branchreplyto,
336 sender => $library->branchreturnpath,
337 subject => "" . $letter->{title},
341 if ( $letter->{is_html} ) {
342 $mail->html_body( _wrap_html( $letter->{content}, "" . $letter->{title} ) );
345 $mail->text_body( $letter->{content} );
349 $mail->send_or_die({ transport => $library->smtp_server->transport });
352 # We expect ref($_) eq 'Email::Sender::Failure'
353 $error = $_->message;
359 return { error => $error }
363 elsif ( $type eq 'claimacquisition' or $type eq 'claimissues' or $type eq 'orderacquisition' ) {
365 # prepare the letter...
372 if ( $type eq 'claimacquisition') {
374 SELECT aqorders.*,aqbasket.*,biblio.*,biblioitems.*
376 LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno
377 LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
378 LEFT JOIN biblioitems ON aqorders.biblionumber=biblioitems.biblionumber
379 WHERE aqorders.ordernumber IN (
383 carp "No order selected";
384 return { error => "no_order_selected" };
386 $strsth .= join( ",", ('?') x @$externalid ) . ")";
387 $action = "ACQUISITION CLAIM";
388 $sthorders = $dbh->prepare($strsth);
389 $sthorders->execute( @$externalid );
390 $dataorders = $sthorders->fetchall_arrayref( {} );
393 if ($type eq 'claimissues') {
395 SELECT serial.*,subscription.*, biblio.*, biblioitems.*, aqbooksellers.*,
396 aqbooksellers.id AS booksellerid
398 LEFT JOIN subscription ON serial.subscriptionid=subscription.subscriptionid
399 LEFT JOIN biblio ON serial.biblionumber=biblio.biblionumber
400 LEFT JOIN biblioitems ON serial.biblionumber = biblioitems.biblionumber
401 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id
402 WHERE serial.serialid IN (
406 carp "No issues selected";
407 return { error => "no_issues_selected" };
410 $strsth .= join( ",", ('?') x @$externalid ) . ")";
411 $action = "SERIAL CLAIM";
412 $sthorders = $dbh->prepare($strsth);
413 $sthorders->execute( @$externalid );
414 $dataorders = $sthorders->fetchall_arrayref( {} );
417 if ( $type eq 'orderacquisition') {
418 $basketno = $externalid;
420 SELECT aqorders.*,aqbasket.*,biblio.*,biblioitems.*
422 LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno
423 LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
424 LEFT JOIN biblioitems ON aqorders.biblionumber=biblioitems.biblionumber
425 WHERE aqbasket.basketno = ?
426 AND orderstatus IN ('new','ordered')
429 unless ( $basketno ) {
430 carp "No basketnumber given";
431 return { error => "no_basketno" };
433 $action = "ACQUISITION ORDER";
434 $sthorders = $dbh->prepare($strsth);
435 $sthorders->execute($basketno);
436 $dataorders = $sthorders->fetchall_arrayref( {} );
438 aqorders => [ map { $_->{ordernumber} } @$dataorders ]
442 my $booksellerid = $dataorders->[0]->{booksellerid};
443 my $addressee = $type eq 'claimacquisition' || $type eq 'orderacquisition' ? 'acqprimary' : 'serialsprimary';
446 $dbh->prepare("SELECT * FROM aqcontacts WHERE booksellerid=? AND $type=1 ORDER BY $addressee DESC");
447 $sthcontact->execute( $booksellerid );
448 my $datacontact = $sthcontact->fetchrow_hashref;
452 push @email, $datacontact->{email} if ( $datacontact && $datacontact->{email} );
454 warn "Bookseller $booksellerid without emails";
455 return { error => "no_email" };
458 while ($addlcontact = $sthcontact->fetchrow_hashref) {
459 push @cc, $addlcontact->{email} if ( $addlcontact && $addlcontact->{email} );
462 my $userenv = C4::Context->userenv;
463 my $letter = GetPreparedLetter (
465 letter_code => $letter_code,
466 branchcode => $userenv->{branch},
468 'branches' => $userenv->{branch},
469 'aqbooksellers' => $booksellerid,
470 'aqcontacts' => $datacontact,
471 'aqbasket' => $basketno,
473 repeat => $dataorders,
476 ) or return { error => "no_letter" };
478 # Remove the order tag
479 $letter->{content} =~ s/<order>(.*?)<\/order>/$1/gxms;
482 my $library = Koha::Libraries->find( $userenv->{branch} );
483 my $mail = Koha::Email->create(
485 to => join( ',', @email ),
486 cc => join( ',', @cc ),
489 C4::Context->preference("ClaimsBccCopy")
490 && ( $type eq 'claimacquisition'
491 || $type eq 'claimissues' )
493 ? ( bcc => $userenv->{emailaddress} )
496 from => $library->branchemail
497 || C4::Context->preference('KohaAdminEmailAddress'),
498 subject => "" . $letter->{title},
502 if ( $letter->{is_html} ) {
503 $mail->html_body( _wrap_html( $letter->{content}, "" . $letter->{title} ) );
506 $mail->text_body( "" . $letter->{content} );
510 $mail->send_or_die({ transport => $library->smtp_server->transport });
513 # We expect ref($_) eq 'Email::Sender::Failure'
514 $error = $_->message;
520 return { error => $error }
523 my $log_object = $action eq 'ACQUISITION ORDER' ? $externalid : undef;
524 my $module = $action eq 'ACQUISITION ORDER' ? 'ACQUISITIONS' : 'CLAIMS';
530 . join( ',', @email )
535 ) if C4::Context->preference("ClaimsLog");
538 # If we come here, return an OK status
542 =head2 GetPreparedLetter( %params )
545 module => letter module, mandatory
546 letter_code => letter code, mandatory
547 branchcode => for letter selection, if missing default system letter taken
548 tables => a hashref with table names as keys. Values are either:
549 - a scalar - primary key value
550 - an arrayref - primary key values
551 - a hashref - full record
552 substitute => custom substitution key/value pairs
553 repeat => records to be substituted on consecutive lines:
554 - an arrayref - tries to guess what needs substituting by
555 taking remaining << >> tokensr; not recommended
556 - a hashref token => @tables - replaces <token> << >> << >> </token>
557 subtemplate for each @tables row; table is a hashref as above
558 want_librarian => boolean, if set to true triggers librarian details
559 substitution from the userenv
561 letter fields hashref (title & content useful)
565 sub GetPreparedLetter {
568 my $letter = $params{letter};
569 my $lang = $params{lang} || 'default';
572 my $module = $params{module} or croak "No module";
573 my $letter_code = $params{letter_code} or croak "No letter_code";
574 my $branchcode = $params{branchcode} || '';
575 my $mtt = $params{message_transport_type} || 'email';
577 my $template = Koha::Notice::Templates->find_effective_template(
580 code => $letter_code,
581 branchcode => $branchcode,
582 message_transport_type => $mtt,
587 unless ( $template ) {
588 warn( "No $module $letter_code letter transported by " . $mtt );
592 $letter = $template->unblessed;
593 $letter->{'content-type'} = 'text/html; charset="UTF-8"' if $letter->{is_html};
596 my $objects = $params{objects} || {};
597 my $tables = $params{tables} || {};
598 my $substitute = $params{substitute} || {};
599 my $loops = $params{loops} || {}; # loops is not supported for historical notices syntax
600 my $repeat = $params{repeat};
601 %$tables || %$substitute || $repeat || %$loops || %$objects
602 or carp( "ERROR: nothing to substitute - all of 'objects', 'tables', 'loops' and 'substitute' are empty" ),
604 my $want_librarian = $params{want_librarian};
607 while ( my ($token, $val) = each %$substitute ) {
609 if ( $token eq 'items.content' ) {
610 $val =~ s|\n|<br/>|g if $letter->{is_html};
613 $letter->{title} =~ s/<<$token>>/$val/g;
614 $letter->{content} =~ s/<<$token>>/$val/g;
618 my $OPACBaseURL = C4::Context->preference('OPACBaseURL');
619 $letter->{content} =~ s/<<OPACBaseURL>>/$OPACBaseURL/go;
621 if ($want_librarian) {
622 # parsing librarian name
623 my $userenv = C4::Context->userenv;
624 $letter->{content} =~ s/<<LibrarianFirstname>>/$userenv->{firstname}/go;
625 $letter->{content} =~ s/<<LibrarianSurname>>/$userenv->{surname}/go;
626 $letter->{content} =~ s/<<LibrarianEmailaddress>>/$userenv->{emailaddress}/go;
629 my ($repeat_no_enclosing_tags, $repeat_enclosing_tags);
632 if (ref ($repeat) eq 'ARRAY' ) {
633 $repeat_no_enclosing_tags = $repeat;
635 $repeat_enclosing_tags = $repeat;
639 if ($repeat_enclosing_tags) {
640 while ( my ($tag, $tag_tables) = each %$repeat_enclosing_tags ) {
641 if ( $letter->{content} =~ m!<$tag>(.*)</$tag>!s ) {
644 my %subletter = ( title => '', content => $subcontent );
645 _substitute_tables( \%subletter, $_ );
648 $letter->{content} =~ s!<$tag>.*</$tag>!join( "\n", @lines )!se;
654 _substitute_tables( $letter, $tables );
657 if ($repeat_no_enclosing_tags) {
658 if ( $letter->{content} =~ m/[^\n]*<<.*>>[^\n]*/so ) {
663 $c =~ s/<<count>>/$i/go;
664 foreach my $field ( keys %{$_} ) {
665 $c =~ s/(<<[^\.]+.$field>>)/$_->{$field}/;
669 } @$repeat_no_enclosing_tags;
671 my $replaceby = join( "\n", @lines );
672 $letter->{content} =~ s/\Q$line\E/$replaceby/s;
676 $letter->{content} = _process_tt(
678 content => $letter->{content},
682 substitute => $substitute,
687 $letter->{title} = _process_tt(
689 content => $letter->{title},
693 substitute => $substitute,
698 $letter->{content} =~ s/<<\S*>>//go; #remove any stragglers
703 sub _substitute_tables {
704 my ( $letter, $tables ) = @_;
705 while ( my ($table, $param) = each %$tables ) {
708 my $ref = ref $param;
711 if ($ref && $ref eq 'HASH') {
715 my $sth = _parseletter_sth($table);
717 warn "_parseletter_sth('$table') failed to return a valid sth. No substitution will be done for that table.";
720 $sth->execute( $ref ? @$param : $param );
722 $values = $sth->fetchrow_hashref;
726 _parseletter ( $letter, $table, $values );
730 sub _parseletter_sth {
734 carp "ERROR: _parseletter_sth() called without argument (table)";
737 # NOTE: we used to check whether we had a statement handle cached in
738 # a %handles module-level variable. This was a dumb move and
739 # broke things for the rest of us. prepare_cached is a better
740 # way to cache statement handles anyway.
742 ($table eq 'accountlines' ) ? "SELECT * FROM $table WHERE accountlines_id = ?" :
743 ($table eq 'biblio' ) ? "SELECT * FROM $table WHERE biblionumber = ?" :
744 ($table eq 'biblioitems' ) ? "SELECT * FROM $table WHERE biblionumber = ?" :
745 ($table eq 'tickets' ) ? "SELECT * FROM $table WHERE id = ?" :
746 ($table eq 'ticket_updates' ) ? "SELECT * FROM $table WHERE id = ?" :
747 ($table eq 'credits' ) ? "SELECT * FROM accountlines WHERE accountlines_id = ?" :
748 ($table eq 'debits' ) ? "SELECT * FROM accountlines WHERE accountlines_id = ?" :
749 ($table eq 'items' ) ? "SELECT * FROM $table WHERE itemnumber = ?" :
750 ($table eq 'issues' ) ? "SELECT * FROM $table WHERE itemnumber = ?" :
751 ($table eq 'old_issues' ) ? "SELECT * FROM $table WHERE issue_id = ?" :
752 ($table eq 'reserves' ) ? "SELECT * FROM $table WHERE borrowernumber = ? and biblionumber = ?" :
753 ($table eq 'borrowers' ) ? "SELECT * FROM $table WHERE borrowernumber = ?" :
754 ($table eq 'branches' ) ? "SELECT * FROM $table WHERE branchcode = ?" :
755 ($table eq 'suggestions' ) ? "SELECT * FROM $table WHERE suggestionid = ?" :
756 ($table eq 'aqbooksellers') ? "SELECT * FROM $table WHERE id = ?" :
757 ($table eq 'aqorders' ) ? "SELECT * FROM $table WHERE ordernumber = ?" :
758 ($table eq 'aqbasket' ) ? "SELECT * FROM $table WHERE basketno = ?" :
759 ($table eq 'illrequests' ) ? "SELECT * FROM $table WHERE illrequest_id = ?" :
760 ($table eq 'article_requests') ? "SELECT * FROM $table WHERE id = ?" :
761 ($table eq 'borrower_modifications') ? "SELECT * FROM $table WHERE verification_token = ?" :
762 ($table eq 'subscription') ? "SELECT * FROM $table WHERE subscriptionid = ?" :
763 ($table eq 'serial') ? "SELECT * FROM $table WHERE serialid = ?" :
764 ($table eq 'problem_reports') ? "SELECT * FROM $table WHERE reportid = ?" :
765 ($table eq 'additional_contents' || $table eq 'opac_news') ? "SELECT * FROM additional_contents WHERE idnew = ?" :
766 ($table eq 'recalls') ? "SELECT * FROM $table WHERE recall_id = ?" :
769 warn "ERROR: No _parseletter_sth query for table '$table'";
770 return; # nothing to get
772 unless ($sth = C4::Context->dbh->prepare_cached($query)) {
773 warn "ERROR: Failed to prepare query: '$query'";
776 return $sth; # now cache is populated for that $table
779 =head2 _parseletter($letter, $table, $values)
782 - $letter : a hash to letter fields (title & content useful)
783 - $table : the Koha table to parse.
784 - $values_in : table record hashref
785 parse all fields from a table, and replace values in title & content with the appropriate value
786 (not exported sub, used only internally)
791 my ( $letter, $table, $values_in ) = @_;
793 # Work on a local copy of $values_in (passed by reference) to avoid side effects
794 # in callers ( by changing / formatting values )
795 my $values = $values_in ? { %$values_in } : {};
797 # FIXME Dates formatting must be done in notice's templates
798 if ( $table eq 'borrowers' && $values->{'dateexpiry'} ){
799 $values->{'dateexpiry'} = output_pref({ dt => dt_from_string( $values->{'dateexpiry'} ), dateonly => 1 });
802 if ( $table eq 'reserves' && $values->{'waitingdate'} ) {
803 $values->{'waitingdate'} = output_pref({ dt => dt_from_string( $values->{'waitingdate'} ), dateonly => 1 });
806 if ($letter->{content} && $letter->{content} =~ /<<today>>/) {
807 my $todaysdate = output_pref( dt_from_string() );
808 $letter->{content} =~ s/<<today>>/$todaysdate/go;
811 while ( my ($field, $val) = each %$values ) {
812 $val =~ s/\p{P}$// if $val && $table=~/biblio/;
813 #BZ 9886: Assuming that we want to eliminate ISBD punctuation here
814 #Therefore adding the test on biblio. This includes biblioitems,
815 #but excludes items. Removed unneeded global and lookahead.
817 if ( $table=~/^borrowers$/ && $field=~/^streettype$/ ) {
818 my $av = Koha::AuthorisedValues->search({ category => 'ROADTYPE', authorised_value => $val });
819 $val = $av->count ? $av->next->lib : '';
823 my $replacedby = defined ($val) ? $val : '';
825 and not $replacedby =~ m|9999-12-31|
826 and $replacedby =~ m|^\d{4}-\d{2}-\d{2}( \d{2}:\d{2}:\d{2})?$| )
828 # If the value is XXXX-YY-ZZ[ AA:BB:CC] we assume it is a date
829 my $dateonly = defined $1 ? 0 : 1; #$1 refers to the capture group wrapped in parentheses. In this case, that's the hours, minutes, seconds.
830 my $re_dateonly_filter = qr{ $field( \s* \| \s* dateonly\s*)?>> }xms;
832 for my $letter_field ( qw( title content ) ) {
833 my $filter_string_used = q{};
834 if ( $letter->{ $letter_field } =~ $re_dateonly_filter ) {
835 # We overwrite $dateonly if the filter exists and we have a time in the datetime
836 $filter_string_used = $1 || q{};
837 $dateonly = $1 unless $dateonly;
839 my $replacedby_date = eval {
840 output_pref({ dt => scalar dt_from_string( $replacedby ), dateonly => $dateonly });
842 $replacedby_date //= q{};
844 if ( $letter->{ $letter_field } ) {
845 $letter->{ $letter_field } =~ s/\Q<<$table.$field$filter_string_used>>\E/$replacedby_date/g;
846 $letter->{ $letter_field } =~ s/\Q<<$field$filter_string_used>>\E/$replacedby_date/g;
850 # Other fields replacement
852 for my $letter_field ( qw( title content ) ) {
853 if ( $letter->{ $letter_field } ) {
854 $letter->{ $letter_field } =~ s/<<$table.$field>>/$replacedby/g;
855 $letter->{ $letter_field } =~ s/<<$field>>/$replacedby/g;
861 if ($table eq 'borrowers' && $letter->{content}) {
862 my $patron = Koha::Patrons->find( $values->{borrowernumber} );
864 my $attributes = $patron->extended_attributes;
866 while ( my $attribute = $attributes->next ) {
867 my $code = $attribute->code;
868 my $val = $attribute->description; # FIXME - we always display intranet description here!
869 $val =~ s/\p{P}(?=$)//g if $val;
870 next unless $val gt '';
872 push @{ $attr{$code} }, $val;
874 while ( my ($code, $val_ar) = each %attr ) {
875 my $replacefield = "<<borrower-attribute:$code>>";
876 my $replacedby = join ',', @$val_ar;
877 $letter->{content} =~ s/$replacefield/$replacedby/g;
886 my $success = EnqueueLetter( { letter => $letter,
887 borrowernumber => '12', message_transport_type => 'email' } )
889 Places a letter in the message_queue database table, which will
890 eventually get processed (sent) by the process_message_queue.pl
891 cronjob when it calls SendQueuedMessages.
893 Return message_id on success
896 * letter - required; A letter hashref as returned from GetPreparedLetter
897 * message_transport_type - required; One of the available mtts
898 * borrowernumber - optional if 'to_address' is passed; The borrowernumber of the patron we enqueuing the notice for
899 * to_address - optional if 'borrowernumber' is passed; The destination email address for the notice (defaults to patron->notice_email_address)
900 * from_address - optional; The from address for the notice, defaults to patron->library->from_email_address
901 * reply_address - optional; The reply address for the notice, defaults to patron->library->reply_to
906 my $params = shift or return;
908 return unless exists $params->{'letter'};
909 # return unless exists $params->{'borrowernumber'};
910 return unless exists $params->{'message_transport_type'};
912 my $content = $params->{letter}->{content};
913 $content =~ s/\s+//g if(defined $content);
914 if ( not defined $content or $content eq '' ) {
915 Koha::Logger->get->info("Trying to add an empty message to the message queue");
919 # If we have any attachments we should encode then into the body.
920 if ( $params->{'attachments'} ) {
921 $params->{'letter'} = _add_attachments(
922 { letter => $params->{'letter'},
923 attachments => $params->{'attachments'},
928 my $message = Koha::Notice::Message->new(
930 letter_id => $params->{letter}->{id} || undef,
931 borrowernumber => $params->{borrowernumber},
932 subject => $params->{letter}->{title},
933 content => $params->{letter}->{content},
934 metadata => $params->{letter}->{metadata} || q{},
935 letter_code => $params->{letter}->{code} || q{},
936 message_transport_type => $params->{message_transport_type},
938 time_queued => dt_from_string(),
939 to_address => $params->{to_address},
940 from_address => $params->{from_address},
941 reply_address => $params->{reply_address},
942 content_type => $params->{letter}->{'content-type'},
943 failure_code => $params->{failure_code} || q{},
949 =head2 SendQueuedMessages ([$hashref])
951 my $sent = SendQueuedMessages({
953 borrowernumber => $who_letter_is_for,
954 letter_code => $letter_code, # can be scalar or arrayref
955 type => $type, # can be scalar or arrayref
961 Sends 'pending' messages from the queue, based on parameters.
963 The (optional) message_id, borrowernumber, letter_code, type and where
964 parameter are used to select which pending messages will be processed. The
965 limit parameter determines the volume of results, i.e. sent messages.
967 The optional verbose parameter can be used to generate debugging output.
969 Returns number of messages sent.
973 sub SendQueuedMessages {
975 my $limit = $params->{limit};
976 my $where = $params->{where};
978 Koha::Exceptions::BadParameter->throw("Parameter message_id cannot be empty if passed.")
979 if ( exists( $params->{message_id} ) && !$params->{message_id} );
981 my $smtp_transports = {};
983 my $count_messages = 0;
984 my $unsent_messages = Koha::Notice::Messages->search({
986 $params->{message_id} ? ( message_id => $params->{message_id} ) : (),
987 $params->{borrowernumber} ? ( borrowernumber => $params->{borrowernumber} ) : (),
988 # Check for scalar or array in letter_code and type
989 ref($params->{letter_code}) && @{$params->{letter_code}} ? ( letter_code => $params->{letter_code} ) : (),
990 !ref($params->{letter_code}) && $params->{letter_code} ? ( letter_code => $params->{letter_code} ) : (),
991 ref($params->{type}) && @{$params->{type}} ? ( message_transport_type => $params->{type} ) : (), #TODO Existing inconsistency
992 !ref($params->{type}) && $params->{type} ? ( message_transport_type => $params->{type} ) : (), #TODO Existing inconsistency
994 $unsent_messages = $unsent_messages->search( \$where ) if $where;
996 $domain_limits = Koha::Notice::Util->load_domain_limits; # (re)initialize per run
997 while( ( my $message_object = $unsent_messages->next ) && ( !$limit || $count_messages < $limit ) ) {
998 my $message = $message_object->unblessed;
1000 # If this fails the database is unwritable and we won't manage to send a message that continues to be marked 'pending'
1001 $message_object->make_column_dirty('status');
1002 return unless $message_object->store;
1004 # warn Data::Dumper->Dump( [ $message ], [ 'message' ] );
1005 warn sprintf( 'Processing %s message to patron: %s',
1006 $message->{'message_transport_type'},
1007 $message->{'borrowernumber'} || 'Admin' )
1008 if $params->{'verbose'};
1009 # This is just begging for subclassing
1010 next if ( lc($message->{'message_transport_type'}) eq 'rss' );
1011 if ( lc( $message->{'message_transport_type'} ) eq 'email' ) {
1012 my $rv = _send_message_by_email( $message, $params->{'username'}, $params->{'password'}, $params->{'method'}, $smtp_transports );
1013 $count_messages++ if $rv;
1015 elsif ( lc( $message->{'message_transport_type'} ) eq 'sms' ) {
1016 if ( C4::Context->preference('SMSSendDriver') eq 'Email' ) {
1017 my $patron = Koha::Patrons->find( $message->{borrowernumber} );
1018 my $sms_provider = Koha::SMS::Providers->find( $patron->sms_provider_id );
1019 unless ( $sms_provider ) {
1020 warn sprintf( "Patron %s has no sms provider id set!", $message->{'borrowernumber'} ) if $params->{'verbose'};
1021 _set_message_status( { message_id => $message->{'message_id'}, status => 'failed' } );
1024 unless ( $patron->smsalertnumber ) {
1025 _set_message_status( { message_id => $message->{'message_id'}, status => 'failed' } );
1026 warn sprintf( "No smsalertnumber found for patron %s!", $message->{'borrowernumber'} ) if $params->{'verbose'};
1029 $message->{to_address} = $patron->smsalertnumber; #Sometime this is set to email - sms should always use smsalertnumber
1030 $message->{to_address} .= '@' . $sms_provider->domain();
1032 # Check for possible from_address override
1033 my $from_address = C4::Context->preference('EmailSMSSendDriverFromAddress');
1034 if ($from_address && $message->{from_address} ne $from_address) {
1035 $message->{from_address} = $from_address;
1036 _update_message_from_address($message->{'message_id'}, $message->{from_address});
1039 _update_message_to_address($message->{'message_id'}, $message->{to_address});
1040 my $rv = _send_message_by_email( $message, $params->{'username'}, $params->{'password'}, $params->{'method'} );
1041 $count_messages++ if $rv;
1043 my $rv = _send_message_by_sms( $message );
1044 $count_messages++ if $rv;
1048 return $count_messages;
1051 =head2 GetRSSMessages
1053 my $message_list = GetRSSMessages( { limit => 10, borrowernumber => '14' } )
1055 returns a listref of all queued RSS messages for a particular person.
1059 sub GetRSSMessages {
1062 return unless $params;
1063 return unless ref $params;
1064 return unless $params->{'borrowernumber'};
1066 return _get_unsent_messages( { message_transport_type => 'rss',
1067 limit => $params->{'limit'},
1068 borrowernumber => $params->{'borrowernumber'}, } );
1071 =head2 GetPrintMessages
1073 my $message_list = GetPrintMessages( { borrowernumber => $borrowernumber } )
1075 Returns a arrayref of all queued print messages (optionally, for a particular
1080 sub GetPrintMessages {
1081 my $params = shift || {};
1083 return _get_unsent_messages( { message_transport_type => 'print',
1084 borrowernumber => $params->{'borrowernumber'},
1088 =head2 GetQueuedMessages ([$hashref])
1090 my $messages = GetQueuedMessage( { borrowernumber => '123', limit => 20 } );
1092 Fetches a list of messages from the message queue optionally filtered by borrowernumber
1093 and limited to specified limit.
1095 Return is an arrayref of hashes, each has represents a message in the message queue.
1099 sub GetQueuedMessages {
1102 my $dbh = C4::Context->dbh();
1103 my $statement = << 'ENDSQL';
1104 SELECT message_id, borrowernumber, subject, content, message_transport_type, status, time_queued, updated_on, failure_code
1110 if ( exists $params->{'borrowernumber'} ) {
1111 push @whereclauses, ' borrowernumber = ? ';
1112 push @query_params, $params->{'borrowernumber'};
1115 if ( @whereclauses ) {
1116 $statement .= ' WHERE ' . join( 'AND', @whereclauses );
1119 if ( defined $params->{'limit'} ) {
1120 $statement .= ' LIMIT ? ';
1121 push @query_params, $params->{'limit'};
1124 my $sth = $dbh->prepare( $statement );
1125 my $result = $sth->execute( @query_params );
1126 return $sth->fetchall_arrayref({});
1129 =head2 GetMessageTransportTypes
1131 my @mtt = GetMessageTransportTypes();
1133 returns an arrayref of transport types
1137 sub GetMessageTransportTypes {
1138 my $dbh = C4::Context->dbh();
1139 my $mtts = $dbh->selectcol_arrayref("
1140 SELECT message_transport_type
1141 FROM message_transport_types
1142 ORDER BY message_transport_type
1149 my $message = C4::Letters::Message($message_id);
1154 my ( $message_id ) = @_;
1155 return unless $message_id;
1156 my $dbh = C4::Context->dbh;
1157 return $dbh->selectrow_hashref(q|
1158 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
1160 WHERE message_id = ?
1161 |, {}, $message_id );
1164 =head2 ResendMessage
1166 Attempt to resend a message which has failed previously.
1168 my $has_been_resent = C4::Letters::ResendMessage($message_id);
1170 Updates the message to 'pending' status so that
1171 it will be resent later on.
1173 returns 1 on success, 0 on failure, undef if no message was found
1178 my $message_id = shift;
1179 return unless $message_id;
1181 my $message = GetMessage( $message_id );
1182 return unless $message;
1184 if ( $message->{status} ne 'pending' ) {
1185 $rv = C4::Letters::_set_message_status({
1186 message_id => $message_id,
1187 status => 'pending',
1189 $rv = $rv > 0? 1: 0;
1190 # Clear destination email address to force address update
1191 _update_message_to_address( $message_id, undef ) if $rv &&
1192 $message->{message_transport_type} eq 'email';
1197 =head2 _add_attachements
1199 _add_attachments({ letter => $letter, attachments => $attachments });
1202 letter - the standard letter hashref
1203 attachments - listref of attachments. each attachment is a hashref of:
1204 type - the mime type, like 'text/plain'
1205 content - the actual attachment
1206 filename - the name of the attachment.
1208 returns your letter object, with the content updated.
1209 This routine picks the I<content> of I<letter> and generates a MIME
1210 email, attaching the passed I<attachments> using Koha::Email. The
1211 content is replaced by the string representation of the MIME object,
1212 and the content-type is updated for later handling.
1216 sub _add_attachments {
1219 my $letter = $params->{letter};
1220 my $attachments = $params->{attachments};
1221 return $letter unless @$attachments;
1223 my $message = Koha::Email->new;
1225 if ( $letter->{is_html} ) {
1226 $message->html_body( _wrap_html( $letter->{content}, $letter->{title} ) );
1229 $message->text_body( $letter->{content} );
1232 foreach my $attachment ( @$attachments ) {
1234 Encode::encode( "UTF-8", $attachment->{content} ),
1235 content_type => $attachment->{type} || 'application/octet-stream',
1236 name => $attachment->{filename},
1237 disposition => 'attachment',
1241 $letter->{'content-type'} = SERIALIZED_EMAIL_CONTENT_TYPE;
1242 $letter->{content} = $message->as_string;
1248 =head2 _get_unsent_messages
1250 This function's parameter hash reference takes the following
1251 optional named parameters:
1252 message_transport_type: method of message sending (e.g. email, sms, etc.)
1253 Can be a single string, or an arrayref of strings
1254 borrowernumber : who the message is to be sent
1255 letter_code : type of message being sent (e.g. PASSWORD_RESET)
1256 Can be a single string, or an arrayref of strings
1257 message_id : the message_id of the message. In that case the sub will return only 1 result
1258 limit : maximum number of messages to send
1260 This function returns an array of matching hash referenced rows from
1261 message_queue with some borrower information added.
1265 sub _get_unsent_messages {
1268 my $dbh = C4::Context->dbh();
1270 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
1271 FROM message_queue mq
1272 LEFT JOIN borrowers b ON b.borrowernumber = mq.borrowernumber
1276 my @query_params = ('pending');
1277 if ( ref $params ) {
1278 if ( $params->{'borrowernumber'} ) {
1279 $statement .= ' AND mq.borrowernumber = ? ';
1280 push @query_params, $params->{'borrowernumber'};
1282 if ( $params->{'letter_code'} ) {
1283 my @letter_codes = ref $params->{'letter_code'} eq "ARRAY" ? @{$params->{'letter_code'}} : $params->{'letter_code'};
1284 if ( @letter_codes ) {
1285 my $q = join( ",", ("?") x @letter_codes );
1286 $statement .= " AND mq.letter_code IN ( $q ) ";
1287 push @query_params, @letter_codes;
1290 if ( $params->{'message_transport_type'} ) {
1291 my @types = ref $params->{'message_transport_type'} eq "ARRAY" ? @{$params->{'message_transport_type'}} : $params->{'message_transport_type'};
1293 my $q = join( ",", ("?") x @types );
1294 $statement .= " AND message_transport_type IN ( $q ) ";
1295 push @query_params, @types;
1298 if ( $params->{message_id} ) {
1299 $statement .= ' AND message_id = ?';
1300 push @query_params, $params->{message_id};
1302 if ( $params->{where} ) {
1303 $statement .= " AND $params->{where} ";
1305 if ( $params->{'limit'} ) {
1306 $statement .= ' limit ? ';
1307 push @query_params, $params->{'limit'};
1311 my $sth = $dbh->prepare( $statement );
1312 my $result = $sth->execute( @query_params );
1313 return $sth->fetchall_arrayref({});
1316 sub _send_message_by_email {
1317 my $message = shift or return;
1318 my ( $username, $password, $method, $smtp_transports ) = @_;
1320 my $patron = Koha::Patrons->find( $message->{borrowernumber} );
1321 my $to_address = $message->{'to_address'};
1323 my @guarantor_address;
1324 my $count_guarantor_address;
1325 if (C4::Context->preference('RedirectGuaranteeEmail') && $patron) {
1326 # Get guarantor addresses
1327 my $guarantor_relationships = $patron->guarantor_relationships;
1328 my @guarantors = $guarantor_relationships->guarantors->as_list;
1329 foreach my $guarantor (@guarantors) {
1330 my $address = $guarantor->notice_email_address;
1331 push( @guarantor_address, $address ) if $address;
1333 $count_guarantor_address = scalar @guarantor_address;
1335 unless ($to_address) {
1337 warn "FAIL: No 'to_address' and INVALID borrowernumber ($message->{borrowernumber})";
1338 _set_message_status(
1340 message_id => $message->{'message_id'},
1342 failure_code => 'INVALID_BORNUMBER'
1348 $to_address = $patron->notice_email_address;
1350 if (!$to_address && !$count_guarantor_address) {
1351 warn "FAIL: No 'to_address', email address or guarantors email address for borrowernumber ($message->{borrowernumber})";
1352 _set_message_status(
1354 message_id => $message->{'message_id'},
1356 failure_code => 'NO_EMAIL'
1361 if ( !$to_address && $count_guarantor_address ) {
1362 $to_address = shift @guarantor_address;
1366 $cc_address = join( ',', @guarantor_address );
1367 _update_message_cc_address( $message->{'message_id'}, $cc_address );
1368 # Skip this message if we exceed domain limits in this run
1369 if( Koha::Notice::Util->exceeds_limit({ to => $to_address, limits => $domain_limits }) ) {
1370 # Save the to_address if you delay the message so that we dont need to look it up again
1371 _update_message_to_address( $message->{'message_id'}, $to_address )
1372 if !$message->{to_address};
1376 my $subject = $message->{'subject'};
1378 my $content = $message->{'content'};
1379 my $content_type = $message->{'content_type'} || 'text/plain; charset="UTF-8"';
1380 my $is_html = $content_type =~ m/html/io;
1382 my $branch_email = undef;
1383 my $branch_replyto = undef;
1384 my $branch_returnpath = undef;
1387 $patron //= Koha::Patrons->find( $message->{borrowernumber} ); # we might already found him
1389 $library = $patron->library;
1390 $branch_email = $library->from_email_address;
1391 $branch_replyto = $library->branchreplyto;
1392 $branch_returnpath = $library->branchreturnpath;
1395 # NOTE: Patron may not be defined above so branch_email may be undefined still
1396 # so we need to fallback to KohaAdminEmailAddress as a last resort.
1398 $message->{'from_address'}
1400 || C4::Context->preference('KohaAdminEmailAddress');
1401 if( !$from_address ) {
1402 _set_message_status(
1404 message_id => $message->{'message_id'},
1406 failure_code => 'NO_FROM',
1418 C4::Context->preference('NoticeBcc')
1419 ? ( bcc => C4::Context->preference('NoticeBcc') )
1424 ? ( cc => $cc_address )
1427 from => $from_address,
1428 reply_to => $message->{'reply_address'} || $branch_replyto,
1429 sender => $branch_returnpath,
1430 subject => "" . $message->{subject}
1433 if ( $message->{'content_type'} && $message->{'content_type'} eq SERIALIZED_EMAIL_CONTENT_TYPE ) {
1435 # The message has been previously composed as a valid MIME object
1436 # and serialized as a string on the DB
1437 $email = Koha::Email->new_from_string($content);
1438 $email->create($params);
1440 $email = Koha::Email->create($params);
1442 $email->html_body( _wrap_html( $content, $subject ) );
1444 $email->text_body($content);
1449 if ( ref($_) eq 'Koha::Exceptions::BadParameter' ) {
1450 _set_message_status(
1452 message_id => $message->{'message_id'},
1454 failure_code => "INVALID_EMAIL:".$_->parameter
1458 _set_message_status(
1460 message_id => $message->{'message_id'},
1462 failure_code => 'UNKNOWN_ERROR'
1468 return unless $email;
1472 $smtp_server = $library->smtp_server;
1475 $smtp_server = Koha::SMTP::Servers->get_default;
1481 sasl_username => $username,
1482 sasl_password => $password,
1487 # if initial message address was empty, coming here means that a to address was found and
1488 # queue should be updated; same if to address was overriden by Koha::Email->create
1489 _update_message_to_address( $message->{'message_id'}, $email->email->header('To') )
1490 if !$message->{to_address}
1491 || $message->{to_address} ne $email->email->header('To');
1493 $smtp_transports->{ $smtp_server->id // 'default' } ||= $smtp_server->transport;
1494 my $smtp_transport = $smtp_transports->{ $smtp_server->id // 'default' };
1496 _update_message_from_address( $message->{'message_id'}, $email->email->header('From') )
1497 if !$message->{from_address}
1498 || $message->{from_address} ne $email->email->header('From');
1501 $email->send_or_die({ transport => $smtp_transport });
1503 _set_message_status(
1505 message_id => $message->{'message_id'},
1513 _set_message_status(
1515 message_id => $message->{'message_id'},
1517 failure_code => 'SENDMAIL'
1521 carp "$Mail::Sendmail::error";
1527 my ($content, $title) = @_;
1529 my $css = C4::Context->preference("NoticeCSS") || '';
1530 $css = qq{<link rel="stylesheet" type="text/css" href="$css">} if $css;
1532 <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
1533 "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
1534 <html lang="en" xml:lang="en" xmlns="http://www.w3.org/1999/xhtml">
1536 <title>$title</title>
1537 <meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
1548 my ( $message ) = @_;
1549 my $dbh = C4::Context->dbh;
1550 my $count = $dbh->selectrow_array(q|
1553 WHERE message_transport_type = ?
1554 AND borrowernumber = ?
1556 AND CAST(updated_on AS date) = CAST(NOW() AS date)
1559 |, {}, $message->{message_transport_type}, $message->{borrowernumber}, $message->{letter_code}, $message->{content} );
1563 sub _send_message_by_sms {
1564 my $message = shift or return;
1565 my $patron = Koha::Patrons->find( $message->{borrowernumber} );
1566 _update_message_to_address($message->{message_id}, $patron->smsalertnumber) if $patron;
1568 unless ( $patron and $patron->smsalertnumber ) {
1569 _set_message_status( { message_id => $message->{'message_id'},
1571 failure_code => 'MISSING_SMS' } );
1575 if ( _is_duplicate( $message ) ) {
1576 _set_message_status(
1578 message_id => $message->{'message_id'},
1580 failure_code => 'DUPLICATE_MESSAGE'
1586 my $success = C4::SMS->send_sms(
1588 destination => $patron->smsalertnumber,
1589 message => $message->{'content'},
1594 _set_message_status(
1596 message_id => $message->{'message_id'},
1603 _set_message_status(
1605 message_id => $message->{'message_id'},
1607 failure_code => 'NO_NOTES'
1615 sub _update_message_to_address {
1617 my $dbh = C4::Context->dbh();
1618 $dbh->do('UPDATE message_queue SET to_address=? WHERE message_id=?',undef,($to,$id));
1621 sub _update_message_from_address {
1622 my ($message_id, $from_address) = @_;
1623 my $dbh = C4::Context->dbh();
1624 $dbh->do('UPDATE message_queue SET from_address = ? WHERE message_id = ?', undef, ($from_address, $message_id));
1627 sub _update_message_cc_address {
1628 my ($message_id, $cc_address) = @_;
1629 my $dbh = C4::Context->dbh();
1630 $dbh->do('UPDATE message_queue SET cc_address = ? WHERE message_id = ?', undef, ($cc_address, $message_id));
1633 sub _set_message_status {
1634 my $params = shift or return;
1636 foreach my $required_parameter ( qw( message_id status ) ) {
1637 return unless exists $params->{ $required_parameter };
1640 my $dbh = C4::Context->dbh();
1641 my $statement = 'UPDATE message_queue SET status= ?, failure_code= ? WHERE message_id = ?';
1642 my $sth = $dbh->prepare( $statement );
1643 my $result = $sth->execute( $params->{'status'},
1644 $params->{'failure_code'} || '',
1645 $params->{'message_id'} );
1650 my ( $params ) = @_;
1652 my $content = $params->{content};
1653 my $tables = $params->{tables};
1654 my $loops = $params->{loops};
1655 my $objects = $params->{objects} || {};
1656 my $substitute = $params->{substitute} || {};
1657 my $lang = defined($params->{lang}) && $params->{lang} ne 'default' ? $params->{lang} : 'en';
1658 my ($theme, $availablethemes);
1660 my $htdocs = C4::Context->config('intrahtdocs');
1661 ($theme, $lang, $availablethemes)= C4::Templates::availablethemes( $htdocs, 'about.tt', 'intranet', $lang);
1663 foreach (@$availablethemes) {
1664 push @includes, "$htdocs/$_/$lang/includes";
1665 push @includes, "$htdocs/$_/en/includes" unless $lang eq 'en';
1668 my $use_template_cache = C4::Context->config('template_cache_dir') && defined $ENV{GATEWAY_INTERFACE};
1669 my $template = Template->new(
1673 PLUGIN_BASE => 'Koha::Template::Plugin',
1674 COMPILE_EXT => $use_template_cache ? '.ttc' : '',
1675 COMPILE_DIR => $use_template_cache ? C4::Context->config('template_cache_dir') : '',
1676 INCLUDE_PATH => \@includes,
1678 ENCODING => 'UTF-8',
1680 ) or die Template->error();
1682 my $tt_params = { %{ _get_tt_params( $tables ) }, %{ _get_tt_params( $loops, 'is_a_loop' ) }, %$substitute, %$objects };
1684 $content = add_tt_filters( $content );
1685 $content = qq|[% USE KohaDates %][% USE Remove_MARC_punctuation %]$content|;
1688 my $schema = Koha::Database->new->schema;
1690 my $processed = try {
1691 $template->process( \$content, $tt_params, \$output );
1694 $schema->txn_rollback;
1696 croak "ERROR PROCESSING TEMPLATE: " . $template->error() unless $processed;
1701 sub _get_tt_params {
1702 my ($tables, $is_a_loop) = @_;
1708 article_requests => {
1709 module => 'Koha::ArticleRequests',
1710 singular => 'article_request',
1711 plural => 'article_requests',
1715 module => 'Koha::Acquisition::Baskets',
1716 singular => 'basket',
1717 plural => 'baskets',
1721 module => 'Koha::Acquisition::Booksellers',
1722 singular => 'bookseller',
1723 plural => 'booksellers',
1727 module => 'Koha::Biblios',
1728 singular => 'biblio',
1729 plural => 'biblios',
1730 pk => 'biblionumber',
1733 module => 'Koha::Biblioitems',
1734 singular => 'biblioitem',
1735 plural => 'biblioitems',
1736 pk => 'biblioitemnumber',
1739 module => 'Koha::Patrons',
1740 singular => 'borrower',
1741 plural => 'borrowers',
1742 pk => 'borrowernumber',
1745 module => 'Koha::Libraries',
1746 singular => 'branch',
1747 plural => 'branches',
1751 module => 'Koha::Account::Lines',
1752 singular => 'credit',
1753 plural => 'credits',
1754 pk => 'accountlines_id',
1757 module => 'Koha::Account::Lines',
1758 singular => 'debit',
1760 pk => 'accountlines_id',
1763 module => 'Koha::Items',
1768 additional_contents => {
1769 module => 'Koha::AdditionalContents',
1770 singular => 'additional_content',
1771 plural => 'additional_contents',
1775 module => 'Koha::AdditionalContents',
1781 module => 'Koha::Acquisition::Orders',
1782 singular => 'order',
1784 pk => 'ordernumber',
1787 module => 'Koha::Holds',
1793 module => 'Koha::Serials',
1794 singular => 'serial',
1795 plural => 'serials',
1799 module => 'Koha::Subscriptions',
1800 singular => 'subscription',
1801 plural => 'subscriptions',
1802 pk => 'subscriptionid',
1805 module => 'Koha::Suggestions',
1806 singular => 'suggestion',
1807 plural => 'suggestions',
1808 pk => 'suggestionid',
1811 module => 'Koha::Tickets',
1812 singular => 'ticket',
1813 plural => 'tickets',
1817 module => 'Koha::Ticket::Updates',
1818 singular => 'ticket_update',
1819 plural => 'ticket_updates',
1823 module => 'Koha::Checkouts',
1824 singular => 'checkout',
1825 plural => 'checkouts',
1829 module => 'Koha::Old::Checkouts',
1830 singular => 'old_checkout',
1831 plural => 'old_checkouts',
1835 module => 'Koha::Checkouts',
1836 singular => 'overdue',
1837 plural => 'overdues',
1840 borrower_modifications => {
1841 module => 'Koha::Patron::Modifications',
1842 singular => 'patron_modification',
1843 plural => 'patron_modifications',
1844 fk => 'verification_token',
1847 module => 'Koha::Illrequests',
1848 singular => 'illrequest',
1849 plural => 'illrequests',
1850 pk => 'illrequest_id'
1854 foreach my $table ( keys %$tables ) {
1855 next unless $config->{$table};
1857 my $ref = ref( $tables->{$table} ) || q{};
1858 my $module = $config->{$table}->{module};
1860 if ( can_load( modules => { $module => undef } ) ) {
1861 my $pk = $config->{$table}->{pk};
1862 my $fk = $config->{$table}->{fk};
1865 my $values = $tables->{$table} || [];
1866 unless ( ref( $values ) eq 'ARRAY' ) {
1867 croak "ERROR processing table $table. Wrong API call.";
1869 my $key = $pk ? $pk : $fk;
1870 # $key does not come from user input
1871 my $objects = $module->search(
1872 { $key => $values },
1874 # We want to retrieve the data in the same order
1876 # field is a MySQLism, but they are no other way to do it
1877 # To be generic we could do it in perl, but we will need to fetch
1878 # all the data then order them
1879 @$values ? ( order_by => \[ "field($key, " . join( ', ', @$values ) . ")" ] ) : ()
1882 $params->{ $config->{$table}->{plural} } = $objects;
1884 elsif ( $ref eq q{} || $ref eq 'HASH' ) {
1885 my $id = ref $ref eq 'HASH' ? $tables->{$table}->{$pk} : $tables->{$table};
1887 if ( $fk ) { # Using a foreign key for lookup
1888 if ( ref( $fk ) eq 'ARRAY' ) { # Foreign key is multi-column
1890 foreach my $key ( @$fk ) {
1891 $search->{$key} = $id->{$key};
1893 $object = $module->search( $search )->last();
1894 } else { # Foreign key is single column
1895 $object = $module->search( { $fk => $id } )->last();
1897 } else { # using the table's primary key for lookup
1898 $object = $module->find($id);
1900 $params->{ $config->{$table}->{singular} } = $object;
1902 else { # $ref eq 'ARRAY'
1904 if ( @{ $tables->{$table} } == 1 ) { # Param is a single key
1905 $object = $module->search( { $pk => $tables->{$table} } )->last();
1907 else { # Params are mutliple foreign keys
1908 croak "Multiple foreign keys (table $table) should be passed using an hashref";
1910 $params->{ $config->{$table}->{singular} } = $object;
1914 croak "ERROR LOADING MODULE $module: $Module::Load::Conditional::ERROR";
1918 $params->{today} = output_pref({ dt => dt_from_string, dateformat => 'iso' });
1923 =head3 add_tt_filters
1925 $content = add_tt_filters( $content );
1927 Add TT filters to some specific fields if needed.
1929 For now we only add the Remove_MARC_punctuation TT filter to biblio and biblioitem fields
1933 sub add_tt_filters {
1934 my ( $content ) = @_;
1935 $content =~ s|\[%\s*biblio\.(.*?)\s*%\]|[% biblio.$1 \| \$Remove_MARC_punctuation %]|gxms;
1936 $content =~ s|\[%\s*biblioitem\.(.*?)\s*%\]|[% biblioitem.$1 \| \$Remove_MARC_punctuation %]|gxms;
1940 =head2 get_item_content
1942 my $item = Koha::Items->find(...)->unblessed;
1943 my @item_content_fields = qw( date_due title barcode author itemnumber );
1944 my $item_content = C4::Letters::get_item_content({
1946 item_content_fields => \@item_content_fields
1949 This function generates a tab-separated list of values for the passed item. Dates
1950 are formatted following the current setup.
1954 sub get_item_content {
1955 my ( $params ) = @_;
1956 my $item = $params->{item};
1957 my $dateonly = $params->{dateonly} || 0;
1958 my $item_content_fields = $params->{item_content_fields} || [];
1960 return unless $item;
1962 my @item_info = map {
1966 { dt => dt_from_string( $item->{$_} ), dateonly => $dateonly } );
1970 } @$item_content_fields;
1971 return join( "\t", @item_info ) . "\n";