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} )
497 $type eq 'claimissues'
498 ? C4::Context->preference('SerialsDefaultEMailAddress')
499 : C4::Context->preference('AcquisitionsDefaultEMailAddress')
501 || $library->branchemail
502 || C4::Context->preference('KohaAdminEmailAddress'),
504 $type eq 'claimissues' && C4::Context->preference('SerialsDefaultReplyTo')
505 ? ( reply_to => C4::Context->preference('SerialsDefaultReplyTo') )
507 ( $type eq 'claimacquisition' || $type eq 'orderacquisition' )
508 && C4::Context->preference('AcquisitionsDefaultReplyTo')
509 ? ( reply_to => C4::Context->preference('AcquisitionsDefaultReplyTo') )
513 subject => "" . $letter->{title},
517 if ( $letter->{is_html} ) {
518 $mail->html_body( _wrap_html( $letter->{content}, "" . $letter->{title} ) );
521 $mail->text_body( "" . $letter->{content} );
525 $mail->send_or_die({ transport => $library->smtp_server->transport });
528 # We expect ref($_) eq 'Email::Sender::Failure'
529 $error = $_->message;
535 return { error => $error }
538 my $log_object = $action eq 'ACQUISITION ORDER' ? $externalid : undef;
539 my $module = $action eq 'ACQUISITION ORDER' ? 'ACQUISITIONS' : 'CLAIMS';
545 . join( ',', @email )
550 ) if C4::Context->preference("ClaimsLog");
553 # If we come here, return an OK status
557 =head2 GetPreparedLetter( %params )
560 module => letter module, mandatory
561 letter_code => letter code, mandatory
562 branchcode => for letter selection, if missing default system letter taken
563 tables => a hashref with table names as keys. Values are either:
564 - a scalar - primary key value
565 - an arrayref - primary key values
566 - a hashref - full record
567 substitute => custom substitution key/value pairs
568 repeat => records to be substituted on consecutive lines:
569 - an arrayref - tries to guess what needs substituting by
570 taking remaining << >> tokensr; not recommended
571 - a hashref token => @tables - replaces <token> << >> << >> </token>
572 subtemplate for each @tables row; table is a hashref as above
573 want_librarian => boolean, if set to true triggers librarian details
574 substitution from the userenv
576 letter fields hashref (title & content useful)
580 sub GetPreparedLetter {
583 my $letter = $params{letter};
584 my $lang = $params{lang} || 'default';
587 my $module = $params{module} or croak "No module";
588 my $letter_code = $params{letter_code} or croak "No letter_code";
589 my $branchcode = $params{branchcode} || '';
590 my $mtt = $params{message_transport_type} || 'email';
592 my $template = Koha::Notice::Templates->find_effective_template(
595 code => $letter_code,
596 branchcode => $branchcode,
597 message_transport_type => $mtt,
602 unless ( $template ) {
603 warn( "No $module $letter_code letter transported by " . $mtt );
607 $letter = $template->unblessed;
608 $letter->{'content-type'} = 'text/html; charset="UTF-8"' if $letter->{is_html};
611 my $objects = $params{objects} || {};
612 my $tables = $params{tables} || {};
613 my $substitute = $params{substitute} || {};
614 my $loops = $params{loops} || {}; # loops is not supported for historical notices syntax
615 my $repeat = $params{repeat};
616 %$tables || %$substitute || $repeat || %$loops || %$objects
617 or carp( "ERROR: nothing to substitute - all of 'objects', 'tables', 'loops' and 'substitute' are empty" ),
619 my $want_librarian = $params{want_librarian};
622 while ( my ($token, $val) = each %$substitute ) {
624 if ( $token eq 'items.content' ) {
625 $val =~ s|\n|<br/>|g if $letter->{is_html};
628 $letter->{title} =~ s/<<$token>>/$val/g;
629 $letter->{content} =~ s/<<$token>>/$val/g;
633 my $OPACBaseURL = C4::Context->preference('OPACBaseURL');
634 $letter->{content} =~ s/<<OPACBaseURL>>/$OPACBaseURL/go;
636 if ($want_librarian) {
637 # parsing librarian name
638 my $userenv = C4::Context->userenv;
639 $letter->{content} =~ s/<<LibrarianFirstname>>/$userenv->{firstname}/go;
640 $letter->{content} =~ s/<<LibrarianSurname>>/$userenv->{surname}/go;
641 $letter->{content} =~ s/<<LibrarianEmailaddress>>/$userenv->{emailaddress}/go;
644 my ($repeat_no_enclosing_tags, $repeat_enclosing_tags);
647 if (ref ($repeat) eq 'ARRAY' ) {
648 $repeat_no_enclosing_tags = $repeat;
650 $repeat_enclosing_tags = $repeat;
654 if ($repeat_enclosing_tags) {
655 while ( my ($tag, $tag_tables) = each %$repeat_enclosing_tags ) {
656 if ( $letter->{content} =~ m!<$tag>(.*)</$tag>!s ) {
659 my %subletter = ( title => '', content => $subcontent );
660 _substitute_tables( \%subletter, $_ );
663 $letter->{content} =~ s!<$tag>.*</$tag>!join( "\n", @lines )!se;
669 _substitute_tables( $letter, $tables );
672 if ($repeat_no_enclosing_tags) {
673 if ( $letter->{content} =~ m/[^\n]*<<.*>>[^\n]*/so ) {
678 $c =~ s/<<count>>/$i/go;
679 foreach my $field ( keys %{$_} ) {
680 $c =~ s/(<<[^\.]+.$field>>)/$_->{$field}/;
684 } @$repeat_no_enclosing_tags;
686 my $replaceby = join( "\n", @lines );
687 $letter->{content} =~ s/\Q$line\E/$replaceby/s;
691 $letter->{content} = _process_tt(
693 content => $letter->{content},
697 substitute => $substitute,
702 $letter->{title} = _process_tt(
704 content => $letter->{title},
708 substitute => $substitute,
713 $letter->{content} =~ s/<<\S*>>//go; #remove any stragglers
718 sub _substitute_tables {
719 my ( $letter, $tables ) = @_;
720 while ( my ($table, $param) = each %$tables ) {
723 my $ref = ref $param;
726 if ($ref && $ref eq 'HASH') {
730 my $sth = _parseletter_sth($table);
732 warn "_parseletter_sth('$table') failed to return a valid sth. No substitution will be done for that table.";
735 $sth->execute( $ref ? @$param : $param );
737 $values = $sth->fetchrow_hashref;
741 _parseletter ( $letter, $table, $values );
745 sub _parseletter_sth {
749 carp "ERROR: _parseletter_sth() called without argument (table)";
752 # NOTE: we used to check whether we had a statement handle cached in
753 # a %handles module-level variable. This was a dumb move and
754 # broke things for the rest of us. prepare_cached is a better
755 # way to cache statement handles anyway.
757 ($table eq 'accountlines' ) ? "SELECT * FROM $table WHERE accountlines_id = ?" :
758 ($table eq 'biblio' ) ? "SELECT * FROM $table WHERE biblionumber = ?" :
759 ($table eq 'biblioitems' ) ? "SELECT * FROM $table WHERE biblionumber = ?" :
760 ($table eq 'tickets' ) ? "SELECT * FROM $table WHERE id = ?" :
761 ($table eq 'ticket_updates' ) ? "SELECT * FROM $table WHERE id = ?" :
762 ($table eq 'credits' ) ? "SELECT * FROM accountlines WHERE accountlines_id = ?" :
763 ($table eq 'debits' ) ? "SELECT * FROM accountlines WHERE accountlines_id = ?" :
764 ($table eq 'items' ) ? "SELECT * FROM $table WHERE itemnumber = ?" :
765 ($table eq 'issues' ) ? "SELECT * FROM $table WHERE itemnumber = ?" :
766 ($table eq 'old_issues' ) ? "SELECT * FROM $table WHERE issue_id = ?" :
767 ($table eq 'reserves' ) ? "SELECT * FROM $table WHERE borrowernumber = ? and biblionumber = ?" :
768 ($table eq 'borrowers' ) ? "SELECT * FROM $table WHERE borrowernumber = ?" :
769 ($table eq 'branches' ) ? "SELECT * FROM $table WHERE branchcode = ?" :
770 ($table eq 'suggestions' ) ? "SELECT * FROM $table WHERE suggestionid = ?" :
771 ($table eq 'aqbooksellers') ? "SELECT * FROM $table WHERE id = ?" :
772 ($table eq 'aqorders' ) ? "SELECT * FROM $table WHERE ordernumber = ?" :
773 ($table eq 'aqbasket' ) ? "SELECT * FROM $table WHERE basketno = ?" :
774 ($table eq 'illrequests' ) ? "SELECT * FROM $table WHERE illrequest_id = ?" :
775 ($table eq 'article_requests') ? "SELECT * FROM $table WHERE id = ?" :
776 ($table eq 'borrower_modifications') ? "SELECT * FROM $table WHERE verification_token = ?" :
777 ($table eq 'subscription') ? "SELECT * FROM $table WHERE subscriptionid = ?" :
778 ($table eq 'serial') ? "SELECT * FROM $table WHERE serialid = ?" :
779 ($table eq 'problem_reports') ? "SELECT * FROM $table WHERE reportid = ?" :
780 ($table eq 'additional_contents' || $table eq 'opac_news') ? "SELECT * FROM additional_contents_localizations WHERE id = ?" :
781 ($table eq 'recalls') ? "SELECT * FROM $table WHERE recall_id = ?" :
784 warn "ERROR: No _parseletter_sth query for table '$table'";
785 return; # nothing to get
787 unless ($sth = C4::Context->dbh->prepare_cached($query)) {
788 warn "ERROR: Failed to prepare query: '$query'";
791 return $sth; # now cache is populated for that $table
794 =head2 _parseletter($letter, $table, $values)
797 - $letter : a hash to letter fields (title & content useful)
798 - $table : the Koha table to parse.
799 - $values_in : table record hashref
800 parse all fields from a table, and replace values in title & content with the appropriate value
801 (not exported sub, used only internally)
806 my ( $letter, $table, $values_in ) = @_;
808 # Work on a local copy of $values_in (passed by reference) to avoid side effects
809 # in callers ( by changing / formatting values )
810 my $values = $values_in ? { %$values_in } : {};
812 # FIXME Dates formatting must be done in notice's templates
813 if ( $table eq 'borrowers' && $values->{'dateexpiry'} ){
814 $values->{'dateexpiry'} = output_pref({ dt => dt_from_string( $values->{'dateexpiry'} ), dateonly => 1 });
817 if ( $table eq 'reserves' && $values->{'waitingdate'} ) {
818 $values->{'waitingdate'} = output_pref({ dt => dt_from_string( $values->{'waitingdate'} ), dateonly => 1 });
821 if ($letter->{content} && $letter->{content} =~ /<<today>>/) {
822 my $todaysdate = output_pref( dt_from_string() );
823 $letter->{content} =~ s/<<today>>/$todaysdate/go;
826 while ( my ($field, $val) = each %$values ) {
827 $val =~ s/\p{P}$// if $val && $table=~/biblio/;
828 #BZ 9886: Assuming that we want to eliminate ISBD punctuation here
829 #Therefore adding the test on biblio. This includes biblioitems,
830 #but excludes items. Removed unneeded global and lookahead.
832 if ( $table=~/^borrowers$/ && $field=~/^streettype$/ ) {
833 my $av = Koha::AuthorisedValues->search({ category => 'ROADTYPE', authorised_value => $val });
834 $val = $av->count ? $av->next->lib : '';
838 my $replacedby = defined ($val) ? $val : '';
840 and not $replacedby =~ m|9999-12-31|
841 and $replacedby =~ m|^\d{4}-\d{2}-\d{2}( \d{2}:\d{2}:\d{2})?$| )
843 # If the value is XXXX-YY-ZZ[ AA:BB:CC] we assume it is a date
844 my $dateonly = defined $1 ? 0 : 1; #$1 refers to the capture group wrapped in parentheses. In this case, that's the hours, minutes, seconds.
845 my $re_dateonly_filter = qr{ $field( \s* \| \s* dateonly\s*)?>> }xms;
847 for my $letter_field ( qw( title content ) ) {
848 my $filter_string_used = q{};
849 if ( $letter->{ $letter_field } =~ $re_dateonly_filter ) {
850 # We overwrite $dateonly if the filter exists and we have a time in the datetime
851 $filter_string_used = $1 || q{};
852 $dateonly = $1 unless $dateonly;
854 my $replacedby_date = eval {
855 output_pref({ dt => scalar dt_from_string( $replacedby ), dateonly => $dateonly });
857 $replacedby_date //= q{};
859 if ( $letter->{ $letter_field } ) {
860 $letter->{ $letter_field } =~ s/\Q<<$table.$field$filter_string_used>>\E/$replacedby_date/g;
861 $letter->{ $letter_field } =~ s/\Q<<$field$filter_string_used>>\E/$replacedby_date/g;
865 # Other fields replacement
867 for my $letter_field ( qw( title content ) ) {
868 if ( $letter->{ $letter_field } ) {
869 $letter->{ $letter_field } =~ s/<<$table.$field>>/$replacedby/g;
870 $letter->{ $letter_field } =~ s/<<$field>>/$replacedby/g;
876 if ($table eq 'borrowers' && $letter->{content}) {
877 my $patron = Koha::Patrons->find( $values->{borrowernumber} );
879 my $attributes = $patron->extended_attributes;
881 while ( my $attribute = $attributes->next ) {
882 my $code = $attribute->code;
883 my $val = $attribute->description; # FIXME - we always display intranet description here!
884 $val =~ s/\p{P}(?=$)//g if $val;
885 next unless $val gt '';
887 push @{ $attr{$code} }, $val;
889 while ( my ($code, $val_ar) = each %attr ) {
890 my $replacefield = "<<borrower-attribute:$code>>";
891 my $replacedby = join ',', @$val_ar;
892 $letter->{content} =~ s/$replacefield/$replacedby/g;
901 my $success = EnqueueLetter( { letter => $letter,
902 borrowernumber => '12', message_transport_type => 'email' } )
904 Places a letter in the message_queue database table, which will
905 eventually get processed (sent) by the process_message_queue.pl
906 cronjob when it calls SendQueuedMessages.
908 Return message_id on success
911 * letter - required; A letter hashref as returned from GetPreparedLetter
912 * message_transport_type - required; One of the available mtts
913 * borrowernumber - optional if 'to_address' is passed; The borrowernumber of the patron we enqueuing the notice for
914 * to_address - optional if 'borrowernumber' is passed; The destination email address for the notice (defaults to patron->notice_email_address)
915 * from_address - optional; The from address for the notice, defaults to patron->library->from_email_address
916 * reply_address - optional; The reply address for the notice, defaults to patron->library->reply_to
921 my $params = shift or return;
923 return unless exists $params->{'letter'};
924 # return unless exists $params->{'borrowernumber'};
925 return unless exists $params->{'message_transport_type'};
927 my $content = $params->{letter}->{content};
928 $content =~ s/\s+//g if(defined $content);
929 if ( not defined $content or $content eq '' ) {
930 Koha::Logger->get->info("Trying to add an empty message to the message queue");
934 # If we have any attachments we should encode then into the body.
935 if ( $params->{'attachments'} ) {
936 $params->{'letter'} = _add_attachments(
937 { letter => $params->{'letter'},
938 attachments => $params->{'attachments'},
943 my $message = Koha::Notice::Message->new(
945 letter_id => $params->{letter}->{id} || undef,
946 borrowernumber => $params->{borrowernumber},
947 subject => $params->{letter}->{title},
948 content => $params->{letter}->{content},
949 metadata => $params->{letter}->{metadata} || q{},
950 letter_code => $params->{letter}->{code} || q{},
951 message_transport_type => $params->{message_transport_type},
953 time_queued => dt_from_string(),
954 to_address => $params->{to_address},
955 from_address => $params->{from_address},
956 reply_address => $params->{reply_address},
957 content_type => $params->{letter}->{'content-type'},
958 failure_code => $params->{failure_code} || q{},
964 =head2 SendQueuedMessages ([$hashref])
966 my $sent = SendQueuedMessages({
968 borrowernumber => $who_letter_is_for,
969 letter_code => $letter_code, # can be scalar or arrayref
970 type => $type, # can be scalar or arrayref
976 Sends 'pending' messages from the queue, based on parameters.
978 The (optional) message_id, borrowernumber, letter_code, type and where
979 parameter are used to select which pending messages will be processed. The
980 limit parameter determines the volume of results, i.e. sent messages.
982 The optional verbose parameter can be used to generate debugging output.
984 Returns number of messages sent.
988 sub SendQueuedMessages {
990 my $limit = $params->{limit};
991 my $where = $params->{where};
993 Koha::Exceptions::BadParameter->throw("Parameter message_id cannot be empty if passed.")
994 if ( exists( $params->{message_id} ) && !$params->{message_id} );
996 my $smtp_transports = {};
998 my $count_messages = 0;
999 my $unsent_messages = Koha::Notice::Messages->search({
1000 status => 'pending',
1001 $params->{message_id} ? ( message_id => $params->{message_id} ) : (),
1002 $params->{borrowernumber} ? ( borrowernumber => $params->{borrowernumber} ) : (),
1003 # Check for scalar or array in letter_code and type
1004 ref($params->{letter_code}) && @{$params->{letter_code}} ? ( letter_code => $params->{letter_code} ) : (),
1005 !ref($params->{letter_code}) && $params->{letter_code} ? ( letter_code => $params->{letter_code} ) : (),
1006 ref($params->{type}) && @{$params->{type}} ? ( message_transport_type => $params->{type} ) : (), #TODO Existing inconsistency
1007 !ref($params->{type}) && $params->{type} ? ( message_transport_type => $params->{type} ) : (), #TODO Existing inconsistency
1009 $unsent_messages = $unsent_messages->search( \$where ) if $where;
1011 $domain_limits = Koha::Notice::Util->load_domain_limits; # (re)initialize per run
1012 while( ( my $message_object = $unsent_messages->next ) && ( !$limit || $count_messages < $limit ) ) {
1013 my $message = $message_object->unblessed;
1015 # If this fails the database is unwritable and we won't manage to send a message that continues to be marked 'pending'
1016 $message_object->make_column_dirty('status');
1017 return unless $message_object->store;
1019 # warn Data::Dumper->Dump( [ $message ], [ 'message' ] );
1020 warn sprintf( 'Processing %s message to patron: %s',
1021 $message->{'message_transport_type'},
1022 $message->{'borrowernumber'} || 'Admin' )
1023 if $params->{'verbose'};
1024 # This is just begging for subclassing
1025 next if ( lc($message->{'message_transport_type'}) eq 'rss' );
1026 if ( lc( $message->{'message_transport_type'} ) eq 'email' ) {
1027 my $rv = _send_message_by_email( $message, $params->{'username'}, $params->{'password'}, $params->{'method'}, $smtp_transports );
1028 $count_messages++ if $rv;
1030 elsif ( lc( $message->{'message_transport_type'} ) eq 'sms' ) {
1031 if ( C4::Context->preference('SMSSendDriver') eq 'Email' ) {
1032 my $patron = Koha::Patrons->find( $message->{borrowernumber} );
1033 my $sms_provider = Koha::SMS::Providers->find( $patron->sms_provider_id );
1034 unless ( $sms_provider ) {
1035 warn sprintf( "Patron %s has no sms provider id set!", $message->{'borrowernumber'} ) if $params->{'verbose'};
1036 _set_message_status( { message_id => $message->{'message_id'}, status => 'failed' } );
1039 unless ( $patron->smsalertnumber ) {
1040 _set_message_status( { message_id => $message->{'message_id'}, status => 'failed' } );
1041 warn sprintf( "No smsalertnumber found for patron %s!", $message->{'borrowernumber'} ) if $params->{'verbose'};
1044 $message->{to_address} = $patron->smsalertnumber; #Sometime this is set to email - sms should always use smsalertnumber
1045 $message->{to_address} .= '@' . $sms_provider->domain();
1047 # Check for possible from_address override
1048 my $from_address = C4::Context->preference('EmailSMSSendDriverFromAddress');
1049 if ($from_address && $message->{from_address} ne $from_address) {
1050 $message->{from_address} = $from_address;
1051 _update_message_from_address($message->{'message_id'}, $message->{from_address});
1054 _update_message_to_address($message->{'message_id'}, $message->{to_address});
1055 my $rv = _send_message_by_email( $message, $params->{'username'}, $params->{'password'}, $params->{'method'} );
1056 $count_messages++ if $rv;
1058 my $rv = _send_message_by_sms( $message );
1059 $count_messages++ if $rv;
1063 return $count_messages;
1066 =head2 GetRSSMessages
1068 my $message_list = GetRSSMessages( { limit => 10, borrowernumber => '14' } )
1070 returns a listref of all queued RSS messages for a particular person.
1074 sub GetRSSMessages {
1077 return unless $params;
1078 return unless ref $params;
1079 return unless $params->{'borrowernumber'};
1081 return _get_unsent_messages( { message_transport_type => 'rss',
1082 limit => $params->{'limit'},
1083 borrowernumber => $params->{'borrowernumber'}, } );
1086 =head2 GetPrintMessages
1088 my $message_list = GetPrintMessages( { borrowernumber => $borrowernumber } )
1090 Returns a arrayref of all queued print messages (optionally, for a particular
1095 sub GetPrintMessages {
1096 my $params = shift || {};
1098 return _get_unsent_messages( { message_transport_type => 'print',
1099 borrowernumber => $params->{'borrowernumber'},
1103 =head2 GetQueuedMessages ([$hashref])
1105 my $messages = GetQueuedMessage( { borrowernumber => '123', limit => 20 } );
1107 Fetches a list of messages from the message queue optionally filtered by borrowernumber
1108 and limited to specified limit.
1110 Return is an arrayref of hashes, each has represents a message in the message queue.
1114 sub GetQueuedMessages {
1117 my $dbh = C4::Context->dbh();
1118 my $statement = << 'ENDSQL';
1119 SELECT message_id, borrowernumber, subject, content, message_transport_type, status, time_queued, updated_on, failure_code, from_address, to_address, cc_address
1125 if ( exists $params->{'borrowernumber'} ) {
1126 push @whereclauses, ' borrowernumber = ? ';
1127 push @query_params, $params->{'borrowernumber'};
1130 if ( @whereclauses ) {
1131 $statement .= ' WHERE ' . join( 'AND', @whereclauses );
1134 if ( defined $params->{'limit'} ) {
1135 $statement .= ' LIMIT ? ';
1136 push @query_params, $params->{'limit'};
1139 my $sth = $dbh->prepare( $statement );
1140 my $result = $sth->execute( @query_params );
1141 return $sth->fetchall_arrayref({});
1144 =head2 GetMessageTransportTypes
1146 my @mtt = GetMessageTransportTypes();
1148 returns an arrayref of transport types
1152 sub GetMessageTransportTypes {
1153 my $dbh = C4::Context->dbh();
1154 my $mtts = $dbh->selectcol_arrayref("
1155 SELECT message_transport_type
1156 FROM message_transport_types
1157 ORDER BY message_transport_type
1164 my $message = C4::Letters::Message($message_id);
1169 my ( $message_id ) = @_;
1170 return unless $message_id;
1171 my $dbh = C4::Context->dbh;
1172 return $dbh->selectrow_hashref(q|
1173 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
1175 WHERE message_id = ?
1176 |, {}, $message_id );
1179 =head2 ResendMessage
1181 Attempt to resend a message which has failed previously.
1183 my $has_been_resent = C4::Letters::ResendMessage($message_id);
1185 Updates the message to 'pending' status so that
1186 it will be resent later on.
1188 returns 1 on success, 0 on failure, undef if no message was found
1193 my $message_id = shift;
1194 return unless $message_id;
1196 my $message = GetMessage( $message_id );
1197 return unless $message;
1199 if ( $message->{status} ne 'pending' ) {
1200 $rv = C4::Letters::_set_message_status({
1201 message_id => $message_id,
1202 status => 'pending',
1204 $rv = $rv > 0? 1: 0;
1205 # Clear destination email address to force address update
1206 _update_message_to_address( $message_id, undef ) if $rv &&
1207 $message->{message_transport_type} eq 'email';
1212 =head2 _add_attachements
1214 _add_attachments({ letter => $letter, attachments => $attachments });
1217 letter - the standard letter hashref
1218 attachments - listref of attachments. each attachment is a hashref of:
1219 type - the mime type, like 'text/plain'
1220 content - the actual attachment
1221 filename - the name of the attachment.
1223 returns your letter object, with the content updated.
1224 This routine picks the I<content> of I<letter> and generates a MIME
1225 email, attaching the passed I<attachments> using Koha::Email. The
1226 content is replaced by the string representation of the MIME object,
1227 and the content-type is updated for later handling.
1231 sub _add_attachments {
1234 my $letter = $params->{letter};
1235 my $attachments = $params->{attachments};
1236 return $letter unless @$attachments;
1238 my $message = Koha::Email->new;
1240 if ( $letter->{is_html} ) {
1241 $message->html_body( _wrap_html( $letter->{content}, $letter->{title} ) );
1244 $message->text_body( $letter->{content} );
1247 foreach my $attachment ( @$attachments ) {
1249 Encode::encode( "UTF-8", $attachment->{content} ),
1250 content_type => $attachment->{type} || 'application/octet-stream',
1251 name => $attachment->{filename},
1252 disposition => 'attachment',
1256 $letter->{'content-type'} = SERIALIZED_EMAIL_CONTENT_TYPE;
1257 $letter->{content} = $message->as_string;
1263 =head2 _get_unsent_messages
1265 This function's parameter hash reference takes the following
1266 optional named parameters:
1267 message_transport_type: method of message sending (e.g. email, sms, etc.)
1268 Can be a single string, or an arrayref of strings
1269 borrowernumber : who the message is to be sent
1270 letter_code : type of message being sent (e.g. PASSWORD_RESET)
1271 Can be a single string, or an arrayref of strings
1272 message_id : the message_id of the message. In that case the sub will return only 1 result
1273 limit : maximum number of messages to send
1275 This function returns an array of matching hash referenced rows from
1276 message_queue with some borrower information added.
1280 sub _get_unsent_messages {
1283 my $dbh = C4::Context->dbh();
1285 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
1286 FROM message_queue mq
1287 LEFT JOIN borrowers b ON b.borrowernumber = mq.borrowernumber
1291 my @query_params = ('pending');
1292 if ( ref $params ) {
1293 if ( $params->{'borrowernumber'} ) {
1294 $statement .= ' AND mq.borrowernumber = ? ';
1295 push @query_params, $params->{'borrowernumber'};
1297 if ( $params->{'letter_code'} ) {
1298 my @letter_codes = ref $params->{'letter_code'} eq "ARRAY" ? @{$params->{'letter_code'}} : $params->{'letter_code'};
1299 if ( @letter_codes ) {
1300 my $q = join( ",", ("?") x @letter_codes );
1301 $statement .= " AND mq.letter_code IN ( $q ) ";
1302 push @query_params, @letter_codes;
1305 if ( $params->{'message_transport_type'} ) {
1306 my @types = ref $params->{'message_transport_type'} eq "ARRAY" ? @{$params->{'message_transport_type'}} : $params->{'message_transport_type'};
1308 my $q = join( ",", ("?") x @types );
1309 $statement .= " AND message_transport_type IN ( $q ) ";
1310 push @query_params, @types;
1313 if ( $params->{message_id} ) {
1314 $statement .= ' AND message_id = ?';
1315 push @query_params, $params->{message_id};
1317 if ( $params->{where} ) {
1318 $statement .= " AND $params->{where} ";
1320 if ( $params->{'limit'} ) {
1321 $statement .= ' limit ? ';
1322 push @query_params, $params->{'limit'};
1326 my $sth = $dbh->prepare( $statement );
1327 my $result = $sth->execute( @query_params );
1328 return $sth->fetchall_arrayref({});
1331 sub _send_message_by_email {
1332 my $message = shift or return;
1333 my ( $username, $password, $method, $smtp_transports ) = @_;
1335 my $patron = Koha::Patrons->find( $message->{borrowernumber} );
1336 my $to_address = $message->{'to_address'};
1338 my @guarantor_address;
1339 my $count_guarantor_address;
1340 if (C4::Context->preference('RedirectGuaranteeEmail') && $patron) {
1341 # Get guarantor addresses
1342 my $guarantor_relationships = $patron->guarantor_relationships;
1343 my @guarantors = $guarantor_relationships->guarantors->as_list;
1344 foreach my $guarantor (@guarantors) {
1345 my $address = $guarantor->notice_email_address;
1346 push( @guarantor_address, $address ) if $address;
1348 $count_guarantor_address = scalar @guarantor_address;
1350 unless ($to_address) {
1352 warn "FAIL: No 'to_address' and INVALID borrowernumber ($message->{borrowernumber})";
1353 _set_message_status(
1355 message_id => $message->{'message_id'},
1357 failure_code => 'INVALID_BORNUMBER'
1363 $to_address = $patron->notice_email_address;
1365 if (!$to_address && !$count_guarantor_address) {
1366 warn "FAIL: No 'to_address', email address or guarantors email address for borrowernumber ($message->{borrowernumber})";
1367 _set_message_status(
1369 message_id => $message->{'message_id'},
1371 failure_code => 'NO_EMAIL'
1376 if ( !$to_address && $count_guarantor_address ) {
1377 $to_address = shift @guarantor_address;
1381 $cc_address = join( ',', @guarantor_address );
1382 _update_message_cc_address( $message->{'message_id'}, $cc_address );
1383 # Skip this message if we exceed domain limits in this run
1384 if( Koha::Notice::Util->exceeds_limit({ to => $to_address, limits => $domain_limits }) ) {
1385 # Save the to_address if you delay the message so that we dont need to look it up again
1386 _update_message_to_address( $message->{'message_id'}, $to_address )
1387 if !$message->{to_address};
1391 my $subject = $message->{'subject'};
1393 my $content = $message->{'content'};
1394 my $content_type = $message->{'content_type'} || 'text/plain; charset="UTF-8"';
1395 my $is_html = $content_type =~ m/html/io;
1397 my $branch_email = undef;
1398 my $branch_replyto = undef;
1399 my $branch_returnpath = undef;
1402 $patron //= Koha::Patrons->find( $message->{borrowernumber} ); # we might already found him
1404 $library = $patron->library;
1405 $branch_email = $library->from_email_address;
1406 $branch_replyto = $library->branchreplyto;
1407 $branch_returnpath = $library->branchreturnpath;
1410 # NOTE: Patron may not be defined above so branch_email may be undefined still
1411 # so we need to fallback to KohaAdminEmailAddress as a last resort.
1413 $message->{'from_address'}
1415 || C4::Context->preference('KohaAdminEmailAddress');
1416 if( !$from_address ) {
1417 _set_message_status(
1419 message_id => $message->{'message_id'},
1421 failure_code => 'NO_FROM',
1433 C4::Context->preference('NoticeBcc')
1434 ? ( bcc => C4::Context->preference('NoticeBcc') )
1439 ? ( cc => $cc_address )
1442 from => $from_address,
1443 reply_to => $message->{'reply_address'} || $branch_replyto,
1444 sender => $branch_returnpath,
1445 subject => "" . $message->{subject}
1448 if ( $message->{'content_type'} && $message->{'content_type'} eq SERIALIZED_EMAIL_CONTENT_TYPE ) {
1450 # The message has been previously composed as a valid MIME object
1451 # and serialized as a string on the DB
1452 $email = Koha::Email->new_from_string($content);
1453 $email->create($params);
1455 $email = Koha::Email->create($params);
1457 $email->html_body( _wrap_html( $content, $subject ) );
1459 $email->text_body($content);
1464 if ( ref($_) eq 'Koha::Exceptions::BadParameter' ) {
1465 _set_message_status(
1467 message_id => $message->{'message_id'},
1469 failure_code => "INVALID_EMAIL:".$_->parameter
1473 _set_message_status(
1475 message_id => $message->{'message_id'},
1477 failure_code => 'UNKNOWN_ERROR'
1483 return unless $email;
1487 $smtp_server = $library->smtp_server;
1490 $smtp_server = Koha::SMTP::Servers->get_default;
1496 sasl_username => $username,
1497 sasl_password => $password,
1502 # if initial message address was empty, coming here means that a to address was found and
1503 # queue should be updated; same if to address was overriden by Koha::Email->create
1504 _update_message_to_address( $message->{'message_id'}, $email->email->header('To') )
1505 if !$message->{to_address}
1506 || $message->{to_address} ne $email->email->header('To');
1508 $smtp_transports->{ $smtp_server->id // 'default' } ||= $smtp_server->transport;
1509 my $smtp_transport = $smtp_transports->{ $smtp_server->id // 'default' };
1511 _update_message_from_address( $message->{'message_id'}, $email->email->header('From') )
1512 if !$message->{from_address}
1513 || $message->{from_address} ne $email->email->header('From');
1516 $email->send_or_die({ transport => $smtp_transport });
1518 _set_message_status(
1520 message_id => $message->{'message_id'},
1528 _set_message_status(
1530 message_id => $message->{'message_id'},
1532 failure_code => 'SENDMAIL'
1536 carp "$Mail::Sendmail::error";
1542 my ($content, $title) = @_;
1544 my $css = C4::Context->preference("NoticeCSS") || '';
1545 $css = qq{<link rel="stylesheet" type="text/css" href="$css">} if $css;
1547 <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
1548 "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
1549 <html lang="en" xml:lang="en" xmlns="http://www.w3.org/1999/xhtml">
1551 <title>$title</title>
1552 <meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
1563 my ( $message ) = @_;
1564 my $dbh = C4::Context->dbh;
1565 my $count = $dbh->selectrow_array(q|
1568 WHERE message_transport_type = ?
1569 AND borrowernumber = ?
1571 AND CAST(updated_on AS date) = CAST(NOW() AS date)
1574 |, {}, $message->{message_transport_type}, $message->{borrowernumber}, $message->{letter_code}, $message->{content} );
1578 sub _send_message_by_sms {
1579 my $message = shift or return;
1580 my $patron = Koha::Patrons->find( $message->{borrowernumber} );
1581 _update_message_to_address($message->{message_id}, $patron->smsalertnumber) if $patron;
1583 unless ( $patron and $patron->smsalertnumber ) {
1584 _set_message_status( { message_id => $message->{'message_id'},
1586 failure_code => 'MISSING_SMS' } );
1590 if ( _is_duplicate( $message ) ) {
1591 _set_message_status(
1593 message_id => $message->{'message_id'},
1595 failure_code => 'DUPLICATE_MESSAGE'
1601 my $success = C4::SMS->send_sms(
1603 destination => $patron->smsalertnumber,
1604 message => $message->{'content'},
1609 _set_message_status(
1611 message_id => $message->{'message_id'},
1618 _set_message_status(
1620 message_id => $message->{'message_id'},
1622 failure_code => 'NO_NOTES'
1630 sub _update_message_to_address {
1632 my $dbh = C4::Context->dbh();
1633 $dbh->do('UPDATE message_queue SET to_address=? WHERE message_id=?',undef,($to,$id));
1636 sub _update_message_from_address {
1637 my ($message_id, $from_address) = @_;
1638 my $dbh = C4::Context->dbh();
1639 $dbh->do('UPDATE message_queue SET from_address = ? WHERE message_id = ?', undef, ($from_address, $message_id));
1642 sub _update_message_cc_address {
1643 my ($message_id, $cc_address) = @_;
1644 my $dbh = C4::Context->dbh();
1645 $dbh->do('UPDATE message_queue SET cc_address = ? WHERE message_id = ?', undef, ($cc_address, $message_id));
1648 sub _set_message_status {
1649 my $params = shift or return;
1651 foreach my $required_parameter ( qw( message_id status ) ) {
1652 return unless exists $params->{ $required_parameter };
1655 my $dbh = C4::Context->dbh();
1656 my $statement = 'UPDATE message_queue SET status= ?, failure_code= ? WHERE message_id = ?';
1657 my $sth = $dbh->prepare( $statement );
1658 my $result = $sth->execute( $params->{'status'},
1659 $params->{'failure_code'} || '',
1660 $params->{'message_id'} );
1665 my ( $params ) = @_;
1667 my $content = $params->{content};
1668 my $tables = $params->{tables};
1669 my $loops = $params->{loops};
1670 my $objects = $params->{objects} || {};
1671 my $substitute = $params->{substitute} || {};
1672 my $lang = defined($params->{lang}) && $params->{lang} ne 'default' ? $params->{lang} : 'en';
1673 my ($theme, $availablethemes);
1675 my $htdocs = C4::Context->config('intrahtdocs');
1676 ($theme, $lang, $availablethemes)= C4::Templates::availablethemes( $htdocs, 'about.tt', 'intranet', $lang);
1678 foreach (@$availablethemes) {
1679 push @includes, "$htdocs/$_/$lang/includes";
1680 push @includes, "$htdocs/$_/en/includes" unless $lang eq 'en';
1683 my $use_template_cache = C4::Context->config('template_cache_dir') && defined $ENV{GATEWAY_INTERFACE};
1684 my $template = Template->new(
1688 PLUGIN_BASE => 'Koha::Template::Plugin',
1689 COMPILE_EXT => $use_template_cache ? '.ttc' : '',
1690 COMPILE_DIR => $use_template_cache ? C4::Context->config('template_cache_dir') : '',
1691 INCLUDE_PATH => \@includes,
1693 ENCODING => 'UTF-8',
1695 ) or die Template->error();
1697 my $tt_params = { %{ _get_tt_params( $tables ) }, %{ _get_tt_params( $loops, 'is_a_loop' ) }, %$substitute, %$objects };
1699 $content = add_tt_filters( $content );
1700 $content = qq|[% USE KohaDates %][% USE Remove_MARC_punctuation %]$content|;
1703 my $schema = Koha::Database->new->schema;
1705 my $processed = try {
1706 $template->process( \$content, $tt_params, \$output );
1709 $schema->txn_rollback;
1711 croak "ERROR PROCESSING TEMPLATE: " . $template->error() unless $processed;
1716 sub _get_tt_params {
1717 my ($tables, $is_a_loop) = @_;
1723 article_requests => {
1724 module => 'Koha::ArticleRequests',
1725 singular => 'article_request',
1726 plural => 'article_requests',
1730 module => 'Koha::Acquisition::Baskets',
1731 singular => 'basket',
1732 plural => 'baskets',
1736 module => 'Koha::Acquisition::Booksellers',
1737 singular => 'bookseller',
1738 plural => 'booksellers',
1742 module => 'Koha::Biblios',
1743 singular => 'biblio',
1744 plural => 'biblios',
1745 pk => 'biblionumber',
1748 module => 'Koha::Biblioitems',
1749 singular => 'biblioitem',
1750 plural => 'biblioitems',
1751 pk => 'biblioitemnumber',
1754 module => 'Koha::Patrons',
1755 singular => 'borrower',
1756 plural => 'borrowers',
1757 pk => 'borrowernumber',
1760 module => 'Koha::Libraries',
1761 singular => 'branch',
1762 plural => 'branches',
1766 module => 'Koha::Account::Lines',
1767 singular => 'credit',
1768 plural => 'credits',
1769 pk => 'accountlines_id',
1772 module => 'Koha::Account::Lines',
1773 singular => 'debit',
1775 pk => 'accountlines_id',
1778 module => 'Koha::Items',
1783 additional_contents => {
1784 module => 'Koha::AdditionalContentsLocalizations',
1785 singular => 'additional_content',
1786 plural => 'additional_contents',
1790 module => 'Koha::AdditionalContentsLocalizations',
1796 module => 'Koha::Acquisition::Orders',
1797 singular => 'order',
1799 pk => 'ordernumber',
1802 module => 'Koha::Holds',
1808 module => 'Koha::Serials',
1809 singular => 'serial',
1810 plural => 'serials',
1814 module => 'Koha::Subscriptions',
1815 singular => 'subscription',
1816 plural => 'subscriptions',
1817 pk => 'subscriptionid',
1820 module => 'Koha::Suggestions',
1821 singular => 'suggestion',
1822 plural => 'suggestions',
1823 pk => 'suggestionid',
1826 module => 'Koha::Tickets',
1827 singular => 'ticket',
1828 plural => 'tickets',
1832 module => 'Koha::Ticket::Updates',
1833 singular => 'ticket_update',
1834 plural => 'ticket_updates',
1838 module => 'Koha::Checkouts',
1839 singular => 'checkout',
1840 plural => 'checkouts',
1844 module => 'Koha::Old::Checkouts',
1845 singular => 'old_checkout',
1846 plural => 'old_checkouts',
1850 module => 'Koha::Checkouts',
1851 singular => 'overdue',
1852 plural => 'overdues',
1855 borrower_modifications => {
1856 module => 'Koha::Patron::Modifications',
1857 singular => 'patron_modification',
1858 plural => 'patron_modifications',
1859 fk => 'verification_token',
1862 module => 'Koha::Illrequests',
1863 singular => 'illrequest',
1864 plural => 'illrequests',
1865 pk => 'illrequest_id'
1867 preservation_train_items => {
1868 module => 'Koha::Preservation::Train::Items',
1869 singular => 'train_item',
1870 plural => 'train_items',
1871 pk => 'train_item_id'
1875 foreach my $table ( keys %$tables ) {
1876 next unless $config->{$table};
1878 my $ref = ref( $tables->{$table} ) || q{};
1879 my $module = $config->{$table}->{module};
1881 if ( can_load( modules => { $module => undef } ) ) {
1882 my $pk = $config->{$table}->{pk};
1883 my $fk = $config->{$table}->{fk};
1886 my $values = $tables->{$table} || [];
1887 unless ( ref( $values ) eq 'ARRAY' ) {
1888 croak "ERROR processing table $table. Wrong API call.";
1890 my $key = $pk ? $pk : $fk;
1891 # $key does not come from user input
1892 my $objects = $module->search(
1893 { $key => $values },
1895 # We want to retrieve the data in the same order
1897 # field is a MySQLism, but they are no other way to do it
1898 # To be generic we could do it in perl, but we will need to fetch
1899 # all the data then order them
1900 @$values ? ( order_by => \[ "field($key, " . join( ', ', @$values ) . ")" ] ) : ()
1903 $params->{ $config->{$table}->{plural} } = $objects;
1905 elsif ( $ref eq q{} || $ref eq 'HASH' ) {
1906 my $id = ref $ref eq 'HASH' ? $tables->{$table}->{$pk} : $tables->{$table};
1908 if ( $fk ) { # Using a foreign key for lookup
1909 if ( ref( $fk ) eq 'ARRAY' ) { # Foreign key is multi-column
1911 foreach my $key ( @$fk ) {
1912 $search->{$key} = $id->{$key};
1914 $object = $module->search( $search )->last();
1915 } else { # Foreign key is single column
1916 $object = $module->search( { $fk => $id } )->last();
1918 } else { # using the table's primary key for lookup
1919 $object = $module->find($id);
1921 $params->{ $config->{$table}->{singular} } = $object;
1923 else { # $ref eq 'ARRAY'
1925 if ( @{ $tables->{$table} } == 1 ) { # Param is a single key
1926 $object = $module->search( { $pk => $tables->{$table} } )->last();
1928 else { # Params are mutliple foreign keys
1929 croak "Multiple foreign keys (table $table) should be passed using an hashref";
1931 $params->{ $config->{$table}->{singular} } = $object;
1935 croak "ERROR LOADING MODULE $module: $Module::Load::Conditional::ERROR";
1939 $params->{today} = output_pref({ dt => dt_from_string, dateformat => 'iso' });
1944 =head3 add_tt_filters
1946 $content = add_tt_filters( $content );
1948 Add TT filters to some specific fields if needed.
1950 For now we only add the Remove_MARC_punctuation TT filter to biblio and biblioitem fields
1954 sub add_tt_filters {
1955 my ( $content ) = @_;
1956 $content =~ s|\[%\s*biblio\.(.*?)\s*%\]|[% biblio.$1 \| \$Remove_MARC_punctuation %]|gxms;
1957 $content =~ s|\[%\s*biblioitem\.(.*?)\s*%\]|[% biblioitem.$1 \| \$Remove_MARC_punctuation %]|gxms;
1961 =head2 get_item_content
1963 my $item = Koha::Items->find(...)->unblessed;
1964 my @item_content_fields = qw( date_due title barcode author itemnumber );
1965 my $item_content = C4::Letters::get_item_content({
1967 item_content_fields => \@item_content_fields
1970 This function generates a tab-separated list of values for the passed item. Dates
1971 are formatted following the current setup.
1975 sub get_item_content {
1976 my ( $params ) = @_;
1977 my $item = $params->{item};
1978 my $dateonly = $params->{dateonly} || 0;
1979 my $item_content_fields = $params->{item_content_fields} || [];
1981 return unless $item;
1983 my @item_info = map {
1987 { dt => dt_from_string( $item->{$_} ), dateonly => $dateonly } );
1991 } @$item_content_fields;
1992 return join( "\t", @item_info ) . "\n";