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 Carp qw( carp croak );
25 use Module::Load::Conditional qw( can_load );
27 use Try::Tiny qw( catch try );
30 use C4::Log qw( logaction );
33 use Koha::DateUtils qw( dt_from_string output_pref );
34 use Koha::SMS::Providers;
37 use Koha::Notice::Messages;
38 use Koha::Notice::Templates;
39 use Koha::DateUtils qw( dt_from_string output_pref );
41 use Koha::SMTP::Servers;
42 use Koha::Subscriptions;
44 our (@ISA, @EXPORT_OK);
50 GetLettersAvailableForALibrary
59 GetMessageTransportTypes
69 C4::Letters - Give functions for Letters management
77 "Letters" is the tool used in Koha to manage informations sent to the patrons and/or the library. This include some cron jobs like
78 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)
80 Letters are managed through "alerts" sent by Koha on some events. All "alert" related functions are in this module too.
82 =head2 GetLetters([$module])
84 $letters = &GetLetters($module);
85 returns informations about letters.
86 if needed, $module filters for letters given module
88 DEPRECATED - You must use Koha::Notice::Templates instead
89 The group by clause is confusing and can lead to issues
95 my $module = $filters->{module};
96 my $code = $filters->{code};
97 my $branchcode = $filters->{branchcode};
98 my $dbh = C4::Context->dbh;
99 my $letters = $dbh->selectall_arrayref(
101 SELECT code, module, name
105 . ( $module ? q| AND module = ?| : q|| )
106 . ( $code ? q| AND code = ?| : q|| )
107 . ( defined $branchcode ? q| AND branchcode = ?| : q|| )
108 . q| GROUP BY code, module, name ORDER BY name|, { Slice => {} }
109 , ( $module ? $module : () )
110 , ( $code ? $code : () )
111 , ( defined $branchcode ? $branchcode : () )
117 =head2 GetLetterTemplates
119 my $letter_templates = GetLetterTemplates(
121 module => 'circulation',
123 branchcode => 'CPL', # '' for default,
127 Return a hashref of letter templates.
131 sub GetLetterTemplates {
134 my $module = $params->{module};
135 my $code = $params->{code};
136 my $branchcode = $params->{branchcode} // '';
137 my $dbh = C4::Context->dbh;
138 return Koha::Notice::Templates->search(
142 branchcode => $branchcode,
144 C4::Context->preference('TranslateNotices')
146 : ( lang => 'default' )
152 =head2 GetLettersAvailableForALibrary
154 my $letters = GetLettersAvailableForALibrary(
156 branchcode => 'CPL', # '' for default
157 module => 'circulation',
161 Return an arrayref of letters, sorted by name.
162 If a specific letter exist for the given branchcode, it will be retrieve.
163 Otherwise the default letter will be.
167 sub GetLettersAvailableForALibrary {
169 my $branchcode = $filters->{branchcode};
170 my $module = $filters->{module};
172 croak "module should be provided" unless $module;
174 my $dbh = C4::Context->dbh;
175 my $default_letters = $dbh->selectall_arrayref(
177 SELECT module, code, branchcode, name
181 . q| AND branchcode = ''|
182 . ( $module ? q| AND module = ?| : q|| )
183 . q| ORDER BY name|, { Slice => {} }
184 , ( $module ? $module : () )
187 my $specific_letters;
189 $specific_letters = $dbh->selectall_arrayref(
191 SELECT module, code, branchcode, name
195 . q| AND branchcode = ?|
196 . ( $module ? q| AND module = ?| : q|| )
197 . q| ORDER BY name|, { Slice => {} }
199 , ( $module ? $module : () )
204 for my $l (@$default_letters) {
205 $letters{ $l->{code} } = $l;
207 for my $l (@$specific_letters) {
208 # Overwrite the default letter with the specific one.
209 $letters{ $l->{code} } = $l;
212 return [ map { $letters{$_} }
213 sort { $letters{$a}->{name} cmp $letters{$b}->{name} }
223 module => 'circulation',
229 Delete the letter. The mtt parameter is facultative.
230 If not given, all templates mathing the other parameters will be removed.
236 my $branchcode = $params->{branchcode};
237 my $module = $params->{module};
238 my $code = $params->{code};
239 my $mtt = $params->{mtt};
240 my $lang = $params->{lang};
241 my $dbh = C4::Context->dbh;
248 . ( $mtt ? q| AND message_transport_type = ?| : q|| )
249 . ( $lang? q| AND lang = ?| : q|| )
250 , undef, $branchcode, $module, $code, ( $mtt ? $mtt : () ), ( $lang ? $lang : () ) );
255 my $err = &SendAlerts($type, $externalid, $letter_code);
258 - $type : the type of alert
259 - $externalid : the id of the "object" to query
260 - $letter_code : the notice template to use
262 C<&SendAlerts> sends an email notice directly to a patron or a vendor.
264 Currently it supports ($type):
265 - claim serial issues (claimissues)
266 - claim acquisition orders (claimacquisition)
267 - send acquisition orders to the vendor (orderacquisition)
268 - notify patrons about newly received serial issues (issue)
269 - notify patrons when their account is created (members)
271 Returns undef or { error => 'message } on failure.
272 Returns true on success.
277 my ( $type, $externalid, $letter_code ) = @_;
278 my $dbh = C4::Context->dbh;
281 if ( $type eq 'issue' ) {
283 # prepare the letter...
284 # search the subscriptionid
287 "SELECT subscriptionid FROM serial WHERE serialid=?");
288 $sth->execute($externalid);
289 my ($subscriptionid) = $sth->fetchrow
290 or warn( "No subscription for '$externalid'" ),
293 # search the biblionumber
296 "SELECT biblionumber FROM subscription WHERE subscriptionid=?");
297 $sth->execute($subscriptionid);
298 my ($biblionumber) = $sth->fetchrow
299 or warn( "No biblionumber for '$subscriptionid'" ),
302 # find the list of subscribers to notify
303 my $subscription = Koha::Subscriptions->find( $subscriptionid );
304 my $subscribers = $subscription->subscribers;
305 while ( my $patron = $subscribers->next ) {
306 my $email = $patron->email or next;
308 # warn "sending issues...";
309 my $userenv = C4::Context->userenv;
310 my $library = $patron->library;
311 my $letter = GetPreparedLetter (
313 letter_code => $letter_code,
314 branchcode => $userenv->{branch},
316 'branches' => $library->branchcode,
317 'biblio' => $biblionumber,
318 'biblioitems' => $biblionumber,
319 'borrowers' => $patron->unblessed,
320 'subscription' => $subscriptionid,
321 'serial' => $externalid,
326 # FIXME: This 'default' behaviour should be moved to Koha::Email
327 my $mail = Koha::Email->create(
330 from => $library->branchemail,
331 reply_to => $library->branchreplyto,
332 sender => $library->branchreturnpath,
333 subject => "" . $letter->{title},
337 if ( $letter->{is_html} ) {
338 $mail->html_body( _wrap_html( $letter->{content}, "" . $letter->{title} ) );
341 $mail->text_body( $letter->{content} );
345 $mail->send_or_die({ transport => $library->smtp_server->transport });
348 # We expect ref($_) eq 'Email::Sender::Failure'
349 $error = $_->message;
355 return { error => $error }
359 elsif ( $type eq 'claimacquisition' or $type eq 'claimissues' or $type eq 'orderacquisition' ) {
361 # prepare the letter...
367 if ( $type eq 'claimacquisition') {
369 SELECT aqorders.*,aqbasket.*,biblio.*,biblioitems.*
371 LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno
372 LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
373 LEFT JOIN biblioitems ON aqorders.biblionumber=biblioitems.biblionumber
374 WHERE aqorders.ordernumber IN (
378 carp "No order selected";
379 return { error => "no_order_selected" };
381 $strsth .= join( ",", ('?') x @$externalid ) . ")";
382 $action = "ACQUISITION CLAIM";
383 $sthorders = $dbh->prepare($strsth);
384 $sthorders->execute( @$externalid );
385 $dataorders = $sthorders->fetchall_arrayref( {} );
388 if ($type eq 'claimissues') {
390 SELECT serial.*,subscription.*, biblio.*, biblioitems.*, aqbooksellers.*,
391 aqbooksellers.id AS booksellerid
393 LEFT JOIN subscription ON serial.subscriptionid=subscription.subscriptionid
394 LEFT JOIN biblio ON serial.biblionumber=biblio.biblionumber
395 LEFT JOIN biblioitems ON serial.biblionumber = biblioitems.biblionumber
396 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id
397 WHERE serial.serialid IN (
401 carp "No issues selected";
402 return { error => "no_issues_selected" };
405 $strsth .= join( ",", ('?') x @$externalid ) . ")";
406 $action = "SERIAL CLAIM";
407 $sthorders = $dbh->prepare($strsth);
408 $sthorders->execute( @$externalid );
409 $dataorders = $sthorders->fetchall_arrayref( {} );
412 if ( $type eq 'orderacquisition') {
413 my $basketno = $externalid;
415 SELECT aqorders.*,aqbasket.*,biblio.*,biblioitems.*
417 LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno
418 LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
419 LEFT JOIN biblioitems ON aqorders.biblionumber=biblioitems.biblionumber
420 WHERE aqbasket.basketno = ?
421 AND orderstatus IN ('new','ordered')
424 unless ( $basketno ) {
425 carp "No basketnumber given";
426 return { error => "no_basketno" };
428 $action = "ACQUISITION ORDER";
429 $sthorders = $dbh->prepare($strsth);
430 $sthorders->execute($basketno);
431 $dataorders = $sthorders->fetchall_arrayref( {} );
435 $dbh->prepare("select * from aqbooksellers where id=?");
436 $sthbookseller->execute( $dataorders->[0]->{booksellerid} );
437 my $databookseller = $sthbookseller->fetchrow_hashref;
439 my $addressee = $type eq 'claimacquisition' || $type eq 'orderacquisition' ? 'acqprimary' : 'serialsprimary';
442 $dbh->prepare("SELECT * FROM aqcontacts WHERE booksellerid=? AND $type=1 ORDER BY $addressee DESC");
443 $sthcontact->execute( $dataorders->[0]->{booksellerid} );
444 my $datacontact = $sthcontact->fetchrow_hashref;
448 push @email, $datacontact->{email} if ( $datacontact && $datacontact->{email} );
450 warn "Bookseller $dataorders->[0]->{booksellerid} without emails";
451 return { error => "no_email" };
454 while ($addlcontact = $sthcontact->fetchrow_hashref) {
455 push @cc, $addlcontact->{email} if ( $addlcontact && $addlcontact->{email} );
458 my $userenv = C4::Context->userenv;
459 my $letter = GetPreparedLetter (
461 letter_code => $letter_code,
462 branchcode => $userenv->{branch},
464 'branches' => $userenv->{branch},
465 'aqbooksellers' => $databookseller,
466 'aqcontacts' => $datacontact,
467 'aqbasket' => $basketno,
469 repeat => $dataorders,
471 ) or return { error => "no_letter" };
473 # Remove the order tag
474 $letter->{content} =~ s/<order>(.*?)<\/order>/$1/gxms;
477 my $library = Koha::Libraries->find( $userenv->{branch} );
478 my $mail = Koha::Email->create(
480 to => join( ',', @email ),
481 cc => join( ',', @cc ),
484 C4::Context->preference("ClaimsBccCopy")
485 && ( $type eq 'claimacquisition'
486 || $type eq 'claimissues' )
488 ? ( bcc => $userenv->{emailaddress} )
491 from => $library->branchemail
492 || C4::Context->preference('KohaAdminEmailAddress'),
493 subject => "" . $letter->{title},
497 if ( $letter->{is_html} ) {
498 $mail->html_body( _wrap_html( $letter->{content}, "" . $letter->{title} ) );
501 $mail->text_body( "" . $letter->{content} );
505 $mail->send_or_die({ transport => $library->smtp_server->transport });
508 # We expect ref($_) eq 'Email::Sender::Failure'
509 $error = $_->message;
515 return { error => $error }
518 my $module = $action eq 'ACQUISITION ORDER' ? 'ACQUISITIONS' : 'CLAIMS';
524 . join( ',', @email )
529 ) if C4::Context->preference("ClaimsLog");
531 # send an "account details" notice to a newly created user
532 elsif ( $type eq 'members' ) {
533 my $library = Koha::Libraries->find( $externalid->{branchcode} );
534 my $letter = GetPreparedLetter (
536 letter_code => $letter_code,
537 branchcode => $externalid->{'branchcode'},
538 lang => $externalid->{lang} || 'default',
540 'branches' => $library->unblessed,
541 'borrowers' => $externalid->{'borrowernumber'},
543 substitute => { 'borrowers.password' => $externalid->{'password'} },
546 return { error => "no_email" } unless $externalid->{'emailaddr'};
550 # FIXME: This 'default' behaviour should be moved to Koha::Email
551 my $mail = Koha::Email->create(
553 to => $externalid->{'emailaddr'},
554 from => $library->branchemail,
555 reply_to => $library->branchreplyto,
556 sender => $library->branchreturnpath,
557 subject => "" . $letter->{'title'},
561 if ( $letter->{is_html} ) {
562 $mail->html_body( _wrap_html( $letter->{content}, "" . $letter->{title} ) );
565 $mail->text_body( $letter->{content} );
568 $mail->send_or_die({ transport => $library->smtp_server->transport });
571 # We expect ref($_) eq 'Email::Sender::Failure'
572 $error = $_->message;
578 return { error => $error }
582 # If we come here, return an OK status
586 =head2 GetPreparedLetter( %params )
589 module => letter module, mandatory
590 letter_code => letter code, mandatory
591 branchcode => for letter selection, if missing default system letter taken
592 tables => a hashref with table names as keys. Values are either:
593 - a scalar - primary key value
594 - an arrayref - primary key values
595 - a hashref - full record
596 substitute => custom substitution key/value pairs
597 repeat => records to be substituted on consecutive lines:
598 - an arrayref - tries to guess what needs substituting by
599 taking remaining << >> tokensr; not recommended
600 - a hashref token => @tables - replaces <token> << >> << >> </token>
601 subtemplate for each @tables row; table is a hashref as above
602 want_librarian => boolean, if set to true triggers librarian details
603 substitution from the userenv
605 letter fields hashref (title & content useful)
609 sub GetPreparedLetter {
612 my $letter = $params{letter};
613 my $lang = $params{lang} || 'default';
616 my $module = $params{module} or croak "No module";
617 my $letter_code = $params{letter_code} or croak "No letter_code";
618 my $branchcode = $params{branchcode} || '';
619 my $mtt = $params{message_transport_type} || 'email';
621 my $template = Koha::Notice::Templates->find_effective_template(
624 code => $letter_code,
625 branchcode => $branchcode,
626 message_transport_type => $mtt,
631 unless ( $template ) {
632 warn( "No $module $letter_code letter transported by " . $mtt );
636 $letter = $template->unblessed;
637 $letter->{'content-type'} = 'text/html; charset="UTF-8"' if $letter->{is_html};
640 my $tables = $params{tables} || {};
641 my $substitute = $params{substitute} || {};
642 my $loops = $params{loops} || {}; # loops is not supported for historical notices syntax
643 my $repeat = $params{repeat};
644 %$tables || %$substitute || $repeat || %$loops
645 or carp( "ERROR: nothing to substitute - both 'tables', 'loops' and 'substitute' are empty" ),
647 my $want_librarian = $params{want_librarian};
650 while ( my ($token, $val) = each %$substitute ) {
651 if ( $token eq 'items.content' ) {
652 $val =~ s|\n|<br/>|g if $letter->{is_html};
655 $letter->{title} =~ s/<<$token>>/$val/g;
656 $letter->{content} =~ s/<<$token>>/$val/g;
660 my $OPACBaseURL = C4::Context->preference('OPACBaseURL');
661 $letter->{content} =~ s/<<OPACBaseURL>>/$OPACBaseURL/go;
663 if ($want_librarian) {
664 # parsing librarian name
665 my $userenv = C4::Context->userenv;
666 $letter->{content} =~ s/<<LibrarianFirstname>>/$userenv->{firstname}/go;
667 $letter->{content} =~ s/<<LibrarianSurname>>/$userenv->{surname}/go;
668 $letter->{content} =~ s/<<LibrarianEmailaddress>>/$userenv->{emailaddress}/go;
671 my ($repeat_no_enclosing_tags, $repeat_enclosing_tags);
674 if (ref ($repeat) eq 'ARRAY' ) {
675 $repeat_no_enclosing_tags = $repeat;
677 $repeat_enclosing_tags = $repeat;
681 if ($repeat_enclosing_tags) {
682 while ( my ($tag, $tag_tables) = each %$repeat_enclosing_tags ) {
683 if ( $letter->{content} =~ m!<$tag>(.*)</$tag>!s ) {
686 my %subletter = ( title => '', content => $subcontent );
687 _substitute_tables( \%subletter, $_ );
690 $letter->{content} =~ s!<$tag>.*</$tag>!join( "\n", @lines )!se;
696 _substitute_tables( $letter, $tables );
699 if ($repeat_no_enclosing_tags) {
700 if ( $letter->{content} =~ m/[^\n]*<<.*>>[^\n]*/so ) {
705 $c =~ s/<<count>>/$i/go;
706 foreach my $field ( keys %{$_} ) {
707 $c =~ s/(<<[^\.]+.$field>>)/$_->{$field}/;
711 } @$repeat_no_enclosing_tags;
713 my $replaceby = join( "\n", @lines );
714 $letter->{content} =~ s/\Q$line\E/$replaceby/s;
718 $letter->{content} = _process_tt(
720 content => $letter->{content},
723 substitute => $substitute,
728 $letter->{title} = _process_tt(
730 content => $letter->{title},
733 substitute => $substitute,
737 $letter->{content} =~ s/<<\S*>>//go; #remove any stragglers
742 sub _substitute_tables {
743 my ( $letter, $tables ) = @_;
744 while ( my ($table, $param) = each %$tables ) {
747 my $ref = ref $param;
750 if ($ref && $ref eq 'HASH') {
754 my $sth = _parseletter_sth($table);
756 warn "_parseletter_sth('$table') failed to return a valid sth. No substitution will be done for that table.";
759 $sth->execute( $ref ? @$param : $param );
761 $values = $sth->fetchrow_hashref;
765 _parseletter ( $letter, $table, $values );
769 sub _parseletter_sth {
773 carp "ERROR: _parseletter_sth() called without argument (table)";
776 # NOTE: we used to check whether we had a statement handle cached in
777 # a %handles module-level variable. This was a dumb move and
778 # broke things for the rest of us. prepare_cached is a better
779 # way to cache statement handles anyway.
781 ($table eq 'accountlines' ) ? "SELECT * FROM $table WHERE accountlines_id = ?" :
782 ($table eq 'biblio' ) ? "SELECT * FROM $table WHERE biblionumber = ?" :
783 ($table eq 'biblioitems' ) ? "SELECT * FROM $table WHERE biblionumber = ?" :
784 ($table eq 'credits' ) ? "SELECT * FROM accountlines WHERE accountlines_id = ?" :
785 ($table eq 'debits' ) ? "SELECT * FROM accountlines WHERE accountlines_id = ?" :
786 ($table eq 'items' ) ? "SELECT * FROM $table WHERE itemnumber = ?" :
787 ($table eq 'issues' ) ? "SELECT * FROM $table WHERE itemnumber = ?" :
788 ($table eq 'old_issues' ) ? "SELECT * FROM $table WHERE itemnumber = ? ORDER BY timestamp DESC LIMIT 1" :
789 ($table eq 'reserves' ) ? "SELECT * FROM $table WHERE borrowernumber = ? and biblionumber = ?" :
790 ($table eq 'borrowers' ) ? "SELECT * FROM $table WHERE borrowernumber = ?" :
791 ($table eq 'branches' ) ? "SELECT * FROM $table WHERE branchcode = ?" :
792 ($table eq 'suggestions' ) ? "SELECT * FROM $table WHERE suggestionid = ?" :
793 ($table eq 'aqbooksellers') ? "SELECT * FROM $table WHERE id = ?" :
794 ($table eq 'aqorders' ) ? "SELECT * FROM $table WHERE ordernumber = ?" :
795 ($table eq 'aqbasket' ) ? "SELECT * FROM $table WHERE basketno = ?" :
796 ($table eq 'illrequests' ) ? "SELECT * FROM $table WHERE illrequest_id = ?" :
797 ($table eq 'opac_news' ) ? "SELECT * FROM $table WHERE idnew = ?" :
798 ($table eq 'article_requests') ? "SELECT * FROM $table WHERE id = ?" :
799 ($table eq 'borrower_modifications') ? "SELECT * FROM $table WHERE verification_token = ?" :
800 ($table eq 'subscription') ? "SELECT * FROM $table WHERE subscriptionid = ?" :
801 ($table eq 'serial') ? "SELECT * FROM $table WHERE serialid = ?" :
802 ($table eq 'problem_reports') ? "SELECT * FROM $table WHERE reportid = ?" :
805 warn "ERROR: No _parseletter_sth query for table '$table'";
806 return; # nothing to get
808 unless ($sth = C4::Context->dbh->prepare_cached($query)) {
809 warn "ERROR: Failed to prepare query: '$query'";
812 return $sth; # now cache is populated for that $table
815 =head2 _parseletter($letter, $table, $values)
818 - $letter : a hash to letter fields (title & content useful)
819 - $table : the Koha table to parse.
820 - $values_in : table record hashref
821 parse all fields from a table, and replace values in title & content with the appropriate value
822 (not exported sub, used only internally)
827 my ( $letter, $table, $values_in ) = @_;
829 # Work on a local copy of $values_in (passed by reference) to avoid side effects
830 # in callers ( by changing / formatting values )
831 my $values = $values_in ? { %$values_in } : {};
833 if ( $table eq 'borrowers' && $values->{'dateexpiry'} ){
834 $values->{'dateexpiry'} = output_pref({ dt => dt_from_string( $values->{'dateexpiry'} ), dateonly => 1 });
837 if ( $table eq 'reserves' && $values->{'waitingdate'} ) {
838 $values->{'waitingdate'} = output_pref({ dt => dt_from_string( $values->{'waitingdate'} ), dateonly => 1 });
841 if ($letter->{content} && $letter->{content} =~ /<<today>>/) {
842 my $todaysdate = output_pref( dt_from_string() );
843 $letter->{content} =~ s/<<today>>/$todaysdate/go;
846 while ( my ($field, $val) = each %$values ) {
847 $val =~ s/\p{P}$// if $val && $table=~/biblio/;
848 #BZ 9886: Assuming that we want to eliminate ISBD punctuation here
849 #Therefore adding the test on biblio. This includes biblioitems,
850 #but excludes items. Removed unneeded global and lookahead.
852 if ( $table=~/^borrowers$/ && $field=~/^streettype$/ ) {
853 my $av = Koha::AuthorisedValues->search({ category => 'ROADTYPE', authorised_value => $val });
854 $val = $av->count ? $av->next->lib : '';
858 my $replacedby = defined ($val) ? $val : '';
860 and not $replacedby =~ m|9999-12-31|
861 and $replacedby =~ m|^\d{4}-\d{2}-\d{2}( \d{2}:\d{2}:\d{2})?$| )
863 # If the value is XXXX-YY-ZZ[ AA:BB:CC] we assume it is a date
864 my $dateonly = defined $1 ? 0 : 1; #$1 refers to the capture group wrapped in parentheses. In this case, that's the hours, minutes, seconds.
865 my $re_dateonly_filter = qr{ $field( \s* \| \s* dateonly\s*)?>> }xms;
867 for my $letter_field ( qw( title content ) ) {
868 my $filter_string_used = q{};
869 if ( $letter->{ $letter_field } =~ $re_dateonly_filter ) {
870 # We overwrite $dateonly if the filter exists and we have a time in the datetime
871 $filter_string_used = $1 || q{};
872 $dateonly = $1 unless $dateonly;
874 my $replacedby_date = eval {
875 output_pref({ dt => dt_from_string( $replacedby ), dateonly => $dateonly });
878 if ( $letter->{ $letter_field } ) {
879 $letter->{ $letter_field } =~ s/\Q<<$table.$field$filter_string_used>>\E/$replacedby_date/g;
880 $letter->{ $letter_field } =~ s/\Q<<$field$filter_string_used>>\E/$replacedby_date/g;
884 # Other fields replacement
886 for my $letter_field ( qw( title content ) ) {
887 if ( $letter->{ $letter_field } ) {
888 $letter->{ $letter_field } =~ s/<<$table.$field>>/$replacedby/g;
889 $letter->{ $letter_field } =~ s/<<$field>>/$replacedby/g;
895 if ($table eq 'borrowers' && $letter->{content}) {
896 my $patron = Koha::Patrons->find( $values->{borrowernumber} );
898 my $attributes = $patron->extended_attributes;
900 while ( my $attribute = $attributes->next ) {
901 my $code = $attribute->code;
902 my $val = $attribute->description; # FIXME - we always display intranet description here!
903 $val =~ s/\p{P}(?=$)//g if $val;
904 next unless $val gt '';
906 push @{ $attr{$code} }, $val;
908 while ( my ($code, $val_ar) = each %attr ) {
909 my $replacefield = "<<borrower-attribute:$code>>";
910 my $replacedby = join ',', @$val_ar;
911 $letter->{content} =~ s/$replacefield/$replacedby/g;
920 my $success = EnqueueLetter( { letter => $letter,
921 borrowernumber => '12', message_transport_type => 'email' } )
923 Places a letter in the message_queue database table, which will
924 eventually get processed (sent) by the process_message_queue.pl
925 cronjob when it calls SendQueuedMessages.
927 Return message_id on success
930 * letter - required; A letter hashref as returned from GetPreparedLetter
931 * message_transport_type - required; One of the available mtts
932 * borrowernumber - optional if 'to_address' is passed; The borrowernumber of the patron we enqueuing the notice for
933 * to_address - optional if 'borrowernumber' is passed; The destination email address for the notice (defaults to patron->notice_email_address)
934 * from_address - optional; The from address for the notice, defaults to patron->library->from_email_address
935 * reply_address - optional; The reply address for the notice, defaults to patron->library->reply_to
940 my $params = shift or return;
942 return unless exists $params->{'letter'};
943 # return unless exists $params->{'borrowernumber'};
944 return unless exists $params->{'message_transport_type'};
946 my $content = $params->{letter}->{content};
947 $content =~ s/\s+//g if(defined $content);
948 if ( not defined $content or $content eq '' ) {
949 Koha::Logger->get->info("Trying to add an empty message to the message queue");
953 # If we have any attachments we should encode then into the body.
954 if ( $params->{'attachments'} ) {
955 $params->{'letter'} = _add_attachments(
956 { letter => $params->{'letter'},
957 attachments => $params->{'attachments'},
958 message => MIME::Lite->new( Type => 'multipart/mixed' ),
963 my $dbh = C4::Context->dbh();
964 my $statement = << 'ENDSQL';
965 INSERT INTO message_queue
966 ( borrowernumber, subject, content, metadata, letter_code, message_transport_type, status, time_queued, to_address, from_address, reply_address, content_type, delivery_note )
968 ( ?, ?, ?, ?, ?, ?, ?, CAST(NOW() AS DATETIME), ?, ?, ?, ?, ? )
971 my $sth = $dbh->prepare($statement);
972 my $result = $sth->execute(
973 $params->{'borrowernumber'}, # borrowernumber
974 $params->{'letter'}->{'title'}, # subject
975 $params->{'letter'}->{'content'}, # content
976 $params->{'letter'}->{'metadata'} || '', # metadata
977 $params->{'letter'}->{'code'} || '', # letter_code
978 $params->{'message_transport_type'}, # message_transport_type
980 $params->{'to_address'}, # to_address
981 $params->{'from_address'}, # from_address
982 $params->{'reply_address'}, # reply_address
983 $params->{'letter'}->{'content-type'}, # content_type
984 $params->{'delivery_note'} || '', # delivery_note
986 return $dbh->last_insert_id(undef,undef,'message_queue', undef);
989 =head2 SendQueuedMessages ([$hashref])
991 my $sent = SendQueuedMessages({
992 letter_code => $letter_code,
993 borrowernumber => $who_letter_is_for,
999 Sends all of the 'pending' items in the message queue, unless
1000 parameters are passed.
1002 The letter_code, borrowernumber and limit parameters are used
1003 to build a parameter set for _get_unsent_messages, thus limiting
1004 which pending messages will be processed. They are all optional.
1006 The verbose parameter can be used to generate debugging output.
1007 It is also optional.
1009 Returns number of messages sent.
1013 sub SendQueuedMessages {
1016 my $which_unsent_messages = {
1017 'message_id' => $params->{'message_id'},
1018 'limit' => $params->{'limit'} // 0,
1019 'borrowernumber' => $params->{'borrowernumber'} // q{},
1020 'letter_code' => $params->{'letter_code'} // q{},
1021 'type' => $params->{'type'} // q{},
1023 my $unsent_messages = _get_unsent_messages( $which_unsent_messages );
1024 MESSAGE: foreach my $message ( @$unsent_messages ) {
1025 my $message_object = Koha::Notice::Messages->find( $message->{message_id} );
1026 # If this fails the database is unwritable and we won't manage to send a message that continues to be marked 'pending'
1027 $message_object->make_column_dirty('status');
1028 return unless $message_object->store;
1030 # warn Data::Dumper->Dump( [ $message ], [ 'message' ] );
1031 warn sprintf( 'sending %s message to patron: %s',
1032 $message->{'message_transport_type'},
1033 $message->{'borrowernumber'} || 'Admin' )
1034 if $params->{'verbose'};
1035 # This is just begging for subclassing
1036 next MESSAGE if ( lc($message->{'message_transport_type'}) eq 'rss' );
1037 if ( lc( $message->{'message_transport_type'} ) eq 'email' ) {
1038 _send_message_by_email( $message, $params->{'username'}, $params->{'password'}, $params->{'method'} );
1040 elsif ( lc( $message->{'message_transport_type'} ) eq 'sms' ) {
1041 if ( C4::Context->preference('SMSSendDriver') eq 'Email' ) {
1042 my $patron = Koha::Patrons->find( $message->{borrowernumber} );
1043 my $sms_provider = Koha::SMS::Providers->find( $patron->sms_provider_id );
1044 unless ( $sms_provider ) {
1045 warn sprintf( "Patron %s has no sms provider id set!", $message->{'borrowernumber'} ) if $params->{'verbose'};
1046 _set_message_status( { message_id => $message->{'message_id'}, status => 'failed' } );
1049 unless ( $patron->smsalertnumber ) {
1050 _set_message_status( { message_id => $message->{'message_id'}, status => 'failed' } );
1051 warn sprintf( "No smsalertnumber found for patron %s!", $message->{'borrowernumber'} ) if $params->{'verbose'};
1054 $message->{to_address} = $patron->smsalertnumber; #Sometime this is set to email - sms should always use smsalertnumber
1055 $message->{to_address} .= '@' . $sms_provider->domain();
1057 # Check for possible from_address override
1058 my $from_address = C4::Context->preference('EmailSMSSendDriverFromAddress');
1059 if ($from_address && $message->{from_address} ne $from_address) {
1060 $message->{from_address} = $from_address;
1061 _update_message_from_address($message->{'message_id'}, $message->{from_address});
1064 _update_message_to_address($message->{'message_id'}, $message->{to_address});
1065 _send_message_by_email( $message, $params->{'username'}, $params->{'password'}, $params->{'method'} );
1067 _send_message_by_sms( $message );
1071 return scalar( @$unsent_messages );
1074 =head2 GetRSSMessages
1076 my $message_list = GetRSSMessages( { limit => 10, borrowernumber => '14' } )
1078 returns a listref of all queued RSS messages for a particular person.
1082 sub GetRSSMessages {
1085 return unless $params;
1086 return unless ref $params;
1087 return unless $params->{'borrowernumber'};
1089 return _get_unsent_messages( { message_transport_type => 'rss',
1090 limit => $params->{'limit'},
1091 borrowernumber => $params->{'borrowernumber'}, } );
1094 =head2 GetPrintMessages
1096 my $message_list = GetPrintMessages( { borrowernumber => $borrowernumber } )
1098 Returns a arrayref of all queued print messages (optionally, for a particular
1103 sub GetPrintMessages {
1104 my $params = shift || {};
1106 return _get_unsent_messages( { message_transport_type => 'print',
1107 borrowernumber => $params->{'borrowernumber'},
1111 =head2 GetQueuedMessages ([$hashref])
1113 my $messages = GetQueuedMessage( { borrowernumber => '123', limit => 20 } );
1115 Fetches a list of messages from the message queue optionally filtered by borrowernumber
1116 and limited to specified limit.
1118 Return is an arrayref of hashes, each has represents a message in the message queue.
1122 sub GetQueuedMessages {
1125 my $dbh = C4::Context->dbh();
1126 my $statement = << 'ENDSQL';
1127 SELECT message_id, borrowernumber, subject, content, message_transport_type, status, time_queued, updated_on, delivery_note
1133 if ( exists $params->{'borrowernumber'} ) {
1134 push @whereclauses, ' borrowernumber = ? ';
1135 push @query_params, $params->{'borrowernumber'};
1138 if ( @whereclauses ) {
1139 $statement .= ' WHERE ' . join( 'AND', @whereclauses );
1142 if ( defined $params->{'limit'} ) {
1143 $statement .= ' LIMIT ? ';
1144 push @query_params, $params->{'limit'};
1147 my $sth = $dbh->prepare( $statement );
1148 my $result = $sth->execute( @query_params );
1149 return $sth->fetchall_arrayref({});
1152 =head2 GetMessageTransportTypes
1154 my @mtt = GetMessageTransportTypes();
1156 returns an arrayref of transport types
1160 sub GetMessageTransportTypes {
1161 my $dbh = C4::Context->dbh();
1162 my $mtts = $dbh->selectcol_arrayref("
1163 SELECT message_transport_type
1164 FROM message_transport_types
1165 ORDER BY message_transport_type
1172 my $message = C4::Letters::Message($message_id);
1177 my ( $message_id ) = @_;
1178 return unless $message_id;
1179 my $dbh = C4::Context->dbh;
1180 return $dbh->selectrow_hashref(q|
1181 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
1183 WHERE message_id = ?
1184 |, {}, $message_id );
1187 =head2 ResendMessage
1189 Attempt to resend a message which has failed previously.
1191 my $has_been_resent = C4::Letters::ResendMessage($message_id);
1193 Updates the message to 'pending' status so that
1194 it will be resent later on.
1196 returns 1 on success, 0 on failure, undef if no message was found
1201 my $message_id = shift;
1202 return unless $message_id;
1204 my $message = GetMessage( $message_id );
1205 return unless $message;
1207 if ( $message->{status} ne 'pending' ) {
1208 $rv = C4::Letters::_set_message_status({
1209 message_id => $message_id,
1210 status => 'pending',
1212 $rv = $rv > 0? 1: 0;
1213 # Clear destination email address to force address update
1214 _update_message_to_address( $message_id, undef ) if $rv &&
1215 $message->{message_transport_type} eq 'email';
1220 =head2 _add_attachements
1223 letter - the standard letter hashref
1224 attachments - listref of attachments. each attachment is a hashref of:
1225 type - the mime type, like 'text/plain'
1226 content - the actual attachment
1227 filename - the name of the attachment.
1228 message - a MIME::Lite object to attach these to.
1230 returns your letter object, with the content updated.
1234 sub _add_attachments {
1237 my $letter = $params->{'letter'};
1238 my $attachments = $params->{'attachments'};
1239 return $letter unless @$attachments;
1240 my $message = $params->{'message'};
1242 # First, we have to put the body in as the first attachment
1244 Type => $letter->{'content-type'} || 'TEXT',
1245 Data => $letter->{'is_html'}
1246 ? _wrap_html($letter->{'content'}, $letter->{'title'})
1247 : $letter->{'content'},
1250 foreach my $attachment ( @$attachments ) {
1252 Type => $attachment->{'type'},
1253 Data => $attachment->{'content'},
1254 Filename => $attachment->{'filename'},
1257 # we're forcing list context here to get the header, not the count back from grep.
1258 ( $letter->{'content-type'} ) = grep( /^Content-Type:/, split( /\n/, $params->{'message'}->header_as_string ) );
1259 $letter->{'content-type'} =~ s/^Content-Type:\s+//;
1260 $letter->{'content'} = $message->body_as_string;
1266 =head2 _get_unsent_messages
1268 This function's parameter hash reference takes the following
1269 optional named parameters:
1270 message_transport_type: method of message sending (e.g. email, sms, etc.)
1271 borrowernumber : who the message is to be sent
1272 letter_code : type of message being sent (e.g. PASSWORD_RESET)
1273 message_id : the message_id of the message. In that case the sub will return only 1 result
1274 limit : maximum number of messages to send
1276 This function returns an array of matching hash referenced rows from
1277 message_queue with some borrower information added.
1281 sub _get_unsent_messages {
1284 my $dbh = C4::Context->dbh();
1286 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
1287 FROM message_queue mq
1288 LEFT JOIN borrowers b ON b.borrowernumber = mq.borrowernumber
1292 my @query_params = ('pending');
1293 if ( ref $params ) {
1294 if ( $params->{'message_transport_type'} ) {
1295 $statement .= ' AND mq.message_transport_type = ? ';
1296 push @query_params, $params->{'message_transport_type'};
1298 if ( $params->{'borrowernumber'} ) {
1299 $statement .= ' AND mq.borrowernumber = ? ';
1300 push @query_params, $params->{'borrowernumber'};
1302 if ( $params->{'letter_code'} ) {
1303 $statement .= ' AND mq.letter_code = ? ';
1304 push @query_params, $params->{'letter_code'};
1306 if ( $params->{'type'} ) {
1307 $statement .= ' AND message_transport_type = ? ';
1308 push @query_params, $params->{'type'};
1310 if ( $params->{message_id} ) {
1311 $statement .= ' AND message_id = ?';
1312 push @query_params, $params->{message_id};
1314 if ( $params->{'limit'} ) {
1315 $statement .= ' limit ? ';
1316 push @query_params, $params->{'limit'};
1320 my $sth = $dbh->prepare( $statement );
1321 my $result = $sth->execute( @query_params );
1322 return $sth->fetchall_arrayref({});
1325 sub _send_message_by_email {
1326 my $message = shift or return;
1327 my ($username, $password, $method) = @_;
1329 my $patron = Koha::Patrons->find( $message->{borrowernumber} );
1330 my $to_address = $message->{'to_address'};
1331 unless ($to_address) {
1333 warn "FAIL: No 'to_address' and INVALID borrowernumber ($message->{borrowernumber})";
1334 _set_message_status( { message_id => $message->{'message_id'},
1336 delivery_note => 'Invalid borrowernumber '.$message->{borrowernumber},
1337 error_code => 'INVALID_BORNUMBER' } );
1340 $to_address = $patron->notice_email_address;
1341 unless ($to_address) {
1342 # warn "FAIL: No 'to_address' and no email for " . ($member->{surname} ||'') . ", borrowernumber ($message->{borrowernumber})";
1343 # warning too verbose for this more common case?
1344 _set_message_status( { message_id => $message->{'message_id'},
1346 delivery_note => 'Unable to find an email address for this borrower',
1347 error_code => 'NO_EMAIL' } );
1352 my $subject = $message->{'subject'};
1354 my $content = $message->{'content'};
1355 my $content_type = $message->{'content_type'} || 'text/plain; charset="UTF-8"';
1356 my $is_html = $content_type =~ m/html/io;
1358 my $branch_email = undef;
1359 my $branch_replyto = undef;
1360 my $branch_returnpath = undef;
1364 $library = $patron->library;
1365 $branch_email = $library->from_email_address;
1366 $branch_replyto = $library->branchreplyto;
1367 $branch_returnpath = $library->branchreturnpath;
1370 # NOTE: Patron may not be defined above so branch_email may be undefined still
1371 # so we need to fallback to KohaAdminEmailAddress as a last resort.
1373 $message->{'from_address'}
1375 || C4::Context->preference('KohaAdminEmailAddress');
1376 if( !$from_address ) {
1377 _set_message_status({
1378 message_id => $message->{'message_id'},
1380 delivery_note => 'No from address',
1384 my $email = Koha::Email->create(
1388 C4::Context->preference('NoticeBcc')
1389 ? ( bcc => C4::Context->preference('NoticeBcc') )
1392 from => $from_address,
1393 reply_to => $message->{'reply_address'} || $branch_replyto,
1394 sender => $branch_returnpath,
1395 subject => "" . $message->{subject}
1401 _wrap_html( $content, $subject )
1405 $email->text_body( $content );
1410 $smtp_server = $library->smtp_server;
1413 $smtp_server = Koha::SMTP::Servers->get_default;
1419 sasl_username => $username,
1420 sasl_password => $password,
1425 # if initial message address was empty, coming here means that a to address was found and
1426 # queue should be updated; same if to address was overriden by Koha::Email->create
1427 _update_message_to_address( $message->{'message_id'}, $email->email->header('To') )
1428 if !$message->{to_address}
1429 || $message->{to_address} ne $email->email->header('To');
1432 $email->send_or_die({ transport => $smtp_server->transport });
1434 _set_message_status(
1436 message_id => $message->{'message_id'},
1444 _set_message_status(
1446 message_id => $message->{'message_id'},
1448 delivery_note => $Mail::Sendmail::error
1457 my ($content, $title) = @_;
1459 my $css = C4::Context->preference("NoticeCSS") || '';
1460 $css = qq{<link rel="stylesheet" type="text/css" href="$css">} if $css;
1462 <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
1463 "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
1464 <html lang="en" xml:lang="en" xmlns="http://www.w3.org/1999/xhtml">
1466 <title>$title</title>
1467 <meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
1478 my ( $message ) = @_;
1479 my $dbh = C4::Context->dbh;
1480 my $count = $dbh->selectrow_array(q|
1483 WHERE message_transport_type = ?
1484 AND borrowernumber = ?
1486 AND CAST(updated_on AS date) = CAST(NOW() AS date)
1489 |, {}, $message->{message_transport_type}, $message->{borrowernumber}, $message->{letter_code}, $message->{content} );
1493 sub _send_message_by_sms {
1494 my $message = shift or return;
1495 my $patron = Koha::Patrons->find( $message->{borrowernumber} );
1497 unless ( $patron and $patron->smsalertnumber ) {
1498 _set_message_status( { message_id => $message->{'message_id'},
1500 delivery_note => 'Missing SMS number',
1501 error_code => 'MISSING_SMS' } );
1505 if ( _is_duplicate( $message ) ) {
1506 _set_message_status( { message_id => $message->{'message_id'},
1508 delivery_note => 'Message is duplicate',
1509 error_code => 'DUPLICATE_MESSAGE' } );
1513 my $success = C4::SMS->send_sms( { destination => $patron->smsalertnumber,
1514 message => $message->{'content'},
1516 _set_message_status( { message_id => $message->{'message_id'},
1517 status => ($success ? 'sent' : 'failed'),
1518 delivery_note => ($success ? '' : 'No notes from SMS driver'),
1519 error_code => 'NO_NOTES' } );
1524 sub _update_message_to_address {
1526 my $dbh = C4::Context->dbh();
1527 $dbh->do('UPDATE message_queue SET to_address=? WHERE message_id=?',undef,($to,$id));
1530 sub _update_message_from_address {
1531 my ($message_id, $from_address) = @_;
1532 my $dbh = C4::Context->dbh();
1533 $dbh->do('UPDATE message_queue SET from_address = ? WHERE message_id = ?', undef, ($from_address, $message_id));
1536 sub _set_message_status {
1537 my $params = shift or return;
1539 foreach my $required_parameter ( qw( message_id status ) ) {
1540 return unless exists $params->{ $required_parameter };
1543 my $dbh = C4::Context->dbh();
1544 my $statement = 'UPDATE message_queue SET status= ?, delivery_note= ? WHERE message_id = ?';
1545 my $sth = $dbh->prepare( $statement );
1546 my $result = $sth->execute( $params->{'status'},
1547 $params->{'delivery_note'} || '',
1548 $params->{'message_id'} );
1553 my ( $params ) = @_;
1555 my $content = $params->{content};
1556 my $tables = $params->{tables};
1557 my $loops = $params->{loops};
1558 my $substitute = $params->{substitute} || {};
1559 my $lang = defined($params->{lang}) && $params->{lang} ne 'default' ? $params->{lang} : 'en';
1560 my ($theme, $availablethemes);
1562 my $htdocs = C4::Context->config('intrahtdocs');
1563 ($theme, $lang, $availablethemes)= C4::Templates::availablethemes( $htdocs, 'about.tt', 'intranet', $lang);
1565 foreach (@$availablethemes) {
1566 push @includes, "$htdocs/$_/$lang/includes";
1567 push @includes, "$htdocs/$_/en/includes" unless $lang eq 'en';
1570 my $use_template_cache = C4::Context->config('template_cache_dir') && defined $ENV{GATEWAY_INTERFACE};
1571 my $template = Template->new(
1575 PLUGIN_BASE => 'Koha::Template::Plugin',
1576 COMPILE_EXT => $use_template_cache ? '.ttc' : '',
1577 COMPILE_DIR => $use_template_cache ? C4::Context->config('template_cache_dir') : '',
1578 INCLUDE_PATH => \@includes,
1580 ENCODING => 'UTF-8',
1582 ) or die Template->error();
1584 my $tt_params = { %{ _get_tt_params( $tables ) }, %{ _get_tt_params( $loops, 'is_a_loop' ) }, %$substitute };
1586 $content = add_tt_filters( $content );
1587 $content = qq|[% USE KohaDates %][% USE Remove_MARC_punctuation %]$content|;
1590 $template->process( \$content, $tt_params, \$output ) || croak "ERROR PROCESSING TEMPLATE: " . $template->error();
1595 sub _get_tt_params {
1596 my ($tables, $is_a_loop) = @_;
1602 article_requests => {
1603 module => 'Koha::ArticleRequests',
1604 singular => 'article_request',
1605 plural => 'article_requests',
1609 module => 'Koha::Acquisition::Baskets',
1610 singular => 'basket',
1611 plural => 'baskets',
1615 module => 'Koha::Biblios',
1616 singular => 'biblio',
1617 plural => 'biblios',
1618 pk => 'biblionumber',
1621 module => 'Koha::Biblioitems',
1622 singular => 'biblioitem',
1623 plural => 'biblioitems',
1624 pk => 'biblioitemnumber',
1627 module => 'Koha::Patrons',
1628 singular => 'borrower',
1629 plural => 'borrowers',
1630 pk => 'borrowernumber',
1633 module => 'Koha::Libraries',
1634 singular => 'branch',
1635 plural => 'branches',
1639 module => 'Koha::Account::Lines',
1640 singular => 'credit',
1641 plural => 'credits',
1642 pk => 'accountlines_id',
1645 module => 'Koha::Account::Lines',
1646 singular => 'debit',
1648 pk => 'accountlines_id',
1651 module => 'Koha::Items',
1657 module => 'Koha::News',
1663 module => 'Koha::Acquisition::Orders',
1664 singular => 'order',
1666 pk => 'ordernumber',
1669 module => 'Koha::Holds',
1675 module => 'Koha::Serials',
1676 singular => 'serial',
1677 plural => 'serials',
1681 module => 'Koha::Subscriptions',
1682 singular => 'subscription',
1683 plural => 'subscriptions',
1684 pk => 'subscriptionid',
1687 module => 'Koha::Suggestions',
1688 singular => 'suggestion',
1689 plural => 'suggestions',
1690 pk => 'suggestionid',
1693 module => 'Koha::Checkouts',
1694 singular => 'checkout',
1695 plural => 'checkouts',
1699 module => 'Koha::Old::Checkouts',
1700 singular => 'old_checkout',
1701 plural => 'old_checkouts',
1705 module => 'Koha::Checkouts',
1706 singular => 'overdue',
1707 plural => 'overdues',
1710 borrower_modifications => {
1711 module => 'Koha::Patron::Modifications',
1712 singular => 'patron_modification',
1713 plural => 'patron_modifications',
1714 fk => 'verification_token',
1717 module => 'Koha::Illrequests',
1718 singular => 'illrequest',
1719 plural => 'illrequests',
1720 pk => 'illrequest_id'
1724 foreach my $table ( keys %$tables ) {
1725 next unless $config->{$table};
1727 my $ref = ref( $tables->{$table} ) || q{};
1728 my $module = $config->{$table}->{module};
1730 if ( can_load( modules => { $module => undef } ) ) {
1731 my $pk = $config->{$table}->{pk};
1732 my $fk = $config->{$table}->{fk};
1735 my $values = $tables->{$table} || [];
1736 unless ( ref( $values ) eq 'ARRAY' ) {
1737 croak "ERROR processing table $table. Wrong API call.";
1739 my $key = $pk ? $pk : $fk;
1740 # $key does not come from user input
1741 my $objects = $module->search(
1742 { $key => $values },
1744 # We want to retrieve the data in the same order
1746 # field is a MySQLism, but they are no other way to do it
1747 # To be generic we could do it in perl, but we will need to fetch
1748 # all the data then order them
1749 @$values ? ( order_by => \[ "field($key, " . join( ', ', @$values ) . ")" ] ) : ()
1752 $params->{ $config->{$table}->{plural} } = $objects;
1754 elsif ( $ref eq q{} || $ref eq 'HASH' ) {
1755 my $id = ref $ref eq 'HASH' ? $tables->{$table}->{$pk} : $tables->{$table};
1757 if ( $fk ) { # Using a foreign key for lookup
1758 if ( ref( $fk ) eq 'ARRAY' ) { # Foreign key is multi-column
1760 foreach my $key ( @$fk ) {
1761 $search->{$key} = $id->{$key};
1763 $object = $module->search( $search )->last();
1764 } else { # Foreign key is single column
1765 $object = $module->search( { $fk => $id } )->last();
1767 } else { # using the table's primary key for lookup
1768 $object = $module->find($id);
1770 $params->{ $config->{$table}->{singular} } = $object;
1772 else { # $ref eq 'ARRAY'
1774 if ( @{ $tables->{$table} } == 1 ) { # Param is a single key
1775 $object = $module->search( { $pk => $tables->{$table} } )->last();
1777 else { # Params are mutliple foreign keys
1778 croak "Multiple foreign keys (table $table) should be passed using an hashref";
1780 $params->{ $config->{$table}->{singular} } = $object;
1784 croak "ERROR LOADING MODULE $module: $Module::Load::Conditional::ERROR";
1788 $params->{today} = output_pref({ dt => dt_from_string, dateformat => 'iso' });
1793 =head3 add_tt_filters
1795 $content = add_tt_filters( $content );
1797 Add TT filters to some specific fields if needed.
1799 For now we only add the Remove_MARC_punctuation TT filter to biblio and biblioitem fields
1803 sub add_tt_filters {
1804 my ( $content ) = @_;
1805 $content =~ s|\[%\s*biblio\.(.*?)\s*%\]|[% biblio.$1 \| \$Remove_MARC_punctuation %]|gxms;
1806 $content =~ s|\[%\s*biblioitem\.(.*?)\s*%\]|[% biblioitem.$1 \| \$Remove_MARC_punctuation %]|gxms;
1810 =head2 get_item_content
1812 my $item = Koha::Items->find(...)->unblessed;
1813 my @item_content_fields = qw( date_due title barcode author itemnumber );
1814 my $item_content = C4::Letters::get_item_content({
1816 item_content_fields => \@item_content_fields
1819 This function generates a tab-separated list of values for the passed item. Dates
1820 are formatted following the current setup.
1824 sub get_item_content {
1825 my ( $params ) = @_;
1826 my $item = $params->{item};
1827 my $dateonly = $params->{dateonly} || 0;
1828 my $item_content_fields = $params->{item_content_fields} || [];
1830 return unless $item;
1832 my @item_info = map {
1836 { dt => dt_from_string( $item->{$_} ), dateonly => $dateonly } );
1840 } @$item_content_fields;
1841 return join( "\t", @item_info ) . "\n";