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 &EnqueueLetter &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} }
212 module => 'circulation',
218 Delete the letter. The mtt parameter is facultative.
219 If not given, all templates mathing the other parameters will be removed.
225 my $branchcode = $params->{branchcode};
226 my $module = $params->{module};
227 my $code = $params->{code};
228 my $mtt = $params->{mtt};
229 my $lang = $params->{lang};
230 my $dbh = C4::Context->dbh;
237 . ( $mtt ? q| AND message_transport_type = ?| : q|| )
238 . ( $lang? q| AND lang = ?| : q|| )
239 , undef, $branchcode, $module, $code, ( $mtt ? $mtt : () ), ( $lang ? $lang : () ) );
244 my $err = &SendAlerts($type, $externalid, $letter_code);
247 - $type : the type of alert
248 - $externalid : the id of the "object" to query
249 - $letter_code : the notice template to use
251 C<&SendAlerts> sends an email notice directly to a patron or a vendor.
253 Currently it supports ($type):
254 - claim serial issues (claimissues)
255 - claim acquisition orders (claimacquisition)
256 - send acquisition orders to the vendor (orderacquisition)
257 - notify patrons about newly received serial issues (issue)
258 - notify patrons when their account is created (members)
260 Returns undef or { error => 'message } on failure.
261 Returns true on success.
266 my ( $type, $externalid, $letter_code ) = @_;
267 my $dbh = C4::Context->dbh;
270 if ( $type eq 'issue' ) {
272 # prepare the letter...
273 # search the subscriptionid
276 "SELECT subscriptionid FROM serial WHERE serialid=?");
277 $sth->execute($externalid);
278 my ($subscriptionid) = $sth->fetchrow
279 or warn( "No subscription for '$externalid'" ),
282 # search the biblionumber
285 "SELECT biblionumber FROM subscription WHERE subscriptionid=?");
286 $sth->execute($subscriptionid);
287 my ($biblionumber) = $sth->fetchrow
288 or warn( "No biblionumber for '$subscriptionid'" ),
291 # find the list of subscribers to notify
292 my $subscription = Koha::Subscriptions->find( $subscriptionid );
293 my $subscribers = $subscription->subscribers;
294 while ( my $patron = $subscribers->next ) {
295 my $email = $patron->email or next;
297 # warn "sending issues...";
298 my $userenv = C4::Context->userenv;
299 my $library = $patron->library;
300 my $letter = GetPreparedLetter (
302 letter_code => $letter_code,
303 branchcode => $userenv->{branch},
305 'branches' => $library->branchcode,
306 'biblio' => $biblionumber,
307 'biblioitems' => $biblionumber,
308 'borrowers' => $patron->unblessed,
309 'subscription' => $subscriptionid,
310 'serial' => $externalid,
315 # FIXME: This 'default' behaviour should be moved to Koha::Email
316 my $mail = Koha::Email->create(
319 from => $library->branchemail,
320 reply_to => $library->branchreplyto,
321 sender => $library->branchreturnpath,
322 subject => "" . $letter->{title},
326 if ( $letter->{is_html} ) {
327 $mail->html_body( _wrap_html( $letter->{content}, "" . $letter->{title} ) );
330 $mail->text_body( $letter->{content} );
334 $mail->send_or_die({ transport => $library->smtp_server->transport });
337 # We expect ref($_) eq 'Email::Sender::Failure'
338 $error = $_->message;
344 return { error => $error }
348 elsif ( $type eq 'claimacquisition' or $type eq 'claimissues' or $type eq 'orderacquisition' ) {
350 # prepare the letter...
356 if ( $type eq 'claimacquisition') {
358 SELECT aqorders.*,aqbasket.*,biblio.*,biblioitems.*
360 LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno
361 LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
362 LEFT JOIN biblioitems ON aqorders.biblionumber=biblioitems.biblionumber
363 WHERE aqorders.ordernumber IN (
367 carp "No order selected";
368 return { error => "no_order_selected" };
370 $strsth .= join( ",", ('?') x @$externalid ) . ")";
371 $action = "ACQUISITION CLAIM";
372 $sthorders = $dbh->prepare($strsth);
373 $sthorders->execute( @$externalid );
374 $dataorders = $sthorders->fetchall_arrayref( {} );
377 if ($type eq 'claimissues') {
379 SELECT serial.*,subscription.*, biblio.*, biblioitems.*, aqbooksellers.*,
380 aqbooksellers.id AS booksellerid
382 LEFT JOIN subscription ON serial.subscriptionid=subscription.subscriptionid
383 LEFT JOIN biblio ON serial.biblionumber=biblio.biblionumber
384 LEFT JOIN biblioitems ON serial.biblionumber = biblioitems.biblionumber
385 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id
386 WHERE serial.serialid IN (
390 carp "No issues selected";
391 return { error => "no_issues_selected" };
394 $strsth .= join( ",", ('?') x @$externalid ) . ")";
395 $action = "SERIAL CLAIM";
396 $sthorders = $dbh->prepare($strsth);
397 $sthorders->execute( @$externalid );
398 $dataorders = $sthorders->fetchall_arrayref( {} );
401 if ( $type eq 'orderacquisition') {
402 my $basketno = $externalid;
404 SELECT aqorders.*,aqbasket.*,biblio.*,biblioitems.*
406 LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno
407 LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
408 LEFT JOIN biblioitems ON aqorders.biblionumber=biblioitems.biblionumber
409 WHERE aqbasket.basketno = ?
410 AND orderstatus IN ('new','ordered')
413 unless ( $basketno ) {
414 carp "No basketnumber given";
415 return { error => "no_basketno" };
417 $action = "ACQUISITION ORDER";
418 $sthorders = $dbh->prepare($strsth);
419 $sthorders->execute($basketno);
420 $dataorders = $sthorders->fetchall_arrayref( {} );
424 $dbh->prepare("select * from aqbooksellers where id=?");
425 $sthbookseller->execute( $dataorders->[0]->{booksellerid} );
426 my $databookseller = $sthbookseller->fetchrow_hashref;
428 my $addressee = $type eq 'claimacquisition' || $type eq 'orderacquisition' ? 'acqprimary' : 'serialsprimary';
431 $dbh->prepare("SELECT * FROM aqcontacts WHERE booksellerid=? AND $type=1 ORDER BY $addressee DESC");
432 $sthcontact->execute( $dataorders->[0]->{booksellerid} );
433 my $datacontact = $sthcontact->fetchrow_hashref;
437 push @email, $datacontact->{email} if ( $datacontact && $datacontact->{email} );
439 warn "Bookseller $dataorders->[0]->{booksellerid} without emails";
440 return { error => "no_email" };
443 while ($addlcontact = $sthcontact->fetchrow_hashref) {
444 push @cc, $addlcontact->{email} if ( $addlcontact && $addlcontact->{email} );
447 my $userenv = C4::Context->userenv;
448 my $letter = GetPreparedLetter (
450 letter_code => $letter_code,
451 branchcode => $userenv->{branch},
453 'branches' => $userenv->{branch},
454 'aqbooksellers' => $databookseller,
455 'aqcontacts' => $datacontact,
456 'aqbasket' => $basketno,
458 repeat => $dataorders,
460 ) or return { error => "no_letter" };
462 # Remove the order tag
463 $letter->{content} =~ s/<order>(.*?)<\/order>/$1/gxms;
466 my $library = Koha::Libraries->find( $userenv->{branch} );
467 my $mail = Koha::Email->create(
469 to => join( ',', @email ),
470 cc => join( ',', @cc ),
473 C4::Context->preference("ClaimsBccCopy")
474 && ( $type eq 'claimacquisition'
475 || $type eq 'claimissues' )
477 ? ( bcc => $userenv->{emailaddress} )
480 from => $library->branchemail
481 || C4::Context->preference('KohaAdminEmailAddress'),
482 subject => "" . $letter->{title},
486 if ( $letter->{is_html} ) {
487 $mail->html_body( _wrap_html( $letter->{content}, "" . $letter->{title} ) );
490 $mail->text_body( "" . $letter->{content} );
494 $mail->send_or_die({ transport => $library->smtp_server->transport });
497 # We expect ref($_) eq 'Email::Sender::Failure'
498 $error = $_->message;
504 return { error => $error }
507 my $module = $action eq 'ACQUISITION ORDER' ? 'ACQUISITIONS' : 'CLAIMS';
513 . join( ',', @email )
518 ) if C4::Context->preference("ClaimsLog");
520 # send an "account details" notice to a newly created user
521 elsif ( $type eq 'members' ) {
522 my $library = Koha::Libraries->find( $externalid->{branchcode} );
523 my $letter = GetPreparedLetter (
525 letter_code => $letter_code,
526 branchcode => $externalid->{'branchcode'},
527 lang => $externalid->{lang} || 'default',
529 'branches' => $library->unblessed,
530 'borrowers' => $externalid->{'borrowernumber'},
532 substitute => { 'borrowers.password' => $externalid->{'password'} },
535 return { error => "no_email" } unless $externalid->{'emailaddr'};
539 # FIXME: This 'default' behaviour should be moved to Koha::Email
540 my $mail = Koha::Email->create(
542 to => $externalid->{'emailaddr'},
543 from => $library->branchemail,
544 reply_to => $library->branchreplyto,
545 sender => $library->branchreturnpath,
546 subject => "" . $letter->{'title'},
550 if ( $letter->{is_html} ) {
551 $mail->html_body( _wrap_html( $letter->{content}, "" . $letter->{title} ) );
554 $mail->text_body( $letter->{content} );
557 $mail->send_or_die({ transport => $library->smtp_server->transport });
560 # We expect ref($_) eq 'Email::Sender::Failure'
561 $error = $_->message;
567 return { error => $error }
571 # If we come here, return an OK status
575 =head2 GetPreparedLetter( %params )
578 module => letter module, mandatory
579 letter_code => letter code, mandatory
580 branchcode => for letter selection, if missing default system letter taken
581 tables => a hashref with table names as keys. Values are either:
582 - a scalar - primary key value
583 - an arrayref - primary key values
584 - a hashref - full record
585 substitute => custom substitution key/value pairs
586 repeat => records to be substituted on consecutive lines:
587 - an arrayref - tries to guess what needs substituting by
588 taking remaining << >> tokensr; not recommended
589 - a hashref token => @tables - replaces <token> << >> << >> </token>
590 subtemplate for each @tables row; table is a hashref as above
591 want_librarian => boolean, if set to true triggers librarian details
592 substitution from the userenv
594 letter fields hashref (title & content useful)
598 sub GetPreparedLetter {
601 my $letter = $params{letter};
602 my $lang = $params{lang} || 'default';
605 my $module = $params{module} or croak "No module";
606 my $letter_code = $params{letter_code} or croak "No letter_code";
607 my $branchcode = $params{branchcode} || '';
608 my $mtt = $params{message_transport_type} || 'email';
610 my $template = Koha::Notice::Templates->find_effective_template(
613 code => $letter_code,
614 branchcode => $branchcode,
615 message_transport_type => $mtt,
620 unless ( $template ) {
621 warn( "No $module $letter_code letter transported by " . $mtt );
625 $letter = $template->unblessed;
626 $letter->{'content-type'} = 'text/html; charset="UTF-8"' if $letter->{is_html};
629 my $tables = $params{tables} || {};
630 my $substitute = $params{substitute} || {};
631 my $loops = $params{loops} || {}; # loops is not supported for historical notices syntax
632 my $repeat = $params{repeat};
633 %$tables || %$substitute || $repeat || %$loops
634 or carp( "ERROR: nothing to substitute - both 'tables', 'loops' and 'substitute' are empty" ),
636 my $want_librarian = $params{want_librarian};
639 while ( my ($token, $val) = each %$substitute ) {
640 if ( $token eq 'items.content' ) {
641 $val =~ s|\n|<br/>|g if $letter->{is_html};
644 $letter->{title} =~ s/<<$token>>/$val/g;
645 $letter->{content} =~ s/<<$token>>/$val/g;
649 my $OPACBaseURL = C4::Context->preference('OPACBaseURL');
650 $letter->{content} =~ s/<<OPACBaseURL>>/$OPACBaseURL/go;
652 if ($want_librarian) {
653 # parsing librarian name
654 my $userenv = C4::Context->userenv;
655 $letter->{content} =~ s/<<LibrarianFirstname>>/$userenv->{firstname}/go;
656 $letter->{content} =~ s/<<LibrarianSurname>>/$userenv->{surname}/go;
657 $letter->{content} =~ s/<<LibrarianEmailaddress>>/$userenv->{emailaddress}/go;
660 my ($repeat_no_enclosing_tags, $repeat_enclosing_tags);
663 if (ref ($repeat) eq 'ARRAY' ) {
664 $repeat_no_enclosing_tags = $repeat;
666 $repeat_enclosing_tags = $repeat;
670 if ($repeat_enclosing_tags) {
671 while ( my ($tag, $tag_tables) = each %$repeat_enclosing_tags ) {
672 if ( $letter->{content} =~ m!<$tag>(.*)</$tag>!s ) {
675 my %subletter = ( title => '', content => $subcontent );
676 _substitute_tables( \%subletter, $_ );
679 $letter->{content} =~ s!<$tag>.*</$tag>!join( "\n", @lines )!se;
685 _substitute_tables( $letter, $tables );
688 if ($repeat_no_enclosing_tags) {
689 if ( $letter->{content} =~ m/[^\n]*<<.*>>[^\n]*/so ) {
694 $c =~ s/<<count>>/$i/go;
695 foreach my $field ( keys %{$_} ) {
696 $c =~ s/(<<[^\.]+.$field>>)/$_->{$field}/;
700 } @$repeat_no_enclosing_tags;
702 my $replaceby = join( "\n", @lines );
703 $letter->{content} =~ s/\Q$line\E/$replaceby/s;
707 $letter->{content} = _process_tt(
709 content => $letter->{content},
712 substitute => $substitute,
717 $letter->{title} = _process_tt(
719 content => $letter->{title},
722 substitute => $substitute,
726 $letter->{content} =~ s/<<\S*>>//go; #remove any stragglers
731 sub _substitute_tables {
732 my ( $letter, $tables ) = @_;
733 while ( my ($table, $param) = each %$tables ) {
736 my $ref = ref $param;
739 if ($ref && $ref eq 'HASH') {
743 my $sth = _parseletter_sth($table);
745 warn "_parseletter_sth('$table') failed to return a valid sth. No substitution will be done for that table.";
748 $sth->execute( $ref ? @$param : $param );
750 $values = $sth->fetchrow_hashref;
754 _parseletter ( $letter, $table, $values );
758 sub _parseletter_sth {
762 carp "ERROR: _parseletter_sth() called without argument (table)";
765 # NOTE: we used to check whether we had a statement handle cached in
766 # a %handles module-level variable. This was a dumb move and
767 # broke things for the rest of us. prepare_cached is a better
768 # way to cache statement handles anyway.
770 ($table eq 'accountlines' ) ? "SELECT * FROM $table WHERE accountlines_id = ?" :
771 ($table eq 'biblio' ) ? "SELECT * FROM $table WHERE biblionumber = ?" :
772 ($table eq 'biblioitems' ) ? "SELECT * FROM $table WHERE biblionumber = ?" :
773 ($table eq 'credits' ) ? "SELECT * FROM accountlines WHERE accountlines_id = ?" :
774 ($table eq 'debits' ) ? "SELECT * FROM accountlines WHERE accountlines_id = ?" :
775 ($table eq 'items' ) ? "SELECT * FROM $table WHERE itemnumber = ?" :
776 ($table eq 'issues' ) ? "SELECT * FROM $table WHERE itemnumber = ?" :
777 ($table eq 'old_issues' ) ? "SELECT * FROM $table WHERE itemnumber = ? ORDER BY timestamp DESC LIMIT 1" :
778 ($table eq 'reserves' ) ? "SELECT * FROM $table WHERE borrowernumber = ? and biblionumber = ?" :
779 ($table eq 'borrowers' ) ? "SELECT * FROM $table WHERE borrowernumber = ?" :
780 ($table eq 'branches' ) ? "SELECT * FROM $table WHERE branchcode = ?" :
781 ($table eq 'suggestions' ) ? "SELECT * FROM $table WHERE suggestionid = ?" :
782 ($table eq 'aqbooksellers') ? "SELECT * FROM $table WHERE id = ?" :
783 ($table eq 'aqorders' ) ? "SELECT * FROM $table WHERE ordernumber = ?" :
784 ($table eq 'aqbasket' ) ? "SELECT * FROM $table WHERE basketno = ?" :
785 ($table eq 'illrequests' ) ? "SELECT * FROM $table WHERE illrequest_id = ?" :
786 ($table eq 'opac_news' ) ? "SELECT * FROM $table WHERE idnew = ?" :
787 ($table eq 'article_requests') ? "SELECT * FROM $table WHERE id = ?" :
788 ($table eq 'borrower_modifications') ? "SELECT * FROM $table WHERE verification_token = ?" :
789 ($table eq 'subscription') ? "SELECT * FROM $table WHERE subscriptionid = ?" :
790 ($table eq 'serial') ? "SELECT * FROM $table WHERE serialid = ?" :
791 ($table eq 'problem_reports') ? "SELECT * FROM $table WHERE reportid = ?" :
794 warn "ERROR: No _parseletter_sth query for table '$table'";
795 return; # nothing to get
797 unless ($sth = C4::Context->dbh->prepare_cached($query)) {
798 warn "ERROR: Failed to prepare query: '$query'";
801 return $sth; # now cache is populated for that $table
804 =head2 _parseletter($letter, $table, $values)
807 - $letter : a hash to letter fields (title & content useful)
808 - $table : the Koha table to parse.
809 - $values_in : table record hashref
810 parse all fields from a table, and replace values in title & content with the appropriate value
811 (not exported sub, used only internally)
816 my ( $letter, $table, $values_in ) = @_;
818 # Work on a local copy of $values_in (passed by reference) to avoid side effects
819 # in callers ( by changing / formatting values )
820 my $values = $values_in ? { %$values_in } : {};
822 if ( $table eq 'borrowers' && $values->{'dateexpiry'} ){
823 $values->{'dateexpiry'} = output_pref({ dt => dt_from_string( $values->{'dateexpiry'} ), dateonly => 1 });
826 if ( $table eq 'reserves' && $values->{'waitingdate'} ) {
827 $values->{'waitingdate'} = output_pref({ dt => dt_from_string( $values->{'waitingdate'} ), dateonly => 1 });
830 if ($letter->{content} && $letter->{content} =~ /<<today>>/) {
831 my $todaysdate = output_pref( dt_from_string() );
832 $letter->{content} =~ s/<<today>>/$todaysdate/go;
835 while ( my ($field, $val) = each %$values ) {
836 $val =~ s/\p{P}$// if $val && $table=~/biblio/;
837 #BZ 9886: Assuming that we want to eliminate ISBD punctuation here
838 #Therefore adding the test on biblio. This includes biblioitems,
839 #but excludes items. Removed unneeded global and lookahead.
841 if ( $table=~/^borrowers$/ && $field=~/^streettype$/ ) {
842 my $av = Koha::AuthorisedValues->search({ category => 'ROADTYPE', authorised_value => $val });
843 $val = $av->count ? $av->next->lib : '';
847 my $replacedby = defined ($val) ? $val : '';
849 and not $replacedby =~ m|9999-12-31|
850 and $replacedby =~ m|^\d{4}-\d{2}-\d{2}( \d{2}:\d{2}:\d{2})?$| )
852 # If the value is XXXX-YY-ZZ[ AA:BB:CC] we assume it is a date
853 my $dateonly = defined $1 ? 0 : 1; #$1 refers to the capture group wrapped in parentheses. In this case, that's the hours, minutes, seconds.
854 my $re_dateonly_filter = qr{ $field( \s* \| \s* dateonly\s*)?>> }xms;
856 for my $letter_field ( qw( title content ) ) {
857 my $filter_string_used = q{};
858 if ( $letter->{ $letter_field } =~ $re_dateonly_filter ) {
859 # We overwrite $dateonly if the filter exists and we have a time in the datetime
860 $filter_string_used = $1 || q{};
861 $dateonly = $1 unless $dateonly;
863 my $replacedby_date = eval {
864 output_pref({ dt => dt_from_string( $replacedby ), dateonly => $dateonly });
867 if ( $letter->{ $letter_field } ) {
868 $letter->{ $letter_field } =~ s/\Q<<$table.$field$filter_string_used>>\E/$replacedby_date/g;
869 $letter->{ $letter_field } =~ s/\Q<<$field$filter_string_used>>\E/$replacedby_date/g;
873 # Other fields replacement
875 for my $letter_field ( qw( title content ) ) {
876 if ( $letter->{ $letter_field } ) {
877 $letter->{ $letter_field } =~ s/<<$table.$field>>/$replacedby/g;
878 $letter->{ $letter_field } =~ s/<<$field>>/$replacedby/g;
884 if ($table eq 'borrowers' && $letter->{content}) {
885 my $patron = Koha::Patrons->find( $values->{borrowernumber} );
887 my $attributes = $patron->extended_attributes;
889 while ( my $attribute = $attributes->next ) {
890 my $code = $attribute->code;
891 my $val = $attribute->description; # FIXME - we always display intranet description here!
892 $val =~ s/\p{P}(?=$)//g if $val;
893 next unless $val gt '';
895 push @{ $attr{$code} }, $val;
897 while ( my ($code, $val_ar) = each %attr ) {
898 my $replacefield = "<<borrower-attribute:$code>>";
899 my $replacedby = join ',', @$val_ar;
900 $letter->{content} =~ s/$replacefield/$replacedby/g;
909 my $success = EnqueueLetter( { letter => $letter,
910 borrowernumber => '12', message_transport_type => 'email' } )
912 places a letter in the message_queue database table, which will
913 eventually get processed (sent) by the process_message_queue.pl
914 cronjob when it calls SendQueuedMessages.
916 return message_id on success
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'},
939 message => MIME::Lite->new( Type => 'multipart/mixed' ),
944 my $dbh = C4::Context->dbh();
945 my $statement = << 'ENDSQL';
946 INSERT INTO message_queue
947 ( borrowernumber, subject, content, metadata, letter_code, message_transport_type, status, time_queued, to_address, from_address, reply_address, content_type, delivery_note )
949 ( ?, ?, ?, ?, ?, ?, ?, CAST(NOW() AS DATETIME), ?, ?, ?, ?, ? )
952 my $sth = $dbh->prepare($statement);
953 my $result = $sth->execute(
954 $params->{'borrowernumber'}, # borrowernumber
955 $params->{'letter'}->{'title'}, # subject
956 $params->{'letter'}->{'content'}, # content
957 $params->{'letter'}->{'metadata'} || '', # metadata
958 $params->{'letter'}->{'code'} || '', # letter_code
959 $params->{'message_transport_type'}, # message_transport_type
961 $params->{'to_address'}, # to_address
962 $params->{'from_address'}, # from_address
963 $params->{'reply_address'}, # reply_address
964 $params->{'letter'}->{'content-type'}, # content_type
965 $params->{'delivery_note'} || '', # delivery_note
967 return $dbh->last_insert_id(undef,undef,'message_queue', undef);
970 =head2 SendQueuedMessages ([$hashref])
972 my $sent = SendQueuedMessages({
973 letter_code => $letter_code,
974 borrowernumber => $who_letter_is_for,
980 Sends all of the 'pending' items in the message queue, unless
981 parameters are passed.
983 The letter_code, borrowernumber and limit parameters are used
984 to build a parameter set for _get_unsent_messages, thus limiting
985 which pending messages will be processed. They are all optional.
987 The verbose parameter can be used to generate debugging output.
990 Returns number of messages sent.
994 sub SendQueuedMessages {
997 my $which_unsent_messages = {
998 'message_id' => $params->{'message_id'},
999 'limit' => $params->{'limit'} // 0,
1000 'borrowernumber' => $params->{'borrowernumber'} // q{},
1001 'letter_code' => $params->{'letter_code'} // q{},
1002 'type' => $params->{'type'} // q{},
1004 my $unsent_messages = _get_unsent_messages( $which_unsent_messages );
1005 MESSAGE: foreach my $message ( @$unsent_messages ) {
1006 my $message_object = Koha::Notice::Messages->find( $message->{message_id} );
1007 # If this fails the database is unwritable and we won't manage to send a message that continues to be marked 'pending'
1008 $message_object->make_column_dirty('status');
1009 return unless $message_object->store;
1011 # warn Data::Dumper->Dump( [ $message ], [ 'message' ] );
1012 warn sprintf( 'sending %s message to patron: %s',
1013 $message->{'message_transport_type'},
1014 $message->{'borrowernumber'} || 'Admin' )
1015 if $params->{'verbose'};
1016 # This is just begging for subclassing
1017 next MESSAGE if ( lc($message->{'message_transport_type'}) eq 'rss' );
1018 if ( lc( $message->{'message_transport_type'} ) eq 'email' ) {
1019 _send_message_by_email( $message, $params->{'username'}, $params->{'password'}, $params->{'method'} );
1021 elsif ( lc( $message->{'message_transport_type'} ) eq 'sms' ) {
1022 if ( C4::Context->preference('SMSSendDriver') eq 'Email' ) {
1023 my $patron = Koha::Patrons->find( $message->{borrowernumber} );
1024 my $sms_provider = Koha::SMS::Providers->find( $patron->sms_provider_id );
1025 unless ( $sms_provider ) {
1026 warn sprintf( "Patron %s has no sms provider id set!", $message->{'borrowernumber'} ) if $params->{'verbose'};
1027 _set_message_status( { message_id => $message->{'message_id'}, status => 'failed' } );
1030 unless ( $patron->smsalertnumber ) {
1031 _set_message_status( { message_id => $message->{'message_id'}, status => 'failed' } );
1032 warn sprintf( "No smsalertnumber found for patron %s!", $message->{'borrowernumber'} ) if $params->{'verbose'};
1035 $message->{to_address} = $patron->smsalertnumber; #Sometime this is set to email - sms should always use smsalertnumber
1036 $message->{to_address} .= '@' . $sms_provider->domain();
1038 # Check for possible from_address override
1039 my $from_address = C4::Context->preference('EmailSMSSendDriverFromAddress');
1040 if ($from_address && $message->{from_address} ne $from_address) {
1041 $message->{from_address} = $from_address;
1042 _update_message_from_address($message->{'message_id'}, $message->{from_address});
1045 _update_message_to_address($message->{'message_id'}, $message->{to_address});
1046 _send_message_by_email( $message, $params->{'username'}, $params->{'password'}, $params->{'method'} );
1048 _send_message_by_sms( $message );
1052 return scalar( @$unsent_messages );
1055 =head2 GetRSSMessages
1057 my $message_list = GetRSSMessages( { limit => 10, borrowernumber => '14' } )
1059 returns a listref of all queued RSS messages for a particular person.
1063 sub GetRSSMessages {
1066 return unless $params;
1067 return unless ref $params;
1068 return unless $params->{'borrowernumber'};
1070 return _get_unsent_messages( { message_transport_type => 'rss',
1071 limit => $params->{'limit'},
1072 borrowernumber => $params->{'borrowernumber'}, } );
1075 =head2 GetPrintMessages
1077 my $message_list = GetPrintMessages( { borrowernumber => $borrowernumber } )
1079 Returns a arrayref of all queued print messages (optionally, for a particular
1084 sub GetPrintMessages {
1085 my $params = shift || {};
1087 return _get_unsent_messages( { message_transport_type => 'print',
1088 borrowernumber => $params->{'borrowernumber'},
1092 =head2 GetQueuedMessages ([$hashref])
1094 my $messages = GetQueuedMessage( { borrowernumber => '123', limit => 20 } );
1096 Fetches a list of messages from the message queue optionally filtered by borrowernumber
1097 and limited to specified limit.
1099 Return is an arrayref of hashes, each has represents a message in the message queue.
1103 sub GetQueuedMessages {
1106 my $dbh = C4::Context->dbh();
1107 my $statement = << 'ENDSQL';
1108 SELECT message_id, borrowernumber, subject, content, message_transport_type, status, time_queued, updated_on, delivery_note
1114 if ( exists $params->{'borrowernumber'} ) {
1115 push @whereclauses, ' borrowernumber = ? ';
1116 push @query_params, $params->{'borrowernumber'};
1119 if ( @whereclauses ) {
1120 $statement .= ' WHERE ' . join( 'AND', @whereclauses );
1123 if ( defined $params->{'limit'} ) {
1124 $statement .= ' LIMIT ? ';
1125 push @query_params, $params->{'limit'};
1128 my $sth = $dbh->prepare( $statement );
1129 my $result = $sth->execute( @query_params );
1130 return $sth->fetchall_arrayref({});
1133 =head2 GetMessageTransportTypes
1135 my @mtt = GetMessageTransportTypes();
1137 returns an arrayref of transport types
1141 sub GetMessageTransportTypes {
1142 my $dbh = C4::Context->dbh();
1143 my $mtts = $dbh->selectcol_arrayref("
1144 SELECT message_transport_type
1145 FROM message_transport_types
1146 ORDER BY message_transport_type
1153 my $message = C4::Letters::Message($message_id);
1158 my ( $message_id ) = @_;
1159 return unless $message_id;
1160 my $dbh = C4::Context->dbh;
1161 return $dbh->selectrow_hashref(q|
1162 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, delivery_note
1164 WHERE message_id = ?
1165 |, {}, $message_id );
1168 =head2 ResendMessage
1170 Attempt to resend a message which has failed previously.
1172 my $has_been_resent = C4::Letters::ResendMessage($message_id);
1174 Updates the message to 'pending' status so that
1175 it will be resent later on.
1177 returns 1 on success, 0 on failure, undef if no message was found
1182 my $message_id = shift;
1183 return unless $message_id;
1185 my $message = GetMessage( $message_id );
1186 return unless $message;
1188 if ( $message->{status} ne 'pending' ) {
1189 $rv = C4::Letters::_set_message_status({
1190 message_id => $message_id,
1191 status => 'pending',
1193 $rv = $rv > 0? 1: 0;
1194 # Clear destination email address to force address update
1195 _update_message_to_address( $message_id, undef ) if $rv &&
1196 $message->{message_transport_type} eq 'email';
1201 =head2 _add_attachements
1204 letter - the standard letter hashref
1205 attachments - listref of attachments. each attachment is a hashref of:
1206 type - the mime type, like 'text/plain'
1207 content - the actual attachment
1208 filename - the name of the attachment.
1209 message - a MIME::Lite object to attach these to.
1211 returns your letter object, with the content updated.
1215 sub _add_attachments {
1218 my $letter = $params->{'letter'};
1219 my $attachments = $params->{'attachments'};
1220 return $letter unless @$attachments;
1221 my $message = $params->{'message'};
1223 # First, we have to put the body in as the first attachment
1225 Type => $letter->{'content-type'} || 'TEXT',
1226 Data => $letter->{'is_html'}
1227 ? _wrap_html($letter->{'content'}, $letter->{'title'})
1228 : $letter->{'content'},
1231 foreach my $attachment ( @$attachments ) {
1233 Type => $attachment->{'type'},
1234 Data => $attachment->{'content'},
1235 Filename => $attachment->{'filename'},
1238 # we're forcing list context here to get the header, not the count back from grep.
1239 ( $letter->{'content-type'} ) = grep( /^Content-Type:/, split( /\n/, $params->{'message'}->header_as_string ) );
1240 $letter->{'content-type'} =~ s/^Content-Type:\s+//;
1241 $letter->{'content'} = $message->body_as_string;
1247 =head2 _get_unsent_messages
1249 This function's parameter hash reference takes the following
1250 optional named parameters:
1251 message_transport_type: method of message sending (e.g. email, sms, etc.)
1252 borrowernumber : who the message is to be sent
1253 letter_code : type of message being sent (e.g. PASSWORD_RESET)
1254 message_id : the message_id of the message. In that case the sub will return only 1 result
1255 limit : maximum number of messages to send
1257 This function returns an array of matching hash referenced rows from
1258 message_queue with some borrower information added.
1262 sub _get_unsent_messages {
1265 my $dbh = C4::Context->dbh();
1267 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.delivery_note
1268 FROM message_queue mq
1269 LEFT JOIN borrowers b ON b.borrowernumber = mq.borrowernumber
1273 my @query_params = ('pending');
1274 if ( ref $params ) {
1275 if ( $params->{'message_transport_type'} ) {
1276 $statement .= ' AND mq.message_transport_type = ? ';
1277 push @query_params, $params->{'message_transport_type'};
1279 if ( $params->{'borrowernumber'} ) {
1280 $statement .= ' AND mq.borrowernumber = ? ';
1281 push @query_params, $params->{'borrowernumber'};
1283 if ( $params->{'letter_code'} ) {
1284 $statement .= ' AND mq.letter_code = ? ';
1285 push @query_params, $params->{'letter_code'};
1287 if ( $params->{'type'} ) {
1288 $statement .= ' AND message_transport_type = ? ';
1289 push @query_params, $params->{'type'};
1291 if ( $params->{message_id} ) {
1292 $statement .= ' AND message_id = ?';
1293 push @query_params, $params->{message_id};
1295 if ( $params->{'limit'} ) {
1296 $statement .= ' limit ? ';
1297 push @query_params, $params->{'limit'};
1301 my $sth = $dbh->prepare( $statement );
1302 my $result = $sth->execute( @query_params );
1303 return $sth->fetchall_arrayref({});
1306 sub _send_message_by_email {
1307 my $message = shift or return;
1308 my ($username, $password, $method) = @_;
1310 my $patron = Koha::Patrons->find( $message->{borrowernumber} );
1311 my $to_address = $message->{'to_address'};
1312 unless ($to_address) {
1314 warn "FAIL: No 'to_address' and INVALID borrowernumber ($message->{borrowernumber})";
1315 _set_message_status( { message_id => $message->{'message_id'},
1317 delivery_note => 'Invalid borrowernumber '.$message->{borrowernumber},
1318 error_code => 'INVALID_BORNUMBER' } );
1321 $to_address = $patron->notice_email_address;
1322 unless ($to_address) {
1323 # warn "FAIL: No 'to_address' and no email for " . ($member->{surname} ||'') . ", borrowernumber ($message->{borrowernumber})";
1324 # warning too verbose for this more common case?
1325 _set_message_status( { message_id => $message->{'message_id'},
1327 delivery_note => 'Unable to find an email address for this borrower',
1328 error_code => 'NO_EMAIL' } );
1333 my $subject = $message->{'subject'};
1335 my $content = $message->{'content'};
1336 my $content_type = $message->{'content_type'} || 'text/plain; charset="UTF-8"';
1337 my $is_html = $content_type =~ m/html/io;
1339 my $branch_email = undef;
1340 my $branch_replyto = undef;
1341 my $branch_returnpath = undef;
1345 $library = $patron->library;
1346 $branch_email = $library->from_email_address;
1347 $branch_replyto = $library->branchreplyto;
1348 $branch_returnpath = $library->branchreturnpath;
1352 $message->{'from_address'}
1354 || C4::Context->preference('KohaAdminEmailAddress');
1355 if( !$from_address ) {
1356 _set_message_status({
1357 message_id => $message->{'message_id'},
1359 delivery_note => 'No from address',
1363 my $email = Koha::Email->create(
1367 C4::Context->preference('NoticeBcc')
1368 ? ( bcc => C4::Context->preference('NoticeBcc') )
1371 from => $from_address,
1372 reply_to => $message->{'reply_address'} || $branch_replyto,
1373 sender => $branch_returnpath,
1374 subject => "" . $message->{subject}
1380 _wrap_html( $content, $subject )
1384 $email->text_body( $content );
1389 $smtp_server = $library->smtp_server;
1392 $smtp_server = Koha::SMTP::Servers->get_default;
1398 sasl_username => $username,
1399 sasl_password => $password,
1404 # if initial message address was empty, coming here means that a to address was found and
1405 # queue should be updated; same if to address was overriden by Koha::Email->create
1406 _update_message_to_address( $message->{'message_id'}, $email->email->header('To') )
1407 if !$message->{to_address}
1408 || $message->{to_address} ne $email->email->header('To');
1411 $email->send_or_die({ transport => $smtp_server->transport });
1413 _set_message_status(
1415 message_id => $message->{'message_id'},
1423 _set_message_status(
1425 message_id => $message->{'message_id'},
1427 delivery_note => $Mail::Sendmail::error
1436 my ($content, $title) = @_;
1438 my $css = C4::Context->preference("NoticeCSS") || '';
1439 $css = qq{<link rel="stylesheet" type="text/css" href="$css">} if $css;
1441 <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
1442 "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
1443 <html lang="en" xml:lang="en" xmlns="http://www.w3.org/1999/xhtml">
1445 <title>$title</title>
1446 <meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
1457 my ( $message ) = @_;
1458 my $dbh = C4::Context->dbh;
1459 my $count = $dbh->selectrow_array(q|
1462 WHERE message_transport_type = ?
1463 AND borrowernumber = ?
1465 AND CAST(updated_on AS date) = CAST(NOW() AS date)
1468 |, {}, $message->{message_transport_type}, $message->{borrowernumber}, $message->{letter_code}, $message->{content} );
1472 sub _send_message_by_sms {
1473 my $message = shift or return;
1474 my $patron = Koha::Patrons->find( $message->{borrowernumber} );
1476 unless ( $patron and $patron->smsalertnumber ) {
1477 _set_message_status( { message_id => $message->{'message_id'},
1479 delivery_note => 'Missing SMS number',
1480 error_code => 'MISSING_SMS' } );
1484 if ( _is_duplicate( $message ) ) {
1485 _set_message_status( { message_id => $message->{'message_id'},
1487 delivery_note => 'Message is duplicate',
1488 error_code => 'DUPLICATE_MESSAGE' } );
1492 my $success = C4::SMS->send_sms( { destination => $patron->smsalertnumber,
1493 message => $message->{'content'},
1495 _set_message_status( { message_id => $message->{'message_id'},
1496 status => ($success ? 'sent' : 'failed'),
1497 delivery_note => ($success ? '' : 'No notes from SMS driver'),
1498 error_code => 'NO_NOTES' } );
1503 sub _update_message_to_address {
1505 my $dbh = C4::Context->dbh();
1506 $dbh->do('UPDATE message_queue SET to_address=? WHERE message_id=?',undef,($to,$id));
1509 sub _update_message_from_address {
1510 my ($message_id, $from_address) = @_;
1511 my $dbh = C4::Context->dbh();
1512 $dbh->do('UPDATE message_queue SET from_address = ? WHERE message_id = ?', undef, ($from_address, $message_id));
1515 sub _set_message_status {
1516 my $params = shift or return;
1518 foreach my $required_parameter ( qw( message_id status ) ) {
1519 return unless exists $params->{ $required_parameter };
1522 my $dbh = C4::Context->dbh();
1523 my $statement = 'UPDATE message_queue SET status= ?, delivery_note= ? WHERE message_id = ?';
1524 my $sth = $dbh->prepare( $statement );
1525 my $result = $sth->execute( $params->{'status'},
1526 $params->{'delivery_note'} || '',
1527 $params->{'message_id'} );
1532 my ( $params ) = @_;
1534 my $content = $params->{content};
1535 my $tables = $params->{tables};
1536 my $loops = $params->{loops};
1537 my $substitute = $params->{substitute} || {};
1538 my $lang = defined($params->{lang}) && $params->{lang} ne 'default' ? $params->{lang} : 'en';
1539 my ($theme, $availablethemes);
1541 my $htdocs = C4::Context->config('intrahtdocs');
1542 ($theme, $lang, $availablethemes)= C4::Templates::availablethemes( $htdocs, 'about.tt', 'intranet', $lang);
1544 foreach (@$availablethemes) {
1545 push @includes, "$htdocs/$_/$lang/includes";
1546 push @includes, "$htdocs/$_/en/includes" unless $lang eq 'en';
1549 my $use_template_cache = C4::Context->config('template_cache_dir') && defined $ENV{GATEWAY_INTERFACE};
1550 my $template = Template->new(
1554 PLUGIN_BASE => 'Koha::Template::Plugin',
1555 COMPILE_EXT => $use_template_cache ? '.ttc' : '',
1556 COMPILE_DIR => $use_template_cache ? C4::Context->config('template_cache_dir') : '',
1557 INCLUDE_PATH => \@includes,
1559 ENCODING => 'UTF-8',
1561 ) or die Template->error();
1563 my $tt_params = { %{ _get_tt_params( $tables ) }, %{ _get_tt_params( $loops, 'is_a_loop' ) }, %$substitute };
1565 $content = add_tt_filters( $content );
1566 $content = qq|[% USE KohaDates %][% USE Remove_MARC_punctuation %]$content|;
1569 $template->process( \$content, $tt_params, \$output ) || croak "ERROR PROCESSING TEMPLATE: " . $template->error();
1574 sub _get_tt_params {
1575 my ($tables, $is_a_loop) = @_;
1581 article_requests => {
1582 module => 'Koha::ArticleRequests',
1583 singular => 'article_request',
1584 plural => 'article_requests',
1588 module => 'Koha::Acquisition::Baskets',
1589 singular => 'basket',
1590 plural => 'baskets',
1594 module => 'Koha::Biblios',
1595 singular => 'biblio',
1596 plural => 'biblios',
1597 pk => 'biblionumber',
1600 module => 'Koha::Biblioitems',
1601 singular => 'biblioitem',
1602 plural => 'biblioitems',
1603 pk => 'biblioitemnumber',
1606 module => 'Koha::Patrons',
1607 singular => 'borrower',
1608 plural => 'borrowers',
1609 pk => 'borrowernumber',
1612 module => 'Koha::Libraries',
1613 singular => 'branch',
1614 plural => 'branches',
1618 module => 'Koha::Account::Lines',
1619 singular => 'credit',
1620 plural => 'credits',
1621 pk => 'accountlines_id',
1624 module => 'Koha::Account::Lines',
1625 singular => 'debit',
1627 pk => 'accountlines_id',
1630 module => 'Koha::Items',
1636 module => 'Koha::News',
1642 module => 'Koha::Acquisition::Orders',
1643 singular => 'order',
1645 pk => 'ordernumber',
1648 module => 'Koha::Holds',
1654 module => 'Koha::Serials',
1655 singular => 'serial',
1656 plural => 'serials',
1660 module => 'Koha::Subscriptions',
1661 singular => 'subscription',
1662 plural => 'subscriptions',
1663 pk => 'subscriptionid',
1666 module => 'Koha::Suggestions',
1667 singular => 'suggestion',
1668 plural => 'suggestions',
1669 pk => 'suggestionid',
1672 module => 'Koha::Checkouts',
1673 singular => 'checkout',
1674 plural => 'checkouts',
1678 module => 'Koha::Old::Checkouts',
1679 singular => 'old_checkout',
1680 plural => 'old_checkouts',
1684 module => 'Koha::Checkouts',
1685 singular => 'overdue',
1686 plural => 'overdues',
1689 borrower_modifications => {
1690 module => 'Koha::Patron::Modifications',
1691 singular => 'patron_modification',
1692 plural => 'patron_modifications',
1693 fk => 'verification_token',
1696 module => 'Koha::Illrequests',
1697 singular => 'illrequest',
1698 plural => 'illrequests',
1699 pk => 'illrequest_id'
1703 foreach my $table ( keys %$tables ) {
1704 next unless $config->{$table};
1706 my $ref = ref( $tables->{$table} ) || q{};
1707 my $module = $config->{$table}->{module};
1709 if ( can_load( modules => { $module => undef } ) ) {
1710 my $pk = $config->{$table}->{pk};
1711 my $fk = $config->{$table}->{fk};
1714 my $values = $tables->{$table} || [];
1715 unless ( ref( $values ) eq 'ARRAY' ) {
1716 croak "ERROR processing table $table. Wrong API call.";
1718 my $key = $pk ? $pk : $fk;
1719 # $key does not come from user input
1720 my $objects = $module->search(
1721 { $key => $values },
1723 # We want to retrieve the data in the same order
1725 # field is a MySQLism, but they are no other way to do it
1726 # To be generic we could do it in perl, but we will need to fetch
1727 # all the data then order them
1728 @$values ? ( order_by => \[ "field($key, " . join( ', ', @$values ) . ")" ] ) : ()
1731 $params->{ $config->{$table}->{plural} } = $objects;
1733 elsif ( $ref eq q{} || $ref eq 'HASH' ) {
1734 my $id = ref $ref eq 'HASH' ? $tables->{$table}->{$pk} : $tables->{$table};
1736 if ( $fk ) { # Using a foreign key for lookup
1737 if ( ref( $fk ) eq 'ARRAY' ) { # Foreign key is multi-column
1739 foreach my $key ( @$fk ) {
1740 $search->{$key} = $id->{$key};
1742 $object = $module->search( $search )->last();
1743 } else { # Foreign key is single column
1744 $object = $module->search( { $fk => $id } )->last();
1746 } else { # using the table's primary key for lookup
1747 $object = $module->find($id);
1749 $params->{ $config->{$table}->{singular} } = $object;
1751 else { # $ref eq 'ARRAY'
1753 if ( @{ $tables->{$table} } == 1 ) { # Param is a single key
1754 $object = $module->search( { $pk => $tables->{$table} } )->last();
1756 else { # Params are mutliple foreign keys
1757 croak "Multiple foreign keys (table $table) should be passed using an hashref";
1759 $params->{ $config->{$table}->{singular} } = $object;
1763 croak "ERROR LOADING MODULE $module: $Module::Load::Conditional::ERROR";
1767 $params->{today} = output_pref({ dt => dt_from_string, dateformat => 'iso' });
1772 =head3 add_tt_filters
1774 $content = add_tt_filters( $content );
1776 Add TT filters to some specific fields if needed.
1778 For now we only add the Remove_MARC_punctuation TT filter to biblio and biblioitem fields
1782 sub add_tt_filters {
1783 my ( $content ) = @_;
1784 $content =~ s|\[%\s*biblio\.(.*?)\s*%\]|[% biblio.$1 \| \$Remove_MARC_punctuation %]|gxms;
1785 $content =~ s|\[%\s*biblioitem\.(.*?)\s*%\]|[% biblioitem.$1 \| \$Remove_MARC_punctuation %]|gxms;
1789 =head2 get_item_content
1791 my $item = Koha::Items->find(...)->unblessed;
1792 my @item_content_fields = qw( date_due title barcode author itemnumber );
1793 my $item_content = C4::Letters::get_item_content({
1795 item_content_fields => \@item_content_fields
1798 This function generates a tab-separated list of values for the passed item. Dates
1799 are formatted following the current setup.
1803 sub get_item_content {
1804 my ( $params ) = @_;
1805 my $item = $params->{item};
1806 my $dateonly = $params->{dateonly} || 0;
1807 my $item_content_fields = $params->{item_content_fields} || [];
1809 return unless $item;
1811 my @item_info = map {
1815 { dt => dt_from_string( $item->{$_} ), dateonly => $dateonly } );
1819 } @$item_content_fields;
1820 return join( "\t", @item_info ) . "\n";