3 # Copyright 2000-2002 Katipo Communications
5 # This file is part of Koha.
7 # Koha is free software; you can redistribute it and/or modify it
8 # under the terms of the GNU General Public License as published by
9 # the Free Software Foundation; either version 3 of the License, or
10 # (at your option) any later version.
12 # Koha is distributed in the hope that it will be useful, but
13 # WITHOUT ANY WARRANTY; without even the implied warranty of
14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 # GNU General Public License for more details.
17 # You should have received a copy of the GNU General Public License
18 # along with Koha; if not, see <http://www.gnu.org/licenses>.
22 use Carp qw( carp croak );
24 use Module::Load::Conditional qw( can_load );
26 use Try::Tiny qw( catch try );
29 use C4::Log qw( logaction );
32 use Koha::DateUtils qw( dt_from_string output_pref );
33 use Koha::SMS::Providers;
36 use Koha::Notice::Messages;
37 use Koha::Notice::Templates;
38 use Koha::DateUtils qw( dt_from_string output_pref );
40 use Koha::SMTP::Servers;
41 use Koha::Subscriptions;
43 use constant SERIALIZED_EMAIL_CONTENT_TYPE => 'message/rfc822';
45 our (@ISA, @EXPORT_OK);
51 GetLettersAvailableForALibrary
60 GetMessageTransportTypes
70 C4::Letters - Give functions for Letters management
78 "Letters" is the tool used in Koha to manage informations sent to the patrons and/or the library. This include some cron jobs like
79 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)
81 Letters are managed through "alerts" sent by Koha on some events. All "alert" related functions are in this module too.
83 =head2 GetLetters([$module])
85 $letters = &GetLetters($module);
86 returns informations about letters.
87 if needed, $module filters for letters given module
89 DEPRECATED - You must use Koha::Notice::Templates instead
90 The group by clause is confusing and can lead to issues
96 my $module = $filters->{module};
97 my $code = $filters->{code};
98 my $branchcode = $filters->{branchcode};
99 my $dbh = C4::Context->dbh;
100 my $letters = $dbh->selectall_arrayref(
102 SELECT code, module, name
106 . ( $module ? q| AND module = ?| : q|| )
107 . ( $code ? q| AND code = ?| : q|| )
108 . ( defined $branchcode ? q| AND branchcode = ?| : q|| )
109 . q| GROUP BY code, module, name ORDER BY name|, { Slice => {} }
110 , ( $module ? $module : () )
111 , ( $code ? $code : () )
112 , ( defined $branchcode ? $branchcode : () )
118 =head2 GetLetterTemplates
120 my $letter_templates = GetLetterTemplates(
122 module => 'circulation',
124 branchcode => 'CPL', # '' for default,
128 Return a hashref of letter templates.
132 sub GetLetterTemplates {
135 my $module = $params->{module};
136 my $code = $params->{code};
137 my $branchcode = $params->{branchcode} // '';
138 my $dbh = C4::Context->dbh;
139 return Koha::Notice::Templates->search(
143 branchcode => $branchcode,
145 C4::Context->preference('TranslateNotices')
147 : ( lang => 'default' )
153 =head2 GetLettersAvailableForALibrary
155 my $letters = GetLettersAvailableForALibrary(
157 branchcode => 'CPL', # '' for default
158 module => 'circulation',
162 Return an arrayref of letters, sorted by name.
163 If a specific letter exist for the given branchcode, it will be retrieve.
164 Otherwise the default letter will be.
168 sub GetLettersAvailableForALibrary {
170 my $branchcode = $filters->{branchcode};
171 my $module = $filters->{module};
173 croak "module should be provided" unless $module;
175 my $dbh = C4::Context->dbh;
176 my $default_letters = $dbh->selectall_arrayref(
178 SELECT module, code, branchcode, name
182 . q| AND branchcode = ''|
183 . ( $module ? q| AND module = ?| : q|| )
184 . q| ORDER BY name|, { Slice => {} }
185 , ( $module ? $module : () )
188 my $specific_letters;
190 $specific_letters = $dbh->selectall_arrayref(
192 SELECT module, code, branchcode, name
196 . q| AND branchcode = ?|
197 . ( $module ? q| AND module = ?| : q|| )
198 . q| ORDER BY name|, { Slice => {} }
200 , ( $module ? $module : () )
205 for my $l (@$default_letters) {
206 $letters{ $l->{code} } = $l;
208 for my $l (@$specific_letters) {
209 # Overwrite the default letter with the specific one.
210 $letters{ $l->{code} } = $l;
213 return [ map { $letters{$_} }
214 sort { $letters{$a}->{name} cmp $letters{$b}->{name} }
224 module => 'circulation',
230 Delete the letter. The mtt parameter is facultative.
231 If not given, all templates mathing the other parameters will be removed.
237 my $branchcode = $params->{branchcode};
238 my $module = $params->{module};
239 my $code = $params->{code};
240 my $mtt = $params->{mtt};
241 my $lang = $params->{lang};
242 my $dbh = C4::Context->dbh;
249 . ( $mtt ? q| AND message_transport_type = ?| : q|| )
250 . ( $lang? q| AND lang = ?| : q|| )
251 , undef, $branchcode, $module, $code, ( $mtt ? $mtt : () ), ( $lang ? $lang : () ) );
256 my $err = &SendAlerts($type, $externalid, $letter_code);
259 - $type : the type of alert
260 - $externalid : the id of the "object" to query
261 - $letter_code : the notice template to use
263 C<&SendAlerts> sends an email notice directly to a patron or a vendor.
265 Currently it supports ($type):
266 - claim serial issues (claimissues)
267 - claim acquisition orders (claimacquisition)
268 - send acquisition orders to the vendor (orderacquisition)
269 - notify patrons about newly received serial issues (issue)
270 - notify patrons when their account is created (members)
272 Returns undef or { error => 'message } on failure.
273 Returns true on success.
278 my ( $type, $externalid, $letter_code ) = @_;
279 my $dbh = C4::Context->dbh;
282 if ( $type eq 'issue' ) {
284 # prepare the letter...
285 # search the subscriptionid
288 "SELECT subscriptionid FROM serial WHERE serialid=?");
289 $sth->execute($externalid);
290 my ($subscriptionid) = $sth->fetchrow
291 or warn( "No subscription for '$externalid'" ),
294 # search the biblionumber
297 "SELECT biblionumber FROM subscription WHERE subscriptionid=?");
298 $sth->execute($subscriptionid);
299 my ($biblionumber) = $sth->fetchrow
300 or warn( "No biblionumber for '$subscriptionid'" ),
303 # find the list of subscribers to notify
304 my $subscription = Koha::Subscriptions->find( $subscriptionid );
305 my $subscribers = $subscription->subscribers;
306 while ( my $patron = $subscribers->next ) {
307 my $email = $patron->email or next;
309 # warn "sending issues...";
310 my $userenv = C4::Context->userenv;
311 my $library = $patron->library;
312 my $letter = GetPreparedLetter (
314 letter_code => $letter_code,
315 branchcode => $userenv->{branch},
317 'branches' => $library->branchcode,
318 'biblio' => $biblionumber,
319 'biblioitems' => $biblionumber,
320 'borrowers' => $patron->unblessed,
321 'subscription' => $subscriptionid,
322 'serial' => $externalid,
327 # FIXME: This 'default' behaviour should be moved to Koha::Email
328 my $mail = Koha::Email->create(
331 from => $library->branchemail,
332 reply_to => $library->branchreplyto,
333 sender => $library->branchreturnpath,
334 subject => "" . $letter->{title},
338 if ( $letter->{is_html} ) {
339 $mail->html_body( _wrap_html( $letter->{content}, "" . $letter->{title} ) );
342 $mail->text_body( $letter->{content} );
346 $mail->send_or_die({ transport => $library->smtp_server->transport });
349 # We expect ref($_) eq 'Email::Sender::Failure'
350 $error = $_->message;
356 return { error => $error }
360 elsif ( $type eq 'claimacquisition' or $type eq 'claimissues' or $type eq 'orderacquisition' ) {
362 # prepare the letter...
368 if ( $type eq 'claimacquisition') {
370 SELECT aqorders.*,aqbasket.*,biblio.*,biblioitems.*
372 LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno
373 LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
374 LEFT JOIN biblioitems ON aqorders.biblionumber=biblioitems.biblionumber
375 WHERE aqorders.ordernumber IN (
379 carp "No order selected";
380 return { error => "no_order_selected" };
382 $strsth .= join( ",", ('?') x @$externalid ) . ")";
383 $action = "ACQUISITION CLAIM";
384 $sthorders = $dbh->prepare($strsth);
385 $sthorders->execute( @$externalid );
386 $dataorders = $sthorders->fetchall_arrayref( {} );
389 if ($type eq 'claimissues') {
391 SELECT serial.*,subscription.*, biblio.*, biblioitems.*, aqbooksellers.*,
392 aqbooksellers.id AS booksellerid
394 LEFT JOIN subscription ON serial.subscriptionid=subscription.subscriptionid
395 LEFT JOIN biblio ON serial.biblionumber=biblio.biblionumber
396 LEFT JOIN biblioitems ON serial.biblionumber = biblioitems.biblionumber
397 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id
398 WHERE serial.serialid IN (
402 carp "No issues selected";
403 return { error => "no_issues_selected" };
406 $strsth .= join( ",", ('?') x @$externalid ) . ")";
407 $action = "SERIAL CLAIM";
408 $sthorders = $dbh->prepare($strsth);
409 $sthorders->execute( @$externalid );
410 $dataorders = $sthorders->fetchall_arrayref( {} );
413 if ( $type eq 'orderacquisition') {
414 my $basketno = $externalid;
416 SELECT aqorders.*,aqbasket.*,biblio.*,biblioitems.*
418 LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno
419 LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
420 LEFT JOIN biblioitems ON aqorders.biblionumber=biblioitems.biblionumber
421 WHERE aqbasket.basketno = ?
422 AND orderstatus IN ('new','ordered')
425 unless ( $basketno ) {
426 carp "No basketnumber given";
427 return { error => "no_basketno" };
429 $action = "ACQUISITION ORDER";
430 $sthorders = $dbh->prepare($strsth);
431 $sthorders->execute($basketno);
432 $dataorders = $sthorders->fetchall_arrayref( {} );
436 $dbh->prepare("select * from aqbooksellers where id=?");
437 $sthbookseller->execute( $dataorders->[0]->{booksellerid} );
438 my $databookseller = $sthbookseller->fetchrow_hashref;
440 my $addressee = $type eq 'claimacquisition' || $type eq 'orderacquisition' ? 'acqprimary' : 'serialsprimary';
443 $dbh->prepare("SELECT * FROM aqcontacts WHERE booksellerid=? AND $type=1 ORDER BY $addressee DESC");
444 $sthcontact->execute( $dataorders->[0]->{booksellerid} );
445 my $datacontact = $sthcontact->fetchrow_hashref;
449 push @email, $datacontact->{email} if ( $datacontact && $datacontact->{email} );
451 warn "Bookseller $dataorders->[0]->{booksellerid} without emails";
452 return { error => "no_email" };
455 while ($addlcontact = $sthcontact->fetchrow_hashref) {
456 push @cc, $addlcontact->{email} if ( $addlcontact && $addlcontact->{email} );
459 my $userenv = C4::Context->userenv;
460 my $letter = GetPreparedLetter (
462 letter_code => $letter_code,
463 branchcode => $userenv->{branch},
465 'branches' => $userenv->{branch},
466 'aqbooksellers' => $databookseller,
467 'aqcontacts' => $datacontact,
468 'aqbasket' => $basketno,
470 repeat => $dataorders,
472 ) or return { error => "no_letter" };
474 # Remove the order tag
475 $letter->{content} =~ s/<order>(.*?)<\/order>/$1/gxms;
478 my $library = Koha::Libraries->find( $userenv->{branch} );
479 my $mail = Koha::Email->create(
481 to => join( ',', @email ),
482 cc => join( ',', @cc ),
485 C4::Context->preference("ClaimsBccCopy")
486 && ( $type eq 'claimacquisition'
487 || $type eq 'claimissues' )
489 ? ( bcc => $userenv->{emailaddress} )
492 from => $library->branchemail
493 || C4::Context->preference('KohaAdminEmailAddress'),
494 subject => "" . $letter->{title},
498 if ( $letter->{is_html} ) {
499 $mail->html_body( _wrap_html( $letter->{content}, "" . $letter->{title} ) );
502 $mail->text_body( "" . $letter->{content} );
506 $mail->send_or_die({ transport => $library->smtp_server->transport });
509 # We expect ref($_) eq 'Email::Sender::Failure'
510 $error = $_->message;
516 return { error => $error }
519 my $module = $action eq 'ACQUISITION ORDER' ? 'ACQUISITIONS' : 'CLAIMS';
525 . join( ',', @email )
530 ) if C4::Context->preference("ClaimsLog");
532 # send an "account details" notice to a newly created user
533 elsif ( $type eq 'members' ) {
534 my $library = Koha::Libraries->find( $externalid->{branchcode} );
535 my $letter = GetPreparedLetter (
537 letter_code => $letter_code,
538 branchcode => $externalid->{'branchcode'},
539 lang => $externalid->{lang} || 'default',
541 'branches' => $library->unblessed,
542 'borrowers' => $externalid->{'borrowernumber'},
544 substitute => { 'borrowers.password' => $externalid->{'password'} },
547 return { error => "no_email" } unless $externalid->{'emailaddr'};
551 # FIXME: This 'default' behaviour should be moved to Koha::Email
552 my $mail = Koha::Email->create(
554 to => $externalid->{'emailaddr'},
555 from => $library->branchemail,
556 reply_to => $library->branchreplyto,
557 sender => $library->branchreturnpath,
558 subject => "" . $letter->{'title'},
562 if ( $letter->{is_html} ) {
563 $mail->html_body( _wrap_html( $letter->{content}, "" . $letter->{title} ) );
566 $mail->text_body( $letter->{content} );
569 $mail->send_or_die({ transport => $library->smtp_server->transport });
572 # We expect ref($_) eq 'Email::Sender::Failure'
573 $error = $_->message;
579 return { error => $error }
583 # If we come here, return an OK status
587 =head2 GetPreparedLetter( %params )
590 module => letter module, mandatory
591 letter_code => letter code, mandatory
592 branchcode => for letter selection, if missing default system letter taken
593 tables => a hashref with table names as keys. Values are either:
594 - a scalar - primary key value
595 - an arrayref - primary key values
596 - a hashref - full record
597 substitute => custom substitution key/value pairs
598 repeat => records to be substituted on consecutive lines:
599 - an arrayref - tries to guess what needs substituting by
600 taking remaining << >> tokensr; not recommended
601 - a hashref token => @tables - replaces <token> << >> << >> </token>
602 subtemplate for each @tables row; table is a hashref as above
603 want_librarian => boolean, if set to true triggers librarian details
604 substitution from the userenv
606 letter fields hashref (title & content useful)
610 sub GetPreparedLetter {
613 my $letter = $params{letter};
614 my $lang = $params{lang} || 'default';
617 my $module = $params{module} or croak "No module";
618 my $letter_code = $params{letter_code} or croak "No letter_code";
619 my $branchcode = $params{branchcode} || '';
620 my $mtt = $params{message_transport_type} || 'email';
622 my $template = Koha::Notice::Templates->find_effective_template(
625 code => $letter_code,
626 branchcode => $branchcode,
627 message_transport_type => $mtt,
632 unless ( $template ) {
633 warn( "No $module $letter_code letter transported by " . $mtt );
637 $letter = $template->unblessed;
638 $letter->{'content-type'} = 'text/html; charset="UTF-8"' if $letter->{is_html};
641 my $tables = $params{tables} || {};
642 my $substitute = $params{substitute} || {};
643 my $loops = $params{loops} || {}; # loops is not supported for historical notices syntax
644 my $repeat = $params{repeat};
645 %$tables || %$substitute || $repeat || %$loops
646 or carp( "ERROR: nothing to substitute - both 'tables', 'loops' and 'substitute' are empty" ),
648 my $want_librarian = $params{want_librarian};
651 while ( my ($token, $val) = each %$substitute ) {
652 if ( $token eq 'items.content' ) {
653 $val =~ s|\n|<br/>|g if $letter->{is_html};
656 $letter->{title} =~ s/<<$token>>/$val/g;
657 $letter->{content} =~ s/<<$token>>/$val/g;
661 my $OPACBaseURL = C4::Context->preference('OPACBaseURL');
662 $letter->{content} =~ s/<<OPACBaseURL>>/$OPACBaseURL/go;
664 if ($want_librarian) {
665 # parsing librarian name
666 my $userenv = C4::Context->userenv;
667 $letter->{content} =~ s/<<LibrarianFirstname>>/$userenv->{firstname}/go;
668 $letter->{content} =~ s/<<LibrarianSurname>>/$userenv->{surname}/go;
669 $letter->{content} =~ s/<<LibrarianEmailaddress>>/$userenv->{emailaddress}/go;
672 my ($repeat_no_enclosing_tags, $repeat_enclosing_tags);
675 if (ref ($repeat) eq 'ARRAY' ) {
676 $repeat_no_enclosing_tags = $repeat;
678 $repeat_enclosing_tags = $repeat;
682 if ($repeat_enclosing_tags) {
683 while ( my ($tag, $tag_tables) = each %$repeat_enclosing_tags ) {
684 if ( $letter->{content} =~ m!<$tag>(.*)</$tag>!s ) {
687 my %subletter = ( title => '', content => $subcontent );
688 _substitute_tables( \%subletter, $_ );
691 $letter->{content} =~ s!<$tag>.*</$tag>!join( "\n", @lines )!se;
697 _substitute_tables( $letter, $tables );
700 if ($repeat_no_enclosing_tags) {
701 if ( $letter->{content} =~ m/[^\n]*<<.*>>[^\n]*/so ) {
706 $c =~ s/<<count>>/$i/go;
707 foreach my $field ( keys %{$_} ) {
708 $c =~ s/(<<[^\.]+.$field>>)/$_->{$field}/;
712 } @$repeat_no_enclosing_tags;
714 my $replaceby = join( "\n", @lines );
715 $letter->{content} =~ s/\Q$line\E/$replaceby/s;
719 $letter->{content} = _process_tt(
721 content => $letter->{content},
724 substitute => $substitute,
729 $letter->{title} = _process_tt(
731 content => $letter->{title},
734 substitute => $substitute,
738 $letter->{content} =~ s/<<\S*>>//go; #remove any stragglers
743 sub _substitute_tables {
744 my ( $letter, $tables ) = @_;
745 while ( my ($table, $param) = each %$tables ) {
748 my $ref = ref $param;
751 if ($ref && $ref eq 'HASH') {
755 my $sth = _parseletter_sth($table);
757 warn "_parseletter_sth('$table') failed to return a valid sth. No substitution will be done for that table.";
760 $sth->execute( $ref ? @$param : $param );
762 $values = $sth->fetchrow_hashref;
766 _parseletter ( $letter, $table, $values );
770 sub _parseletter_sth {
774 carp "ERROR: _parseletter_sth() called without argument (table)";
777 # NOTE: we used to check whether we had a statement handle cached in
778 # a %handles module-level variable. This was a dumb move and
779 # broke things for the rest of us. prepare_cached is a better
780 # way to cache statement handles anyway.
782 ($table eq 'accountlines' ) ? "SELECT * FROM $table WHERE accountlines_id = ?" :
783 ($table eq 'biblio' ) ? "SELECT * FROM $table WHERE biblionumber = ?" :
784 ($table eq 'biblioitems' ) ? "SELECT * FROM $table WHERE biblionumber = ?" :
785 ($table eq 'credits' ) ? "SELECT * FROM accountlines WHERE accountlines_id = ?" :
786 ($table eq 'debits' ) ? "SELECT * FROM accountlines WHERE accountlines_id = ?" :
787 ($table eq 'items' ) ? "SELECT * FROM $table WHERE itemnumber = ?" :
788 ($table eq 'issues' ) ? "SELECT * FROM $table WHERE itemnumber = ?" :
789 ($table eq 'old_issues' ) ? "SELECT * FROM $table WHERE issue_id = ?" :
790 ($table eq 'reserves' ) ? "SELECT * FROM $table WHERE borrowernumber = ? and biblionumber = ?" :
791 ($table eq 'borrowers' ) ? "SELECT * FROM $table WHERE borrowernumber = ?" :
792 ($table eq 'branches' ) ? "SELECT * FROM $table WHERE branchcode = ?" :
793 ($table eq 'suggestions' ) ? "SELECT * FROM $table WHERE suggestionid = ?" :
794 ($table eq 'aqbooksellers') ? "SELECT * FROM $table WHERE id = ?" :
795 ($table eq 'aqorders' ) ? "SELECT * FROM $table WHERE ordernumber = ?" :
796 ($table eq 'aqbasket' ) ? "SELECT * FROM $table WHERE basketno = ?" :
797 ($table eq 'illrequests' ) ? "SELECT * FROM $table WHERE illrequest_id = ?" :
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 = ?" :
803 ($table eq 'additional_contents' || $table eq 'opac_news') ? "SELECT * FROM additional_contents WHERE idnew = ?" :
806 warn "ERROR: No _parseletter_sth query for table '$table'";
807 return; # nothing to get
809 unless ($sth = C4::Context->dbh->prepare_cached($query)) {
810 warn "ERROR: Failed to prepare query: '$query'";
813 return $sth; # now cache is populated for that $table
816 =head2 _parseletter($letter, $table, $values)
819 - $letter : a hash to letter fields (title & content useful)
820 - $table : the Koha table to parse.
821 - $values_in : table record hashref
822 parse all fields from a table, and replace values in title & content with the appropriate value
823 (not exported sub, used only internally)
828 my ( $letter, $table, $values_in ) = @_;
830 # Work on a local copy of $values_in (passed by reference) to avoid side effects
831 # in callers ( by changing / formatting values )
832 my $values = $values_in ? { %$values_in } : {};
834 if ( $table eq 'borrowers' && $values->{'dateexpiry'} ){
835 $values->{'dateexpiry'} = output_pref({ dt => dt_from_string( $values->{'dateexpiry'} ), dateonly => 1 });
838 if ( $table eq 'reserves' && $values->{'waitingdate'} ) {
839 $values->{'waitingdate'} = output_pref({ dt => dt_from_string( $values->{'waitingdate'} ), dateonly => 1 });
842 if ($letter->{content} && $letter->{content} =~ /<<today>>/) {
843 my $todaysdate = output_pref( dt_from_string() );
844 $letter->{content} =~ s/<<today>>/$todaysdate/go;
847 while ( my ($field, $val) = each %$values ) {
848 $val =~ s/\p{P}$// if $val && $table=~/biblio/;
849 #BZ 9886: Assuming that we want to eliminate ISBD punctuation here
850 #Therefore adding the test on biblio. This includes biblioitems,
851 #but excludes items. Removed unneeded global and lookahead.
853 if ( $table=~/^borrowers$/ && $field=~/^streettype$/ ) {
854 my $av = Koha::AuthorisedValues->search({ category => 'ROADTYPE', authorised_value => $val });
855 $val = $av->count ? $av->next->lib : '';
859 my $replacedby = defined ($val) ? $val : '';
861 and not $replacedby =~ m|9999-12-31|
862 and $replacedby =~ m|^\d{4}-\d{2}-\d{2}( \d{2}:\d{2}:\d{2})?$| )
864 # If the value is XXXX-YY-ZZ[ AA:BB:CC] we assume it is a date
865 my $dateonly = defined $1 ? 0 : 1; #$1 refers to the capture group wrapped in parentheses. In this case, that's the hours, minutes, seconds.
866 my $re_dateonly_filter = qr{ $field( \s* \| \s* dateonly\s*)?>> }xms;
868 for my $letter_field ( qw( title content ) ) {
869 my $filter_string_used = q{};
870 if ( $letter->{ $letter_field } =~ $re_dateonly_filter ) {
871 # We overwrite $dateonly if the filter exists and we have a time in the datetime
872 $filter_string_used = $1 || q{};
873 $dateonly = $1 unless $dateonly;
875 my $replacedby_date = eval {
876 output_pref({ dt => dt_from_string( $replacedby ), dateonly => $dateonly });
879 if ( $letter->{ $letter_field } ) {
880 $letter->{ $letter_field } =~ s/\Q<<$table.$field$filter_string_used>>\E/$replacedby_date/g;
881 $letter->{ $letter_field } =~ s/\Q<<$field$filter_string_used>>\E/$replacedby_date/g;
885 # Other fields replacement
887 for my $letter_field ( qw( title content ) ) {
888 if ( $letter->{ $letter_field } ) {
889 $letter->{ $letter_field } =~ s/<<$table.$field>>/$replacedby/g;
890 $letter->{ $letter_field } =~ s/<<$field>>/$replacedby/g;
896 if ($table eq 'borrowers' && $letter->{content}) {
897 my $patron = Koha::Patrons->find( $values->{borrowernumber} );
899 my $attributes = $patron->extended_attributes;
901 while ( my $attribute = $attributes->next ) {
902 my $code = $attribute->code;
903 my $val = $attribute->description; # FIXME - we always display intranet description here!
904 $val =~ s/\p{P}(?=$)//g if $val;
905 next unless $val gt '';
907 push @{ $attr{$code} }, $val;
909 while ( my ($code, $val_ar) = each %attr ) {
910 my $replacefield = "<<borrower-attribute:$code>>";
911 my $replacedby = join ',', @$val_ar;
912 $letter->{content} =~ s/$replacefield/$replacedby/g;
921 my $success = EnqueueLetter( { letter => $letter,
922 borrowernumber => '12', message_transport_type => 'email' } )
924 Places a letter in the message_queue database table, which will
925 eventually get processed (sent) by the process_message_queue.pl
926 cronjob when it calls SendQueuedMessages.
928 Return message_id on success
931 * letter - required; A letter hashref as returned from GetPreparedLetter
932 * message_transport_type - required; One of the available mtts
933 * borrowernumber - optional if 'to_address' is passed; The borrowernumber of the patron we enqueuing the notice for
934 * to_address - optional if 'borrowernumber' is passed; The destination email address for the notice (defaults to patron->notice_email_address)
935 * from_address - optional; The from address for the notice, defaults to patron->library->from_email_address
936 * reply_address - optional; The reply address for the notice, defaults to patron->library->reply_to
941 my $params = shift or return;
943 return unless exists $params->{'letter'};
944 # return unless exists $params->{'borrowernumber'};
945 return unless exists $params->{'message_transport_type'};
947 my $content = $params->{letter}->{content};
948 $content =~ s/\s+//g if(defined $content);
949 if ( not defined $content or $content eq '' ) {
950 Koha::Logger->get->info("Trying to add an empty message to the message queue");
954 # If we have any attachments we should encode then into the body.
955 if ( $params->{'attachments'} ) {
956 $params->{'letter'} = _add_attachments(
957 { letter => $params->{'letter'},
958 attachments => $params->{'attachments'},
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, failure_code )
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->{'failure_code'} || '', # failure_code
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, failure_code
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, failure_code
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
1222 _add_attachments({ letter => $letter, attachments => $attachments });
1225 letter - the standard letter hashref
1226 attachments - listref of attachments. each attachment is a hashref of:
1227 type - the mime type, like 'text/plain'
1228 content - the actual attachment
1229 filename - the name of the attachment.
1231 returns your letter object, with the content updated.
1232 This routine picks the I<content> of I<letter> and generates a MIME
1233 email, attaching the passed I<attachments> using Koha::Email. The
1234 content is replaced by the string representation of the MIME object,
1235 and the content-type is updated for later handling.
1239 sub _add_attachments {
1242 my $letter = $params->{letter};
1243 my $attachments = $params->{attachments};
1244 return $letter unless @$attachments;
1246 my $message = Koha::Email->new;
1248 if ( $letter->{is_html} ) {
1249 $message->html_body( _wrap_html( $letter->{content}, $letter->{title} ) );
1252 $message->text_body( $letter->{content} );
1255 foreach my $attachment ( @$attachments ) {
1257 Encode::encode( "UTF-8", $attachment->{content} ),
1258 content_type => $attachment->{type} || 'application/octet-stream',
1259 name => $attachment->{filename},
1260 disposition => 'attachment',
1264 $letter->{'content-type'} = SERIALIZED_EMAIL_CONTENT_TYPE;
1265 $letter->{content} = $message->as_string;
1271 =head2 _get_unsent_messages
1273 This function's parameter hash reference takes the following
1274 optional named parameters:
1275 message_transport_type: method of message sending (e.g. email, sms, etc.)
1276 borrowernumber : who the message is to be sent
1277 letter_code : type of message being sent (e.g. PASSWORD_RESET)
1278 message_id : the message_id of the message. In that case the sub will return only 1 result
1279 limit : maximum number of messages to send
1281 This function returns an array of matching hash referenced rows from
1282 message_queue with some borrower information added.
1286 sub _get_unsent_messages {
1289 my $dbh = C4::Context->dbh();
1291 SELECT mq.message_id, mq.borrowernumber, mq.subject, mq.content, mq.message_transport_type, mq.status, mq.time_queued, mq.from_address, mq.reply_address, mq.to_address, mq.content_type, b.branchcode, mq.letter_code, mq.failure_code
1292 FROM message_queue mq
1293 LEFT JOIN borrowers b ON b.borrowernumber = mq.borrowernumber
1297 my @query_params = ('pending');
1298 if ( ref $params ) {
1299 if ( $params->{'message_transport_type'} ) {
1300 $statement .= ' AND mq.message_transport_type = ? ';
1301 push @query_params, $params->{'message_transport_type'};
1303 if ( $params->{'borrowernumber'} ) {
1304 $statement .= ' AND mq.borrowernumber = ? ';
1305 push @query_params, $params->{'borrowernumber'};
1307 if ( $params->{'letter_code'} ) {
1308 $statement .= ' AND mq.letter_code = ? ';
1309 push @query_params, $params->{'letter_code'};
1311 if ( $params->{'type'} ) {
1312 $statement .= ' AND message_transport_type = ? ';
1313 push @query_params, $params->{'type'};
1315 if ( $params->{message_id} ) {
1316 $statement .= ' AND message_id = ?';
1317 push @query_params, $params->{message_id};
1319 if ( $params->{'limit'} ) {
1320 $statement .= ' limit ? ';
1321 push @query_params, $params->{'limit'};
1325 my $sth = $dbh->prepare( $statement );
1326 my $result = $sth->execute( @query_params );
1327 return $sth->fetchall_arrayref({});
1330 sub _send_message_by_email {
1331 my $message = shift or return;
1332 my ($username, $password, $method) = @_;
1334 my $patron = Koha::Patrons->find( $message->{borrowernumber} );
1335 my $to_address = $message->{'to_address'};
1336 unless ($to_address) {
1338 warn "FAIL: No 'to_address' and INVALID borrowernumber ($message->{borrowernumber})";
1339 _set_message_status(
1341 message_id => $message->{'message_id'},
1343 failure_code => 'INVALID_BORNUMBER'
1348 $to_address = $patron->notice_email_address;
1349 unless ($to_address) {
1350 # warn "FAIL: No 'to_address' and no email for " . ($member->{surname} ||'') . ", borrowernumber ($message->{borrowernumber})";
1351 # warning too verbose for this more common case?
1352 _set_message_status(
1354 message_id => $message->{'message_id'},
1356 failure_code => 'NO_EMAIL'
1363 my $subject = $message->{'subject'};
1365 my $content = $message->{'content'};
1366 my $content_type = $message->{'content_type'} || 'text/plain; charset="UTF-8"';
1367 my $is_html = $content_type =~ m/html/io;
1369 my $branch_email = undef;
1370 my $branch_replyto = undef;
1371 my $branch_returnpath = undef;
1375 $library = $patron->library;
1376 $branch_email = $library->from_email_address;
1377 $branch_replyto = $library->branchreplyto;
1378 $branch_returnpath = $library->branchreturnpath;
1381 # NOTE: Patron may not be defined above so branch_email may be undefined still
1382 # so we need to fallback to KohaAdminEmailAddress as a last resort.
1384 $message->{'from_address'}
1386 || C4::Context->preference('KohaAdminEmailAddress');
1387 if( !$from_address ) {
1388 _set_message_status(
1390 message_id => $message->{'message_id'},
1392 failure_code => 'NO_FROM',
1404 C4::Context->preference('NoticeBcc')
1405 ? ( bcc => C4::Context->preference('NoticeBcc') )
1408 from => $from_address,
1409 reply_to => $message->{'reply_address'} || $branch_replyto,
1410 sender => $branch_returnpath,
1411 subject => "" . $message->{subject}
1414 if ( $message->{'content_type'} && $message->{'content_type'} eq SERIALIZED_EMAIL_CONTENT_TYPE ) {
1416 # The message has been previously composed as a valid MIME object
1417 # and serialized as a string on the DB
1418 $email = Koha::Email->new_from_string($content);
1419 $email->create($params);
1421 $email = Koha::Email->create($params);
1423 $email->html_body( _wrap_html( $content, $subject ) );
1425 $email->text_body($content);
1430 if ( ref($_) eq 'Koha::Exceptions::BadParameter' ) {
1431 _set_message_status(
1433 message_id => $message->{'message_id'},
1435 failure_code => "INVALID_EMAIL:".$_->parameter
1439 _set_message_status(
1441 message_id => $message->{'message_id'},
1443 failure_code => 'UNKNOWN_ERROR'
1449 return unless $email;
1453 $smtp_server = $library->smtp_server;
1456 $smtp_server = Koha::SMTP::Servers->get_default;
1462 sasl_username => $username,
1463 sasl_password => $password,
1468 # if initial message address was empty, coming here means that a to address was found and
1469 # queue should be updated; same if to address was overriden by Koha::Email->create
1470 _update_message_to_address( $message->{'message_id'}, $email->email->header('To') )
1471 if !$message->{to_address}
1472 || $message->{to_address} ne $email->email->header('To');
1475 $email->send_or_die({ transport => $smtp_server->transport });
1477 _set_message_status(
1479 message_id => $message->{'message_id'},
1487 _set_message_status(
1489 message_id => $message->{'message_id'},
1491 failure_code => 'SENDMAIL'
1495 carp "$Mail::Sendmail::error";
1501 my ($content, $title) = @_;
1503 my $css = C4::Context->preference("NoticeCSS") || '';
1504 $css = qq{<link rel="stylesheet" type="text/css" href="$css">} if $css;
1506 <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
1507 "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
1508 <html lang="en" xml:lang="en" xmlns="http://www.w3.org/1999/xhtml">
1510 <title>$title</title>
1511 <meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
1522 my ( $message ) = @_;
1523 my $dbh = C4::Context->dbh;
1524 my $count = $dbh->selectrow_array(q|
1527 WHERE message_transport_type = ?
1528 AND borrowernumber = ?
1530 AND CAST(updated_on AS date) = CAST(NOW() AS date)
1533 |, {}, $message->{message_transport_type}, $message->{borrowernumber}, $message->{letter_code}, $message->{content} );
1537 sub _send_message_by_sms {
1538 my $message = shift or return;
1539 my $patron = Koha::Patrons->find( $message->{borrowernumber} );
1541 unless ( $patron and $patron->smsalertnumber ) {
1542 _set_message_status( { message_id => $message->{'message_id'},
1544 failure_code => 'MISSING_SMS' } );
1548 if ( _is_duplicate( $message ) ) {
1549 _set_message_status(
1551 message_id => $message->{'message_id'},
1553 failure_code => 'DUPLICATE_MESSAGE'
1559 my $success = C4::SMS->send_sms(
1561 destination => $patron->smsalertnumber,
1562 message => $message->{'content'},
1567 _set_message_status(
1569 message_id => $message->{'message_id'},
1576 _set_message_status(
1578 message_id => $message->{'message_id'},
1580 failure_code => 'NO_NOTES'
1588 sub _update_message_to_address {
1590 my $dbh = C4::Context->dbh();
1591 $dbh->do('UPDATE message_queue SET to_address=? WHERE message_id=?',undef,($to,$id));
1594 sub _update_message_from_address {
1595 my ($message_id, $from_address) = @_;
1596 my $dbh = C4::Context->dbh();
1597 $dbh->do('UPDATE message_queue SET from_address = ? WHERE message_id = ?', undef, ($from_address, $message_id));
1600 sub _set_message_status {
1601 my $params = shift or return;
1603 foreach my $required_parameter ( qw( message_id status ) ) {
1604 return unless exists $params->{ $required_parameter };
1607 my $dbh = C4::Context->dbh();
1608 my $statement = 'UPDATE message_queue SET status= ?, failure_code= ? WHERE message_id = ?';
1609 my $sth = $dbh->prepare( $statement );
1610 my $result = $sth->execute( $params->{'status'},
1611 $params->{'failure_code'} || '',
1612 $params->{'message_id'} );
1617 my ( $params ) = @_;
1619 my $content = $params->{content};
1620 my $tables = $params->{tables};
1621 my $loops = $params->{loops};
1622 my $substitute = $params->{substitute} || {};
1623 my $lang = defined($params->{lang}) && $params->{lang} ne 'default' ? $params->{lang} : 'en';
1624 my ($theme, $availablethemes);
1626 my $htdocs = C4::Context->config('intrahtdocs');
1627 ($theme, $lang, $availablethemes)= C4::Templates::availablethemes( $htdocs, 'about.tt', 'intranet', $lang);
1629 foreach (@$availablethemes) {
1630 push @includes, "$htdocs/$_/$lang/includes";
1631 push @includes, "$htdocs/$_/en/includes" unless $lang eq 'en';
1634 my $use_template_cache = C4::Context->config('template_cache_dir') && defined $ENV{GATEWAY_INTERFACE};
1635 my $template = Template->new(
1639 PLUGIN_BASE => 'Koha::Template::Plugin',
1640 COMPILE_EXT => $use_template_cache ? '.ttc' : '',
1641 COMPILE_DIR => $use_template_cache ? C4::Context->config('template_cache_dir') : '',
1642 INCLUDE_PATH => \@includes,
1644 ENCODING => 'UTF-8',
1646 ) or die Template->error();
1648 my $tt_params = { %{ _get_tt_params( $tables ) }, %{ _get_tt_params( $loops, 'is_a_loop' ) }, %$substitute };
1650 $content = add_tt_filters( $content );
1651 $content = qq|[% USE KohaDates %][% USE Remove_MARC_punctuation %]$content|;
1654 $template->process( \$content, $tt_params, \$output ) || croak "ERROR PROCESSING TEMPLATE: " . $template->error();
1659 sub _get_tt_params {
1660 my ($tables, $is_a_loop) = @_;
1666 article_requests => {
1667 module => 'Koha::ArticleRequests',
1668 singular => 'article_request',
1669 plural => 'article_requests',
1673 module => 'Koha::Acquisition::Baskets',
1674 singular => 'basket',
1675 plural => 'baskets',
1679 module => 'Koha::Biblios',
1680 singular => 'biblio',
1681 plural => 'biblios',
1682 pk => 'biblionumber',
1685 module => 'Koha::Biblioitems',
1686 singular => 'biblioitem',
1687 plural => 'biblioitems',
1688 pk => 'biblioitemnumber',
1691 module => 'Koha::Patrons',
1692 singular => 'borrower',
1693 plural => 'borrowers',
1694 pk => 'borrowernumber',
1697 module => 'Koha::Libraries',
1698 singular => 'branch',
1699 plural => 'branches',
1703 module => 'Koha::Account::Lines',
1704 singular => 'credit',
1705 plural => 'credits',
1706 pk => 'accountlines_id',
1709 module => 'Koha::Account::Lines',
1710 singular => 'debit',
1712 pk => 'accountlines_id',
1715 module => 'Koha::Items',
1720 additional_contents => {
1721 module => 'Koha::AdditionalContents',
1722 singular => 'additional_content',
1723 plural => 'additional_contents',
1727 module => 'Koha::AdditionalContents',
1733 module => 'Koha::Acquisition::Orders',
1734 singular => 'order',
1736 pk => 'ordernumber',
1739 module => 'Koha::Holds',
1745 module => 'Koha::Serials',
1746 singular => 'serial',
1747 plural => 'serials',
1751 module => 'Koha::Subscriptions',
1752 singular => 'subscription',
1753 plural => 'subscriptions',
1754 pk => 'subscriptionid',
1757 module => 'Koha::Suggestions',
1758 singular => 'suggestion',
1759 plural => 'suggestions',
1760 pk => 'suggestionid',
1763 module => 'Koha::Checkouts',
1764 singular => 'checkout',
1765 plural => 'checkouts',
1769 module => 'Koha::Old::Checkouts',
1770 singular => 'old_checkout',
1771 plural => 'old_checkouts',
1775 module => 'Koha::Checkouts',
1776 singular => 'overdue',
1777 plural => 'overdues',
1780 borrower_modifications => {
1781 module => 'Koha::Patron::Modifications',
1782 singular => 'patron_modification',
1783 plural => 'patron_modifications',
1784 fk => 'verification_token',
1787 module => 'Koha::Illrequests',
1788 singular => 'illrequest',
1789 plural => 'illrequests',
1790 pk => 'illrequest_id'
1794 foreach my $table ( keys %$tables ) {
1795 next unless $config->{$table};
1797 my $ref = ref( $tables->{$table} ) || q{};
1798 my $module = $config->{$table}->{module};
1800 if ( can_load( modules => { $module => undef } ) ) {
1801 my $pk = $config->{$table}->{pk};
1802 my $fk = $config->{$table}->{fk};
1805 my $values = $tables->{$table} || [];
1806 unless ( ref( $values ) eq 'ARRAY' ) {
1807 croak "ERROR processing table $table. Wrong API call.";
1809 my $key = $pk ? $pk : $fk;
1810 # $key does not come from user input
1811 my $objects = $module->search(
1812 { $key => $values },
1814 # We want to retrieve the data in the same order
1816 # field is a MySQLism, but they are no other way to do it
1817 # To be generic we could do it in perl, but we will need to fetch
1818 # all the data then order them
1819 @$values ? ( order_by => \[ "field($key, " . join( ', ', @$values ) . ")" ] ) : ()
1822 $params->{ $config->{$table}->{plural} } = $objects;
1824 elsif ( $ref eq q{} || $ref eq 'HASH' ) {
1825 my $id = ref $ref eq 'HASH' ? $tables->{$table}->{$pk} : $tables->{$table};
1827 if ( $fk ) { # Using a foreign key for lookup
1828 if ( ref( $fk ) eq 'ARRAY' ) { # Foreign key is multi-column
1830 foreach my $key ( @$fk ) {
1831 $search->{$key} = $id->{$key};
1833 $object = $module->search( $search )->last();
1834 } else { # Foreign key is single column
1835 $object = $module->search( { $fk => $id } )->last();
1837 } else { # using the table's primary key for lookup
1838 $object = $module->find($id);
1840 $params->{ $config->{$table}->{singular} } = $object;
1842 else { # $ref eq 'ARRAY'
1844 if ( @{ $tables->{$table} } == 1 ) { # Param is a single key
1845 $object = $module->search( { $pk => $tables->{$table} } )->last();
1847 else { # Params are mutliple foreign keys
1848 croak "Multiple foreign keys (table $table) should be passed using an hashref";
1850 $params->{ $config->{$table}->{singular} } = $object;
1854 croak "ERROR LOADING MODULE $module: $Module::Load::Conditional::ERROR";
1858 $params->{today} = output_pref({ dt => dt_from_string, dateformat => 'iso' });
1863 =head3 add_tt_filters
1865 $content = add_tt_filters( $content );
1867 Add TT filters to some specific fields if needed.
1869 For now we only add the Remove_MARC_punctuation TT filter to biblio and biblioitem fields
1873 sub add_tt_filters {
1874 my ( $content ) = @_;
1875 $content =~ s|\[%\s*biblio\.(.*?)\s*%\]|[% biblio.$1 \| \$Remove_MARC_punctuation %]|gxms;
1876 $content =~ s|\[%\s*biblioitem\.(.*?)\s*%\]|[% biblioitem.$1 \| \$Remove_MARC_punctuation %]|gxms;
1880 =head2 get_item_content
1882 my $item = Koha::Items->find(...)->unblessed;
1883 my @item_content_fields = qw( date_due title barcode author itemnumber );
1884 my $item_content = C4::Letters::get_item_content({
1886 item_content_fields => \@item_content_fields
1889 This function generates a tab-separated list of values for the passed item. Dates
1890 are formatted following the current setup.
1894 sub get_item_content {
1895 my ( $params ) = @_;
1896 my $item = $params->{item};
1897 my $dateonly = $params->{dateonly} || 0;
1898 my $item_content_fields = $params->{item_content_fields} || [];
1900 return unless $item;
1902 my @item_info = map {
1906 { dt => dt_from_string( $item->{$_} ), dateonly => $dateonly } );
1910 } @$item_content_fields;
1911 return join( "\t", @item_info ) . "\n";