3 # Copyright 2000-2002 Katipo Communications
5 # This file is part of Koha.
7 # Koha is free software; you can redistribute it and/or modify it
8 # under the terms of the GNU General Public License as published by
9 # the Free Software Foundation; either version 3 of the License, or
10 # (at your option) any later version.
12 # Koha is distributed in the hope that it will be useful, but
13 # WITHOUT ANY WARRANTY; without even the implied warranty of
14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 # GNU General Public License for more details.
17 # You should have received a copy of the GNU General Public License
18 # along with Koha; if not, see <http://www.gnu.org/licenses>.
23 use Date::Calc qw( Add_Delta_Days );
27 use Module::Load::Conditional qw(can_load);
36 use Koha::SMS::Providers;
39 use Koha::Notice::Messages;
40 use Koha::Notice::Templates;
41 use Koha::DateUtils qw( format_sqldatetime dt_from_string );
43 use Koha::SMTP::Servers;
44 use Koha::Subscriptions;
46 use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
52 &EnqueueLetter &GetLetters &GetLettersAvailableForALibrary &GetLetterTemplates &DelLetter &GetPreparedLetter &GetWrappedLetter &SendAlerts &GetPrintMessages &GetMessageTransportTypes
58 C4::Letters - Give functions for Letters management
66 "Letters" is the tool used in Koha to manage informations sent to the patrons and/or the library. This include some cron jobs like
67 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)
69 Letters are managed through "alerts" sent by Koha on some events. All "alert" related functions are in this module too.
71 =head2 GetLetters([$module])
73 $letters = &GetLetters($module);
74 returns informations about letters.
75 if needed, $module filters for letters given module
77 DEPRECATED - You must use Koha::Notice::Templates instead
78 The group by clause is confusing and can lead to issues
84 my $module = $filters->{module};
85 my $code = $filters->{code};
86 my $branchcode = $filters->{branchcode};
87 my $dbh = C4::Context->dbh;
88 my $letters = $dbh->selectall_arrayref(
90 SELECT code, module, name
94 . ( $module ? q| AND module = ?| : q|| )
95 . ( $code ? q| AND code = ?| : q|| )
96 . ( defined $branchcode ? q| AND branchcode = ?| : q|| )
97 . q| GROUP BY code, module, name ORDER BY name|, { Slice => {} }
98 , ( $module ? $module : () )
99 , ( $code ? $code : () )
100 , ( defined $branchcode ? $branchcode : () )
106 =head2 GetLetterTemplates
108 my $letter_templates = GetLetterTemplates(
110 module => 'circulation',
112 branchcode => 'CPL', # '' for default,
116 Return a hashref of letter templates.
120 sub GetLetterTemplates {
123 my $module = $params->{module};
124 my $code = $params->{code};
125 my $branchcode = $params->{branchcode} // '';
126 my $dbh = C4::Context->dbh;
127 return Koha::Notice::Templates->search(
131 branchcode => $branchcode,
133 C4::Context->preference('TranslateNotices')
135 : ( lang => 'default' )
141 =head2 GetLettersAvailableForALibrary
143 my $letters = GetLettersAvailableForALibrary(
145 branchcode => 'CPL', # '' for default
146 module => 'circulation',
150 Return an arrayref of letters, sorted by name.
151 If a specific letter exist for the given branchcode, it will be retrieve.
152 Otherwise the default letter will be.
156 sub GetLettersAvailableForALibrary {
158 my $branchcode = $filters->{branchcode};
159 my $module = $filters->{module};
161 croak "module should be provided" unless $module;
163 my $dbh = C4::Context->dbh;
164 my $default_letters = $dbh->selectall_arrayref(
166 SELECT module, code, branchcode, name
170 . q| AND branchcode = ''|
171 . ( $module ? q| AND module = ?| : q|| )
172 . q| ORDER BY name|, { Slice => {} }
173 , ( $module ? $module : () )
176 my $specific_letters;
178 $specific_letters = $dbh->selectall_arrayref(
180 SELECT module, code, branchcode, name
184 . q| AND branchcode = ?|
185 . ( $module ? q| AND module = ?| : q|| )
186 . q| ORDER BY name|, { Slice => {} }
188 , ( $module ? $module : () )
193 for my $l (@$default_letters) {
194 $letters{ $l->{code} } = $l;
196 for my $l (@$specific_letters) {
197 # Overwrite the default letter with the specific one.
198 $letters{ $l->{code} } = $l;
201 return [ map { $letters{$_} }
202 sort { $letters{$a}->{name} cmp $letters{$b}->{name} }
212 module => 'circulation',
218 Delete the letter. The mtt parameter is facultative.
219 If not given, all templates mathing the other parameters will be removed.
225 my $branchcode = $params->{branchcode};
226 my $module = $params->{module};
227 my $code = $params->{code};
228 my $mtt = $params->{mtt};
229 my $lang = $params->{lang};
230 my $dbh = C4::Context->dbh;
237 . ( $mtt ? q| AND message_transport_type = ?| : q|| )
238 . ( $lang? q| AND lang = ?| : q|| )
239 , undef, $branchcode, $module, $code, ( $mtt ? $mtt : () ), ( $lang ? $lang : () ) );
244 my $err = &SendAlerts($type, $externalid, $letter_code);
247 - $type : the type of alert
248 - $externalid : the id of the "object" to query
249 - $letter_code : the notice template to use
251 C<&SendAlerts> sends an email notice directly to a patron or a vendor.
253 Currently it supports ($type):
254 - claim serial issues (claimissues)
255 - claim acquisition orders (claimacquisition)
256 - send acquisition orders to the vendor (orderacquisition)
257 - notify patrons about newly received serial issues (issue)
258 - notify patrons when their account is created (members)
260 Returns undef or { error => 'message } on failure.
261 Returns true on success.
266 my ( $type, $externalid, $letter_code ) = @_;
267 my $dbh = C4::Context->dbh;
270 if ( $type eq 'issue' ) {
272 # prepare the letter...
273 # search the subscriptionid
276 "SELECT subscriptionid FROM serial WHERE serialid=?");
277 $sth->execute($externalid);
278 my ($subscriptionid) = $sth->fetchrow
279 or warn( "No subscription for '$externalid'" ),
282 # search the biblionumber
285 "SELECT biblionumber FROM subscription WHERE subscriptionid=?");
286 $sth->execute($subscriptionid);
287 my ($biblionumber) = $sth->fetchrow
288 or warn( "No biblionumber for '$subscriptionid'" ),
291 # find the list of subscribers to notify
292 my $subscription = Koha::Subscriptions->find( $subscriptionid );
293 my $subscribers = $subscription->subscribers;
294 while ( my $patron = $subscribers->next ) {
295 my $email = $patron->email or next;
297 # warn "sending issues...";
298 my $userenv = C4::Context->userenv;
299 my $library = $patron->library;
300 my $letter = GetPreparedLetter (
302 letter_code => $letter_code,
303 branchcode => $userenv->{branch},
305 'branches' => $library->branchcode,
306 'biblio' => $biblionumber,
307 'biblioitems' => $biblionumber,
308 'borrowers' => $patron->unblessed,
309 'subscription' => $subscriptionid,
310 'serial' => $externalid,
315 # FIXME: This 'default' behaviour should be moved to Koha::Email
316 my $mail = Koha::Email->create(
319 from => $library->branchemail,
320 reply_to => $library->branchreplyto,
321 sender => $library->branchreturnpath,
322 subject => "" . $letter->{title},
326 if ( $letter->{is_html} ) {
327 $mail->html_body( _wrap_html( $letter->{content}, "" . $letter->{title} ) );
330 $mail->text_body( $letter->{content} );
334 $mail->send_or_die({ transport => $library->smtp_server->transport });
337 # We expect ref($_) eq 'Email::Sender::Failure'
338 $error = $_->message;
344 return { error => $error }
348 elsif ( $type eq 'claimacquisition' or $type eq 'claimissues' or $type eq 'orderacquisition' ) {
350 # prepare the letter...
356 if ( $type eq 'claimacquisition') {
358 SELECT aqorders.*,aqbasket.*,biblio.*,biblioitems.*
360 LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno
361 LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
362 LEFT JOIN biblioitems ON aqorders.biblionumber=biblioitems.biblionumber
363 WHERE aqorders.ordernumber IN (
367 carp "No order selected";
368 return { error => "no_order_selected" };
370 $strsth .= join( ",", ('?') x @$externalid ) . ")";
371 $action = "ACQUISITION CLAIM";
372 $sthorders = $dbh->prepare($strsth);
373 $sthorders->execute( @$externalid );
374 $dataorders = $sthorders->fetchall_arrayref( {} );
377 if ($type eq 'claimissues') {
379 SELECT serial.*,subscription.*, biblio.*, biblioitems.*, aqbooksellers.*,
380 aqbooksellers.id AS booksellerid
382 LEFT JOIN subscription ON serial.subscriptionid=subscription.subscriptionid
383 LEFT JOIN biblio ON serial.biblionumber=biblio.biblionumber
384 LEFT JOIN biblioitems ON serial.biblionumber = biblioitems.biblionumber
385 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id
386 WHERE serial.serialid IN (
390 carp "No issues selected";
391 return { error => "no_issues_selected" };
394 $strsth .= join( ",", ('?') x @$externalid ) . ")";
395 $action = "SERIAL CLAIM";
396 $sthorders = $dbh->prepare($strsth);
397 $sthorders->execute( @$externalid );
398 $dataorders = $sthorders->fetchall_arrayref( {} );
401 if ( $type eq 'orderacquisition') {
402 my $basketno = $externalid;
404 SELECT aqorders.*,aqbasket.*,biblio.*,biblioitems.*
406 LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno
407 LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
408 LEFT JOIN biblioitems ON aqorders.biblionumber=biblioitems.biblionumber
409 WHERE aqbasket.basketno = ?
410 AND orderstatus IN ('new','ordered')
413 unless ( $basketno ) {
414 carp "No basketnumber given";
415 return { error => "no_basketno" };
417 $action = "ACQUISITION ORDER";
418 $sthorders = $dbh->prepare($strsth);
419 $sthorders->execute($basketno);
420 $dataorders = $sthorders->fetchall_arrayref( {} );
424 $dbh->prepare("select * from aqbooksellers where id=?");
425 $sthbookseller->execute( $dataorders->[0]->{booksellerid} );
426 my $databookseller = $sthbookseller->fetchrow_hashref;
428 my $addressee = $type eq 'claimacquisition' || $type eq 'orderacquisition' ? 'acqprimary' : 'serialsprimary';
431 $dbh->prepare("SELECT * FROM aqcontacts WHERE booksellerid=? AND $type=1 ORDER BY $addressee DESC");
432 $sthcontact->execute( $dataorders->[0]->{booksellerid} );
433 my $datacontact = $sthcontact->fetchrow_hashref;
437 push @email, $datacontact->{email} if ( $datacontact && $datacontact->{email} );
439 warn "Bookseller $dataorders->[0]->{booksellerid} without emails";
440 return { error => "no_email" };
443 while ($addlcontact = $sthcontact->fetchrow_hashref) {
444 push @cc, $addlcontact->{email} if ( $addlcontact && $addlcontact->{email} );
447 my $userenv = C4::Context->userenv;
448 my $letter = GetPreparedLetter (
450 letter_code => $letter_code,
451 branchcode => $userenv->{branch},
453 'branches' => $userenv->{branch},
454 'aqbooksellers' => $databookseller,
455 'aqcontacts' => $datacontact,
456 'aqbasket' => $basketno,
458 repeat => $dataorders,
460 ) or return { error => "no_letter" };
462 # Remove the order tag
463 $letter->{content} =~ s/<order>(.*?)<\/order>/$1/gxms;
466 my $library = Koha::Libraries->find( $userenv->{branch} );
467 my $mail = Koha::Email->create(
469 to => join( ',', @email ),
470 cc => join( ',', @cc ),
473 C4::Context->preference("ClaimsBccCopy")
474 && ( $type eq 'claimacquisition'
475 || $type eq 'claimissues' )
477 ? ( bcc => $userenv->{emailaddress} )
480 from => $library->branchemail
481 || C4::Context->preference('KohaAdminEmailAddress'),
482 subject => "" . $letter->{title},
486 if ( $letter->{is_html} ) {
487 $mail->html_body( _wrap_html( $letter->{content}, "" . $letter->{title} ) );
490 $mail->text_body( "" . $letter->{content} );
494 $mail->send_or_die({ transport => $library->smtp_server->transport });
497 # We expect ref($_) eq 'Email::Sender::Failure'
498 $error = $_->message;
504 return { error => $error }
507 my $module = $action eq 'ACQUISITION ORDER' ? 'ACQUISITIONS' : 'CLAIMS';
513 . join( ',', @email )
518 ) if C4::Context->preference("ClaimsLog");
520 # send an "account details" notice to a newly created user
521 elsif ( $type eq 'members' ) {
522 my $library = Koha::Libraries->find( $externalid->{branchcode} );
523 my $letter = GetPreparedLetter (
525 letter_code => $letter_code,
526 branchcode => $externalid->{'branchcode'},
527 lang => $externalid->{lang} || 'default',
529 'branches' => $library->unblessed,
530 'borrowers' => $externalid->{'borrowernumber'},
532 substitute => { 'borrowers.password' => $externalid->{'password'} },
535 return { error => "no_email" } unless $externalid->{'emailaddr'};
539 # FIXME: This 'default' behaviour should be moved to Koha::Email
540 my $mail = Koha::Email->create(
542 to => $externalid->{'emailaddr'},
543 from => $library->branchemail,
544 reply_to => $library->branchreplyto,
545 sender => $library->branchreturnpath,
546 subject => "" . $letter->{'title'},
550 if ( $letter->{is_html} ) {
551 $mail->html_body( _wrap_html( $letter->{content}, "" . $letter->{title} ) );
554 $mail->text_body( $letter->{content} );
557 $mail->send_or_die({ transport => $library->smtp_server->transport });
560 # We expect ref($_) eq 'Email::Sender::Failure'
561 $error = $_->message;
567 return { error => $error }
571 # If we come here, return an OK status
575 =head2 GetPreparedLetter( %params )
578 module => letter module, mandatory
579 letter_code => letter code, mandatory
580 branchcode => for letter selection, if missing default system letter taken
581 tables => a hashref with table names as keys. Values are either:
582 - a scalar - primary key value
583 - an arrayref - primary key values
584 - a hashref - full record
585 substitute => custom substitution key/value pairs
586 repeat => records to be substituted on consecutive lines:
587 - an arrayref - tries to guess what needs substituting by
588 taking remaining << >> tokensr; not recommended
589 - a hashref token => @tables - replaces <token> << >> << >> </token>
590 subtemplate for each @tables row; table is a hashref as above
591 want_librarian => boolean, if set to true triggers librarian details
592 substitution from the userenv
594 letter fields hashref (title & content useful)
598 sub GetPreparedLetter {
601 my $letter = $params{letter};
602 my $lang = $params{lang} || 'default';
605 my $module = $params{module} or croak "No module";
606 my $letter_code = $params{letter_code} or croak "No letter_code";
607 my $branchcode = $params{branchcode} || '';
608 my $mtt = $params{message_transport_type} || 'email';
610 my $template = Koha::Notice::Templates->find_effective_template(
613 code => $letter_code,
614 branchcode => $branchcode,
615 message_transport_type => $mtt,
620 unless ( $template ) {
621 warn( "No $module $letter_code letter transported by " . $mtt );
625 $letter = $template->unblessed;
626 $letter->{'content-type'} = 'text/html; charset="UTF-8"' if $letter->{is_html};
629 my $tables = $params{tables} || {};
630 my $substitute = $params{substitute} || {};
631 my $loops = $params{loops} || {}; # loops is not supported for historical notices syntax
632 my $repeat = $params{repeat};
633 %$tables || %$substitute || $repeat || %$loops
634 or carp( "ERROR: nothing to substitute - both 'tables', 'loops' and 'substitute' are empty" ),
636 my $want_librarian = $params{want_librarian};
639 while ( my ($token, $val) = each %$substitute ) {
640 if ( $token eq 'items.content' ) {
641 $val =~ s|\n|<br/>|g if $letter->{is_html};
644 $letter->{title} =~ s/<<$token>>/$val/g;
645 $letter->{content} =~ s/<<$token>>/$val/g;
649 my $OPACBaseURL = C4::Context->preference('OPACBaseURL');
650 $letter->{content} =~ s/<<OPACBaseURL>>/$OPACBaseURL/go;
652 if ($want_librarian) {
653 # parsing librarian name
654 my $userenv = C4::Context->userenv;
655 $letter->{content} =~ s/<<LibrarianFirstname>>/$userenv->{firstname}/go;
656 $letter->{content} =~ s/<<LibrarianSurname>>/$userenv->{surname}/go;
657 $letter->{content} =~ s/<<LibrarianEmailaddress>>/$userenv->{emailaddress}/go;
660 my ($repeat_no_enclosing_tags, $repeat_enclosing_tags);
663 if (ref ($repeat) eq 'ARRAY' ) {
664 $repeat_no_enclosing_tags = $repeat;
666 $repeat_enclosing_tags = $repeat;
670 if ($repeat_enclosing_tags) {
671 while ( my ($tag, $tag_tables) = each %$repeat_enclosing_tags ) {
672 if ( $letter->{content} =~ m!<$tag>(.*)</$tag>!s ) {
675 my %subletter = ( title => '', content => $subcontent );
676 _substitute_tables( \%subletter, $_ );
679 $letter->{content} =~ s!<$tag>.*</$tag>!join( "\n", @lines )!se;
685 _substitute_tables( $letter, $tables );
688 if ($repeat_no_enclosing_tags) {
689 if ( $letter->{content} =~ m/[^\n]*<<.*>>[^\n]*/so ) {
694 $c =~ s/<<count>>/$i/go;
695 foreach my $field ( keys %{$_} ) {
696 $c =~ s/(<<[^\.]+.$field>>)/$_->{$field}/;
700 } @$repeat_no_enclosing_tags;
702 my $replaceby = join( "\n", @lines );
703 $letter->{content} =~ s/\Q$line\E/$replaceby/s;
707 $letter->{content} = _process_tt(
709 content => $letter->{content},
712 substitute => $substitute,
717 $letter->{title} = _process_tt(
719 content => $letter->{title},
722 substitute => $substitute,
726 $letter->{content} =~ s/<<\S*>>//go; #remove any stragglers
731 sub _substitute_tables {
732 my ( $letter, $tables ) = @_;
733 while ( my ($table, $param) = each %$tables ) {
736 my $ref = ref $param;
739 if ($ref && $ref eq 'HASH') {
743 my $sth = _parseletter_sth($table);
745 warn "_parseletter_sth('$table') failed to return a valid sth. No substitution will be done for that table.";
748 $sth->execute( $ref ? @$param : $param );
750 $values = $sth->fetchrow_hashref;
754 _parseletter ( $letter, $table, $values );
758 sub _parseletter_sth {
762 carp "ERROR: _parseletter_sth() called without argument (table)";
765 # NOTE: we used to check whether we had a statement handle cached in
766 # a %handles module-level variable. This was a dumb move and
767 # broke things for the rest of us. prepare_cached is a better
768 # way to cache statement handles anyway.
770 ($table eq 'accountlines' ) ? "SELECT * FROM $table WHERE accountlines_id = ?" :
771 ($table eq 'biblio' ) ? "SELECT * FROM $table WHERE biblionumber = ?" :
772 ($table eq 'biblioitems' ) ? "SELECT * FROM $table WHERE biblionumber = ?" :
773 ($table eq 'credits' ) ? "SELECT * FROM accountlines WHERE accountlines_id = ?" :
774 ($table eq 'debits' ) ? "SELECT * FROM accountlines WHERE accountlines_id = ?" :
775 ($table eq 'items' ) ? "SELECT * FROM $table WHERE itemnumber = ?" :
776 ($table eq 'issues' ) ? "SELECT * FROM $table WHERE itemnumber = ?" :
777 ($table eq 'old_issues' ) ? "SELECT * FROM $table WHERE itemnumber = ? ORDER BY timestamp DESC LIMIT 1" :
778 ($table eq 'reserves' ) ? "SELECT * FROM $table WHERE borrowernumber = ? and biblionumber = ?" :
779 ($table eq 'borrowers' ) ? "SELECT * FROM $table WHERE borrowernumber = ?" :
780 ($table eq 'branches' ) ? "SELECT * FROM $table WHERE branchcode = ?" :
781 ($table eq 'suggestions' ) ? "SELECT * FROM $table WHERE suggestionid = ?" :
782 ($table eq 'aqbooksellers') ? "SELECT * FROM $table WHERE id = ?" :
783 ($table eq 'aqorders' ) ? "SELECT * FROM $table WHERE ordernumber = ?" :
784 ($table eq 'aqbasket' ) ? "SELECT * FROM $table WHERE basketno = ?" :
785 ($table eq 'illrequests' ) ? "SELECT * FROM $table WHERE illrequest_id = ?" :
786 ($table eq 'opac_news' ) ? "SELECT * FROM $table WHERE idnew = ?" :
787 ($table eq 'article_requests') ? "SELECT * FROM $table WHERE id = ?" :
788 ($table eq 'borrower_modifications') ? "SELECT * FROM $table WHERE verification_token = ?" :
789 ($table eq 'subscription') ? "SELECT * FROM $table WHERE subscriptionid = ?" :
790 ($table eq 'serial') ? "SELECT * FROM $table WHERE serialid = ?" :
791 ($table eq 'problem_reports') ? "SELECT * FROM $table WHERE reportid = ?" :
794 warn "ERROR: No _parseletter_sth query for table '$table'";
795 return; # nothing to get
797 unless ($sth = C4::Context->dbh->prepare_cached($query)) {
798 warn "ERROR: Failed to prepare query: '$query'";
801 return $sth; # now cache is populated for that $table
804 =head2 _parseletter($letter, $table, $values)
807 - $letter : a hash to letter fields (title & content useful)
808 - $table : the Koha table to parse.
809 - $values_in : table record hashref
810 parse all fields from a table, and replace values in title & content with the appropriate value
811 (not exported sub, used only internally)
816 my ( $letter, $table, $values_in ) = @_;
818 # Work on a local copy of $values_in (passed by reference) to avoid side effects
819 # in callers ( by changing / formatting values )
820 my $values = $values_in ? { %$values_in } : {};
822 if ( $table eq 'borrowers' && $values->{'dateexpiry'} ){
823 $values->{'dateexpiry'} = output_pref({ dt => dt_from_string( $values->{'dateexpiry'} ), dateonly => 1 });
826 if ( $table eq 'reserves' && $values->{'waitingdate'} ) {
827 $values->{'waitingdate'} = output_pref({ dt => dt_from_string( $values->{'waitingdate'} ), dateonly => 1 });
830 if ($letter->{content} && $letter->{content} =~ /<<today>>/) {
831 my $todaysdate = output_pref( dt_from_string() );
832 $letter->{content} =~ s/<<today>>/$todaysdate/go;
835 while ( my ($field, $val) = each %$values ) {
836 $val =~ s/\p{P}$// if $val && $table=~/biblio/;
837 #BZ 9886: Assuming that we want to eliminate ISBD punctuation here
838 #Therefore adding the test on biblio. This includes biblioitems,
839 #but excludes items. Removed unneeded global and lookahead.
841 if ( $table=~/^borrowers$/ && $field=~/^streettype$/ ) {
842 my $av = Koha::AuthorisedValues->search({ category => 'ROADTYPE', authorised_value => $val });
843 $val = $av->count ? $av->next->lib : '';
847 my $replacedby = defined ($val) ? $val : '';
849 and not $replacedby =~ m|9999-12-31|
850 and $replacedby =~ m|^\d{4}-\d{2}-\d{2}( \d{2}:\d{2}:\d{2})?$| )
852 # If the value is XXXX-YY-ZZ[ AA:BB:CC] we assume it is a date
853 my $dateonly = defined $1 ? 0 : 1; #$1 refers to the capture group wrapped in parentheses. In this case, that's the hours, minutes, seconds.
854 my $re_dateonly_filter = qr{ $field( \s* \| \s* dateonly\s*)?>> }xms;
856 for my $letter_field ( qw( title content ) ) {
857 my $filter_string_used = q{};
858 if ( $letter->{ $letter_field } =~ $re_dateonly_filter ) {
859 # We overwrite $dateonly if the filter exists and we have a time in the datetime
860 $filter_string_used = $1 || q{};
861 $dateonly = $1 unless $dateonly;
863 my $replacedby_date = eval {
864 output_pref({ dt => dt_from_string( $replacedby ), dateonly => $dateonly });
867 if ( $letter->{ $letter_field } ) {
868 $letter->{ $letter_field } =~ s/\Q<<$table.$field$filter_string_used>>\E/$replacedby_date/g;
869 $letter->{ $letter_field } =~ s/\Q<<$field$filter_string_used>>\E/$replacedby_date/g;
873 # Other fields replacement
875 for my $letter_field ( qw( title content ) ) {
876 if ( $letter->{ $letter_field } ) {
877 $letter->{ $letter_field } =~ s/<<$table.$field>>/$replacedby/g;
878 $letter->{ $letter_field } =~ s/<<$field>>/$replacedby/g;
884 if ($table eq 'borrowers' && $letter->{content}) {
885 my $patron = Koha::Patrons->find( $values->{borrowernumber} );
887 my $attributes = $patron->extended_attributes;
889 while ( my $attribute = $attributes->next ) {
890 my $code = $attribute->code;
891 my $val = $attribute->description; # FIXME - we always display intranet description here!
892 $val =~ s/\p{P}(?=$)//g if $val;
893 next unless $val gt '';
895 push @{ $attr{$code} }, $val;
897 while ( my ($code, $val_ar) = each %attr ) {
898 my $replacefield = "<<borrower-attribute:$code>>";
899 my $replacedby = join ',', @$val_ar;
900 $letter->{content} =~ s/$replacefield/$replacedby/g;
909 my $success = EnqueueLetter( { letter => $letter,
910 borrowernumber => '12', message_transport_type => 'email' } )
912 Places a letter in the message_queue database table, which will
913 eventually get processed (sent) by the process_message_queue.pl
914 cronjob when it calls SendQueuedMessages.
916 Return message_id on success
919 * letter - required; A letter hashref as returned from GetPreparedLetter
920 * message_transport_type - required; One of the available mtts
921 * borrowernumber - optional if 'to_address' is passed; The borrowernumber of the patron we enqueuing the notice for
922 * to_address - optional if 'borrowernumber' is passed; The destination email address for the notice (defaults to patron->notice_email_address)
923 * from_address - optional; The from address for the notice, defaults to patron->library->from_email_address
924 * reply_address - optional; The reply address for the notice, defaults to patron->library->reply_to
929 my $params = shift or return;
931 return unless exists $params->{'letter'};
932 # return unless exists $params->{'borrowernumber'};
933 return unless exists $params->{'message_transport_type'};
935 my $content = $params->{letter}->{content};
936 $content =~ s/\s+//g if(defined $content);
937 if ( not defined $content or $content eq '' ) {
938 Koha::Logger->get->info("Trying to add an empty message to the message queue");
942 # If we have any attachments we should encode then into the body.
943 if ( $params->{'attachments'} ) {
944 $params->{'letter'} = _add_attachments(
945 { letter => $params->{'letter'},
946 attachments => $params->{'attachments'},
947 message => MIME::Lite->new( Type => 'multipart/mixed' ),
952 my $dbh = C4::Context->dbh();
953 my $statement = << 'ENDSQL';
954 INSERT INTO message_queue
955 ( borrowernumber, subject, content, metadata, letter_code, message_transport_type, status, time_queued, to_address, from_address, reply_address, content_type, delivery_note )
957 ( ?, ?, ?, ?, ?, ?, ?, CAST(NOW() AS DATETIME), ?, ?, ?, ?, ? )
960 my $sth = $dbh->prepare($statement);
961 my $result = $sth->execute(
962 $params->{'borrowernumber'}, # borrowernumber
963 $params->{'letter'}->{'title'}, # subject
964 $params->{'letter'}->{'content'}, # content
965 $params->{'letter'}->{'metadata'} || '', # metadata
966 $params->{'letter'}->{'code'} || '', # letter_code
967 $params->{'message_transport_type'}, # message_transport_type
969 $params->{'to_address'}, # to_address
970 $params->{'from_address'}, # from_address
971 $params->{'reply_address'}, # reply_address
972 $params->{'letter'}->{'content-type'}, # content_type
973 $params->{'delivery_note'} || '', # delivery_note
975 return $dbh->last_insert_id(undef,undef,'message_queue', undef);
978 =head2 SendQueuedMessages ([$hashref])
980 my $sent = SendQueuedMessages({
981 letter_code => $letter_code,
982 borrowernumber => $who_letter_is_for,
988 Sends all of the 'pending' items in the message queue, unless
989 parameters are passed.
991 The letter_code, borrowernumber and limit parameters are used
992 to build a parameter set for _get_unsent_messages, thus limiting
993 which pending messages will be processed. They are all optional.
995 The verbose parameter can be used to generate debugging output.
998 Returns number of messages sent.
1002 sub SendQueuedMessages {
1005 my $which_unsent_messages = {
1006 'message_id' => $params->{'message_id'},
1007 'limit' => $params->{'limit'} // 0,
1008 'borrowernumber' => $params->{'borrowernumber'} // q{},
1009 'letter_code' => $params->{'letter_code'} // q{},
1010 'type' => $params->{'type'} // q{},
1012 my $unsent_messages = _get_unsent_messages( $which_unsent_messages );
1013 MESSAGE: foreach my $message ( @$unsent_messages ) {
1014 my $message_object = Koha::Notice::Messages->find( $message->{message_id} );
1015 # If this fails the database is unwritable and we won't manage to send a message that continues to be marked 'pending'
1016 $message_object->make_column_dirty('status');
1017 return unless $message_object->store;
1019 # warn Data::Dumper->Dump( [ $message ], [ 'message' ] );
1020 warn sprintf( 'sending %s message to patron: %s',
1021 $message->{'message_transport_type'},
1022 $message->{'borrowernumber'} || 'Admin' )
1023 if $params->{'verbose'};
1024 # This is just begging for subclassing
1025 next MESSAGE if ( lc($message->{'message_transport_type'}) eq 'rss' );
1026 if ( lc( $message->{'message_transport_type'} ) eq 'email' ) {
1027 _send_message_by_email( $message, $params->{'username'}, $params->{'password'}, $params->{'method'} );
1029 elsif ( lc( $message->{'message_transport_type'} ) eq 'sms' ) {
1030 if ( C4::Context->preference('SMSSendDriver') eq 'Email' ) {
1031 my $patron = Koha::Patrons->find( $message->{borrowernumber} );
1032 my $sms_provider = Koha::SMS::Providers->find( $patron->sms_provider_id );
1033 unless ( $sms_provider ) {
1034 warn sprintf( "Patron %s has no sms provider id set!", $message->{'borrowernumber'} ) if $params->{'verbose'};
1035 _set_message_status( { message_id => $message->{'message_id'}, status => 'failed' } );
1038 unless ( $patron->smsalertnumber ) {
1039 _set_message_status( { message_id => $message->{'message_id'}, status => 'failed' } );
1040 warn sprintf( "No smsalertnumber found for patron %s!", $message->{'borrowernumber'} ) if $params->{'verbose'};
1043 $message->{to_address} = $patron->smsalertnumber; #Sometime this is set to email - sms should always use smsalertnumber
1044 $message->{to_address} .= '@' . $sms_provider->domain();
1046 # Check for possible from_address override
1047 my $from_address = C4::Context->preference('EmailSMSSendDriverFromAddress');
1048 if ($from_address && $message->{from_address} ne $from_address) {
1049 $message->{from_address} = $from_address;
1050 _update_message_from_address($message->{'message_id'}, $message->{from_address});
1053 _update_message_to_address($message->{'message_id'}, $message->{to_address});
1054 _send_message_by_email( $message, $params->{'username'}, $params->{'password'}, $params->{'method'} );
1056 _send_message_by_sms( $message );
1060 return scalar( @$unsent_messages );
1063 =head2 GetRSSMessages
1065 my $message_list = GetRSSMessages( { limit => 10, borrowernumber => '14' } )
1067 returns a listref of all queued RSS messages for a particular person.
1071 sub GetRSSMessages {
1074 return unless $params;
1075 return unless ref $params;
1076 return unless $params->{'borrowernumber'};
1078 return _get_unsent_messages( { message_transport_type => 'rss',
1079 limit => $params->{'limit'},
1080 borrowernumber => $params->{'borrowernumber'}, } );
1083 =head2 GetPrintMessages
1085 my $message_list = GetPrintMessages( { borrowernumber => $borrowernumber } )
1087 Returns a arrayref of all queued print messages (optionally, for a particular
1092 sub GetPrintMessages {
1093 my $params = shift || {};
1095 return _get_unsent_messages( { message_transport_type => 'print',
1096 borrowernumber => $params->{'borrowernumber'},
1100 =head2 GetQueuedMessages ([$hashref])
1102 my $messages = GetQueuedMessage( { borrowernumber => '123', limit => 20 } );
1104 Fetches a list of messages from the message queue optionally filtered by borrowernumber
1105 and limited to specified limit.
1107 Return is an arrayref of hashes, each has represents a message in the message queue.
1111 sub GetQueuedMessages {
1114 my $dbh = C4::Context->dbh();
1115 my $statement = << 'ENDSQL';
1116 SELECT message_id, borrowernumber, subject, content, message_transport_type, status, time_queued, updated_on, delivery_note
1122 if ( exists $params->{'borrowernumber'} ) {
1123 push @whereclauses, ' borrowernumber = ? ';
1124 push @query_params, $params->{'borrowernumber'};
1127 if ( @whereclauses ) {
1128 $statement .= ' WHERE ' . join( 'AND', @whereclauses );
1131 if ( defined $params->{'limit'} ) {
1132 $statement .= ' LIMIT ? ';
1133 push @query_params, $params->{'limit'};
1136 my $sth = $dbh->prepare( $statement );
1137 my $result = $sth->execute( @query_params );
1138 return $sth->fetchall_arrayref({});
1141 =head2 GetMessageTransportTypes
1143 my @mtt = GetMessageTransportTypes();
1145 returns an arrayref of transport types
1149 sub GetMessageTransportTypes {
1150 my $dbh = C4::Context->dbh();
1151 my $mtts = $dbh->selectcol_arrayref("
1152 SELECT message_transport_type
1153 FROM message_transport_types
1154 ORDER BY message_transport_type
1161 my $message = C4::Letters::Message($message_id);
1166 my ( $message_id ) = @_;
1167 return unless $message_id;
1168 my $dbh = C4::Context->dbh;
1169 return $dbh->selectrow_hashref(q|
1170 SELECT message_id, borrowernumber, subject, content, metadata, letter_code, message_transport_type, status, time_queued, updated_on, to_address, from_address, reply_address, content_type, delivery_note
1172 WHERE message_id = ?
1173 |, {}, $message_id );
1176 =head2 ResendMessage
1178 Attempt to resend a message which has failed previously.
1180 my $has_been_resent = C4::Letters::ResendMessage($message_id);
1182 Updates the message to 'pending' status so that
1183 it will be resent later on.
1185 returns 1 on success, 0 on failure, undef if no message was found
1190 my $message_id = shift;
1191 return unless $message_id;
1193 my $message = GetMessage( $message_id );
1194 return unless $message;
1196 if ( $message->{status} ne 'pending' ) {
1197 $rv = C4::Letters::_set_message_status({
1198 message_id => $message_id,
1199 status => 'pending',
1201 $rv = $rv > 0? 1: 0;
1202 # Clear destination email address to force address update
1203 _update_message_to_address( $message_id, undef ) if $rv &&
1204 $message->{message_transport_type} eq 'email';
1209 =head2 _add_attachements
1212 letter - the standard letter hashref
1213 attachments - listref of attachments. each attachment is a hashref of:
1214 type - the mime type, like 'text/plain'
1215 content - the actual attachment
1216 filename - the name of the attachment.
1217 message - a MIME::Lite object to attach these to.
1219 returns your letter object, with the content updated.
1223 sub _add_attachments {
1226 my $letter = $params->{'letter'};
1227 my $attachments = $params->{'attachments'};
1228 return $letter unless @$attachments;
1229 my $message = $params->{'message'};
1231 # First, we have to put the body in as the first attachment
1233 Type => $letter->{'content-type'} || 'TEXT',
1234 Data => $letter->{'is_html'}
1235 ? _wrap_html($letter->{'content'}, $letter->{'title'})
1236 : $letter->{'content'},
1239 foreach my $attachment ( @$attachments ) {
1241 Type => $attachment->{'type'},
1242 Data => $attachment->{'content'},
1243 Filename => $attachment->{'filename'},
1246 # we're forcing list context here to get the header, not the count back from grep.
1247 ( $letter->{'content-type'} ) = grep( /^Content-Type:/, split( /\n/, $params->{'message'}->header_as_string ) );
1248 $letter->{'content-type'} =~ s/^Content-Type:\s+//;
1249 $letter->{'content'} = $message->body_as_string;
1255 =head2 _get_unsent_messages
1257 This function's parameter hash reference takes the following
1258 optional named parameters:
1259 message_transport_type: method of message sending (e.g. email, sms, etc.)
1260 borrowernumber : who the message is to be sent
1261 letter_code : type of message being sent (e.g. PASSWORD_RESET)
1262 message_id : the message_id of the message. In that case the sub will return only 1 result
1263 limit : maximum number of messages to send
1265 This function returns an array of matching hash referenced rows from
1266 message_queue with some borrower information added.
1270 sub _get_unsent_messages {
1273 my $dbh = C4::Context->dbh();
1275 SELECT mq.message_id, mq.borrowernumber, mq.subject, mq.content, mq.message_transport_type, mq.status, mq.time_queued, mq.from_address, mq.reply_address, mq.to_address, mq.content_type, b.branchcode, mq.letter_code, mq.delivery_note
1276 FROM message_queue mq
1277 LEFT JOIN borrowers b ON b.borrowernumber = mq.borrowernumber
1281 my @query_params = ('pending');
1282 if ( ref $params ) {
1283 if ( $params->{'message_transport_type'} ) {
1284 $statement .= ' AND mq.message_transport_type = ? ';
1285 push @query_params, $params->{'message_transport_type'};
1287 if ( $params->{'borrowernumber'} ) {
1288 $statement .= ' AND mq.borrowernumber = ? ';
1289 push @query_params, $params->{'borrowernumber'};
1291 if ( $params->{'letter_code'} ) {
1292 $statement .= ' AND mq.letter_code = ? ';
1293 push @query_params, $params->{'letter_code'};
1295 if ( $params->{'type'} ) {
1296 $statement .= ' AND message_transport_type = ? ';
1297 push @query_params, $params->{'type'};
1299 if ( $params->{message_id} ) {
1300 $statement .= ' AND message_id = ?';
1301 push @query_params, $params->{message_id};
1303 if ( $params->{'limit'} ) {
1304 $statement .= ' limit ? ';
1305 push @query_params, $params->{'limit'};
1309 my $sth = $dbh->prepare( $statement );
1310 my $result = $sth->execute( @query_params );
1311 return $sth->fetchall_arrayref({});
1314 sub _send_message_by_email {
1315 my $message = shift or return;
1316 my ($username, $password, $method) = @_;
1318 my $patron = Koha::Patrons->find( $message->{borrowernumber} );
1319 my $to_address = $message->{'to_address'};
1320 unless ($to_address) {
1322 warn "FAIL: No 'to_address' and INVALID borrowernumber ($message->{borrowernumber})";
1323 _set_message_status( { message_id => $message->{'message_id'},
1325 delivery_note => 'Invalid borrowernumber '.$message->{borrowernumber},
1326 error_code => 'INVALID_BORNUMBER' } );
1329 $to_address = $patron->notice_email_address;
1330 unless ($to_address) {
1331 # warn "FAIL: No 'to_address' and no email for " . ($member->{surname} ||'') . ", borrowernumber ($message->{borrowernumber})";
1332 # warning too verbose for this more common case?
1333 _set_message_status( { message_id => $message->{'message_id'},
1335 delivery_note => 'Unable to find an email address for this borrower',
1336 error_code => 'NO_EMAIL' } );
1341 my $subject = $message->{'subject'};
1343 my $content = $message->{'content'};
1344 my $content_type = $message->{'content_type'} || 'text/plain; charset="UTF-8"';
1345 my $is_html = $content_type =~ m/html/io;
1347 my $branch_email = undef;
1348 my $branch_replyto = undef;
1349 my $branch_returnpath = undef;
1353 $library = $patron->library;
1354 $branch_email = $library->from_email_address;
1355 $branch_replyto = $library->branchreplyto;
1356 $branch_returnpath = $library->branchreturnpath;
1359 # NOTE: Patron may not be defined above so branch_email may be undefined still
1360 # so we need to fallback to KohaAdminEmailAddress as a last resort.
1362 $message->{'from_address'}
1364 || C4::Context->preference('KohaAdminEmailAddress');
1365 if( !$from_address ) {
1366 _set_message_status({
1367 message_id => $message->{'message_id'},
1369 delivery_note => 'No from address',
1373 my $email = Koha::Email->create(
1377 C4::Context->preference('NoticeBcc')
1378 ? ( bcc => C4::Context->preference('NoticeBcc') )
1381 from => $from_address,
1382 reply_to => $message->{'reply_address'} || $branch_replyto,
1383 sender => $branch_returnpath,
1384 subject => "" . $message->{subject}
1390 _wrap_html( $content, $subject )
1394 $email->text_body( $content );
1399 $smtp_server = $library->smtp_server;
1402 $smtp_server = Koha::SMTP::Servers->get_default;
1408 sasl_username => $username,
1409 sasl_password => $password,
1414 # if initial message address was empty, coming here means that a to address was found and
1415 # queue should be updated; same if to address was overriden by Koha::Email->create
1416 _update_message_to_address( $message->{'message_id'}, $email->email->header('To') )
1417 if !$message->{to_address}
1418 || $message->{to_address} ne $email->email->header('To');
1421 $email->send_or_die({ transport => $smtp_server->transport });
1423 _set_message_status(
1425 message_id => $message->{'message_id'},
1433 _set_message_status(
1435 message_id => $message->{'message_id'},
1437 delivery_note => $Mail::Sendmail::error
1446 my ($content, $title) = @_;
1448 my $css = C4::Context->preference("NoticeCSS") || '';
1449 $css = qq{<link rel="stylesheet" type="text/css" href="$css">} if $css;
1451 <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
1452 "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
1453 <html lang="en" xml:lang="en" xmlns="http://www.w3.org/1999/xhtml">
1455 <title>$title</title>
1456 <meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
1467 my ( $message ) = @_;
1468 my $dbh = C4::Context->dbh;
1469 my $count = $dbh->selectrow_array(q|
1472 WHERE message_transport_type = ?
1473 AND borrowernumber = ?
1475 AND CAST(updated_on AS date) = CAST(NOW() AS date)
1478 |, {}, $message->{message_transport_type}, $message->{borrowernumber}, $message->{letter_code}, $message->{content} );
1482 sub _send_message_by_sms {
1483 my $message = shift or return;
1484 my $patron = Koha::Patrons->find( $message->{borrowernumber} );
1486 unless ( $patron and $patron->smsalertnumber ) {
1487 _set_message_status( { message_id => $message->{'message_id'},
1489 delivery_note => 'Missing SMS number',
1490 error_code => 'MISSING_SMS' } );
1494 if ( _is_duplicate( $message ) ) {
1495 _set_message_status( { message_id => $message->{'message_id'},
1497 delivery_note => 'Message is duplicate',
1498 error_code => 'DUPLICATE_MESSAGE' } );
1502 my $success = C4::SMS->send_sms( { destination => $patron->smsalertnumber,
1503 message => $message->{'content'},
1505 _set_message_status( { message_id => $message->{'message_id'},
1506 status => ($success ? 'sent' : 'failed'),
1507 delivery_note => ($success ? '' : 'No notes from SMS driver'),
1508 error_code => 'NO_NOTES' } );
1513 sub _update_message_to_address {
1515 my $dbh = C4::Context->dbh();
1516 $dbh->do('UPDATE message_queue SET to_address=? WHERE message_id=?',undef,($to,$id));
1519 sub _update_message_from_address {
1520 my ($message_id, $from_address) = @_;
1521 my $dbh = C4::Context->dbh();
1522 $dbh->do('UPDATE message_queue SET from_address = ? WHERE message_id = ?', undef, ($from_address, $message_id));
1525 sub _set_message_status {
1526 my $params = shift or return;
1528 foreach my $required_parameter ( qw( message_id status ) ) {
1529 return unless exists $params->{ $required_parameter };
1532 my $dbh = C4::Context->dbh();
1533 my $statement = 'UPDATE message_queue SET status= ?, delivery_note= ? WHERE message_id = ?';
1534 my $sth = $dbh->prepare( $statement );
1535 my $result = $sth->execute( $params->{'status'},
1536 $params->{'delivery_note'} || '',
1537 $params->{'message_id'} );
1542 my ( $params ) = @_;
1544 my $content = $params->{content};
1545 my $tables = $params->{tables};
1546 my $loops = $params->{loops};
1547 my $substitute = $params->{substitute} || {};
1548 my $lang = defined($params->{lang}) && $params->{lang} ne 'default' ? $params->{lang} : 'en';
1549 my ($theme, $availablethemes);
1551 my $htdocs = C4::Context->config('intrahtdocs');
1552 ($theme, $lang, $availablethemes)= C4::Templates::availablethemes( $htdocs, 'about.tt', 'intranet', $lang);
1554 foreach (@$availablethemes) {
1555 push @includes, "$htdocs/$_/$lang/includes";
1556 push @includes, "$htdocs/$_/en/includes" unless $lang eq 'en';
1559 my $use_template_cache = C4::Context->config('template_cache_dir') && defined $ENV{GATEWAY_INTERFACE};
1560 my $template = Template->new(
1564 PLUGIN_BASE => 'Koha::Template::Plugin',
1565 COMPILE_EXT => $use_template_cache ? '.ttc' : '',
1566 COMPILE_DIR => $use_template_cache ? C4::Context->config('template_cache_dir') : '',
1567 INCLUDE_PATH => \@includes,
1569 ENCODING => 'UTF-8',
1571 ) or die Template->error();
1573 my $tt_params = { %{ _get_tt_params( $tables ) }, %{ _get_tt_params( $loops, 'is_a_loop' ) }, %$substitute };
1575 $content = add_tt_filters( $content );
1576 $content = qq|[% USE KohaDates %][% USE Remove_MARC_punctuation %]$content|;
1579 $template->process( \$content, $tt_params, \$output ) || croak "ERROR PROCESSING TEMPLATE: " . $template->error();
1584 sub _get_tt_params {
1585 my ($tables, $is_a_loop) = @_;
1591 article_requests => {
1592 module => 'Koha::ArticleRequests',
1593 singular => 'article_request',
1594 plural => 'article_requests',
1598 module => 'Koha::Acquisition::Baskets',
1599 singular => 'basket',
1600 plural => 'baskets',
1604 module => 'Koha::Biblios',
1605 singular => 'biblio',
1606 plural => 'biblios',
1607 pk => 'biblionumber',
1610 module => 'Koha::Biblioitems',
1611 singular => 'biblioitem',
1612 plural => 'biblioitems',
1613 pk => 'biblioitemnumber',
1616 module => 'Koha::Patrons',
1617 singular => 'borrower',
1618 plural => 'borrowers',
1619 pk => 'borrowernumber',
1622 module => 'Koha::Libraries',
1623 singular => 'branch',
1624 plural => 'branches',
1628 module => 'Koha::Account::Lines',
1629 singular => 'credit',
1630 plural => 'credits',
1631 pk => 'accountlines_id',
1634 module => 'Koha::Account::Lines',
1635 singular => 'debit',
1637 pk => 'accountlines_id',
1640 module => 'Koha::Items',
1646 module => 'Koha::News',
1652 module => 'Koha::Acquisition::Orders',
1653 singular => 'order',
1655 pk => 'ordernumber',
1658 module => 'Koha::Holds',
1664 module => 'Koha::Serials',
1665 singular => 'serial',
1666 plural => 'serials',
1670 module => 'Koha::Subscriptions',
1671 singular => 'subscription',
1672 plural => 'subscriptions',
1673 pk => 'subscriptionid',
1676 module => 'Koha::Suggestions',
1677 singular => 'suggestion',
1678 plural => 'suggestions',
1679 pk => 'suggestionid',
1682 module => 'Koha::Checkouts',
1683 singular => 'checkout',
1684 plural => 'checkouts',
1688 module => 'Koha::Old::Checkouts',
1689 singular => 'old_checkout',
1690 plural => 'old_checkouts',
1694 module => 'Koha::Checkouts',
1695 singular => 'overdue',
1696 plural => 'overdues',
1699 borrower_modifications => {
1700 module => 'Koha::Patron::Modifications',
1701 singular => 'patron_modification',
1702 plural => 'patron_modifications',
1703 fk => 'verification_token',
1706 module => 'Koha::Illrequests',
1707 singular => 'illrequest',
1708 plural => 'illrequests',
1709 pk => 'illrequest_id'
1713 foreach my $table ( keys %$tables ) {
1714 next unless $config->{$table};
1716 my $ref = ref( $tables->{$table} ) || q{};
1717 my $module = $config->{$table}->{module};
1719 if ( can_load( modules => { $module => undef } ) ) {
1720 my $pk = $config->{$table}->{pk};
1721 my $fk = $config->{$table}->{fk};
1724 my $values = $tables->{$table} || [];
1725 unless ( ref( $values ) eq 'ARRAY' ) {
1726 croak "ERROR processing table $table. Wrong API call.";
1728 my $key = $pk ? $pk : $fk;
1729 # $key does not come from user input
1730 my $objects = $module->search(
1731 { $key => $values },
1733 # We want to retrieve the data in the same order
1735 # field is a MySQLism, but they are no other way to do it
1736 # To be generic we could do it in perl, but we will need to fetch
1737 # all the data then order them
1738 @$values ? ( order_by => \[ "field($key, " . join( ', ', @$values ) . ")" ] ) : ()
1741 $params->{ $config->{$table}->{plural} } = $objects;
1743 elsif ( $ref eq q{} || $ref eq 'HASH' ) {
1744 my $id = ref $ref eq 'HASH' ? $tables->{$table}->{$pk} : $tables->{$table};
1746 if ( $fk ) { # Using a foreign key for lookup
1747 if ( ref( $fk ) eq 'ARRAY' ) { # Foreign key is multi-column
1749 foreach my $key ( @$fk ) {
1750 $search->{$key} = $id->{$key};
1752 $object = $module->search( $search )->last();
1753 } else { # Foreign key is single column
1754 $object = $module->search( { $fk => $id } )->last();
1756 } else { # using the table's primary key for lookup
1757 $object = $module->find($id);
1759 $params->{ $config->{$table}->{singular} } = $object;
1761 else { # $ref eq 'ARRAY'
1763 if ( @{ $tables->{$table} } == 1 ) { # Param is a single key
1764 $object = $module->search( { $pk => $tables->{$table} } )->last();
1766 else { # Params are mutliple foreign keys
1767 croak "Multiple foreign keys (table $table) should be passed using an hashref";
1769 $params->{ $config->{$table}->{singular} } = $object;
1773 croak "ERROR LOADING MODULE $module: $Module::Load::Conditional::ERROR";
1777 $params->{today} = output_pref({ dt => dt_from_string, dateformat => 'iso' });
1782 =head3 add_tt_filters
1784 $content = add_tt_filters( $content );
1786 Add TT filters to some specific fields if needed.
1788 For now we only add the Remove_MARC_punctuation TT filter to biblio and biblioitem fields
1792 sub add_tt_filters {
1793 my ( $content ) = @_;
1794 $content =~ s|\[%\s*biblio\.(.*?)\s*%\]|[% biblio.$1 \| \$Remove_MARC_punctuation %]|gxms;
1795 $content =~ s|\[%\s*biblioitem\.(.*?)\s*%\]|[% biblioitem.$1 \| \$Remove_MARC_punctuation %]|gxms;
1799 =head2 get_item_content
1801 my $item = Koha::Items->find(...)->unblessed;
1802 my @item_content_fields = qw( date_due title barcode author itemnumber );
1803 my $item_content = C4::Letters::get_item_content({
1805 item_content_fields => \@item_content_fields
1808 This function generates a tab-separated list of values for the passed item. Dates
1809 are formatted following the current setup.
1813 sub get_item_content {
1814 my ( $params ) = @_;
1815 my $item = $params->{item};
1816 my $dateonly = $params->{dateonly} || 0;
1817 my $item_content_fields = $params->{item_content_fields} || [];
1819 return unless $item;
1821 my @item_info = map {
1825 { dt => dt_from_string( $item->{$_} ), dateonly => $dateonly } );
1829 } @$item_content_fields;
1830 return join( "\t", @item_info ) . "\n";