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>.
23 use Date::Calc qw( Add_Delta_Days );
27 use Module::Load::Conditional qw(can_load);
36 use Koha::SMS::Providers;
39 use Koha::Notice::Messages;
40 use Koha::Notice::Templates;
41 use Koha::DateUtils qw( format_sqldatetime dt_from_string );
43 use Koha::SMTP::Servers;
44 use Koha::Subscriptions;
46 use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
52 &GetLetters &GetLettersAvailableForALibrary &GetLetterTemplates &DelLetter &GetPreparedLetter &GetWrappedLetter &SendAlerts &GetPrintMessages &GetMessageTransportTypes
58 C4::Letters - Give functions for Letters management
66 "Letters" is the tool used in Koha to manage informations sent to the patrons and/or the library. This include some cron jobs like
67 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)
69 Letters are managed through "alerts" sent by Koha on some events. All "alert" related functions are in this module too.
71 =head2 GetLetters([$module])
73 $letters = &GetLetters($module);
74 returns informations about letters.
75 if needed, $module filters for letters given module
77 DEPRECATED - You must use Koha::Notice::Templates instead
78 The group by clause is confusing and can lead to issues
84 my $module = $filters->{module};
85 my $code = $filters->{code};
86 my $branchcode = $filters->{branchcode};
87 my $dbh = C4::Context->dbh;
88 my $letters = $dbh->selectall_arrayref(
90 SELECT code, module, name
94 . ( $module ? q| AND module = ?| : q|| )
95 . ( $code ? q| AND code = ?| : q|| )
96 . ( defined $branchcode ? q| AND branchcode = ?| : q|| )
97 . q| GROUP BY code, module, name ORDER BY name|, { Slice => {} }
98 , ( $module ? $module : () )
99 , ( $code ? $code : () )
100 , ( defined $branchcode ? $branchcode : () )
106 =head2 GetLetterTemplates
108 my $letter_templates = GetLetterTemplates(
110 module => 'circulation',
112 branchcode => 'CPL', # '' for default,
116 Return a hashref of letter templates.
120 sub GetLetterTemplates {
123 my $module = $params->{module};
124 my $code = $params->{code};
125 my $branchcode = $params->{branchcode} // '';
126 my $dbh = C4::Context->dbh;
127 return Koha::Notice::Templates->search(
131 branchcode => $branchcode,
133 C4::Context->preference('TranslateNotices')
135 : ( lang => 'default' )
141 =head2 GetLettersAvailableForALibrary
143 my $letters = GetLettersAvailableForALibrary(
145 branchcode => 'CPL', # '' for default
146 module => 'circulation',
150 Return an arrayref of letters, sorted by name.
151 If a specific letter exist for the given branchcode, it will be retrieve.
152 Otherwise the default letter will be.
156 sub GetLettersAvailableForALibrary {
158 my $branchcode = $filters->{branchcode};
159 my $module = $filters->{module};
161 croak "module should be provided" unless $module;
163 my $dbh = C4::Context->dbh;
164 my $default_letters = $dbh->selectall_arrayref(
166 SELECT module, code, branchcode, name
170 . q| AND branchcode = ''|
171 . ( $module ? q| AND module = ?| : q|| )
172 . q| ORDER BY name|, { Slice => {} }
173 , ( $module ? $module : () )
176 my $specific_letters;
178 $specific_letters = $dbh->selectall_arrayref(
180 SELECT module, code, branchcode, name
184 . q| AND branchcode = ?|
185 . ( $module ? q| AND module = ?| : q|| )
186 . q| ORDER BY name|, { Slice => {} }
188 , ( $module ? $module : () )
193 for my $l (@$default_letters) {
194 $letters{ $l->{code} } = $l;
196 for my $l (@$specific_letters) {
197 # Overwrite the default letter with the specific one.
198 $letters{ $l->{code} } = $l;
201 return [ map { $letters{$_} }
202 sort { $letters{$a}->{name} cmp $letters{$b}->{name} }
208 my ( $module, $code, $branchcode, $message_transport_type, $lang) = @_;
209 $message_transport_type //= '%';
210 $lang = 'default' unless( $lang && C4::Context->preference('TranslateNotices') );
213 my $only_my_library = C4::Context->only_my_library;
214 if ( $only_my_library and $branchcode ) {
215 $branchcode = C4::Context::mybranch();
219 my $dbh = C4::Context->dbh;
220 my $sth = $dbh->prepare(q{
223 WHERE module=? AND code=? AND (branchcode = ? OR branchcode = '')
224 AND message_transport_type LIKE ?
226 ORDER BY branchcode DESC LIMIT 1
228 $sth->execute( $module, $code, $branchcode, $message_transport_type, $lang );
229 my $line = $sth->fetchrow_hashref
231 $line->{'content-type'} = 'text/html; charset="UTF-8"' if $line->{is_html};
241 module => 'circulation',
247 Delete the letter. The mtt parameter is facultative.
248 If not given, all templates mathing the other parameters will be removed.
254 my $branchcode = $params->{branchcode};
255 my $module = $params->{module};
256 my $code = $params->{code};
257 my $mtt = $params->{mtt};
258 my $lang = $params->{lang};
259 my $dbh = C4::Context->dbh;
266 . ( $mtt ? q| AND message_transport_type = ?| : q|| )
267 . ( $lang? q| AND lang = ?| : q|| )
268 , undef, $branchcode, $module, $code, ( $mtt ? $mtt : () ), ( $lang ? $lang : () ) );
273 my $err = &SendAlerts($type, $externalid, $letter_code);
276 - $type : the type of alert
277 - $externalid : the id of the "object" to query
278 - $letter_code : the notice template to use
280 C<&SendAlerts> sends an email notice directly to a patron or a vendor.
282 Currently it supports ($type):
283 - claim serial issues (claimissues)
284 - claim acquisition orders (claimacquisition)
285 - send acquisition orders to the vendor (orderacquisition)
286 - notify patrons about newly received serial issues (issue)
287 - notify patrons when their account is created (members)
289 Returns undef or { error => 'message } on failure.
290 Returns true on success.
295 my ( $type, $externalid, $letter_code ) = @_;
296 my $dbh = C4::Context->dbh;
299 if ( $type eq 'issue' ) {
301 # prepare the letter...
302 # search the subscriptionid
305 "SELECT subscriptionid FROM serial WHERE serialid=?");
306 $sth->execute($externalid);
307 my ($subscriptionid) = $sth->fetchrow
308 or warn( "No subscription for '$externalid'" ),
311 # search the biblionumber
314 "SELECT biblionumber FROM subscription WHERE subscriptionid=?");
315 $sth->execute($subscriptionid);
316 my ($biblionumber) = $sth->fetchrow
317 or warn( "No biblionumber for '$subscriptionid'" ),
320 # find the list of subscribers to notify
321 my $subscription = Koha::Subscriptions->find( $subscriptionid );
322 my $subscribers = $subscription->subscribers;
323 while ( my $patron = $subscribers->next ) {
324 my $email = $patron->email or next;
326 # warn "sending issues...";
327 my $userenv = C4::Context->userenv;
328 my $library = $patron->library;
329 my $letter = GetPreparedLetter (
331 letter_code => $letter_code,
332 branchcode => $userenv->{branch},
334 'branches' => $library->branchcode,
335 'biblio' => $biblionumber,
336 'biblioitems' => $biblionumber,
337 'borrowers' => $patron->unblessed,
338 'subscription' => $subscriptionid,
339 'serial' => $externalid,
344 # FIXME: This 'default' behaviour should be moved to Koha::Email
345 my $mail = Koha::Email->create(
348 from => $library->branchemail,
349 reply_to => $library->branchreplyto,
350 sender => $library->branchreturnpath,
351 subject => "" . $letter->{title},
355 if ( $letter->{is_html} ) {
356 $mail->html_body( _wrap_html( $letter->{content}, "" . $letter->{title} ) );
359 $mail->text_body( $letter->{content} );
363 $mail->send_or_die({ transport => $library->smtp_server->transport });
366 # We expect ref($_) eq 'Email::Sender::Failure'
367 $error = $_->message;
373 return { error => $error }
377 elsif ( $type eq 'claimacquisition' or $type eq 'claimissues' or $type eq 'orderacquisition' ) {
379 # prepare the letter...
385 if ( $type eq 'claimacquisition') {
387 SELECT aqorders.*,aqbasket.*,biblio.*,biblioitems.*
389 LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno
390 LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
391 LEFT JOIN biblioitems ON aqorders.biblionumber=biblioitems.biblionumber
392 WHERE aqorders.ordernumber IN (
396 carp "No order selected";
397 return { error => "no_order_selected" };
399 $strsth .= join( ",", ('?') x @$externalid ) . ")";
400 $action = "ACQUISITION CLAIM";
401 $sthorders = $dbh->prepare($strsth);
402 $sthorders->execute( @$externalid );
403 $dataorders = $sthorders->fetchall_arrayref( {} );
406 if ($type eq 'claimissues') {
408 SELECT serial.*,subscription.*, biblio.*, biblioitems.*, aqbooksellers.*,
409 aqbooksellers.id AS booksellerid
411 LEFT JOIN subscription ON serial.subscriptionid=subscription.subscriptionid
412 LEFT JOIN biblio ON serial.biblionumber=biblio.biblionumber
413 LEFT JOIN biblioitems ON serial.biblionumber = biblioitems.biblionumber
414 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id
415 WHERE serial.serialid IN (
419 carp "No issues selected";
420 return { error => "no_issues_selected" };
423 $strsth .= join( ",", ('?') x @$externalid ) . ")";
424 $action = "SERIAL CLAIM";
425 $sthorders = $dbh->prepare($strsth);
426 $sthorders->execute( @$externalid );
427 $dataorders = $sthorders->fetchall_arrayref( {} );
430 if ( $type eq 'orderacquisition') {
431 my $basketno = $externalid;
433 SELECT aqorders.*,aqbasket.*,biblio.*,biblioitems.*
435 LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno
436 LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
437 LEFT JOIN biblioitems ON aqorders.biblionumber=biblioitems.biblionumber
438 WHERE aqbasket.basketno = ?
439 AND orderstatus IN ('new','ordered')
442 unless ( $basketno ) {
443 carp "No basketnumber given";
444 return { error => "no_basketno" };
446 $action = "ACQUISITION ORDER";
447 $sthorders = $dbh->prepare($strsth);
448 $sthorders->execute($basketno);
449 $dataorders = $sthorders->fetchall_arrayref( {} );
453 $dbh->prepare("select * from aqbooksellers where id=?");
454 $sthbookseller->execute( $dataorders->[0]->{booksellerid} );
455 my $databookseller = $sthbookseller->fetchrow_hashref;
457 my $addressee = $type eq 'claimacquisition' || $type eq 'orderacquisition' ? 'acqprimary' : 'serialsprimary';
460 $dbh->prepare("SELECT * FROM aqcontacts WHERE booksellerid=? AND $type=1 ORDER BY $addressee DESC");
461 $sthcontact->execute( $dataorders->[0]->{booksellerid} );
462 my $datacontact = $sthcontact->fetchrow_hashref;
466 push @email, $datacontact->{email} if ( $datacontact && $datacontact->{email} );
468 warn "Bookseller $dataorders->[0]->{booksellerid} without emails";
469 return { error => "no_email" };
472 while ($addlcontact = $sthcontact->fetchrow_hashref) {
473 push @cc, $addlcontact->{email} if ( $addlcontact && $addlcontact->{email} );
476 my $userenv = C4::Context->userenv;
477 my $letter = GetPreparedLetter (
479 letter_code => $letter_code,
480 branchcode => $userenv->{branch},
482 'branches' => $userenv->{branch},
483 'aqbooksellers' => $databookseller,
484 'aqcontacts' => $datacontact,
485 'aqbasket' => $basketno,
487 repeat => $dataorders,
489 ) or return { error => "no_letter" };
491 # Remove the order tag
492 $letter->{content} =~ s/<order>(.*?)<\/order>/$1/gxms;
495 my $library = Koha::Libraries->find( $userenv->{branch} );
496 my $mail = Koha::Email->create(
498 to => join( ',', @email ),
499 cc => join( ',', @cc ),
502 C4::Context->preference("ClaimsBccCopy")
503 && ( $type eq 'claimacquisition'
504 || $type eq 'claimissues' )
506 ? ( bcc => $userenv->{emailaddress} )
509 from => $library->branchemail
510 || C4::Context->preference('KohaAdminEmailAddress'),
511 subject => "" . $letter->{title},
515 if ( $letter->{is_html} ) {
516 $mail->html_body( _wrap_html( $letter->{content}, "" . $letter->{title} ) );
519 $mail->text_body( "" . $letter->{content} );
523 $mail->send_or_die({ transport => $library->smtp_server->transport });
526 # We expect ref($_) eq 'Email::Sender::Failure'
527 $error = $_->message;
533 return { error => $error }
541 . join( ',', @email )
546 ) if C4::Context->preference("LetterLog");
548 # send an "account details" notice to a newly created user
549 elsif ( $type eq 'members' ) {
550 my $library = Koha::Libraries->find( $externalid->{branchcode} );
551 my $letter = GetPreparedLetter (
553 letter_code => $letter_code,
554 branchcode => $externalid->{'branchcode'},
555 lang => $externalid->{lang} || 'default',
557 'branches' => $library->unblessed,
558 'borrowers' => $externalid->{'borrowernumber'},
560 substitute => { 'borrowers.password' => $externalid->{'password'} },
563 return { error => "no_email" } unless $externalid->{'emailaddr'};
567 # FIXME: This 'default' behaviour should be moved to Koha::Email
568 my $mail = Koha::Email->create(
570 to => $externalid->{'emailaddr'},
571 from => $library->branchemail,
572 reply_to => $library->branchreplyto,
573 sender => $library->branchreturnpath,
574 subject => "" . $letter->{'title'},
578 if ( $letter->{is_html} ) {
579 $mail->html_body( _wrap_html( $letter->{content}, "" . $letter->{title} ) );
582 $mail->text_body( $letter->{content} );
585 $mail->send_or_die({ transport => $library->smtp_server->transport });
588 # We expect ref($_) eq 'Email::Sender::Failure'
589 $error = $_->message;
595 return { error => $error }
599 # If we come here, return an OK status
603 =head2 GetPreparedLetter( %params )
606 module => letter module, mandatory
607 letter_code => letter code, mandatory
608 branchcode => for letter selection, if missing default system letter taken
609 tables => a hashref with table names as keys. Values are either:
610 - a scalar - primary key value
611 - an arrayref - primary key values
612 - a hashref - full record
613 substitute => custom substitution key/value pairs
614 repeat => records to be substituted on consecutive lines:
615 - an arrayref - tries to guess what needs substituting by
616 taking remaining << >> tokensr; not recommended
617 - a hashref token => @tables - replaces <token> << >> << >> </token>
618 subtemplate for each @tables row; table is a hashref as above
619 want_librarian => boolean, if set to true triggers librarian details
620 substitution from the userenv
622 letter fields hashref (title & content useful)
626 sub GetPreparedLetter {
629 my $letter = $params{letter};
632 my $module = $params{module} or croak "No module";
633 my $letter_code = $params{letter_code} or croak "No letter_code";
634 my $branchcode = $params{branchcode} || '';
635 my $mtt = $params{message_transport_type} || 'email';
636 my $lang = $params{lang} || 'default';
638 $letter = getletter( $module, $letter_code, $branchcode, $mtt, $lang );
641 $letter = getletter( $module, $letter_code, $branchcode, $mtt, 'default' )
642 or warn( "No $module $letter_code letter transported by " . $mtt ),
647 my $tables = $params{tables} || {};
648 my $substitute = $params{substitute} || {};
649 my $loops = $params{loops} || {}; # loops is not supported for historical notices syntax
650 my $repeat = $params{repeat};
651 %$tables || %$substitute || $repeat || %$loops
652 or carp( "ERROR: nothing to substitute - both 'tables', 'loops' and 'substitute' are empty" ),
654 my $want_librarian = $params{want_librarian};
657 while ( my ($token, $val) = each %$substitute ) {
658 if ( $token eq 'items.content' ) {
659 $val =~ s|\n|<br/>|g if $letter->{is_html};
662 $letter->{title} =~ s/<<$token>>/$val/g;
663 $letter->{content} =~ s/<<$token>>/$val/g;
667 my $OPACBaseURL = C4::Context->preference('OPACBaseURL');
668 $letter->{content} =~ s/<<OPACBaseURL>>/$OPACBaseURL/go;
670 if ($want_librarian) {
671 # parsing librarian name
672 my $userenv = C4::Context->userenv;
673 $letter->{content} =~ s/<<LibrarianFirstname>>/$userenv->{firstname}/go;
674 $letter->{content} =~ s/<<LibrarianSurname>>/$userenv->{surname}/go;
675 $letter->{content} =~ s/<<LibrarianEmailaddress>>/$userenv->{emailaddress}/go;
678 my ($repeat_no_enclosing_tags, $repeat_enclosing_tags);
681 if (ref ($repeat) eq 'ARRAY' ) {
682 $repeat_no_enclosing_tags = $repeat;
684 $repeat_enclosing_tags = $repeat;
688 if ($repeat_enclosing_tags) {
689 while ( my ($tag, $tag_tables) = each %$repeat_enclosing_tags ) {
690 if ( $letter->{content} =~ m!<$tag>(.*)</$tag>!s ) {
693 my %subletter = ( title => '', content => $subcontent );
694 _substitute_tables( \%subletter, $_ );
697 $letter->{content} =~ s!<$tag>.*</$tag>!join( "\n", @lines )!se;
703 _substitute_tables( $letter, $tables );
706 if ($repeat_no_enclosing_tags) {
707 if ( $letter->{content} =~ m/[^\n]*<<.*>>[^\n]*/so ) {
712 $c =~ s/<<count>>/$i/go;
713 foreach my $field ( keys %{$_} ) {
714 $c =~ s/(<<[^\.]+.$field>>)/$_->{$field}/;
718 } @$repeat_no_enclosing_tags;
720 my $replaceby = join( "\n", @lines );
721 $letter->{content} =~ s/\Q$line\E/$replaceby/s;
725 $letter->{content} = _process_tt(
727 content => $letter->{content},
730 substitute => $substitute,
734 $letter->{title} = _process_tt(
736 content => $letter->{title},
739 substitute => $substitute,
743 $letter->{content} =~ s/<<\S*>>//go; #remove any stragglers
748 sub _substitute_tables {
749 my ( $letter, $tables ) = @_;
750 while ( my ($table, $param) = each %$tables ) {
753 my $ref = ref $param;
756 if ($ref && $ref eq 'HASH') {
760 my $sth = _parseletter_sth($table);
762 warn "_parseletter_sth('$table') failed to return a valid sth. No substitution will be done for that table.";
765 $sth->execute( $ref ? @$param : $param );
767 $values = $sth->fetchrow_hashref;
771 _parseletter ( $letter, $table, $values );
775 sub _parseletter_sth {
779 carp "ERROR: _parseletter_sth() called without argument (table)";
782 # NOTE: we used to check whether we had a statement handle cached in
783 # a %handles module-level variable. This was a dumb move and
784 # broke things for the rest of us. prepare_cached is a better
785 # way to cache statement handles anyway.
787 ($table eq 'biblio' ) ? "SELECT * FROM $table WHERE biblionumber = ?" :
788 ($table eq 'biblioitems' ) ? "SELECT * FROM $table WHERE biblionumber = ?" :
789 ($table eq 'items' ) ? "SELECT * FROM $table WHERE itemnumber = ?" :
790 ($table eq 'issues' ) ? "SELECT * FROM $table WHERE itemnumber = ?" :
791 ($table eq 'old_issues' ) ? "SELECT * FROM $table WHERE itemnumber = ? ORDER BY timestamp DESC LIMIT 1" :
792 ($table eq 'reserves' ) ? "SELECT * FROM $table WHERE borrowernumber = ? and biblionumber = ?" :
793 ($table eq 'borrowers' ) ? "SELECT * FROM $table WHERE borrowernumber = ?" :
794 ($table eq 'branches' ) ? "SELECT * FROM $table WHERE branchcode = ?" :
795 ($table eq 'suggestions' ) ? "SELECT * FROM $table WHERE suggestionid = ?" :
796 ($table eq 'aqbooksellers') ? "SELECT * FROM $table WHERE id = ?" :
797 ($table eq 'aqorders' ) ? "SELECT * FROM $table WHERE ordernumber = ?" :
798 ($table eq 'aqbasket' ) ? "SELECT * FROM $table WHERE basketno = ?" :
799 ($table eq 'illrequests' ) ? "SELECT * FROM $table WHERE illrequest_id = ?" :
800 ($table eq 'opac_news' ) ? "SELECT * FROM $table WHERE idnew = ?" :
801 ($table eq 'article_requests') ? "SELECT * FROM $table WHERE id = ?" :
802 ($table eq 'borrower_modifications') ? "SELECT * FROM $table WHERE verification_token = ?" :
803 ($table eq 'subscription') ? "SELECT * FROM $table WHERE subscriptionid = ?" :
804 ($table eq 'serial') ? "SELECT * FROM $table WHERE serialid = ?" :
805 ($table eq 'problem_reports') ? "SELECT * FROM $table WHERE reportid = ?" :
808 warn "ERROR: No _parseletter_sth query for table '$table'";
809 return; # nothing to get
811 unless ($sth = C4::Context->dbh->prepare_cached($query)) {
812 warn "ERROR: Failed to prepare query: '$query'";
815 return $sth; # now cache is populated for that $table
818 =head2 _parseletter($letter, $table, $values)
821 - $letter : a hash to letter fields (title & content useful)
822 - $table : the Koha table to parse.
823 - $values_in : table record hashref
824 parse all fields from a table, and replace values in title & content with the appropriate value
825 (not exported sub, used only internally)
830 my ( $letter, $table, $values_in ) = @_;
832 # Work on a local copy of $values_in (passed by reference) to avoid side effects
833 # in callers ( by changing / formatting values )
834 my $values = $values_in ? { %$values_in } : {};
836 if ( $table eq 'borrowers' && $values->{'dateexpiry'} ){
837 $values->{'dateexpiry'} = output_pref({ dt => dt_from_string( $values->{'dateexpiry'} ), dateonly => 1 });
840 if ( $table eq 'reserves' && $values->{'waitingdate'} ) {
841 $values->{'waitingdate'} = output_pref({ dt => dt_from_string( $values->{'waitingdate'} ), dateonly => 1 });
844 if ($letter->{content} && $letter->{content} =~ /<<today>>/) {
845 my $todaysdate = output_pref( dt_from_string() );
846 $letter->{content} =~ s/<<today>>/$todaysdate/go;
849 while ( my ($field, $val) = each %$values ) {
850 $val =~ s/\p{P}$// if $val && $table=~/biblio/;
851 #BZ 9886: Assuming that we want to eliminate ISBD punctuation here
852 #Therefore adding the test on biblio. This includes biblioitems,
853 #but excludes items. Removed unneeded global and lookahead.
855 if ( $table=~/^borrowers$/ && $field=~/^streettype$/ ) {
856 my $av = Koha::AuthorisedValues->search({ category => 'ROADTYPE', authorised_value => $val });
857 $val = $av->count ? $av->next->lib : '';
861 my $replacedby = defined ($val) ? $val : '';
863 and not $replacedby =~ m|9999-12-31|
864 and $replacedby =~ m|^\d{4}-\d{2}-\d{2}( \d{2}:\d{2}:\d{2})?$| )
866 # If the value is XXXX-YY-ZZ[ AA:BB:CC] we assume it is a date
867 my $dateonly = defined $1 ? 0 : 1; #$1 refers to the capture group wrapped in parentheses. In this case, that's the hours, minutes, seconds.
868 my $re_dateonly_filter = qr{ $field( \s* \| \s* dateonly\s*)?>> }xms;
870 for my $letter_field ( qw( title content ) ) {
871 my $filter_string_used = q{};
872 if ( $letter->{ $letter_field } =~ $re_dateonly_filter ) {
873 # We overwrite $dateonly if the filter exists and we have a time in the datetime
874 $filter_string_used = $1 || q{};
875 $dateonly = $1 unless $dateonly;
877 my $replacedby_date = eval {
878 output_pref({ dt => dt_from_string( $replacedby ), dateonly => $dateonly });
881 if ( $letter->{ $letter_field } ) {
882 $letter->{ $letter_field } =~ s/\Q<<$table.$field$filter_string_used>>\E/$replacedby_date/g;
883 $letter->{ $letter_field } =~ s/\Q<<$field$filter_string_used>>\E/$replacedby_date/g;
887 # Other fields replacement
889 for my $letter_field ( qw( title content ) ) {
890 if ( $letter->{ $letter_field } ) {
891 $letter->{ $letter_field } =~ s/<<$table.$field>>/$replacedby/g;
892 $letter->{ $letter_field } =~ s/<<$field>>/$replacedby/g;
898 if ($table eq 'borrowers' && $letter->{content}) {
899 my $patron = Koha::Patrons->find( $values->{borrowernumber} );
901 my $attributes = $patron->extended_attributes;
903 while ( my $attribute = $attributes->next ) {
904 my $code = $attribute->code;
905 my $val = $attribute->description; # FIXME - we always display intranet description here!
906 $val =~ s/\p{P}(?=$)//g if $val;
907 next unless $val gt '';
909 push @{ $attr{$code} }, $val;
911 while ( my ($code, $val_ar) = each %attr ) {
912 my $replacefield = "<<borrower-attribute:$code>>";
913 my $replacedby = join ',', @$val_ar;
914 $letter->{content} =~ s/$replacefield/$replacedby/g;
923 my $success = EnqueueLetter( { letter => $letter,
924 borrowernumber => '12', message_transport_type => 'email' } )
926 places a letter in the message_queue database table, which will
927 eventually get processed (sent) by the process_message_queue.pl
928 cronjob when it calls SendQueuedMessages.
930 return message_id on success
935 my $params = shift or return;
937 return unless exists $params->{'letter'};
938 # return unless exists $params->{'borrowernumber'};
939 return unless exists $params->{'message_transport_type'};
941 my $content = $params->{letter}->{content};
942 $content =~ s/\s+//g if(defined $content);
943 if ( not defined $content or $content eq '' ) {
944 warn "Trying to add an empty message to the message queue" if $debug;
948 # If we have any attachments we should encode then into the body.
949 if ( $params->{'attachments'} ) {
950 $params->{'letter'} = _add_attachments(
951 { letter => $params->{'letter'},
952 attachments => $params->{'attachments'},
953 message => MIME::Lite->new( Type => 'multipart/mixed' ),
958 my $dbh = C4::Context->dbh();
959 my $statement = << 'ENDSQL';
960 INSERT INTO message_queue
961 ( borrowernumber, subject, content, metadata, letter_code, message_transport_type, status, time_queued, to_address, from_address, reply_address, content_type )
963 ( ?, ?, ?, ?, ?, ?, ?, NOW(), ?, ?, ?, ? )
966 my $sth = $dbh->prepare($statement);
967 my $result = $sth->execute(
968 $params->{'borrowernumber'}, # borrowernumber
969 $params->{'letter'}->{'title'}, # subject
970 $params->{'letter'}->{'content'}, # content
971 $params->{'letter'}->{'metadata'} || '', # metadata
972 $params->{'letter'}->{'code'} || '', # letter_code
973 $params->{'message_transport_type'}, # message_transport_type
975 $params->{'to_address'}, # to_address
976 $params->{'from_address'}, # from_address
977 $params->{'reply_address'}, # reply_address
978 $params->{'letter'}->{'content-type'}, # content_type
980 return $dbh->last_insert_id(undef,undef,'message_queue', undef);
983 =head2 SendQueuedMessages ([$hashref])
985 my $sent = SendQueuedMessages({
986 letter_code => $letter_code,
987 borrowernumber => $who_letter_is_for,
993 Sends all of the 'pending' items in the message queue, unless
994 parameters are passed.
996 The letter_code, borrowernumber and limit parameters are used
997 to build a parameter set for _get_unsent_messages, thus limiting
998 which pending messages will be processed. They are all optional.
1000 The verbose parameter can be used to generate debugging output.
1001 It is also optional.
1003 Returns number of messages sent.
1007 sub SendQueuedMessages {
1010 my $which_unsent_messages = {
1011 'message_id' => $params->{'message_id'},
1012 'limit' => $params->{'limit'} // 0,
1013 'borrowernumber' => $params->{'borrowernumber'} // q{},
1014 'letter_code' => $params->{'letter_code'} // q{},
1015 'type' => $params->{'type'} // q{},
1017 my $unsent_messages = _get_unsent_messages( $which_unsent_messages );
1018 MESSAGE: foreach my $message ( @$unsent_messages ) {
1019 my $message_object = Koha::Notice::Messages->find( $message->{message_id} );
1020 # If this fails the database is unwritable and we won't manage to send a message that continues to be marked 'pending'
1021 $message_object->make_column_dirty('status');
1022 return unless $message_object->store;
1024 # warn Data::Dumper->Dump( [ $message ], [ 'message' ] );
1025 warn sprintf( 'sending %s message to patron: %s',
1026 $message->{'message_transport_type'},
1027 $message->{'borrowernumber'} || 'Admin' )
1028 if $params->{'verbose'} or $debug;
1029 # This is just begging for subclassing
1030 next MESSAGE if ( lc($message->{'message_transport_type'}) eq 'rss' );
1031 if ( lc( $message->{'message_transport_type'} ) eq 'email' ) {
1032 _send_message_by_email( $message, $params->{'username'}, $params->{'password'}, $params->{'method'} );
1034 elsif ( lc( $message->{'message_transport_type'} ) eq 'sms' ) {
1035 if ( C4::Context->preference('SMSSendDriver') eq 'Email' ) {
1036 my $patron = Koha::Patrons->find( $message->{borrowernumber} );
1037 my $sms_provider = Koha::SMS::Providers->find( $patron->sms_provider_id );
1038 unless ( $sms_provider ) {
1039 warn sprintf( "Patron %s has no sms provider id set!", $message->{'borrowernumber'} ) if $params->{'verbose'} or $debug;
1040 _set_message_status( { message_id => $message->{'message_id'}, status => 'failed' } );
1043 unless ( $patron->smsalertnumber ) {
1044 _set_message_status( { message_id => $message->{'message_id'}, status => 'failed' } );
1045 warn sprintf( "No smsalertnumber found for patron %s!", $message->{'borrowernumber'} ) if $params->{'verbose'} or $debug;
1048 $message->{to_address} = $patron->smsalertnumber; #Sometime this is set to email - sms should always use smsalertnumber
1049 $message->{to_address} .= '@' . $sms_provider->domain();
1051 # Check for possible from_address override
1052 my $from_address = C4::Context->preference('EmailSMSSendDriverFromAddress');
1053 if ($from_address && $message->{from_address} ne $from_address) {
1054 $message->{from_address} = $from_address;
1055 _update_message_from_address($message->{'message_id'}, $message->{from_address});
1058 _update_message_to_address($message->{'message_id'}, $message->{to_address});
1059 _send_message_by_email( $message, $params->{'username'}, $params->{'password'}, $params->{'method'} );
1061 _send_message_by_sms( $message );
1065 return scalar( @$unsent_messages );
1068 =head2 GetRSSMessages
1070 my $message_list = GetRSSMessages( { limit => 10, borrowernumber => '14' } )
1072 returns a listref of all queued RSS messages for a particular person.
1076 sub GetRSSMessages {
1079 return unless $params;
1080 return unless ref $params;
1081 return unless $params->{'borrowernumber'};
1083 return _get_unsent_messages( { message_transport_type => 'rss',
1084 limit => $params->{'limit'},
1085 borrowernumber => $params->{'borrowernumber'}, } );
1088 =head2 GetPrintMessages
1090 my $message_list = GetPrintMessages( { borrowernumber => $borrowernumber } )
1092 Returns a arrayref of all queued print messages (optionally, for a particular
1097 sub GetPrintMessages {
1098 my $params = shift || {};
1100 return _get_unsent_messages( { message_transport_type => 'print',
1101 borrowernumber => $params->{'borrowernumber'},
1105 =head2 GetQueuedMessages ([$hashref])
1107 my $messages = GetQueuedMessage( { borrowernumber => '123', limit => 20 } );
1109 Fetches a list of messages from the message queue optionally filtered by borrowernumber
1110 and limited to specified limit.
1112 Return is an arrayref of hashes, each has represents a message in the message queue.
1116 sub GetQueuedMessages {
1119 my $dbh = C4::Context->dbh();
1120 my $statement = << 'ENDSQL';
1121 SELECT message_id, borrowernumber, subject, content, message_transport_type, status, time_queued, updated_on
1127 if ( exists $params->{'borrowernumber'} ) {
1128 push @whereclauses, ' borrowernumber = ? ';
1129 push @query_params, $params->{'borrowernumber'};
1132 if ( @whereclauses ) {
1133 $statement .= ' WHERE ' . join( 'AND', @whereclauses );
1136 if ( defined $params->{'limit'} ) {
1137 $statement .= ' LIMIT ? ';
1138 push @query_params, $params->{'limit'};
1141 my $sth = $dbh->prepare( $statement );
1142 my $result = $sth->execute( @query_params );
1143 return $sth->fetchall_arrayref({});
1146 =head2 GetMessageTransportTypes
1148 my @mtt = GetMessageTransportTypes();
1150 returns an arrayref of transport types
1154 sub GetMessageTransportTypes {
1155 my $dbh = C4::Context->dbh();
1156 my $mtts = $dbh->selectcol_arrayref("
1157 SELECT message_transport_type
1158 FROM message_transport_types
1159 ORDER BY message_transport_type
1166 my $message = C4::Letters::Message($message_id);
1171 my ( $message_id ) = @_;
1172 return unless $message_id;
1173 my $dbh = C4::Context->dbh;
1174 return $dbh->selectrow_hashref(q|
1175 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
1177 WHERE message_id = ?
1178 |, {}, $message_id );
1181 =head2 ResendMessage
1183 Attempt to resend a message which has failed previously.
1185 my $has_been_resent = C4::Letters::ResendMessage($message_id);
1187 Updates the message to 'pending' status so that
1188 it will be resent later on.
1190 returns 1 on success, 0 on failure, undef if no message was found
1195 my $message_id = shift;
1196 return unless $message_id;
1198 my $message = GetMessage( $message_id );
1199 return unless $message;
1201 if ( $message->{status} ne 'pending' ) {
1202 $rv = C4::Letters::_set_message_status({
1203 message_id => $message_id,
1204 status => 'pending',
1206 $rv = $rv > 0? 1: 0;
1207 # Clear destination email address to force address update
1208 _update_message_to_address( $message_id, undef ) if $rv &&
1209 $message->{message_transport_type} eq 'email';
1214 =head2 _add_attachements
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.
1222 message - a MIME::Lite object to attach these to.
1224 returns your letter object, with the content updated.
1228 sub _add_attachments {
1231 my $letter = $params->{'letter'};
1232 my $attachments = $params->{'attachments'};
1233 return $letter unless @$attachments;
1234 my $message = $params->{'message'};
1236 # First, we have to put the body in as the first attachment
1238 Type => $letter->{'content-type'} || 'TEXT',
1239 Data => $letter->{'is_html'}
1240 ? _wrap_html($letter->{'content'}, $letter->{'title'})
1241 : $letter->{'content'},
1244 foreach my $attachment ( @$attachments ) {
1246 Type => $attachment->{'type'},
1247 Data => $attachment->{'content'},
1248 Filename => $attachment->{'filename'},
1251 # we're forcing list context here to get the header, not the count back from grep.
1252 ( $letter->{'content-type'} ) = grep( /^Content-Type:/, split( /\n/, $params->{'message'}->header_as_string ) );
1253 $letter->{'content-type'} =~ s/^Content-Type:\s+//;
1254 $letter->{'content'} = $message->body_as_string;
1260 =head2 _get_unsent_messages
1262 This function's parameter hash reference takes the following
1263 optional named parameters:
1264 message_transport_type: method of message sending (e.g. email, sms, etc.)
1265 borrowernumber : who the message is to be sent
1266 letter_code : type of message being sent (e.g. PASSWORD_RESET)
1267 message_id : the message_id of the message. In that case the sub will return only 1 result
1268 limit : maximum number of messages to send
1270 This function returns an array of matching hash referenced rows from
1271 message_queue with some borrower information added.
1275 sub _get_unsent_messages {
1278 my $dbh = C4::Context->dbh();
1280 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
1281 FROM message_queue mq
1282 LEFT JOIN borrowers b ON b.borrowernumber = mq.borrowernumber
1286 my @query_params = ('pending');
1287 if ( ref $params ) {
1288 if ( $params->{'message_transport_type'} ) {
1289 $statement .= ' AND mq.message_transport_type = ? ';
1290 push @query_params, $params->{'message_transport_type'};
1292 if ( $params->{'borrowernumber'} ) {
1293 $statement .= ' AND mq.borrowernumber = ? ';
1294 push @query_params, $params->{'borrowernumber'};
1296 if ( $params->{'letter_code'} ) {
1297 $statement .= ' AND mq.letter_code = ? ';
1298 push @query_params, $params->{'letter_code'};
1300 if ( $params->{'type'} ) {
1301 $statement .= ' AND message_transport_type = ? ';
1302 push @query_params, $params->{'type'};
1304 if ( $params->{message_id} ) {
1305 $statement .= ' AND message_id = ?';
1306 push @query_params, $params->{message_id};
1308 if ( $params->{'limit'} ) {
1309 $statement .= ' limit ? ';
1310 push @query_params, $params->{'limit'};
1314 $debug and warn "_get_unsent_messages SQL: $statement";
1315 $debug and warn "_get_unsent_messages params: " . join(',',@query_params);
1316 my $sth = $dbh->prepare( $statement );
1317 my $result = $sth->execute( @query_params );
1318 return $sth->fetchall_arrayref({});
1321 sub _send_message_by_email {
1322 my $message = shift or return;
1323 my ($username, $password, $method) = @_;
1325 my $patron = Koha::Patrons->find( $message->{borrowernumber} );
1326 my $to_address = $message->{'to_address'};
1327 unless ($to_address) {
1329 warn "FAIL: No 'to_address' and INVALID borrowernumber ($message->{borrowernumber})";
1330 _set_message_status( { message_id => $message->{'message_id'},
1331 status => 'failed' } );
1334 $to_address = $patron->notice_email_address;
1335 unless ($to_address) {
1336 # warn "FAIL: No 'to_address' and no email for " . ($member->{surname} ||'') . ", borrowernumber ($message->{borrowernumber})";
1337 # warning too verbose for this more common case?
1338 _set_message_status( { message_id => $message->{'message_id'},
1339 status => 'failed' } );
1344 my $subject = $message->{'subject'};
1346 my $content = $message->{'content'};
1347 my $content_type = $message->{'content_type'} || 'text/plain; charset="UTF-8"';
1348 my $is_html = $content_type =~ m/html/io;
1350 my $branch_email = undef;
1351 my $branch_replyto = undef;
1352 my $branch_returnpath = undef;
1356 $library = $patron->library;
1357 $branch_email = $library->branchemail;
1358 $branch_replyto = $library->branchreplyto;
1359 $branch_returnpath = $library->branchreturnpath;
1362 my $email = Koha::Email->create(
1366 C4::Context->preference('NoticeBcc')
1367 ? ( bcc => C4::Context->preference('NoticeBcc') )
1370 from => $message->{'from_address'} || $branch_email,
1371 reply_to => $message->{'reply_address'} || $branch_replyto,
1372 sender => $branch_returnpath,
1373 subject => "" . $message->{subject}
1379 _wrap_html( $content, $subject )
1383 $email->text_body( $content );
1388 $smtp_server = $library->smtp_server;
1391 $smtp_server = Koha::SMTP::Servers->get_default;
1397 sasl_username => $username,
1398 sasl_password => $password,
1403 # if initial message address was empty, coming here means that a to address was found and
1404 # queue should be updated; same if to address was overriden by Koha::Email->create
1405 _update_message_to_address( $message->{'message_id'}, $email->email->header('To') )
1406 if !$message->{to_address}
1407 || $message->{to_address} ne $email->email->header('To');
1410 $email->send_or_die({ transport => $smtp_server->transport });
1412 _set_message_status(
1414 message_id => $message->{'message_id'},
1421 _set_message_status(
1423 message_id => $message->{'message_id'},
1433 my ($content, $title) = @_;
1435 my $css = C4::Context->preference("NoticeCSS") || '';
1436 $css = qq{<link rel="stylesheet" type="text/css" href="$css">} if $css;
1438 <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
1439 "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
1440 <html lang="en" xml:lang="en" xmlns="http://www.w3.org/1999/xhtml">
1442 <title>$title</title>
1443 <meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
1454 my ( $message ) = @_;
1455 my $dbh = C4::Context->dbh;
1456 my $count = $dbh->selectrow_array(q|
1459 WHERE message_transport_type = ?
1460 AND borrowernumber = ?
1462 AND CAST(updated_on AS date) = CAST(NOW() AS date)
1465 |, {}, $message->{message_transport_type}, $message->{borrowernumber}, $message->{letter_code}, $message->{content} );
1469 sub _send_message_by_sms {
1470 my $message = shift or return;
1471 my $patron = Koha::Patrons->find( $message->{borrowernumber} );
1473 unless ( $patron and $patron->smsalertnumber ) {
1474 _set_message_status( { message_id => $message->{'message_id'},
1475 status => 'failed' } );
1479 if ( _is_duplicate( $message ) ) {
1480 _set_message_status( { message_id => $message->{'message_id'},
1481 status => 'failed' } );
1485 my $success = C4::SMS->send_sms( { destination => $patron->smsalertnumber,
1486 message => $message->{'content'},
1488 _set_message_status( { message_id => $message->{'message_id'},
1489 status => ($success ? 'sent' : 'failed') } );
1493 sub _update_message_to_address {
1495 my $dbh = C4::Context->dbh();
1496 $dbh->do('UPDATE message_queue SET to_address=? WHERE message_id=?',undef,($to,$id));
1499 sub _update_message_from_address {
1500 my ($message_id, $from_address) = @_;
1501 my $dbh = C4::Context->dbh();
1502 $dbh->do('UPDATE message_queue SET from_address = ? WHERE message_id = ?', undef, ($from_address, $message_id));
1505 sub _set_message_status {
1506 my $params = shift or return;
1508 foreach my $required_parameter ( qw( message_id status ) ) {
1509 return unless exists $params->{ $required_parameter };
1512 my $dbh = C4::Context->dbh();
1513 my $statement = 'UPDATE message_queue SET status= ? WHERE message_id = ?';
1514 my $sth = $dbh->prepare( $statement );
1515 my $result = $sth->execute( $params->{'status'},
1516 $params->{'message_id'} );
1521 my ( $params ) = @_;
1523 my $content = $params->{content};
1524 my $tables = $params->{tables};
1525 my $loops = $params->{loops};
1526 my $substitute = $params->{substitute} || {};
1528 my $use_template_cache = C4::Context->config('template_cache_dir') && defined $ENV{GATEWAY_INTERFACE};
1529 my $template = Template->new(
1533 PLUGIN_BASE => 'Koha::Template::Plugin',
1534 COMPILE_EXT => $use_template_cache ? '.ttc' : '',
1535 COMPILE_DIR => $use_template_cache ? C4::Context->config('template_cache_dir') : '',
1537 ENCODING => 'UTF-8',
1539 ) or die Template->error();
1541 my $tt_params = { %{ _get_tt_params( $tables ) }, %{ _get_tt_params( $loops, 'is_a_loop' ) }, %$substitute };
1543 $content = add_tt_filters( $content );
1544 $content = qq|[% USE KohaDates %][% USE Remove_MARC_punctuation %]$content|;
1547 $template->process( \$content, $tt_params, \$output ) || croak "ERROR PROCESSING TEMPLATE: " . $template->error();
1552 sub _get_tt_params {
1553 my ($tables, $is_a_loop) = @_;
1559 article_requests => {
1560 module => 'Koha::ArticleRequests',
1561 singular => 'article_request',
1562 plural => 'article_requests',
1566 module => 'Koha::Acquisition::Baskets',
1567 singular => 'basket',
1568 plural => 'baskets',
1572 module => 'Koha::Biblios',
1573 singular => 'biblio',
1574 plural => 'biblios',
1575 pk => 'biblionumber',
1578 module => 'Koha::Biblioitems',
1579 singular => 'biblioitem',
1580 plural => 'biblioitems',
1581 pk => 'biblioitemnumber',
1584 module => 'Koha::Patrons',
1585 singular => 'borrower',
1586 plural => 'borrowers',
1587 pk => 'borrowernumber',
1590 module => 'Koha::Libraries',
1591 singular => 'branch',
1592 plural => 'branches',
1596 module => 'Koha::Items',
1602 module => 'Koha::News',
1608 module => 'Koha::Acquisition::Orders',
1609 singular => 'order',
1611 pk => 'ordernumber',
1614 module => 'Koha::Holds',
1620 module => 'Koha::Serials',
1621 singular => 'serial',
1622 plural => 'serials',
1626 module => 'Koha::Subscriptions',
1627 singular => 'subscription',
1628 plural => 'subscriptions',
1629 pk => 'subscriptionid',
1632 module => 'Koha::Suggestions',
1633 singular => 'suggestion',
1634 plural => 'suggestions',
1635 pk => 'suggestionid',
1638 module => 'Koha::Checkouts',
1639 singular => 'checkout',
1640 plural => 'checkouts',
1644 module => 'Koha::Old::Checkouts',
1645 singular => 'old_checkout',
1646 plural => 'old_checkouts',
1650 module => 'Koha::Checkouts',
1651 singular => 'overdue',
1652 plural => 'overdues',
1655 borrower_modifications => {
1656 module => 'Koha::Patron::Modifications',
1657 singular => 'patron_modification',
1658 plural => 'patron_modifications',
1659 fk => 'verification_token',
1662 module => 'Koha::Illrequests',
1663 singular => 'illrequest',
1664 plural => 'illrequests',
1665 pk => 'illrequest_id'
1669 foreach my $table ( keys %$tables ) {
1670 next unless $config->{$table};
1672 my $ref = ref( $tables->{$table} ) || q{};
1673 my $module = $config->{$table}->{module};
1675 if ( can_load( modules => { $module => undef } ) ) {
1676 my $pk = $config->{$table}->{pk};
1677 my $fk = $config->{$table}->{fk};
1680 my $values = $tables->{$table} || [];
1681 unless ( ref( $values ) eq 'ARRAY' ) {
1682 croak "ERROR processing table $table. Wrong API call.";
1684 my $key = $pk ? $pk : $fk;
1685 # $key does not come from user input
1686 my $objects = $module->search(
1687 { $key => $values },
1689 # We want to retrieve the data in the same order
1691 # field is a MySQLism, but they are no other way to do it
1692 # To be generic we could do it in perl, but we will need to fetch
1693 # all the data then order them
1694 @$values ? ( order_by => \[ "field($key, " . join( ', ', @$values ) . ")" ] ) : ()
1697 $params->{ $config->{$table}->{plural} } = $objects;
1699 elsif ( $ref eq q{} || $ref eq 'HASH' ) {
1700 my $id = ref $ref eq 'HASH' ? $tables->{$table}->{$pk} : $tables->{$table};
1702 if ( $fk ) { # Using a foreign key for lookup
1703 if ( ref( $fk ) eq 'ARRAY' ) { # Foreign key is multi-column
1705 foreach my $key ( @$fk ) {
1706 $search->{$key} = $id->{$key};
1708 $object = $module->search( $search )->last();
1709 } else { # Foreign key is single column
1710 $object = $module->search( { $fk => $id } )->last();
1712 } else { # using the table's primary key for lookup
1713 $object = $module->find($id);
1715 $params->{ $config->{$table}->{singular} } = $object;
1717 else { # $ref eq 'ARRAY'
1719 if ( @{ $tables->{$table} } == 1 ) { # Param is a single key
1720 $object = $module->search( { $pk => $tables->{$table} } )->last();
1722 else { # Params are mutliple foreign keys
1723 croak "Multiple foreign keys (table $table) should be passed using an hashref";
1725 $params->{ $config->{$table}->{singular} } = $object;
1729 croak "ERROR LOADING MODULE $module: $Module::Load::Conditional::ERROR";
1733 $params->{today} = output_pref({ dt => dt_from_string, dateformat => 'iso' });
1738 =head3 add_tt_filters
1740 $content = add_tt_filters( $content );
1742 Add TT filters to some specific fields if needed.
1744 For now we only add the Remove_MARC_punctuation TT filter to biblio and biblioitem fields
1748 sub add_tt_filters {
1749 my ( $content ) = @_;
1750 $content =~ s|\[%\s*biblio\.(.*?)\s*%\]|[% biblio.$1 \| \$Remove_MARC_punctuation %]|gxms;
1751 $content =~ s|\[%\s*biblioitem\.(.*?)\s*%\]|[% biblioitem.$1 \| \$Remove_MARC_punctuation %]|gxms;
1755 =head2 get_item_content
1757 my $item = Koha::Items->find(...)->unblessed;
1758 my @item_content_fields = qw( date_due title barcode author itemnumber );
1759 my $item_content = C4::Letters::get_item_content({
1761 item_content_fields => \@item_content_fields
1764 This function generates a tab-separated list of values for the passed item. Dates
1765 are formatted following the current setup.
1769 sub get_item_content {
1770 my ( $params ) = @_;
1771 my $item = $params->{item};
1772 my $dateonly = $params->{dateonly} || 0;
1773 my $item_content_fields = $params->{item_content_fields} || [];
1775 return unless $item;
1777 my @item_info = map {
1781 { dt => dt_from_string( $item->{$_} ), dateonly => $dateonly } );
1785 } @$item_content_fields;
1786 return join( "\t", @item_info ) . "\n";