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 );
29 use C4::Log qw( logaction );
32 use Koha::SMS::Providers;
35 use Koha::Notice::Messages;
36 use Koha::Notice::Templates;
37 use Koha::DateUtils qw( dt_from_string output_pref );
38 use Koha::Auth::TwoFactorAuth;
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 $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 $log_object = $action eq 'ACQUISITION ORDER' ? $externalid : undef;
520 my $module = $action eq 'ACQUISITION ORDER' ? 'ACQUISITIONS' : 'CLAIMS';
526 . join( ',', @email )
531 ) if C4::Context->preference("ClaimsLog");
534 # If we come here, return an OK status
538 =head2 GetPreparedLetter( %params )
541 module => letter module, mandatory
542 letter_code => letter code, mandatory
543 branchcode => for letter selection, if missing default system letter taken
544 tables => a hashref with table names as keys. Values are either:
545 - a scalar - primary key value
546 - an arrayref - primary key values
547 - a hashref - full record
548 substitute => custom substitution key/value pairs
549 repeat => records to be substituted on consecutive lines:
550 - an arrayref - tries to guess what needs substituting by
551 taking remaining << >> tokensr; not recommended
552 - a hashref token => @tables - replaces <token> << >> << >> </token>
553 subtemplate for each @tables row; table is a hashref as above
554 want_librarian => boolean, if set to true triggers librarian details
555 substitution from the userenv
557 letter fields hashref (title & content useful)
561 sub GetPreparedLetter {
564 my $letter = $params{letter};
565 my $lang = $params{lang} || 'default';
568 my $module = $params{module} or croak "No module";
569 my $letter_code = $params{letter_code} or croak "No letter_code";
570 my $branchcode = $params{branchcode} || '';
571 my $mtt = $params{message_transport_type} || 'email';
573 my $template = Koha::Notice::Templates->find_effective_template(
576 code => $letter_code,
577 branchcode => $branchcode,
578 message_transport_type => $mtt,
583 unless ( $template ) {
584 warn( "No $module $letter_code letter transported by " . $mtt );
588 $letter = $template->unblessed;
589 $letter->{'content-type'} = 'text/html; charset="UTF-8"' if $letter->{is_html};
592 my $objects = $params{objects} || {};
593 my $tables = $params{tables} || {};
594 my $substitute = $params{substitute} || {};
595 my $loops = $params{loops} || {}; # loops is not supported for historical notices syntax
596 my $repeat = $params{repeat};
597 %$tables || %$substitute || $repeat || %$loops || %$objects
598 or carp( "ERROR: nothing to substitute - all of 'objects', 'tables', 'loops' and 'substitute' are empty" ),
600 my $want_librarian = $params{want_librarian};
603 while ( my ($token, $val) = each %$substitute ) {
605 if ( $token eq 'items.content' ) {
606 $val =~ s|\n|<br/>|g if $letter->{is_html};
609 $letter->{title} =~ s/<<$token>>/$val/g;
610 $letter->{content} =~ s/<<$token>>/$val/g;
614 my $OPACBaseURL = C4::Context->preference('OPACBaseURL');
615 $letter->{content} =~ s/<<OPACBaseURL>>/$OPACBaseURL/go;
617 if ($want_librarian) {
618 # parsing librarian name
619 my $userenv = C4::Context->userenv;
620 $letter->{content} =~ s/<<LibrarianFirstname>>/$userenv->{firstname}/go;
621 $letter->{content} =~ s/<<LibrarianSurname>>/$userenv->{surname}/go;
622 $letter->{content} =~ s/<<LibrarianEmailaddress>>/$userenv->{emailaddress}/go;
625 my ($repeat_no_enclosing_tags, $repeat_enclosing_tags);
628 if (ref ($repeat) eq 'ARRAY' ) {
629 $repeat_no_enclosing_tags = $repeat;
631 $repeat_enclosing_tags = $repeat;
635 if ($repeat_enclosing_tags) {
636 while ( my ($tag, $tag_tables) = each %$repeat_enclosing_tags ) {
637 if ( $letter->{content} =~ m!<$tag>(.*)</$tag>!s ) {
640 my %subletter = ( title => '', content => $subcontent );
641 _substitute_tables( \%subletter, $_ );
644 $letter->{content} =~ s!<$tag>.*</$tag>!join( "\n", @lines )!se;
650 _substitute_tables( $letter, $tables );
653 if ($repeat_no_enclosing_tags) {
654 if ( $letter->{content} =~ m/[^\n]*<<.*>>[^\n]*/so ) {
659 $c =~ s/<<count>>/$i/go;
660 foreach my $field ( keys %{$_} ) {
661 $c =~ s/(<<[^\.]+.$field>>)/$_->{$field}/;
665 } @$repeat_no_enclosing_tags;
667 my $replaceby = join( "\n", @lines );
668 $letter->{content} =~ s/\Q$line\E/$replaceby/s;
672 $letter->{content} = _process_tt(
674 content => $letter->{content},
678 substitute => $substitute,
683 $letter->{title} = _process_tt(
685 content => $letter->{title},
689 substitute => $substitute,
694 $letter->{content} =~ s/<<\S*>>//go; #remove any stragglers
699 sub _substitute_tables {
700 my ( $letter, $tables ) = @_;
701 while ( my ($table, $param) = each %$tables ) {
704 my $ref = ref $param;
707 if ($ref && $ref eq 'HASH') {
711 my $sth = _parseletter_sth($table);
713 warn "_parseletter_sth('$table') failed to return a valid sth. No substitution will be done for that table.";
716 $sth->execute( $ref ? @$param : $param );
718 $values = $sth->fetchrow_hashref;
722 _parseletter ( $letter, $table, $values );
726 sub _parseletter_sth {
730 carp "ERROR: _parseletter_sth() called without argument (table)";
733 # NOTE: we used to check whether we had a statement handle cached in
734 # a %handles module-level variable. This was a dumb move and
735 # broke things for the rest of us. prepare_cached is a better
736 # way to cache statement handles anyway.
738 ($table eq 'accountlines' ) ? "SELECT * FROM $table WHERE accountlines_id = ?" :
739 ($table eq 'biblio' ) ? "SELECT * FROM $table WHERE biblionumber = ?" :
740 ($table eq 'biblioitems' ) ? "SELECT * FROM $table WHERE biblionumber = ?" :
741 ($table eq 'tickets' ) ? "SELECT * FROM $table WHERE id = ?" :
742 ($table eq 'credits' ) ? "SELECT * FROM accountlines WHERE accountlines_id = ?" :
743 ($table eq 'debits' ) ? "SELECT * FROM accountlines WHERE accountlines_id = ?" :
744 ($table eq 'items' ) ? "SELECT * FROM $table WHERE itemnumber = ?" :
745 ($table eq 'issues' ) ? "SELECT * FROM $table WHERE itemnumber = ?" :
746 ($table eq 'old_issues' ) ? "SELECT * FROM $table WHERE issue_id = ?" :
747 ($table eq 'reserves' ) ? "SELECT * FROM $table WHERE borrowernumber = ? and biblionumber = ?" :
748 ($table eq 'borrowers' ) ? "SELECT * FROM $table WHERE borrowernumber = ?" :
749 ($table eq 'branches' ) ? "SELECT * FROM $table WHERE branchcode = ?" :
750 ($table eq 'suggestions' ) ? "SELECT * FROM $table WHERE suggestionid = ?" :
751 ($table eq 'aqbooksellers') ? "SELECT * FROM $table WHERE id = ?" :
752 ($table eq 'aqorders' ) ? "SELECT * FROM $table WHERE ordernumber = ?" :
753 ($table eq 'aqbasket' ) ? "SELECT * FROM $table WHERE basketno = ?" :
754 ($table eq 'illrequests' ) ? "SELECT * FROM $table WHERE illrequest_id = ?" :
755 ($table eq 'article_requests') ? "SELECT * FROM $table WHERE id = ?" :
756 ($table eq 'borrower_modifications') ? "SELECT * FROM $table WHERE verification_token = ?" :
757 ($table eq 'subscription') ? "SELECT * FROM $table WHERE subscriptionid = ?" :
758 ($table eq 'serial') ? "SELECT * FROM $table WHERE serialid = ?" :
759 ($table eq 'problem_reports') ? "SELECT * FROM $table WHERE reportid = ?" :
760 ($table eq 'additional_contents' || $table eq 'opac_news') ? "SELECT * FROM additional_contents WHERE idnew = ?" :
761 ($table eq 'recalls') ? "SELECT * FROM $table WHERE recall_id = ?" :
764 warn "ERROR: No _parseletter_sth query for table '$table'";
765 return; # nothing to get
767 unless ($sth = C4::Context->dbh->prepare_cached($query)) {
768 warn "ERROR: Failed to prepare query: '$query'";
771 return $sth; # now cache is populated for that $table
774 =head2 _parseletter($letter, $table, $values)
777 - $letter : a hash to letter fields (title & content useful)
778 - $table : the Koha table to parse.
779 - $values_in : table record hashref
780 parse all fields from a table, and replace values in title & content with the appropriate value
781 (not exported sub, used only internally)
786 my ( $letter, $table, $values_in ) = @_;
788 # Work on a local copy of $values_in (passed by reference) to avoid side effects
789 # in callers ( by changing / formatting values )
790 my $values = $values_in ? { %$values_in } : {};
792 # FIXME Dates formatting must be done in notice's templates
793 if ( $table eq 'borrowers' && $values->{'dateexpiry'} ){
794 $values->{'dateexpiry'} = output_pref({ dt => dt_from_string( $values->{'dateexpiry'} ), dateonly => 1 });
797 if ( $table eq 'reserves' && $values->{'waitingdate'} ) {
798 $values->{'waitingdate'} = output_pref({ dt => dt_from_string( $values->{'waitingdate'} ), dateonly => 1 });
801 if ($letter->{content} && $letter->{content} =~ /<<today>>/) {
802 my $todaysdate = output_pref( dt_from_string() );
803 $letter->{content} =~ s/<<today>>/$todaysdate/go;
806 while ( my ($field, $val) = each %$values ) {
807 $val =~ s/\p{P}$// if $val && $table=~/biblio/;
808 #BZ 9886: Assuming that we want to eliminate ISBD punctuation here
809 #Therefore adding the test on biblio. This includes biblioitems,
810 #but excludes items. Removed unneeded global and lookahead.
812 if ( $table=~/^borrowers$/ && $field=~/^streettype$/ ) {
813 my $av = Koha::AuthorisedValues->search({ category => 'ROADTYPE', authorised_value => $val });
814 $val = $av->count ? $av->next->lib : '';
818 my $replacedby = defined ($val) ? $val : '';
820 and not $replacedby =~ m|9999-12-31|
821 and $replacedby =~ m|^\d{4}-\d{2}-\d{2}( \d{2}:\d{2}:\d{2})?$| )
823 # If the value is XXXX-YY-ZZ[ AA:BB:CC] we assume it is a date
824 my $dateonly = defined $1 ? 0 : 1; #$1 refers to the capture group wrapped in parentheses. In this case, that's the hours, minutes, seconds.
825 my $re_dateonly_filter = qr{ $field( \s* \| \s* dateonly\s*)?>> }xms;
827 for my $letter_field ( qw( title content ) ) {
828 my $filter_string_used = q{};
829 if ( $letter->{ $letter_field } =~ $re_dateonly_filter ) {
830 # We overwrite $dateonly if the filter exists and we have a time in the datetime
831 $filter_string_used = $1 || q{};
832 $dateonly = $1 unless $dateonly;
834 my $replacedby_date = eval {
835 output_pref({ dt => scalar dt_from_string( $replacedby ), dateonly => $dateonly });
837 $replacedby_date //= q{};
839 if ( $letter->{ $letter_field } ) {
840 $letter->{ $letter_field } =~ s/\Q<<$table.$field$filter_string_used>>\E/$replacedby_date/g;
841 $letter->{ $letter_field } =~ s/\Q<<$field$filter_string_used>>\E/$replacedby_date/g;
845 # Other fields replacement
847 for my $letter_field ( qw( title content ) ) {
848 if ( $letter->{ $letter_field } ) {
849 $letter->{ $letter_field } =~ s/<<$table.$field>>/$replacedby/g;
850 $letter->{ $letter_field } =~ s/<<$field>>/$replacedby/g;
856 if ($table eq 'borrowers' && $letter->{content}) {
857 my $patron = Koha::Patrons->find( $values->{borrowernumber} );
859 my $attributes = $patron->extended_attributes;
861 while ( my $attribute = $attributes->next ) {
862 my $code = $attribute->code;
863 my $val = $attribute->description; # FIXME - we always display intranet description here!
864 $val =~ s/\p{P}(?=$)//g if $val;
865 next unless $val gt '';
867 push @{ $attr{$code} }, $val;
869 while ( my ($code, $val_ar) = each %attr ) {
870 my $replacefield = "<<borrower-attribute:$code>>";
871 my $replacedby = join ',', @$val_ar;
872 $letter->{content} =~ s/$replacefield/$replacedby/g;
881 my $success = EnqueueLetter( { letter => $letter,
882 borrowernumber => '12', message_transport_type => 'email' } )
884 Places a letter in the message_queue database table, which will
885 eventually get processed (sent) by the process_message_queue.pl
886 cronjob when it calls SendQueuedMessages.
888 Return message_id on success
891 * letter - required; A letter hashref as returned from GetPreparedLetter
892 * message_transport_type - required; One of the available mtts
893 * borrowernumber - optional if 'to_address' is passed; The borrowernumber of the patron we enqueuing the notice for
894 * to_address - optional if 'borrowernumber' is passed; The destination email address for the notice (defaults to patron->notice_email_address)
895 * from_address - optional; The from address for the notice, defaults to patron->library->from_email_address
896 * reply_address - optional; The reply address for the notice, defaults to patron->library->reply_to
901 my $params = shift or return;
903 return unless exists $params->{'letter'};
904 # return unless exists $params->{'borrowernumber'};
905 return unless exists $params->{'message_transport_type'};
907 my $content = $params->{letter}->{content};
908 $content =~ s/\s+//g if(defined $content);
909 if ( not defined $content or $content eq '' ) {
910 Koha::Logger->get->info("Trying to add an empty message to the message queue");
914 # If we have any attachments we should encode then into the body.
915 if ( $params->{'attachments'} ) {
916 $params->{'letter'} = _add_attachments(
917 { letter => $params->{'letter'},
918 attachments => $params->{'attachments'},
923 my $dbh = C4::Context->dbh();
924 my $statement = << 'ENDSQL';
925 INSERT INTO message_queue
926 ( letter_id, borrowernumber, subject, content, metadata, letter_code, message_transport_type, status, time_queued, to_address, from_address, reply_address, content_type, failure_code )
927 VALUES ( ?, ?, ?, ?, ?, ?, ?, ?, CAST(NOW() AS DATETIME), ?, ?, ?, ?, ? )
930 my $sth = $dbh->prepare($statement);
931 my $result = $sth->execute(
932 $params->{letter}->{id} || undef, # letter.id
933 $params->{'borrowernumber'}, # borrowernumber
934 $params->{'letter'}->{'title'}, # subject
935 $params->{'letter'}->{'content'}, # content
936 $params->{'letter'}->{'metadata'} || '', # metadata
937 $params->{'letter'}->{'code'} || '', # letter_code
938 $params->{'message_transport_type'}, # message_transport_type
940 $params->{'to_address'}, # to_address
941 $params->{'from_address'}, # from_address
942 $params->{'reply_address'}, # reply_address
943 $params->{'letter'}->{'content-type'}, # content_type
944 $params->{'failure_code'} || '', # failure_code
946 return $dbh->last_insert_id(undef,undef,'message_queue', undef);
949 =head2 SendQueuedMessages ([$hashref])
951 my $sent = SendQueuedMessages({
952 letter_code => $letter_code,
953 borrowernumber => $who_letter_is_for,
959 Sends all of the 'pending' items in the message queue, unless
960 parameters are passed.
962 The letter_code, borrowernumber and limit parameters are used
963 to build a parameter set for _get_unsent_messages, thus limiting
964 which pending messages will be processed. They are all optional.
966 The verbose parameter can be used to generate debugging output.
969 Returns number of messages sent.
973 sub SendQueuedMessages {
976 my $which_unsent_messages = {
977 'message_id' => $params->{'message_id'},
978 'limit' => $params->{'limit'} // 0,
979 'borrowernumber' => $params->{'borrowernumber'} // q{},
980 'letter_code' => $params->{'letter_code'} // q{},
981 'message_transport_type' => $params->{'type'} // q{},
982 'where' => $params->{'where'} // q{},
984 my $unsent_messages = _get_unsent_messages( $which_unsent_messages );
985 MESSAGE: foreach my $message ( @$unsent_messages ) {
986 my $message_object = Koha::Notice::Messages->find( $message->{message_id} );
987 # If this fails the database is unwritable and we won't manage to send a message that continues to be marked 'pending'
988 $message_object->make_column_dirty('status');
989 return unless $message_object->store;
991 # warn Data::Dumper->Dump( [ $message ], [ 'message' ] );
992 warn sprintf( 'sending %s message to patron: %s',
993 $message->{'message_transport_type'},
994 $message->{'borrowernumber'} || 'Admin' )
995 if $params->{'verbose'};
996 # This is just begging for subclassing
997 next MESSAGE if ( lc($message->{'message_transport_type'}) eq 'rss' );
998 if ( lc( $message->{'message_transport_type'} ) eq 'email' ) {
999 _send_message_by_email( $message, $params->{'username'}, $params->{'password'}, $params->{'method'} );
1001 elsif ( lc( $message->{'message_transport_type'} ) eq 'sms' ) {
1002 if ( C4::Context->preference('SMSSendDriver') eq 'Email' ) {
1003 my $patron = Koha::Patrons->find( $message->{borrowernumber} );
1004 my $sms_provider = Koha::SMS::Providers->find( $patron->sms_provider_id );
1005 unless ( $sms_provider ) {
1006 warn sprintf( "Patron %s has no sms provider id set!", $message->{'borrowernumber'} ) if $params->{'verbose'};
1007 _set_message_status( { message_id => $message->{'message_id'}, status => 'failed' } );
1010 unless ( $patron->smsalertnumber ) {
1011 _set_message_status( { message_id => $message->{'message_id'}, status => 'failed' } );
1012 warn sprintf( "No smsalertnumber found for patron %s!", $message->{'borrowernumber'} ) if $params->{'verbose'};
1015 $message->{to_address} = $patron->smsalertnumber; #Sometime this is set to email - sms should always use smsalertnumber
1016 $message->{to_address} .= '@' . $sms_provider->domain();
1018 # Check for possible from_address override
1019 my $from_address = C4::Context->preference('EmailSMSSendDriverFromAddress');
1020 if ($from_address && $message->{from_address} ne $from_address) {
1021 $message->{from_address} = $from_address;
1022 _update_message_from_address($message->{'message_id'}, $message->{from_address});
1025 _update_message_to_address($message->{'message_id'}, $message->{to_address});
1026 _send_message_by_email( $message, $params->{'username'}, $params->{'password'}, $params->{'method'} );
1028 _send_message_by_sms( $message );
1032 return scalar( @$unsent_messages );
1035 =head2 GetRSSMessages
1037 my $message_list = GetRSSMessages( { limit => 10, borrowernumber => '14' } )
1039 returns a listref of all queued RSS messages for a particular person.
1043 sub GetRSSMessages {
1046 return unless $params;
1047 return unless ref $params;
1048 return unless $params->{'borrowernumber'};
1050 return _get_unsent_messages( { message_transport_type => 'rss',
1051 limit => $params->{'limit'},
1052 borrowernumber => $params->{'borrowernumber'}, } );
1055 =head2 GetPrintMessages
1057 my $message_list = GetPrintMessages( { borrowernumber => $borrowernumber } )
1059 Returns a arrayref of all queued print messages (optionally, for a particular
1064 sub GetPrintMessages {
1065 my $params = shift || {};
1067 return _get_unsent_messages( { message_transport_type => 'print',
1068 borrowernumber => $params->{'borrowernumber'},
1072 =head2 GetQueuedMessages ([$hashref])
1074 my $messages = GetQueuedMessage( { borrowernumber => '123', limit => 20 } );
1076 Fetches a list of messages from the message queue optionally filtered by borrowernumber
1077 and limited to specified limit.
1079 Return is an arrayref of hashes, each has represents a message in the message queue.
1083 sub GetQueuedMessages {
1086 my $dbh = C4::Context->dbh();
1087 my $statement = << 'ENDSQL';
1088 SELECT message_id, borrowernumber, subject, content, message_transport_type, status, time_queued, updated_on, failure_code
1094 if ( exists $params->{'borrowernumber'} ) {
1095 push @whereclauses, ' borrowernumber = ? ';
1096 push @query_params, $params->{'borrowernumber'};
1099 if ( @whereclauses ) {
1100 $statement .= ' WHERE ' . join( 'AND', @whereclauses );
1103 if ( defined $params->{'limit'} ) {
1104 $statement .= ' LIMIT ? ';
1105 push @query_params, $params->{'limit'};
1108 my $sth = $dbh->prepare( $statement );
1109 my $result = $sth->execute( @query_params );
1110 return $sth->fetchall_arrayref({});
1113 =head2 GetMessageTransportTypes
1115 my @mtt = GetMessageTransportTypes();
1117 returns an arrayref of transport types
1121 sub GetMessageTransportTypes {
1122 my $dbh = C4::Context->dbh();
1123 my $mtts = $dbh->selectcol_arrayref("
1124 SELECT message_transport_type
1125 FROM message_transport_types
1126 ORDER BY message_transport_type
1133 my $message = C4::Letters::Message($message_id);
1138 my ( $message_id ) = @_;
1139 return unless $message_id;
1140 my $dbh = C4::Context->dbh;
1141 return $dbh->selectrow_hashref(q|
1142 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
1144 WHERE message_id = ?
1145 |, {}, $message_id );
1148 =head2 ResendMessage
1150 Attempt to resend a message which has failed previously.
1152 my $has_been_resent = C4::Letters::ResendMessage($message_id);
1154 Updates the message to 'pending' status so that
1155 it will be resent later on.
1157 returns 1 on success, 0 on failure, undef if no message was found
1162 my $message_id = shift;
1163 return unless $message_id;
1165 my $message = GetMessage( $message_id );
1166 return unless $message;
1168 if ( $message->{status} ne 'pending' ) {
1169 $rv = C4::Letters::_set_message_status({
1170 message_id => $message_id,
1171 status => 'pending',
1173 $rv = $rv > 0? 1: 0;
1174 # Clear destination email address to force address update
1175 _update_message_to_address( $message_id, undef ) if $rv &&
1176 $message->{message_transport_type} eq 'email';
1181 =head2 _add_attachements
1183 _add_attachments({ letter => $letter, attachments => $attachments });
1186 letter - the standard letter hashref
1187 attachments - listref of attachments. each attachment is a hashref of:
1188 type - the mime type, like 'text/plain'
1189 content - the actual attachment
1190 filename - the name of the attachment.
1192 returns your letter object, with the content updated.
1193 This routine picks the I<content> of I<letter> and generates a MIME
1194 email, attaching the passed I<attachments> using Koha::Email. The
1195 content is replaced by the string representation of the MIME object,
1196 and the content-type is updated for later handling.
1200 sub _add_attachments {
1203 my $letter = $params->{letter};
1204 my $attachments = $params->{attachments};
1205 return $letter unless @$attachments;
1207 my $message = Koha::Email->new;
1209 if ( $letter->{is_html} ) {
1210 $message->html_body( _wrap_html( $letter->{content}, $letter->{title} ) );
1213 $message->text_body( $letter->{content} );
1216 foreach my $attachment ( @$attachments ) {
1218 Encode::encode( "UTF-8", $attachment->{content} ),
1219 content_type => $attachment->{type} || 'application/octet-stream',
1220 name => $attachment->{filename},
1221 disposition => 'attachment',
1225 $letter->{'content-type'} = SERIALIZED_EMAIL_CONTENT_TYPE;
1226 $letter->{content} = $message->as_string;
1232 =head2 _get_unsent_messages
1234 This function's parameter hash reference takes the following
1235 optional named parameters:
1236 message_transport_type: method of message sending (e.g. email, sms, etc.)
1237 Can be a single string, or an arrayref of strings
1238 borrowernumber : who the message is to be sent
1239 letter_code : type of message being sent (e.g. PASSWORD_RESET)
1240 Can be a single string, or an arrayref of strings
1241 message_id : the message_id of the message. In that case the sub will return only 1 result
1242 limit : maximum number of messages to send
1244 This function returns an array of matching hash referenced rows from
1245 message_queue with some borrower information added.
1249 sub _get_unsent_messages {
1252 my $dbh = C4::Context->dbh();
1254 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
1255 FROM message_queue mq
1256 LEFT JOIN borrowers b ON b.borrowernumber = mq.borrowernumber
1260 my @query_params = ('pending');
1261 if ( ref $params ) {
1262 if ( $params->{'borrowernumber'} ) {
1263 $statement .= ' AND mq.borrowernumber = ? ';
1264 push @query_params, $params->{'borrowernumber'};
1266 if ( $params->{'letter_code'} ) {
1267 my @letter_codes = ref $params->{'letter_code'} eq "ARRAY" ? @{$params->{'letter_code'}} : $params->{'letter_code'};
1268 if ( @letter_codes ) {
1269 my $q = join( ",", ("?") x @letter_codes );
1270 $statement .= " AND mq.letter_code IN ( $q ) ";
1271 push @query_params, @letter_codes;
1274 if ( $params->{'message_transport_type'} ) {
1275 my @types = ref $params->{'message_transport_type'} eq "ARRAY" ? @{$params->{'message_transport_type'}} : $params->{'message_transport_type'};
1277 my $q = join( ",", ("?") x @types );
1278 $statement .= " AND message_transport_type IN ( $q ) ";
1279 push @query_params, @types;
1282 if ( $params->{message_id} ) {
1283 $statement .= ' AND message_id = ?';
1284 push @query_params, $params->{message_id};
1286 if ( $params->{where} ) {
1287 $statement .= " AND $params->{where} ";
1289 if ( $params->{'limit'} ) {
1290 $statement .= ' limit ? ';
1291 push @query_params, $params->{'limit'};
1295 my $sth = $dbh->prepare( $statement );
1296 my $result = $sth->execute( @query_params );
1297 return $sth->fetchall_arrayref({});
1300 sub _send_message_by_email {
1301 my $message = shift or return;
1302 my ($username, $password, $method) = @_;
1304 my $patron = Koha::Patrons->find( $message->{borrowernumber} );
1305 my $to_address = $message->{'to_address'};
1306 unless ($to_address) {
1308 warn "FAIL: No 'to_address' and INVALID borrowernumber ($message->{borrowernumber})";
1309 _set_message_status(
1311 message_id => $message->{'message_id'},
1313 failure_code => 'INVALID_BORNUMBER'
1318 $to_address = $patron->notice_email_address;
1319 unless ($to_address) {
1320 # warn "FAIL: No 'to_address' and no email for " . ($member->{surname} ||'') . ", borrowernumber ($message->{borrowernumber})";
1321 # warning too verbose for this more common case?
1322 _set_message_status(
1324 message_id => $message->{'message_id'},
1326 failure_code => 'NO_EMAIL'
1333 my $subject = $message->{'subject'};
1335 my $content = $message->{'content'};
1336 my $content_type = $message->{'content_type'} || 'text/plain; charset="UTF-8"';
1337 my $is_html = $content_type =~ m/html/io;
1339 my $branch_email = undef;
1340 my $branch_replyto = undef;
1341 my $branch_returnpath = undef;
1345 $library = $patron->library;
1346 $branch_email = $library->from_email_address;
1347 $branch_replyto = $library->branchreplyto;
1348 $branch_returnpath = $library->branchreturnpath;
1351 # NOTE: Patron may not be defined above so branch_email may be undefined still
1352 # so we need to fallback to KohaAdminEmailAddress as a last resort.
1354 $message->{'from_address'}
1356 || C4::Context->preference('KohaAdminEmailAddress');
1357 if( !$from_address ) {
1358 _set_message_status(
1360 message_id => $message->{'message_id'},
1362 failure_code => 'NO_FROM',
1374 C4::Context->preference('NoticeBcc')
1375 ? ( bcc => C4::Context->preference('NoticeBcc') )
1378 from => $from_address,
1379 reply_to => $message->{'reply_address'} || $branch_replyto,
1380 sender => $branch_returnpath,
1381 subject => "" . $message->{subject}
1384 if ( $message->{'content_type'} && $message->{'content_type'} eq SERIALIZED_EMAIL_CONTENT_TYPE ) {
1386 # The message has been previously composed as a valid MIME object
1387 # and serialized as a string on the DB
1388 $email = Koha::Email->new_from_string($content);
1389 $email->create($params);
1391 $email = Koha::Email->create($params);
1393 $email->html_body( _wrap_html( $content, $subject ) );
1395 $email->text_body($content);
1400 if ( ref($_) eq 'Koha::Exceptions::BadParameter' ) {
1401 _set_message_status(
1403 message_id => $message->{'message_id'},
1405 failure_code => "INVALID_EMAIL:".$_->parameter
1409 _set_message_status(
1411 message_id => $message->{'message_id'},
1413 failure_code => 'UNKNOWN_ERROR'
1419 return unless $email;
1423 $smtp_server = $library->smtp_server;
1426 $smtp_server = Koha::SMTP::Servers->get_default;
1432 sasl_username => $username,
1433 sasl_password => $password,
1438 # if initial message address was empty, coming here means that a to address was found and
1439 # queue should be updated; same if to address was overriden by Koha::Email->create
1440 _update_message_to_address( $message->{'message_id'}, $email->email->header('To') )
1441 if !$message->{to_address}
1442 || $message->{to_address} ne $email->email->header('To');
1445 $email->send_or_die({ transport => $smtp_server->transport });
1447 _set_message_status(
1449 message_id => $message->{'message_id'},
1457 _set_message_status(
1459 message_id => $message->{'message_id'},
1461 failure_code => 'SENDMAIL'
1465 carp "$Mail::Sendmail::error";
1471 my ($content, $title) = @_;
1473 my $css = C4::Context->preference("NoticeCSS") || '';
1474 $css = qq{<link rel="stylesheet" type="text/css" href="$css">} if $css;
1476 <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
1477 "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
1478 <html lang="en" xml:lang="en" xmlns="http://www.w3.org/1999/xhtml">
1480 <title>$title</title>
1481 <meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
1492 my ( $message ) = @_;
1493 my $dbh = C4::Context->dbh;
1494 my $count = $dbh->selectrow_array(q|
1497 WHERE message_transport_type = ?
1498 AND borrowernumber = ?
1500 AND CAST(updated_on AS date) = CAST(NOW() AS date)
1503 |, {}, $message->{message_transport_type}, $message->{borrowernumber}, $message->{letter_code}, $message->{content} );
1507 sub _send_message_by_sms {
1508 my $message = shift or return;
1509 my $patron = Koha::Patrons->find( $message->{borrowernumber} );
1510 _update_message_to_address($message->{message_id}, $patron->smsalertnumber) if $patron;
1512 unless ( $patron and $patron->smsalertnumber ) {
1513 _set_message_status( { message_id => $message->{'message_id'},
1515 failure_code => 'MISSING_SMS' } );
1519 if ( _is_duplicate( $message ) ) {
1520 _set_message_status(
1522 message_id => $message->{'message_id'},
1524 failure_code => 'DUPLICATE_MESSAGE'
1530 my $success = C4::SMS->send_sms(
1532 destination => $patron->smsalertnumber,
1533 message => $message->{'content'},
1538 _set_message_status(
1540 message_id => $message->{'message_id'},
1547 _set_message_status(
1549 message_id => $message->{'message_id'},
1551 failure_code => 'NO_NOTES'
1559 sub _update_message_to_address {
1561 my $dbh = C4::Context->dbh();
1562 $dbh->do('UPDATE message_queue SET to_address=? WHERE message_id=?',undef,($to,$id));
1565 sub _update_message_from_address {
1566 my ($message_id, $from_address) = @_;
1567 my $dbh = C4::Context->dbh();
1568 $dbh->do('UPDATE message_queue SET from_address = ? WHERE message_id = ?', undef, ($from_address, $message_id));
1571 sub _set_message_status {
1572 my $params = shift or return;
1574 foreach my $required_parameter ( qw( message_id status ) ) {
1575 return unless exists $params->{ $required_parameter };
1578 my $dbh = C4::Context->dbh();
1579 my $statement = 'UPDATE message_queue SET status= ?, failure_code= ? WHERE message_id = ?';
1580 my $sth = $dbh->prepare( $statement );
1581 my $result = $sth->execute( $params->{'status'},
1582 $params->{'failure_code'} || '',
1583 $params->{'message_id'} );
1588 my ( $params ) = @_;
1590 my $content = $params->{content};
1591 my $tables = $params->{tables};
1592 my $loops = $params->{loops};
1593 my $objects = $params->{objects} || {};
1594 my $substitute = $params->{substitute} || {};
1595 my $lang = defined($params->{lang}) && $params->{lang} ne 'default' ? $params->{lang} : 'en';
1596 my ($theme, $availablethemes);
1598 my $htdocs = C4::Context->config('intrahtdocs');
1599 ($theme, $lang, $availablethemes)= C4::Templates::availablethemes( $htdocs, 'about.tt', 'intranet', $lang);
1601 foreach (@$availablethemes) {
1602 push @includes, "$htdocs/$_/$lang/includes";
1603 push @includes, "$htdocs/$_/en/includes" unless $lang eq 'en';
1606 my $use_template_cache = C4::Context->config('template_cache_dir') && defined $ENV{GATEWAY_INTERFACE};
1607 my $template = Template->new(
1611 PLUGIN_BASE => 'Koha::Template::Plugin',
1612 COMPILE_EXT => $use_template_cache ? '.ttc' : '',
1613 COMPILE_DIR => $use_template_cache ? C4::Context->config('template_cache_dir') : '',
1614 INCLUDE_PATH => \@includes,
1616 ENCODING => 'UTF-8',
1618 ) or die Template->error();
1620 my $tt_params = { %{ _get_tt_params( $tables ) }, %{ _get_tt_params( $loops, 'is_a_loop' ) }, %$substitute, %$objects };
1622 $content = add_tt_filters( $content );
1623 $content = qq|[% USE KohaDates %][% USE Remove_MARC_punctuation %][% PROCESS 'html_helpers.inc' %]$content|;
1626 my $schema = Koha::Database->new->schema;
1628 my $processed = try {
1629 $template->process( \$content, $tt_params, \$output );
1632 $schema->txn_rollback;
1634 croak "ERROR PROCESSING TEMPLATE: " . $template->error() unless $processed;
1639 sub _get_tt_params {
1640 my ($tables, $is_a_loop) = @_;
1646 article_requests => {
1647 module => 'Koha::ArticleRequests',
1648 singular => 'article_request',
1649 plural => 'article_requests',
1653 module => 'Koha::Acquisition::Baskets',
1654 singular => 'basket',
1655 plural => 'baskets',
1659 module => 'Koha::Biblios',
1660 singular => 'biblio',
1661 plural => 'biblios',
1662 pk => 'biblionumber',
1665 module => 'Koha::Biblioitems',
1666 singular => 'biblioitem',
1667 plural => 'biblioitems',
1668 pk => 'biblioitemnumber',
1671 module => 'Koha::Patrons',
1672 singular => 'borrower',
1673 plural => 'borrowers',
1674 pk => 'borrowernumber',
1677 module => 'Koha::Libraries',
1678 singular => 'branch',
1679 plural => 'branches',
1683 module => 'Koha::Account::Lines',
1684 singular => 'credit',
1685 plural => 'credits',
1686 pk => 'accountlines_id',
1689 module => 'Koha::Account::Lines',
1690 singular => 'debit',
1692 pk => 'accountlines_id',
1695 module => 'Koha::Items',
1700 additional_contents => {
1701 module => 'Koha::AdditionalContents',
1702 singular => 'additional_content',
1703 plural => 'additional_contents',
1707 module => 'Koha::AdditionalContents',
1713 module => 'Koha::Acquisition::Orders',
1714 singular => 'order',
1716 pk => 'ordernumber',
1719 module => 'Koha::Holds',
1725 module => 'Koha::Serials',
1726 singular => 'serial',
1727 plural => 'serials',
1731 module => 'Koha::Subscriptions',
1732 singular => 'subscription',
1733 plural => 'subscriptions',
1734 pk => 'subscriptionid',
1737 module => 'Koha::Suggestions',
1738 singular => 'suggestion',
1739 plural => 'suggestions',
1740 pk => 'suggestionid',
1743 module => 'Koha::Tickets',
1744 singular => 'ticket',
1745 plural => 'tickets',
1749 module => 'Koha::Checkouts',
1750 singular => 'checkout',
1751 plural => 'checkouts',
1755 module => 'Koha::Old::Checkouts',
1756 singular => 'old_checkout',
1757 plural => 'old_checkouts',
1761 module => 'Koha::Checkouts',
1762 singular => 'overdue',
1763 plural => 'overdues',
1766 borrower_modifications => {
1767 module => 'Koha::Patron::Modifications',
1768 singular => 'patron_modification',
1769 plural => 'patron_modifications',
1770 fk => 'verification_token',
1773 module => 'Koha::Illrequests',
1774 singular => 'illrequest',
1775 plural => 'illrequests',
1776 pk => 'illrequest_id'
1780 foreach my $table ( keys %$tables ) {
1781 next unless $config->{$table};
1783 my $ref = ref( $tables->{$table} ) || q{};
1784 my $module = $config->{$table}->{module};
1786 if ( can_load( modules => { $module => undef } ) ) {
1787 my $pk = $config->{$table}->{pk};
1788 my $fk = $config->{$table}->{fk};
1791 my $values = $tables->{$table} || [];
1792 unless ( ref( $values ) eq 'ARRAY' ) {
1793 croak "ERROR processing table $table. Wrong API call.";
1795 my $key = $pk ? $pk : $fk;
1796 # $key does not come from user input
1797 my $objects = $module->search(
1798 { $key => $values },
1800 # We want to retrieve the data in the same order
1802 # field is a MySQLism, but they are no other way to do it
1803 # To be generic we could do it in perl, but we will need to fetch
1804 # all the data then order them
1805 @$values ? ( order_by => \[ "field($key, " . join( ', ', @$values ) . ")" ] ) : ()
1808 $params->{ $config->{$table}->{plural} } = $objects;
1810 elsif ( $ref eq q{} || $ref eq 'HASH' ) {
1811 my $id = ref $ref eq 'HASH' ? $tables->{$table}->{$pk} : $tables->{$table};
1813 if ( $fk ) { # Using a foreign key for lookup
1814 if ( ref( $fk ) eq 'ARRAY' ) { # Foreign key is multi-column
1816 foreach my $key ( @$fk ) {
1817 $search->{$key} = $id->{$key};
1819 $object = $module->search( $search )->last();
1820 } else { # Foreign key is single column
1821 $object = $module->search( { $fk => $id } )->last();
1823 } else { # using the table's primary key for lookup
1824 $object = $module->find($id);
1826 $params->{ $config->{$table}->{singular} } = $object;
1828 else { # $ref eq 'ARRAY'
1830 if ( @{ $tables->{$table} } == 1 ) { # Param is a single key
1831 $object = $module->search( { $pk => $tables->{$table} } )->last();
1833 else { # Params are mutliple foreign keys
1834 croak "Multiple foreign keys (table $table) should be passed using an hashref";
1836 $params->{ $config->{$table}->{singular} } = $object;
1840 croak "ERROR LOADING MODULE $module: $Module::Load::Conditional::ERROR";
1844 $params->{today} = output_pref({ dt => dt_from_string, dateformat => 'iso' });
1849 =head3 add_tt_filters
1851 $content = add_tt_filters( $content );
1853 Add TT filters to some specific fields if needed.
1855 For now we only add the Remove_MARC_punctuation TT filter to biblio and biblioitem fields
1859 sub add_tt_filters {
1860 my ( $content ) = @_;
1861 $content =~ s|\[%\s*biblio\.(.*?)\s*%\]|[% biblio.$1 \| \$Remove_MARC_punctuation %]|gxms;
1862 $content =~ s|\[%\s*biblioitem\.(.*?)\s*%\]|[% biblioitem.$1 \| \$Remove_MARC_punctuation %]|gxms;
1866 =head2 get_item_content
1868 my $item = Koha::Items->find(...)->unblessed;
1869 my @item_content_fields = qw( date_due title barcode author itemnumber );
1870 my $item_content = C4::Letters::get_item_content({
1872 item_content_fields => \@item_content_fields
1875 This function generates a tab-separated list of values for the passed item. Dates
1876 are formatted following the current setup.
1880 sub get_item_content {
1881 my ( $params ) = @_;
1882 my $item = $params->{item};
1883 my $dateonly = $params->{dateonly} || 0;
1884 my $item_content_fields = $params->{item_content_fields} || [];
1886 return unless $item;
1888 my @item_info = map {
1892 { dt => dt_from_string( $item->{$_} ), dateonly => $dateonly } );
1896 } @$item_content_fields;
1897 return join( "\t", @item_info ) . "\n";