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 = ?" :
804 ($table eq 'recalls') ? "SELECT * FROM $table WHERE recall_id = ?" :
807 warn "ERROR: No _parseletter_sth query for table '$table'";
808 return; # nothing to get
810 unless ($sth = C4::Context->dbh->prepare_cached($query)) {
811 warn "ERROR: Failed to prepare query: '$query'";
814 return $sth; # now cache is populated for that $table
817 =head2 _parseletter($letter, $table, $values)
820 - $letter : a hash to letter fields (title & content useful)
821 - $table : the Koha table to parse.
822 - $values_in : table record hashref
823 parse all fields from a table, and replace values in title & content with the appropriate value
824 (not exported sub, used only internally)
829 my ( $letter, $table, $values_in ) = @_;
831 # Work on a local copy of $values_in (passed by reference) to avoid side effects
832 # in callers ( by changing / formatting values )
833 my $values = $values_in ? { %$values_in } : {};
835 if ( $table eq 'borrowers' && $values->{'dateexpiry'} ){
836 $values->{'dateexpiry'} = output_pref({ dt => dt_from_string( $values->{'dateexpiry'} ), dateonly => 1 });
839 if ( $table eq 'reserves' && $values->{'waitingdate'} ) {
840 $values->{'waitingdate'} = output_pref({ dt => dt_from_string( $values->{'waitingdate'} ), dateonly => 1 });
843 if ($letter->{content} && $letter->{content} =~ /<<today>>/) {
844 my $todaysdate = output_pref( dt_from_string() );
845 $letter->{content} =~ s/<<today>>/$todaysdate/go;
848 while ( my ($field, $val) = each %$values ) {
849 $val =~ s/\p{P}$// if $val && $table=~/biblio/;
850 #BZ 9886: Assuming that we want to eliminate ISBD punctuation here
851 #Therefore adding the test on biblio. This includes biblioitems,
852 #but excludes items. Removed unneeded global and lookahead.
854 if ( $table=~/^borrowers$/ && $field=~/^streettype$/ ) {
855 my $av = Koha::AuthorisedValues->search({ category => 'ROADTYPE', authorised_value => $val });
856 $val = $av->count ? $av->next->lib : '';
860 my $replacedby = defined ($val) ? $val : '';
862 and not $replacedby =~ m|9999-12-31|
863 and $replacedby =~ m|^\d{4}-\d{2}-\d{2}( \d{2}:\d{2}:\d{2})?$| )
865 # If the value is XXXX-YY-ZZ[ AA:BB:CC] we assume it is a date
866 my $dateonly = defined $1 ? 0 : 1; #$1 refers to the capture group wrapped in parentheses. In this case, that's the hours, minutes, seconds.
867 my $re_dateonly_filter = qr{ $field( \s* \| \s* dateonly\s*)?>> }xms;
869 for my $letter_field ( qw( title content ) ) {
870 my $filter_string_used = q{};
871 if ( $letter->{ $letter_field } =~ $re_dateonly_filter ) {
872 # We overwrite $dateonly if the filter exists and we have a time in the datetime
873 $filter_string_used = $1 || q{};
874 $dateonly = $1 unless $dateonly;
876 my $replacedby_date = eval {
877 output_pref({ dt => dt_from_string( $replacedby ), dateonly => $dateonly });
880 if ( $letter->{ $letter_field } ) {
881 $letter->{ $letter_field } =~ s/\Q<<$table.$field$filter_string_used>>\E/$replacedby_date/g;
882 $letter->{ $letter_field } =~ s/\Q<<$field$filter_string_used>>\E/$replacedby_date/g;
886 # Other fields replacement
888 for my $letter_field ( qw( title content ) ) {
889 if ( $letter->{ $letter_field } ) {
890 $letter->{ $letter_field } =~ s/<<$table.$field>>/$replacedby/g;
891 $letter->{ $letter_field } =~ s/<<$field>>/$replacedby/g;
897 if ($table eq 'borrowers' && $letter->{content}) {
898 my $patron = Koha::Patrons->find( $values->{borrowernumber} );
900 my $attributes = $patron->extended_attributes;
902 while ( my $attribute = $attributes->next ) {
903 my $code = $attribute->code;
904 my $val = $attribute->description; # FIXME - we always display intranet description here!
905 $val =~ s/\p{P}(?=$)//g if $val;
906 next unless $val gt '';
908 push @{ $attr{$code} }, $val;
910 while ( my ($code, $val_ar) = each %attr ) {
911 my $replacefield = "<<borrower-attribute:$code>>";
912 my $replacedby = join ',', @$val_ar;
913 $letter->{content} =~ s/$replacefield/$replacedby/g;
922 my $success = EnqueueLetter( { letter => $letter,
923 borrowernumber => '12', message_transport_type => 'email' } )
925 Places a letter in the message_queue database table, which will
926 eventually get processed (sent) by the process_message_queue.pl
927 cronjob when it calls SendQueuedMessages.
929 Return message_id on success
932 * letter - required; A letter hashref as returned from GetPreparedLetter
933 * message_transport_type - required; One of the available mtts
934 * borrowernumber - optional if 'to_address' is passed; The borrowernumber of the patron we enqueuing the notice for
935 * to_address - optional if 'borrowernumber' is passed; The destination email address for the notice (defaults to patron->notice_email_address)
936 * from_address - optional; The from address for the notice, defaults to patron->library->from_email_address
937 * reply_address - optional; The reply address for the notice, defaults to patron->library->reply_to
942 my $params = shift or return;
944 return unless exists $params->{'letter'};
945 # return unless exists $params->{'borrowernumber'};
946 return unless exists $params->{'message_transport_type'};
948 my $content = $params->{letter}->{content};
949 $content =~ s/\s+//g if(defined $content);
950 if ( not defined $content or $content eq '' ) {
951 Koha::Logger->get->info("Trying to add an empty message to the message queue");
955 # If we have any attachments we should encode then into the body.
956 if ( $params->{'attachments'} ) {
957 $params->{'letter'} = _add_attachments(
958 { letter => $params->{'letter'},
959 attachments => $params->{'attachments'},
964 my $dbh = C4::Context->dbh();
965 my $statement = << 'ENDSQL';
966 INSERT INTO message_queue
967 ( borrowernumber, subject, content, metadata, letter_code, message_transport_type, status, time_queued, to_address, from_address, reply_address, content_type, failure_code )
969 ( ?, ?, ?, ?, ?, ?, ?, CAST(NOW() AS DATETIME), ?, ?, ?, ?, ? )
972 my $sth = $dbh->prepare($statement);
973 my $result = $sth->execute(
974 $params->{'borrowernumber'}, # borrowernumber
975 $params->{'letter'}->{'title'}, # subject
976 $params->{'letter'}->{'content'}, # content
977 $params->{'letter'}->{'metadata'} || '', # metadata
978 $params->{'letter'}->{'code'} || '', # letter_code
979 $params->{'message_transport_type'}, # message_transport_type
981 $params->{'to_address'}, # to_address
982 $params->{'from_address'}, # from_address
983 $params->{'reply_address'}, # reply_address
984 $params->{'letter'}->{'content-type'}, # content_type
985 $params->{'failure_code'} || '', # failure_code
987 return $dbh->last_insert_id(undef,undef,'message_queue', undef);
990 =head2 SendQueuedMessages ([$hashref])
992 my $sent = SendQueuedMessages({
993 letter_code => $letter_code,
994 borrowernumber => $who_letter_is_for,
1000 Sends all of the 'pending' items in the message queue, unless
1001 parameters are passed.
1003 The letter_code, borrowernumber and limit parameters are used
1004 to build a parameter set for _get_unsent_messages, thus limiting
1005 which pending messages will be processed. They are all optional.
1007 The verbose parameter can be used to generate debugging output.
1008 It is also optional.
1010 Returns number of messages sent.
1014 sub SendQueuedMessages {
1017 my $which_unsent_messages = {
1018 'message_id' => $params->{'message_id'},
1019 'limit' => $params->{'limit'} // 0,
1020 'borrowernumber' => $params->{'borrowernumber'} // q{},
1021 'letter_code' => $params->{'letter_code'} // q{},
1022 'type' => $params->{'type'} // q{},
1024 my $unsent_messages = _get_unsent_messages( $which_unsent_messages );
1025 MESSAGE: foreach my $message ( @$unsent_messages ) {
1026 my $message_object = Koha::Notice::Messages->find( $message->{message_id} );
1027 # If this fails the database is unwritable and we won't manage to send a message that continues to be marked 'pending'
1028 $message_object->make_column_dirty('status');
1029 return unless $message_object->store;
1031 # warn Data::Dumper->Dump( [ $message ], [ 'message' ] );
1032 warn sprintf( 'sending %s message to patron: %s',
1033 $message->{'message_transport_type'},
1034 $message->{'borrowernumber'} || 'Admin' )
1035 if $params->{'verbose'};
1036 # This is just begging for subclassing
1037 next MESSAGE if ( lc($message->{'message_transport_type'}) eq 'rss' );
1038 if ( lc( $message->{'message_transport_type'} ) eq 'email' ) {
1039 _send_message_by_email( $message, $params->{'username'}, $params->{'password'}, $params->{'method'} );
1041 elsif ( lc( $message->{'message_transport_type'} ) eq 'sms' ) {
1042 if ( C4::Context->preference('SMSSendDriver') eq 'Email' ) {
1043 my $patron = Koha::Patrons->find( $message->{borrowernumber} );
1044 my $sms_provider = Koha::SMS::Providers->find( $patron->sms_provider_id );
1045 unless ( $sms_provider ) {
1046 warn sprintf( "Patron %s has no sms provider id set!", $message->{'borrowernumber'} ) if $params->{'verbose'};
1047 _set_message_status( { message_id => $message->{'message_id'}, status => 'failed' } );
1050 unless ( $patron->smsalertnumber ) {
1051 _set_message_status( { message_id => $message->{'message_id'}, status => 'failed' } );
1052 warn sprintf( "No smsalertnumber found for patron %s!", $message->{'borrowernumber'} ) if $params->{'verbose'};
1055 $message->{to_address} = $patron->smsalertnumber; #Sometime this is set to email - sms should always use smsalertnumber
1056 $message->{to_address} .= '@' . $sms_provider->domain();
1058 # Check for possible from_address override
1059 my $from_address = C4::Context->preference('EmailSMSSendDriverFromAddress');
1060 if ($from_address && $message->{from_address} ne $from_address) {
1061 $message->{from_address} = $from_address;
1062 _update_message_from_address($message->{'message_id'}, $message->{from_address});
1065 _update_message_to_address($message->{'message_id'}, $message->{to_address});
1066 _send_message_by_email( $message, $params->{'username'}, $params->{'password'}, $params->{'method'} );
1068 _send_message_by_sms( $message );
1072 return scalar( @$unsent_messages );
1075 =head2 GetRSSMessages
1077 my $message_list = GetRSSMessages( { limit => 10, borrowernumber => '14' } )
1079 returns a listref of all queued RSS messages for a particular person.
1083 sub GetRSSMessages {
1086 return unless $params;
1087 return unless ref $params;
1088 return unless $params->{'borrowernumber'};
1090 return _get_unsent_messages( { message_transport_type => 'rss',
1091 limit => $params->{'limit'},
1092 borrowernumber => $params->{'borrowernumber'}, } );
1095 =head2 GetPrintMessages
1097 my $message_list = GetPrintMessages( { borrowernumber => $borrowernumber } )
1099 Returns a arrayref of all queued print messages (optionally, for a particular
1104 sub GetPrintMessages {
1105 my $params = shift || {};
1107 return _get_unsent_messages( { message_transport_type => 'print',
1108 borrowernumber => $params->{'borrowernumber'},
1112 =head2 GetQueuedMessages ([$hashref])
1114 my $messages = GetQueuedMessage( { borrowernumber => '123', limit => 20 } );
1116 Fetches a list of messages from the message queue optionally filtered by borrowernumber
1117 and limited to specified limit.
1119 Return is an arrayref of hashes, each has represents a message in the message queue.
1123 sub GetQueuedMessages {
1126 my $dbh = C4::Context->dbh();
1127 my $statement = << 'ENDSQL';
1128 SELECT message_id, borrowernumber, subject, content, message_transport_type, status, time_queued, updated_on, failure_code
1134 if ( exists $params->{'borrowernumber'} ) {
1135 push @whereclauses, ' borrowernumber = ? ';
1136 push @query_params, $params->{'borrowernumber'};
1139 if ( @whereclauses ) {
1140 $statement .= ' WHERE ' . join( 'AND', @whereclauses );
1143 if ( defined $params->{'limit'} ) {
1144 $statement .= ' LIMIT ? ';
1145 push @query_params, $params->{'limit'};
1148 my $sth = $dbh->prepare( $statement );
1149 my $result = $sth->execute( @query_params );
1150 return $sth->fetchall_arrayref({});
1153 =head2 GetMessageTransportTypes
1155 my @mtt = GetMessageTransportTypes();
1157 returns an arrayref of transport types
1161 sub GetMessageTransportTypes {
1162 my $dbh = C4::Context->dbh();
1163 my $mtts = $dbh->selectcol_arrayref("
1164 SELECT message_transport_type
1165 FROM message_transport_types
1166 ORDER BY message_transport_type
1173 my $message = C4::Letters::Message($message_id);
1178 my ( $message_id ) = @_;
1179 return unless $message_id;
1180 my $dbh = C4::Context->dbh;
1181 return $dbh->selectrow_hashref(q|
1182 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
1184 WHERE message_id = ?
1185 |, {}, $message_id );
1188 =head2 ResendMessage
1190 Attempt to resend a message which has failed previously.
1192 my $has_been_resent = C4::Letters::ResendMessage($message_id);
1194 Updates the message to 'pending' status so that
1195 it will be resent later on.
1197 returns 1 on success, 0 on failure, undef if no message was found
1202 my $message_id = shift;
1203 return unless $message_id;
1205 my $message = GetMessage( $message_id );
1206 return unless $message;
1208 if ( $message->{status} ne 'pending' ) {
1209 $rv = C4::Letters::_set_message_status({
1210 message_id => $message_id,
1211 status => 'pending',
1213 $rv = $rv > 0? 1: 0;
1214 # Clear destination email address to force address update
1215 _update_message_to_address( $message_id, undef ) if $rv &&
1216 $message->{message_transport_type} eq 'email';
1221 =head2 _add_attachements
1223 _add_attachments({ letter => $letter, attachments => $attachments });
1226 letter - the standard letter hashref
1227 attachments - listref of attachments. each attachment is a hashref of:
1228 type - the mime type, like 'text/plain'
1229 content - the actual attachment
1230 filename - the name of the attachment.
1232 returns your letter object, with the content updated.
1233 This routine picks the I<content> of I<letter> and generates a MIME
1234 email, attaching the passed I<attachments> using Koha::Email. The
1235 content is replaced by the string representation of the MIME object,
1236 and the content-type is updated for later handling.
1240 sub _add_attachments {
1243 my $letter = $params->{letter};
1244 my $attachments = $params->{attachments};
1245 return $letter unless @$attachments;
1247 my $message = Koha::Email->new;
1249 if ( $letter->{is_html} ) {
1250 $message->html_body( _wrap_html( $letter->{content}, $letter->{title} ) );
1253 $message->text_body( $letter->{content} );
1256 foreach my $attachment ( @$attachments ) {
1258 Encode::encode( "UTF-8", $attachment->{content} ),
1259 content_type => $attachment->{type} || 'application/octet-stream',
1260 name => $attachment->{filename},
1261 disposition => 'attachment',
1265 $letter->{'content-type'} = SERIALIZED_EMAIL_CONTENT_TYPE;
1266 $letter->{content} = $message->as_string;
1272 =head2 _get_unsent_messages
1274 This function's parameter hash reference takes the following
1275 optional named parameters:
1276 message_transport_type: method of message sending (e.g. email, sms, etc.)
1277 borrowernumber : who the message is to be sent
1278 letter_code : type of message being sent (e.g. PASSWORD_RESET)
1279 message_id : the message_id of the message. In that case the sub will return only 1 result
1280 limit : maximum number of messages to send
1282 This function returns an array of matching hash referenced rows from
1283 message_queue with some borrower information added.
1287 sub _get_unsent_messages {
1290 my $dbh = C4::Context->dbh();
1292 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
1293 FROM message_queue mq
1294 LEFT JOIN borrowers b ON b.borrowernumber = mq.borrowernumber
1298 my @query_params = ('pending');
1299 if ( ref $params ) {
1300 if ( $params->{'message_transport_type'} ) {
1301 $statement .= ' AND mq.message_transport_type = ? ';
1302 push @query_params, $params->{'message_transport_type'};
1304 if ( $params->{'borrowernumber'} ) {
1305 $statement .= ' AND mq.borrowernumber = ? ';
1306 push @query_params, $params->{'borrowernumber'};
1308 if ( $params->{'letter_code'} ) {
1309 $statement .= ' AND mq.letter_code = ? ';
1310 push @query_params, $params->{'letter_code'};
1312 if ( $params->{'type'} ) {
1313 $statement .= ' AND message_transport_type = ? ';
1314 push @query_params, $params->{'type'};
1316 if ( $params->{message_id} ) {
1317 $statement .= ' AND message_id = ?';
1318 push @query_params, $params->{message_id};
1320 if ( $params->{'limit'} ) {
1321 $statement .= ' limit ? ';
1322 push @query_params, $params->{'limit'};
1326 my $sth = $dbh->prepare( $statement );
1327 my $result = $sth->execute( @query_params );
1328 return $sth->fetchall_arrayref({});
1331 sub _send_message_by_email {
1332 my $message = shift or return;
1333 my ($username, $password, $method) = @_;
1335 my $patron = Koha::Patrons->find( $message->{borrowernumber} );
1336 my $to_address = $message->{'to_address'};
1337 unless ($to_address) {
1339 warn "FAIL: No 'to_address' and INVALID borrowernumber ($message->{borrowernumber})";
1340 _set_message_status(
1342 message_id => $message->{'message_id'},
1344 failure_code => 'INVALID_BORNUMBER'
1349 $to_address = $patron->notice_email_address;
1350 unless ($to_address) {
1351 # warn "FAIL: No 'to_address' and no email for " . ($member->{surname} ||'') . ", borrowernumber ($message->{borrowernumber})";
1352 # warning too verbose for this more common case?
1353 _set_message_status(
1355 message_id => $message->{'message_id'},
1357 failure_code => 'NO_EMAIL'
1364 my $subject = $message->{'subject'};
1366 my $content = $message->{'content'};
1367 my $content_type = $message->{'content_type'} || 'text/plain; charset="UTF-8"';
1368 my $is_html = $content_type =~ m/html/io;
1370 my $branch_email = undef;
1371 my $branch_replyto = undef;
1372 my $branch_returnpath = undef;
1376 $library = $patron->library;
1377 $branch_email = $library->from_email_address;
1378 $branch_replyto = $library->branchreplyto;
1379 $branch_returnpath = $library->branchreturnpath;
1382 # NOTE: Patron may not be defined above so branch_email may be undefined still
1383 # so we need to fallback to KohaAdminEmailAddress as a last resort.
1385 $message->{'from_address'}
1387 || C4::Context->preference('KohaAdminEmailAddress');
1388 if( !$from_address ) {
1389 _set_message_status(
1391 message_id => $message->{'message_id'},
1393 failure_code => 'NO_FROM',
1405 C4::Context->preference('NoticeBcc')
1406 ? ( bcc => C4::Context->preference('NoticeBcc') )
1409 from => $from_address,
1410 reply_to => $message->{'reply_address'} || $branch_replyto,
1411 sender => $branch_returnpath,
1412 subject => "" . $message->{subject}
1415 if ( $message->{'content_type'} && $message->{'content_type'} eq SERIALIZED_EMAIL_CONTENT_TYPE ) {
1417 # The message has been previously composed as a valid MIME object
1418 # and serialized as a string on the DB
1419 $email = Koha::Email->new_from_string($content);
1420 $email->create($params);
1422 $email = Koha::Email->create($params);
1424 $email->html_body( _wrap_html( $content, $subject ) );
1426 $email->text_body($content);
1431 if ( ref($_) eq 'Koha::Exceptions::BadParameter' ) {
1432 _set_message_status(
1434 message_id => $message->{'message_id'},
1436 failure_code => "INVALID_EMAIL:".$_->parameter
1440 _set_message_status(
1442 message_id => $message->{'message_id'},
1444 failure_code => 'UNKNOWN_ERROR'
1450 return unless $email;
1454 $smtp_server = $library->smtp_server;
1457 $smtp_server = Koha::SMTP::Servers->get_default;
1463 sasl_username => $username,
1464 sasl_password => $password,
1469 # if initial message address was empty, coming here means that a to address was found and
1470 # queue should be updated; same if to address was overriden by Koha::Email->create
1471 _update_message_to_address( $message->{'message_id'}, $email->email->header('To') )
1472 if !$message->{to_address}
1473 || $message->{to_address} ne $email->email->header('To');
1476 $email->send_or_die({ transport => $smtp_server->transport });
1478 _set_message_status(
1480 message_id => $message->{'message_id'},
1488 _set_message_status(
1490 message_id => $message->{'message_id'},
1492 failure_code => 'SENDMAIL'
1496 carp "$Mail::Sendmail::error";
1502 my ($content, $title) = @_;
1504 my $css = C4::Context->preference("NoticeCSS") || '';
1505 $css = qq{<link rel="stylesheet" type="text/css" href="$css">} if $css;
1507 <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
1508 "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
1509 <html lang="en" xml:lang="en" xmlns="http://www.w3.org/1999/xhtml">
1511 <title>$title</title>
1512 <meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
1523 my ( $message ) = @_;
1524 my $dbh = C4::Context->dbh;
1525 my $count = $dbh->selectrow_array(q|
1528 WHERE message_transport_type = ?
1529 AND borrowernumber = ?
1531 AND CAST(updated_on AS date) = CAST(NOW() AS date)
1534 |, {}, $message->{message_transport_type}, $message->{borrowernumber}, $message->{letter_code}, $message->{content} );
1538 sub _send_message_by_sms {
1539 my $message = shift or return;
1540 my $patron = Koha::Patrons->find( $message->{borrowernumber} );
1542 unless ( $patron and $patron->smsalertnumber ) {
1543 _set_message_status( { message_id => $message->{'message_id'},
1545 failure_code => 'MISSING_SMS' } );
1549 if ( _is_duplicate( $message ) ) {
1550 _set_message_status(
1552 message_id => $message->{'message_id'},
1554 failure_code => 'DUPLICATE_MESSAGE'
1560 my $success = C4::SMS->send_sms(
1562 destination => $patron->smsalertnumber,
1563 message => $message->{'content'},
1568 _set_message_status(
1570 message_id => $message->{'message_id'},
1577 _set_message_status(
1579 message_id => $message->{'message_id'},
1581 failure_code => 'NO_NOTES'
1589 sub _update_message_to_address {
1591 my $dbh = C4::Context->dbh();
1592 $dbh->do('UPDATE message_queue SET to_address=? WHERE message_id=?',undef,($to,$id));
1595 sub _update_message_from_address {
1596 my ($message_id, $from_address) = @_;
1597 my $dbh = C4::Context->dbh();
1598 $dbh->do('UPDATE message_queue SET from_address = ? WHERE message_id = ?', undef, ($from_address, $message_id));
1601 sub _set_message_status {
1602 my $params = shift or return;
1604 foreach my $required_parameter ( qw( message_id status ) ) {
1605 return unless exists $params->{ $required_parameter };
1608 my $dbh = C4::Context->dbh();
1609 my $statement = 'UPDATE message_queue SET status= ?, failure_code= ? WHERE message_id = ?';
1610 my $sth = $dbh->prepare( $statement );
1611 my $result = $sth->execute( $params->{'status'},
1612 $params->{'failure_code'} || '',
1613 $params->{'message_id'} );
1618 my ( $params ) = @_;
1620 my $content = $params->{content};
1621 my $tables = $params->{tables};
1622 my $loops = $params->{loops};
1623 my $substitute = $params->{substitute} || {};
1624 my $lang = defined($params->{lang}) && $params->{lang} ne 'default' ? $params->{lang} : 'en';
1625 my ($theme, $availablethemes);
1627 my $htdocs = C4::Context->config('intrahtdocs');
1628 ($theme, $lang, $availablethemes)= C4::Templates::availablethemes( $htdocs, 'about.tt', 'intranet', $lang);
1630 foreach (@$availablethemes) {
1631 push @includes, "$htdocs/$_/$lang/includes";
1632 push @includes, "$htdocs/$_/en/includes" unless $lang eq 'en';
1635 my $use_template_cache = C4::Context->config('template_cache_dir') && defined $ENV{GATEWAY_INTERFACE};
1636 my $template = Template->new(
1640 PLUGIN_BASE => 'Koha::Template::Plugin',
1641 COMPILE_EXT => $use_template_cache ? '.ttc' : '',
1642 COMPILE_DIR => $use_template_cache ? C4::Context->config('template_cache_dir') : '',
1643 INCLUDE_PATH => \@includes,
1645 ENCODING => 'UTF-8',
1647 ) or die Template->error();
1649 my $tt_params = { %{ _get_tt_params( $tables ) }, %{ _get_tt_params( $loops, 'is_a_loop' ) }, %$substitute };
1651 $content = add_tt_filters( $content );
1652 $content = qq|[% USE KohaDates %][% USE Remove_MARC_punctuation %]$content|;
1655 $template->process( \$content, $tt_params, \$output ) || croak "ERROR PROCESSING TEMPLATE: " . $template->error();
1660 sub _get_tt_params {
1661 my ($tables, $is_a_loop) = @_;
1667 article_requests => {
1668 module => 'Koha::ArticleRequests',
1669 singular => 'article_request',
1670 plural => 'article_requests',
1674 module => 'Koha::Acquisition::Baskets',
1675 singular => 'basket',
1676 plural => 'baskets',
1680 module => 'Koha::Biblios',
1681 singular => 'biblio',
1682 plural => 'biblios',
1683 pk => 'biblionumber',
1686 module => 'Koha::Biblioitems',
1687 singular => 'biblioitem',
1688 plural => 'biblioitems',
1689 pk => 'biblioitemnumber',
1692 module => 'Koha::Patrons',
1693 singular => 'borrower',
1694 plural => 'borrowers',
1695 pk => 'borrowernumber',
1698 module => 'Koha::Libraries',
1699 singular => 'branch',
1700 plural => 'branches',
1704 module => 'Koha::Account::Lines',
1705 singular => 'credit',
1706 plural => 'credits',
1707 pk => 'accountlines_id',
1710 module => 'Koha::Account::Lines',
1711 singular => 'debit',
1713 pk => 'accountlines_id',
1716 module => 'Koha::Items',
1721 additional_contents => {
1722 module => 'Koha::AdditionalContents',
1723 singular => 'additional_content',
1724 plural => 'additional_contents',
1728 module => 'Koha::AdditionalContents',
1734 module => 'Koha::Acquisition::Orders',
1735 singular => 'order',
1737 pk => 'ordernumber',
1740 module => 'Koha::Holds',
1746 module => 'Koha::Serials',
1747 singular => 'serial',
1748 plural => 'serials',
1752 module => 'Koha::Subscriptions',
1753 singular => 'subscription',
1754 plural => 'subscriptions',
1755 pk => 'subscriptionid',
1758 module => 'Koha::Suggestions',
1759 singular => 'suggestion',
1760 plural => 'suggestions',
1761 pk => 'suggestionid',
1764 module => 'Koha::Checkouts',
1765 singular => 'checkout',
1766 plural => 'checkouts',
1770 module => 'Koha::Old::Checkouts',
1771 singular => 'old_checkout',
1772 plural => 'old_checkouts',
1776 module => 'Koha::Checkouts',
1777 singular => 'overdue',
1778 plural => 'overdues',
1781 borrower_modifications => {
1782 module => 'Koha::Patron::Modifications',
1783 singular => 'patron_modification',
1784 plural => 'patron_modifications',
1785 fk => 'verification_token',
1788 module => 'Koha::Illrequests',
1789 singular => 'illrequest',
1790 plural => 'illrequests',
1791 pk => 'illrequest_id'
1795 foreach my $table ( keys %$tables ) {
1796 next unless $config->{$table};
1798 my $ref = ref( $tables->{$table} ) || q{};
1799 my $module = $config->{$table}->{module};
1801 if ( can_load( modules => { $module => undef } ) ) {
1802 my $pk = $config->{$table}->{pk};
1803 my $fk = $config->{$table}->{fk};
1806 my $values = $tables->{$table} || [];
1807 unless ( ref( $values ) eq 'ARRAY' ) {
1808 croak "ERROR processing table $table. Wrong API call.";
1810 my $key = $pk ? $pk : $fk;
1811 # $key does not come from user input
1812 my $objects = $module->search(
1813 { $key => $values },
1815 # We want to retrieve the data in the same order
1817 # field is a MySQLism, but they are no other way to do it
1818 # To be generic we could do it in perl, but we will need to fetch
1819 # all the data then order them
1820 @$values ? ( order_by => \[ "field($key, " . join( ', ', @$values ) . ")" ] ) : ()
1823 $params->{ $config->{$table}->{plural} } = $objects;
1825 elsif ( $ref eq q{} || $ref eq 'HASH' ) {
1826 my $id = ref $ref eq 'HASH' ? $tables->{$table}->{$pk} : $tables->{$table};
1828 if ( $fk ) { # Using a foreign key for lookup
1829 if ( ref( $fk ) eq 'ARRAY' ) { # Foreign key is multi-column
1831 foreach my $key ( @$fk ) {
1832 $search->{$key} = $id->{$key};
1834 $object = $module->search( $search )->last();
1835 } else { # Foreign key is single column
1836 $object = $module->search( { $fk => $id } )->last();
1838 } else { # using the table's primary key for lookup
1839 $object = $module->find($id);
1841 $params->{ $config->{$table}->{singular} } = $object;
1843 else { # $ref eq 'ARRAY'
1845 if ( @{ $tables->{$table} } == 1 ) { # Param is a single key
1846 $object = $module->search( { $pk => $tables->{$table} } )->last();
1848 else { # Params are mutliple foreign keys
1849 croak "Multiple foreign keys (table $table) should be passed using an hashref";
1851 $params->{ $config->{$table}->{singular} } = $object;
1855 croak "ERROR LOADING MODULE $module: $Module::Load::Conditional::ERROR";
1859 $params->{today} = output_pref({ dt => dt_from_string, dateformat => 'iso' });
1864 =head3 add_tt_filters
1866 $content = add_tt_filters( $content );
1868 Add TT filters to some specific fields if needed.
1870 For now we only add the Remove_MARC_punctuation TT filter to biblio and biblioitem fields
1874 sub add_tt_filters {
1875 my ( $content ) = @_;
1876 $content =~ s|\[%\s*biblio\.(.*?)\s*%\]|[% biblio.$1 \| \$Remove_MARC_punctuation %]|gxms;
1877 $content =~ s|\[%\s*biblioitem\.(.*?)\s*%\]|[% biblioitem.$1 \| \$Remove_MARC_punctuation %]|gxms;
1881 =head2 get_item_content
1883 my $item = Koha::Items->find(...)->unblessed;
1884 my @item_content_fields = qw( date_due title barcode author itemnumber );
1885 my $item_content = C4::Letters::get_item_content({
1887 item_content_fields => \@item_content_fields
1890 This function generates a tab-separated list of values for the passed item. Dates
1891 are formatted following the current setup.
1895 sub get_item_content {
1896 my ( $params ) = @_;
1897 my $item = $params->{item};
1898 my $dateonly = $params->{dateonly} || 0;
1899 my $item_content_fields = $params->{item_content_fields} || [];
1901 return unless $item;
1903 my @item_info = map {
1907 { dt => dt_from_string( $item->{$_} ), dateonly => $dateonly } );
1911 } @$item_content_fields;
1912 return join( "\t", @item_info ) . "\n";