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::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 'credits' ) ? "SELECT * FROM accountlines WHERE accountlines_id = ?" :
742 ($table eq 'debits' ) ? "SELECT * FROM accountlines WHERE accountlines_id = ?" :
743 ($table eq 'items' ) ? "SELECT * FROM $table WHERE itemnumber = ?" :
744 ($table eq 'issues' ) ? "SELECT * FROM $table WHERE itemnumber = ?" :
745 ($table eq 'old_issues' ) ? "SELECT * FROM $table WHERE issue_id = ?" :
746 ($table eq 'reserves' ) ? "SELECT * FROM $table WHERE borrowernumber = ? and biblionumber = ?" :
747 ($table eq 'borrowers' ) ? "SELECT * FROM $table WHERE borrowernumber = ?" :
748 ($table eq 'branches' ) ? "SELECT * FROM $table WHERE branchcode = ?" :
749 ($table eq 'suggestions' ) ? "SELECT * FROM $table WHERE suggestionid = ?" :
750 ($table eq 'aqbooksellers') ? "SELECT * FROM $table WHERE id = ?" :
751 ($table eq 'aqorders' ) ? "SELECT * FROM $table WHERE ordernumber = ?" :
752 ($table eq 'aqbasket' ) ? "SELECT * FROM $table WHERE basketno = ?" :
753 ($table eq 'illrequests' ) ? "SELECT * FROM $table WHERE illrequest_id = ?" :
754 ($table eq 'article_requests') ? "SELECT * FROM $table WHERE id = ?" :
755 ($table eq 'borrower_modifications') ? "SELECT * FROM $table WHERE verification_token = ?" :
756 ($table eq 'subscription') ? "SELECT * FROM $table WHERE subscriptionid = ?" :
757 ($table eq 'serial') ? "SELECT * FROM $table WHERE serialid = ?" :
758 ($table eq 'problem_reports') ? "SELECT * FROM $table WHERE reportid = ?" :
759 ($table eq 'additional_contents' || $table eq 'opac_news') ? "SELECT * FROM additional_contents WHERE idnew = ?" :
760 ($table eq 'recalls') ? "SELECT * FROM $table WHERE recall_id = ?" :
763 warn "ERROR: No _parseletter_sth query for table '$table'";
764 return; # nothing to get
766 unless ($sth = C4::Context->dbh->prepare_cached($query)) {
767 warn "ERROR: Failed to prepare query: '$query'";
770 return $sth; # now cache is populated for that $table
773 =head2 _parseletter($letter, $table, $values)
776 - $letter : a hash to letter fields (title & content useful)
777 - $table : the Koha table to parse.
778 - $values_in : table record hashref
779 parse all fields from a table, and replace values in title & content with the appropriate value
780 (not exported sub, used only internally)
785 my ( $letter, $table, $values_in ) = @_;
787 # Work on a local copy of $values_in (passed by reference) to avoid side effects
788 # in callers ( by changing / formatting values )
789 my $values = $values_in ? { %$values_in } : {};
791 # FIXME Dates formatting must be done in notice's templates
792 if ( $table eq 'borrowers' && $values->{'dateexpiry'} ){
793 $values->{'dateexpiry'} = output_pref({ dt => dt_from_string( $values->{'dateexpiry'} ), dateonly => 1 });
796 if ( $table eq 'reserves' && $values->{'waitingdate'} ) {
797 $values->{'waitingdate'} = output_pref({ dt => dt_from_string( $values->{'waitingdate'} ), dateonly => 1 });
800 if ($letter->{content} && $letter->{content} =~ /<<today>>/) {
801 my $todaysdate = output_pref( dt_from_string() );
802 $letter->{content} =~ s/<<today>>/$todaysdate/go;
805 while ( my ($field, $val) = each %$values ) {
806 $val =~ s/\p{P}$// if $val && $table=~/biblio/;
807 #BZ 9886: Assuming that we want to eliminate ISBD punctuation here
808 #Therefore adding the test on biblio. This includes biblioitems,
809 #but excludes items. Removed unneeded global and lookahead.
811 if ( $table=~/^borrowers$/ && $field=~/^streettype$/ ) {
812 my $av = Koha::AuthorisedValues->search({ category => 'ROADTYPE', authorised_value => $val });
813 $val = $av->count ? $av->next->lib : '';
817 my $replacedby = defined ($val) ? $val : '';
819 and not $replacedby =~ m|9999-12-31|
820 and $replacedby =~ m|^\d{4}-\d{2}-\d{2}( \d{2}:\d{2}:\d{2})?$| )
822 # If the value is XXXX-YY-ZZ[ AA:BB:CC] we assume it is a date
823 my $dateonly = defined $1 ? 0 : 1; #$1 refers to the capture group wrapped in parentheses. In this case, that's the hours, minutes, seconds.
824 my $re_dateonly_filter = qr{ $field( \s* \| \s* dateonly\s*)?>> }xms;
826 for my $letter_field ( qw( title content ) ) {
827 my $filter_string_used = q{};
828 if ( $letter->{ $letter_field } =~ $re_dateonly_filter ) {
829 # We overwrite $dateonly if the filter exists and we have a time in the datetime
830 $filter_string_used = $1 || q{};
831 $dateonly = $1 unless $dateonly;
833 my $replacedby_date = eval {
834 output_pref({ dt => scalar dt_from_string( $replacedby ), dateonly => $dateonly });
836 $replacedby_date //= q{};
838 if ( $letter->{ $letter_field } ) {
839 $letter->{ $letter_field } =~ s/\Q<<$table.$field$filter_string_used>>\E/$replacedby_date/g;
840 $letter->{ $letter_field } =~ s/\Q<<$field$filter_string_used>>\E/$replacedby_date/g;
844 # Other fields replacement
846 for my $letter_field ( qw( title content ) ) {
847 if ( $letter->{ $letter_field } ) {
848 $letter->{ $letter_field } =~ s/<<$table.$field>>/$replacedby/g;
849 $letter->{ $letter_field } =~ s/<<$field>>/$replacedby/g;
855 if ($table eq 'borrowers' && $letter->{content}) {
856 my $patron = Koha::Patrons->find( $values->{borrowernumber} );
858 my $attributes = $patron->extended_attributes;
860 while ( my $attribute = $attributes->next ) {
861 my $code = $attribute->code;
862 my $val = $attribute->description; # FIXME - we always display intranet description here!
863 $val =~ s/\p{P}(?=$)//g if $val;
864 next unless $val gt '';
866 push @{ $attr{$code} }, $val;
868 while ( my ($code, $val_ar) = each %attr ) {
869 my $replacefield = "<<borrower-attribute:$code>>";
870 my $replacedby = join ',', @$val_ar;
871 $letter->{content} =~ s/$replacefield/$replacedby/g;
880 my $success = EnqueueLetter( { letter => $letter,
881 borrowernumber => '12', message_transport_type => 'email' } )
883 Places a letter in the message_queue database table, which will
884 eventually get processed (sent) by the process_message_queue.pl
885 cronjob when it calls SendQueuedMessages.
887 Return message_id on success
890 * letter - required; A letter hashref as returned from GetPreparedLetter
891 * message_transport_type - required; One of the available mtts
892 * borrowernumber - optional if 'to_address' is passed; The borrowernumber of the patron we enqueuing the notice for
893 * to_address - optional if 'borrowernumber' is passed; The destination email address for the notice (defaults to patron->notice_email_address)
894 * from_address - optional; The from address for the notice, defaults to patron->library->from_email_address
895 * reply_address - optional; The reply address for the notice, defaults to patron->library->reply_to
900 my $params = shift or return;
902 return unless exists $params->{'letter'};
903 # return unless exists $params->{'borrowernumber'};
904 return unless exists $params->{'message_transport_type'};
906 my $content = $params->{letter}->{content};
907 $content =~ s/\s+//g if(defined $content);
908 if ( not defined $content or $content eq '' ) {
909 Koha::Logger->get->info("Trying to add an empty message to the message queue");
913 # If we have any attachments we should encode then into the body.
914 if ( $params->{'attachments'} ) {
915 $params->{'letter'} = _add_attachments(
916 { letter => $params->{'letter'},
917 attachments => $params->{'attachments'},
922 my $dbh = C4::Context->dbh();
923 my $statement = << 'ENDSQL';
924 INSERT INTO message_queue
925 ( borrowernumber, subject, content, metadata, letter_code, message_transport_type, status, time_queued, to_address, from_address, reply_address, content_type, failure_code )
927 ( ?, ?, ?, ?, ?, ?, ?, CAST(NOW() AS DATETIME), ?, ?, ?, ?, ? )
930 my $sth = $dbh->prepare($statement);
931 my $result = $sth->execute(
932 $params->{'borrowernumber'}, # borrowernumber
933 $params->{'letter'}->{'title'}, # subject
934 $params->{'letter'}->{'content'}, # content
935 $params->{'letter'}->{'metadata'} || '', # metadata
936 $params->{'letter'}->{'code'} || '', # letter_code
937 $params->{'message_transport_type'}, # message_transport_type
939 $params->{'to_address'}, # to_address
940 $params->{'from_address'}, # from_address
941 $params->{'reply_address'}, # reply_address
942 $params->{'letter'}->{'content-type'}, # content_type
943 $params->{'failure_code'} || '', # failure_code
945 return $dbh->last_insert_id(undef,undef,'message_queue', undef);
948 =head2 SendQueuedMessages ([$hashref])
950 my $sent = SendQueuedMessages({
951 letter_code => $letter_code,
952 borrowernumber => $who_letter_is_for,
958 Sends all of the 'pending' items in the message queue, unless
959 parameters are passed.
961 The letter_code, borrowernumber and limit parameters are used
962 to build a parameter set for _get_unsent_messages, thus limiting
963 which pending messages will be processed. They are all optional.
965 The verbose parameter can be used to generate debugging output.
968 Returns number of messages sent.
972 sub SendQueuedMessages {
975 my $which_unsent_messages = {
976 'message_id' => $params->{'message_id'},
977 'limit' => $params->{'limit'} // 0,
978 'borrowernumber' => $params->{'borrowernumber'} // q{},
979 'letter_code' => $params->{'letter_code'} // q{},
980 'message_transport_type' => $params->{'type'} // q{},
982 my $unsent_messages = _get_unsent_messages( $which_unsent_messages );
983 MESSAGE: foreach my $message ( @$unsent_messages ) {
984 my $message_object = Koha::Notice::Messages->find( $message->{message_id} );
985 # If this fails the database is unwritable and we won't manage to send a message that continues to be marked 'pending'
986 $message_object->make_column_dirty('status');
987 return unless $message_object->store;
989 # warn Data::Dumper->Dump( [ $message ], [ 'message' ] );
990 warn sprintf( 'sending %s message to patron: %s',
991 $message->{'message_transport_type'},
992 $message->{'borrowernumber'} || 'Admin' )
993 if $params->{'verbose'};
994 # This is just begging for subclassing
995 next MESSAGE if ( lc($message->{'message_transport_type'}) eq 'rss' );
996 if ( lc( $message->{'message_transport_type'} ) eq 'email' ) {
997 _send_message_by_email( $message, $params->{'username'}, $params->{'password'}, $params->{'method'} );
999 elsif ( lc( $message->{'message_transport_type'} ) eq 'sms' ) {
1000 if ( C4::Context->preference('SMSSendDriver') eq 'Email' ) {
1001 my $patron = Koha::Patrons->find( $message->{borrowernumber} );
1002 my $sms_provider = Koha::SMS::Providers->find( $patron->sms_provider_id );
1003 unless ( $sms_provider ) {
1004 warn sprintf( "Patron %s has no sms provider id set!", $message->{'borrowernumber'} ) if $params->{'verbose'};
1005 _set_message_status( { message_id => $message->{'message_id'}, status => 'failed' } );
1008 unless ( $patron->smsalertnumber ) {
1009 _set_message_status( { message_id => $message->{'message_id'}, status => 'failed' } );
1010 warn sprintf( "No smsalertnumber found for patron %s!", $message->{'borrowernumber'} ) if $params->{'verbose'};
1013 $message->{to_address} = $patron->smsalertnumber; #Sometime this is set to email - sms should always use smsalertnumber
1014 $message->{to_address} .= '@' . $sms_provider->domain();
1016 # Check for possible from_address override
1017 my $from_address = C4::Context->preference('EmailSMSSendDriverFromAddress');
1018 if ($from_address && $message->{from_address} ne $from_address) {
1019 $message->{from_address} = $from_address;
1020 _update_message_from_address($message->{'message_id'}, $message->{from_address});
1023 _update_message_to_address($message->{'message_id'}, $message->{to_address});
1024 _send_message_by_email( $message, $params->{'username'}, $params->{'password'}, $params->{'method'} );
1026 _send_message_by_sms( $message );
1030 return scalar( @$unsent_messages );
1033 =head2 GetRSSMessages
1035 my $message_list = GetRSSMessages( { limit => 10, borrowernumber => '14' } )
1037 returns a listref of all queued RSS messages for a particular person.
1041 sub GetRSSMessages {
1044 return unless $params;
1045 return unless ref $params;
1046 return unless $params->{'borrowernumber'};
1048 return _get_unsent_messages( { message_transport_type => 'rss',
1049 limit => $params->{'limit'},
1050 borrowernumber => $params->{'borrowernumber'}, } );
1053 =head2 GetPrintMessages
1055 my $message_list = GetPrintMessages( { borrowernumber => $borrowernumber } )
1057 Returns a arrayref of all queued print messages (optionally, for a particular
1062 sub GetPrintMessages {
1063 my $params = shift || {};
1065 return _get_unsent_messages( { message_transport_type => 'print',
1066 borrowernumber => $params->{'borrowernumber'},
1070 =head2 GetQueuedMessages ([$hashref])
1072 my $messages = GetQueuedMessage( { borrowernumber => '123', limit => 20 } );
1074 Fetches a list of messages from the message queue optionally filtered by borrowernumber
1075 and limited to specified limit.
1077 Return is an arrayref of hashes, each has represents a message in the message queue.
1081 sub GetQueuedMessages {
1084 my $dbh = C4::Context->dbh();
1085 my $statement = << 'ENDSQL';
1086 SELECT message_id, borrowernumber, subject, content, message_transport_type, status, time_queued, updated_on, failure_code
1092 if ( exists $params->{'borrowernumber'} ) {
1093 push @whereclauses, ' borrowernumber = ? ';
1094 push @query_params, $params->{'borrowernumber'};
1097 if ( @whereclauses ) {
1098 $statement .= ' WHERE ' . join( 'AND', @whereclauses );
1101 if ( defined $params->{'limit'} ) {
1102 $statement .= ' LIMIT ? ';
1103 push @query_params, $params->{'limit'};
1106 my $sth = $dbh->prepare( $statement );
1107 my $result = $sth->execute( @query_params );
1108 return $sth->fetchall_arrayref({});
1111 =head2 GetMessageTransportTypes
1113 my @mtt = GetMessageTransportTypes();
1115 returns an arrayref of transport types
1119 sub GetMessageTransportTypes {
1120 my $dbh = C4::Context->dbh();
1121 my $mtts = $dbh->selectcol_arrayref("
1122 SELECT message_transport_type
1123 FROM message_transport_types
1124 ORDER BY message_transport_type
1131 my $message = C4::Letters::Message($message_id);
1136 my ( $message_id ) = @_;
1137 return unless $message_id;
1138 my $dbh = C4::Context->dbh;
1139 return $dbh->selectrow_hashref(q|
1140 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
1142 WHERE message_id = ?
1143 |, {}, $message_id );
1146 =head2 ResendMessage
1148 Attempt to resend a message which has failed previously.
1150 my $has_been_resent = C4::Letters::ResendMessage($message_id);
1152 Updates the message to 'pending' status so that
1153 it will be resent later on.
1155 returns 1 on success, 0 on failure, undef if no message was found
1160 my $message_id = shift;
1161 return unless $message_id;
1163 my $message = GetMessage( $message_id );
1164 return unless $message;
1166 if ( $message->{status} ne 'pending' ) {
1167 $rv = C4::Letters::_set_message_status({
1168 message_id => $message_id,
1169 status => 'pending',
1171 $rv = $rv > 0? 1: 0;
1172 # Clear destination email address to force address update
1173 _update_message_to_address( $message_id, undef ) if $rv &&
1174 $message->{message_transport_type} eq 'email';
1179 =head2 _add_attachements
1181 _add_attachments({ letter => $letter, attachments => $attachments });
1184 letter - the standard letter hashref
1185 attachments - listref of attachments. each attachment is a hashref of:
1186 type - the mime type, like 'text/plain'
1187 content - the actual attachment
1188 filename - the name of the attachment.
1190 returns your letter object, with the content updated.
1191 This routine picks the I<content> of I<letter> and generates a MIME
1192 email, attaching the passed I<attachments> using Koha::Email. The
1193 content is replaced by the string representation of the MIME object,
1194 and the content-type is updated for later handling.
1198 sub _add_attachments {
1201 my $letter = $params->{letter};
1202 my $attachments = $params->{attachments};
1203 return $letter unless @$attachments;
1205 my $message = Koha::Email->new;
1207 if ( $letter->{is_html} ) {
1208 $message->html_body( _wrap_html( $letter->{content}, $letter->{title} ) );
1211 $message->text_body( $letter->{content} );
1214 foreach my $attachment ( @$attachments ) {
1216 Encode::encode( "UTF-8", $attachment->{content} ),
1217 content_type => $attachment->{type} || 'application/octet-stream',
1218 name => $attachment->{filename},
1219 disposition => 'attachment',
1223 $letter->{'content-type'} = SERIALIZED_EMAIL_CONTENT_TYPE;
1224 $letter->{content} = $message->as_string;
1230 =head2 _get_unsent_messages
1232 This function's parameter hash reference takes the following
1233 optional named parameters:
1234 message_transport_type: method of message sending (e.g. email, sms, etc.)
1235 Can be a single string, or an arrayref of strings
1236 borrowernumber : who the message is to be sent
1237 letter_code : type of message being sent (e.g. PASSWORD_RESET)
1238 Can be a single string, or an arrayref of strings
1239 message_id : the message_id of the message. In that case the sub will return only 1 result
1240 limit : maximum number of messages to send
1242 This function returns an array of matching hash referenced rows from
1243 message_queue with some borrower information added.
1247 sub _get_unsent_messages {
1250 my $dbh = C4::Context->dbh();
1252 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
1253 FROM message_queue mq
1254 LEFT JOIN borrowers b ON b.borrowernumber = mq.borrowernumber
1258 my @query_params = ('pending');
1259 if ( ref $params ) {
1260 if ( $params->{'borrowernumber'} ) {
1261 $statement .= ' AND mq.borrowernumber = ? ';
1262 push @query_params, $params->{'borrowernumber'};
1264 if ( $params->{'letter_code'} ) {
1265 my @letter_codes = ref $params->{'letter_code'} eq "ARRAY" ? @{$params->{'letter_code'}} : $params->{'letter_code'};
1266 if ( @letter_codes ) {
1267 my $q = join( ",", ("?") x @letter_codes );
1268 $statement .= " AND mq.letter_code IN ( $q ) ";
1269 push @query_params, @letter_codes;
1272 if ( $params->{'message_transport_type'} ) {
1273 my @types = ref $params->{'message_transport_type'} eq "ARRAY" ? @{$params->{'message_transport_type'}} : $params->{'message_transport_type'};
1275 my $q = join( ",", ("?") x @types );
1276 $statement .= " AND message_transport_type IN ( $q ) ";
1277 push @query_params, @types;
1280 if ( $params->{message_id} ) {
1281 $statement .= ' AND message_id = ?';
1282 push @query_params, $params->{message_id};
1284 if ( $params->{'limit'} ) {
1285 $statement .= ' limit ? ';
1286 push @query_params, $params->{'limit'};
1290 my $sth = $dbh->prepare( $statement );
1291 my $result = $sth->execute( @query_params );
1292 return $sth->fetchall_arrayref({});
1295 sub _send_message_by_email {
1296 my $message = shift or return;
1297 my ($username, $password, $method) = @_;
1299 my $patron = Koha::Patrons->find( $message->{borrowernumber} );
1300 my $to_address = $message->{'to_address'};
1301 unless ($to_address) {
1303 warn "FAIL: No 'to_address' and INVALID borrowernumber ($message->{borrowernumber})";
1304 _set_message_status(
1306 message_id => $message->{'message_id'},
1308 failure_code => 'INVALID_BORNUMBER'
1313 $to_address = $patron->notice_email_address;
1314 unless ($to_address) {
1315 # warn "FAIL: No 'to_address' and no email for " . ($member->{surname} ||'') . ", borrowernumber ($message->{borrowernumber})";
1316 # warning too verbose for this more common case?
1317 _set_message_status(
1319 message_id => $message->{'message_id'},
1321 failure_code => 'NO_EMAIL'
1328 my $subject = $message->{'subject'};
1330 my $content = $message->{'content'};
1331 my $content_type = $message->{'content_type'} || 'text/plain; charset="UTF-8"';
1332 my $is_html = $content_type =~ m/html/io;
1334 my $branch_email = undef;
1335 my $branch_replyto = undef;
1336 my $branch_returnpath = undef;
1340 $library = $patron->library;
1341 $branch_email = $library->from_email_address;
1342 $branch_replyto = $library->branchreplyto;
1343 $branch_returnpath = $library->branchreturnpath;
1346 # NOTE: Patron may not be defined above so branch_email may be undefined still
1347 # so we need to fallback to KohaAdminEmailAddress as a last resort.
1349 $message->{'from_address'}
1351 || C4::Context->preference('KohaAdminEmailAddress');
1352 if( !$from_address ) {
1353 _set_message_status(
1355 message_id => $message->{'message_id'},
1357 failure_code => 'NO_FROM',
1369 C4::Context->preference('NoticeBcc')
1370 ? ( bcc => C4::Context->preference('NoticeBcc') )
1373 from => $from_address,
1374 reply_to => $message->{'reply_address'} || $branch_replyto,
1375 sender => $branch_returnpath,
1376 subject => "" . $message->{subject}
1379 if ( $message->{'content_type'} && $message->{'content_type'} eq SERIALIZED_EMAIL_CONTENT_TYPE ) {
1381 # The message has been previously composed as a valid MIME object
1382 # and serialized as a string on the DB
1383 $email = Koha::Email->new_from_string($content);
1384 $email->create($params);
1386 $email = Koha::Email->create($params);
1388 $email->html_body( _wrap_html( $content, $subject ) );
1390 $email->text_body($content);
1395 if ( ref($_) eq 'Koha::Exceptions::BadParameter' ) {
1396 _set_message_status(
1398 message_id => $message->{'message_id'},
1400 failure_code => "INVALID_EMAIL:".$_->parameter
1404 _set_message_status(
1406 message_id => $message->{'message_id'},
1408 failure_code => 'UNKNOWN_ERROR'
1414 return unless $email;
1418 $smtp_server = $library->smtp_server;
1421 $smtp_server = Koha::SMTP::Servers->get_default;
1427 sasl_username => $username,
1428 sasl_password => $password,
1433 # if initial message address was empty, coming here means that a to address was found and
1434 # queue should be updated; same if to address was overriden by Koha::Email->create
1435 _update_message_to_address( $message->{'message_id'}, $email->email->header('To') )
1436 if !$message->{to_address}
1437 || $message->{to_address} ne $email->email->header('To');
1440 $email->send_or_die({ transport => $smtp_server->transport });
1442 _set_message_status(
1444 message_id => $message->{'message_id'},
1452 _set_message_status(
1454 message_id => $message->{'message_id'},
1456 failure_code => 'SENDMAIL'
1460 carp "$Mail::Sendmail::error";
1466 my ($content, $title) = @_;
1468 my $css = C4::Context->preference("NoticeCSS") || '';
1469 $css = qq{<link rel="stylesheet" type="text/css" href="$css">} if $css;
1471 <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
1472 "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
1473 <html lang="en" xml:lang="en" xmlns="http://www.w3.org/1999/xhtml">
1475 <title>$title</title>
1476 <meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
1487 my ( $message ) = @_;
1488 my $dbh = C4::Context->dbh;
1489 my $count = $dbh->selectrow_array(q|
1492 WHERE message_transport_type = ?
1493 AND borrowernumber = ?
1495 AND CAST(updated_on AS date) = CAST(NOW() AS date)
1498 |, {}, $message->{message_transport_type}, $message->{borrowernumber}, $message->{letter_code}, $message->{content} );
1502 sub _send_message_by_sms {
1503 my $message = shift or return;
1504 my $patron = Koha::Patrons->find( $message->{borrowernumber} );
1505 _update_message_to_address($message->{message_id}, $patron->smsalertnumber) if $patron;
1507 unless ( $patron and $patron->smsalertnumber ) {
1508 _set_message_status( { message_id => $message->{'message_id'},
1510 failure_code => 'MISSING_SMS' } );
1514 if ( _is_duplicate( $message ) ) {
1515 _set_message_status(
1517 message_id => $message->{'message_id'},
1519 failure_code => 'DUPLICATE_MESSAGE'
1525 my $success = C4::SMS->send_sms(
1527 destination => $patron->smsalertnumber,
1528 message => $message->{'content'},
1533 _set_message_status(
1535 message_id => $message->{'message_id'},
1542 _set_message_status(
1544 message_id => $message->{'message_id'},
1546 failure_code => 'NO_NOTES'
1554 sub _update_message_to_address {
1556 my $dbh = C4::Context->dbh();
1557 $dbh->do('UPDATE message_queue SET to_address=? WHERE message_id=?',undef,($to,$id));
1560 sub _update_message_from_address {
1561 my ($message_id, $from_address) = @_;
1562 my $dbh = C4::Context->dbh();
1563 $dbh->do('UPDATE message_queue SET from_address = ? WHERE message_id = ?', undef, ($from_address, $message_id));
1566 sub _set_message_status {
1567 my $params = shift or return;
1569 foreach my $required_parameter ( qw( message_id status ) ) {
1570 return unless exists $params->{ $required_parameter };
1573 my $dbh = C4::Context->dbh();
1574 my $statement = 'UPDATE message_queue SET status= ?, failure_code= ? WHERE message_id = ?';
1575 my $sth = $dbh->prepare( $statement );
1576 my $result = $sth->execute( $params->{'status'},
1577 $params->{'failure_code'} || '',
1578 $params->{'message_id'} );
1583 my ( $params ) = @_;
1585 my $content = $params->{content};
1586 my $tables = $params->{tables};
1587 my $loops = $params->{loops};
1588 my $objects = $params->{objects} || {};
1589 my $substitute = $params->{substitute} || {};
1590 my $lang = defined($params->{lang}) && $params->{lang} ne 'default' ? $params->{lang} : 'en';
1591 my ($theme, $availablethemes);
1593 my $htdocs = C4::Context->config('intrahtdocs');
1594 ($theme, $lang, $availablethemes)= C4::Templates::availablethemes( $htdocs, 'about.tt', 'intranet', $lang);
1596 foreach (@$availablethemes) {
1597 push @includes, "$htdocs/$_/$lang/includes";
1598 push @includes, "$htdocs/$_/en/includes" unless $lang eq 'en';
1601 my $use_template_cache = C4::Context->config('template_cache_dir') && defined $ENV{GATEWAY_INTERFACE};
1602 my $template = Template->new(
1606 PLUGIN_BASE => 'Koha::Template::Plugin',
1607 COMPILE_EXT => $use_template_cache ? '.ttc' : '',
1608 COMPILE_DIR => $use_template_cache ? C4::Context->config('template_cache_dir') : '',
1609 INCLUDE_PATH => \@includes,
1611 ENCODING => 'UTF-8',
1613 ) or die Template->error();
1615 my $tt_params = { %{ _get_tt_params( $tables ) }, %{ _get_tt_params( $loops, 'is_a_loop' ) }, %$substitute, %$objects };
1617 $content = add_tt_filters( $content );
1618 $content = qq|[% USE KohaDates %][% USE Remove_MARC_punctuation %]$content|;
1621 my $schema = Koha::Database->new->schema;
1623 $template->process( \$content, $tt_params, \$output ) || croak "ERROR PROCESSING TEMPLATE: " . $template->error();
1624 $schema->txn_rollback;
1629 sub _get_tt_params {
1630 my ($tables, $is_a_loop) = @_;
1636 article_requests => {
1637 module => 'Koha::ArticleRequests',
1638 singular => 'article_request',
1639 plural => 'article_requests',
1643 module => 'Koha::Acquisition::Baskets',
1644 singular => 'basket',
1645 plural => 'baskets',
1649 module => 'Koha::Biblios',
1650 singular => 'biblio',
1651 plural => 'biblios',
1652 pk => 'biblionumber',
1655 module => 'Koha::Biblioitems',
1656 singular => 'biblioitem',
1657 plural => 'biblioitems',
1658 pk => 'biblioitemnumber',
1661 module => 'Koha::Patrons',
1662 singular => 'borrower',
1663 plural => 'borrowers',
1664 pk => 'borrowernumber',
1667 module => 'Koha::Libraries',
1668 singular => 'branch',
1669 plural => 'branches',
1673 module => 'Koha::Account::Lines',
1674 singular => 'credit',
1675 plural => 'credits',
1676 pk => 'accountlines_id',
1679 module => 'Koha::Account::Lines',
1680 singular => 'debit',
1682 pk => 'accountlines_id',
1685 module => 'Koha::Items',
1690 additional_contents => {
1691 module => 'Koha::AdditionalContents',
1692 singular => 'additional_content',
1693 plural => 'additional_contents',
1697 module => 'Koha::AdditionalContents',
1703 module => 'Koha::Acquisition::Orders',
1704 singular => 'order',
1706 pk => 'ordernumber',
1709 module => 'Koha::Holds',
1715 module => 'Koha::Serials',
1716 singular => 'serial',
1717 plural => 'serials',
1721 module => 'Koha::Subscriptions',
1722 singular => 'subscription',
1723 plural => 'subscriptions',
1724 pk => 'subscriptionid',
1727 module => 'Koha::Suggestions',
1728 singular => 'suggestion',
1729 plural => 'suggestions',
1730 pk => 'suggestionid',
1733 module => 'Koha::Checkouts',
1734 singular => 'checkout',
1735 plural => 'checkouts',
1739 module => 'Koha::Old::Checkouts',
1740 singular => 'old_checkout',
1741 plural => 'old_checkouts',
1745 module => 'Koha::Checkouts',
1746 singular => 'overdue',
1747 plural => 'overdues',
1750 borrower_modifications => {
1751 module => 'Koha::Patron::Modifications',
1752 singular => 'patron_modification',
1753 plural => 'patron_modifications',
1754 fk => 'verification_token',
1757 module => 'Koha::Illrequests',
1758 singular => 'illrequest',
1759 plural => 'illrequests',
1760 pk => 'illrequest_id'
1764 foreach my $table ( keys %$tables ) {
1765 next unless $config->{$table};
1767 my $ref = ref( $tables->{$table} ) || q{};
1768 my $module = $config->{$table}->{module};
1770 if ( can_load( modules => { $module => undef } ) ) {
1771 my $pk = $config->{$table}->{pk};
1772 my $fk = $config->{$table}->{fk};
1775 my $values = $tables->{$table} || [];
1776 unless ( ref( $values ) eq 'ARRAY' ) {
1777 croak "ERROR processing table $table. Wrong API call.";
1779 my $key = $pk ? $pk : $fk;
1780 # $key does not come from user input
1781 my $objects = $module->search(
1782 { $key => $values },
1784 # We want to retrieve the data in the same order
1786 # field is a MySQLism, but they are no other way to do it
1787 # To be generic we could do it in perl, but we will need to fetch
1788 # all the data then order them
1789 @$values ? ( order_by => \[ "field($key, " . join( ', ', @$values ) . ")" ] ) : ()
1792 $params->{ $config->{$table}->{plural} } = $objects;
1794 elsif ( $ref eq q{} || $ref eq 'HASH' ) {
1795 my $id = ref $ref eq 'HASH' ? $tables->{$table}->{$pk} : $tables->{$table};
1797 if ( $fk ) { # Using a foreign key for lookup
1798 if ( ref( $fk ) eq 'ARRAY' ) { # Foreign key is multi-column
1800 foreach my $key ( @$fk ) {
1801 $search->{$key} = $id->{$key};
1803 $object = $module->search( $search )->last();
1804 } else { # Foreign key is single column
1805 $object = $module->search( { $fk => $id } )->last();
1807 } else { # using the table's primary key for lookup
1808 $object = $module->find($id);
1810 $params->{ $config->{$table}->{singular} } = $object;
1812 else { # $ref eq 'ARRAY'
1814 if ( @{ $tables->{$table} } == 1 ) { # Param is a single key
1815 $object = $module->search( { $pk => $tables->{$table} } )->last();
1817 else { # Params are mutliple foreign keys
1818 croak "Multiple foreign keys (table $table) should be passed using an hashref";
1820 $params->{ $config->{$table}->{singular} } = $object;
1824 croak "ERROR LOADING MODULE $module: $Module::Load::Conditional::ERROR";
1828 $params->{today} = output_pref({ dt => dt_from_string, dateformat => 'iso' });
1833 =head3 add_tt_filters
1835 $content = add_tt_filters( $content );
1837 Add TT filters to some specific fields if needed.
1839 For now we only add the Remove_MARC_punctuation TT filter to biblio and biblioitem fields
1843 sub add_tt_filters {
1844 my ( $content ) = @_;
1845 $content =~ s|\[%\s*biblio\.(.*?)\s*%\]|[% biblio.$1 \| \$Remove_MARC_punctuation %]|gxms;
1846 $content =~ s|\[%\s*biblioitem\.(.*?)\s*%\]|[% biblioitem.$1 \| \$Remove_MARC_punctuation %]|gxms;
1850 =head2 get_item_content
1852 my $item = Koha::Items->find(...)->unblessed;
1853 my @item_content_fields = qw( date_due title barcode author itemnumber );
1854 my $item_content = C4::Letters::get_item_content({
1856 item_content_fields => \@item_content_fields
1859 This function generates a tab-separated list of values for the passed item. Dates
1860 are formatted following the current setup.
1864 sub get_item_content {
1865 my ( $params ) = @_;
1866 my $item = $params->{item};
1867 my $dateonly = $params->{dateonly} || 0;
1868 my $item_content_fields = $params->{item_content_fields} || [];
1870 return unless $item;
1872 my @item_info = map {
1876 { dt => dt_from_string( $item->{$_} ), dateonly => $dateonly } );
1880 } @$item_content_fields;
1881 return join( "\t", @item_info ) . "\n";