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);
37 use Koha::SMS::Providers;
40 use Koha::Notice::Messages;
41 use Koha::Notice::Templates;
42 use Koha::DateUtils qw( format_sqldatetime dt_from_string );
44 use Koha::SMTP::Servers;
45 use Koha::Subscriptions;
47 use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
53 &EnqueueLetter &GetLetters &GetLettersAvailableForALibrary &GetLetterTemplates &DelLetter &GetPreparedLetter &GetWrappedLetter &SendAlerts &GetPrintMessages &GetMessageTransportTypes
59 C4::Letters - Give functions for Letters management
67 "Letters" is the tool used in Koha to manage informations sent to the patrons and/or the library. This include some cron jobs like
68 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)
70 Letters are managed through "alerts" sent by Koha on some events. All "alert" related functions are in this module too.
72 =head2 GetLetters([$module])
74 $letters = &GetLetters($module);
75 returns informations about letters.
76 if needed, $module filters for letters given module
78 DEPRECATED - You must use Koha::Notice::Templates instead
79 The group by clause is confusing and can lead to issues
85 my $module = $filters->{module};
86 my $code = $filters->{code};
87 my $branchcode = $filters->{branchcode};
88 my $dbh = C4::Context->dbh;
89 my $letters = $dbh->selectall_arrayref(
91 SELECT code, module, name
95 . ( $module ? q| AND module = ?| : q|| )
96 . ( $code ? q| AND code = ?| : q|| )
97 . ( defined $branchcode ? q| AND branchcode = ?| : q|| )
98 . q| GROUP BY code, module, name ORDER BY name|, { Slice => {} }
99 , ( $module ? $module : () )
100 , ( $code ? $code : () )
101 , ( defined $branchcode ? $branchcode : () )
107 =head2 GetLetterTemplates
109 my $letter_templates = GetLetterTemplates(
111 module => 'circulation',
113 branchcode => 'CPL', # '' for default,
117 Return a hashref of letter templates.
121 sub GetLetterTemplates {
124 my $module = $params->{module};
125 my $code = $params->{code};
126 my $branchcode = $params->{branchcode} // '';
127 my $dbh = C4::Context->dbh;
128 return Koha::Notice::Templates->search(
132 branchcode => $branchcode,
134 C4::Context->preference('TranslateNotices')
136 : ( lang => 'default' )
142 =head2 GetLettersAvailableForALibrary
144 my $letters = GetLettersAvailableForALibrary(
146 branchcode => 'CPL', # '' for default
147 module => 'circulation',
151 Return an arrayref of letters, sorted by name.
152 If a specific letter exist for the given branchcode, it will be retrieve.
153 Otherwise the default letter will be.
157 sub GetLettersAvailableForALibrary {
159 my $branchcode = $filters->{branchcode};
160 my $module = $filters->{module};
162 croak "module should be provided" unless $module;
164 my $dbh = C4::Context->dbh;
165 my $default_letters = $dbh->selectall_arrayref(
167 SELECT module, code, branchcode, name
171 . q| AND branchcode = ''|
172 . ( $module ? q| AND module = ?| : q|| )
173 . q| ORDER BY name|, { Slice => {} }
174 , ( $module ? $module : () )
177 my $specific_letters;
179 $specific_letters = $dbh->selectall_arrayref(
181 SELECT module, code, branchcode, name
185 . q| AND branchcode = ?|
186 . ( $module ? q| AND module = ?| : q|| )
187 . q| ORDER BY name|, { Slice => {} }
189 , ( $module ? $module : () )
194 for my $l (@$default_letters) {
195 $letters{ $l->{code} } = $l;
197 for my $l (@$specific_letters) {
198 # Overwrite the default letter with the specific one.
199 $letters{ $l->{code} } = $l;
202 return [ map { $letters{$_} }
203 sort { $letters{$a}->{name} cmp $letters{$b}->{name} }
209 my ( $module, $code, $branchcode, $message_transport_type, $lang) = @_;
210 $message_transport_type //= '%';
211 $lang = 'default' unless( $lang && C4::Context->preference('TranslateNotices') );
214 my $only_my_library = C4::Context->only_my_library;
215 if ( $only_my_library and $branchcode ) {
216 $branchcode = C4::Context::mybranch();
220 my $dbh = C4::Context->dbh;
221 my $sth = $dbh->prepare(q{
224 WHERE module=? AND code=? AND (branchcode = ? OR branchcode = '')
225 AND message_transport_type LIKE ?
227 ORDER BY branchcode DESC LIMIT 1
229 $sth->execute( $module, $code, $branchcode, $message_transport_type, $lang );
230 my $line = $sth->fetchrow_hashref
232 $line->{'content-type'} = 'text/html; charset="UTF-8"' if $line->{is_html};
242 module => 'circulation',
248 Delete the letter. The mtt parameter is facultative.
249 If not given, all templates mathing the other parameters will be removed.
255 my $branchcode = $params->{branchcode};
256 my $module = $params->{module};
257 my $code = $params->{code};
258 my $mtt = $params->{mtt};
259 my $lang = $params->{lang};
260 my $dbh = C4::Context->dbh;
267 . ( $mtt ? q| AND message_transport_type = ?| : q|| )
268 . ( $lang? q| AND lang = ?| : q|| )
269 , undef, $branchcode, $module, $code, ( $mtt ? $mtt : () ), ( $lang ? $lang : () ) );
274 my $err = &SendAlerts($type, $externalid, $letter_code);
277 - $type : the type of alert
278 - $externalid : the id of the "object" to query
279 - $letter_code : the notice template to use
281 C<&SendAlerts> sends an email notice directly to a patron or a vendor.
283 Currently it supports ($type):
284 - claim serial issues (claimissues)
285 - claim acquisition orders (claimacquisition)
286 - send acquisition orders to the vendor (orderacquisition)
287 - notify patrons about newly received serial issues (issue)
288 - notify patrons when their account is created (members)
290 Returns undef or { error => 'message } on failure.
291 Returns true on success.
296 my ( $type, $externalid, $letter_code ) = @_;
297 my $dbh = C4::Context->dbh;
300 if ( $type eq 'issue' ) {
302 # prepare the letter...
303 # search the subscriptionid
306 "SELECT subscriptionid FROM serial WHERE serialid=?");
307 $sth->execute($externalid);
308 my ($subscriptionid) = $sth->fetchrow
309 or warn( "No subscription for '$externalid'" ),
312 # search the biblionumber
315 "SELECT biblionumber FROM subscription WHERE subscriptionid=?");
316 $sth->execute($subscriptionid);
317 my ($biblionumber) = $sth->fetchrow
318 or warn( "No biblionumber for '$subscriptionid'" ),
321 # find the list of subscribers to notify
322 my $subscription = Koha::Subscriptions->find( $subscriptionid );
323 my $subscribers = $subscription->subscribers;
324 while ( my $patron = $subscribers->next ) {
325 my $email = $patron->email or next;
327 # warn "sending issues...";
328 my $userenv = C4::Context->userenv;
329 my $library = $patron->library;
330 my $letter = GetPreparedLetter (
332 letter_code => $letter_code,
333 branchcode => $userenv->{branch},
335 'branches' => $library->branchcode,
336 'biblio' => $biblionumber,
337 'biblioitems' => $biblionumber,
338 'borrowers' => $patron->unblessed,
339 'subscription' => $subscriptionid,
340 'serial' => $externalid,
345 # FIXME: This 'default' behaviour should be moved to Koha::Email
346 my $mail = Koha::Email->create(
349 from => $library->branchemail,
350 reply_to => $library->branchreplyto,
351 sender => $library->branchreturnpath,
352 subject => "" . $letter->{title},
356 if ( $letter->{is_html} ) {
357 $mail->html_body( _wrap_html( $letter->{content}, "" . $letter->{title} ) );
360 $mail->text_body( $letter->{content} );
364 $mail->send_or_die({ transport => $library->smtp_server->transport });
367 # We expect ref($_) eq 'Email::Sender::Failure'
368 $error = $_->message;
374 return { error => $error }
378 elsif ( $type eq 'claimacquisition' or $type eq 'claimissues' or $type eq 'orderacquisition' ) {
380 # prepare the letter...
386 if ( $type eq 'claimacquisition') {
388 SELECT aqorders.*,aqbasket.*,biblio.*,biblioitems.*
390 LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno
391 LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
392 LEFT JOIN biblioitems ON aqorders.biblionumber=biblioitems.biblionumber
393 WHERE aqorders.ordernumber IN (
397 carp "No order selected";
398 return { error => "no_order_selected" };
400 $strsth .= join( ",", ('?') x @$externalid ) . ")";
401 $action = "ACQUISITION CLAIM";
402 $sthorders = $dbh->prepare($strsth);
403 $sthorders->execute( @$externalid );
404 $dataorders = $sthorders->fetchall_arrayref( {} );
407 if ($type eq 'claimissues') {
409 SELECT serial.*,subscription.*, biblio.*, biblioitems.*, aqbooksellers.*,
410 aqbooksellers.id AS booksellerid
412 LEFT JOIN subscription ON serial.subscriptionid=subscription.subscriptionid
413 LEFT JOIN biblio ON serial.biblionumber=biblio.biblionumber
414 LEFT JOIN biblioitems ON serial.biblionumber = biblioitems.biblionumber
415 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id
416 WHERE serial.serialid IN (
420 carp "No issues selected";
421 return { error => "no_issues_selected" };
424 $strsth .= join( ",", ('?') x @$externalid ) . ")";
425 $action = "SERIAL CLAIM";
426 $sthorders = $dbh->prepare($strsth);
427 $sthorders->execute( @$externalid );
428 $dataorders = $sthorders->fetchall_arrayref( {} );
431 if ( $type eq 'orderacquisition') {
432 my $basketno = $externalid;
434 SELECT aqorders.*,aqbasket.*,biblio.*,biblioitems.*
436 LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno
437 LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
438 LEFT JOIN biblioitems ON aqorders.biblionumber=biblioitems.biblionumber
439 WHERE aqbasket.basketno = ?
440 AND orderstatus IN ('new','ordered')
443 unless ( $basketno ) {
444 carp "No basketnumber given";
445 return { error => "no_basketno" };
447 $action = "ACQUISITION ORDER";
448 $sthorders = $dbh->prepare($strsth);
449 $sthorders->execute($basketno);
450 $dataorders = $sthorders->fetchall_arrayref( {} );
454 $dbh->prepare("select * from aqbooksellers where id=?");
455 $sthbookseller->execute( $dataorders->[0]->{booksellerid} );
456 my $databookseller = $sthbookseller->fetchrow_hashref;
458 my $addressee = $type eq 'claimacquisition' || $type eq 'orderacquisition' ? 'acqprimary' : 'serialsprimary';
461 $dbh->prepare("SELECT * FROM aqcontacts WHERE booksellerid=? AND $type=1 ORDER BY $addressee DESC");
462 $sthcontact->execute( $dataorders->[0]->{booksellerid} );
463 my $datacontact = $sthcontact->fetchrow_hashref;
467 push @email, $datacontact->{email} if ( $datacontact && $datacontact->{email} );
469 warn "Bookseller $dataorders->[0]->{booksellerid} without emails";
470 return { error => "no_email" };
473 while ($addlcontact = $sthcontact->fetchrow_hashref) {
474 push @cc, $addlcontact->{email} if ( $addlcontact && $addlcontact->{email} );
477 my $userenv = C4::Context->userenv;
478 my $letter = GetPreparedLetter (
480 letter_code => $letter_code,
481 branchcode => $userenv->{branch},
483 'branches' => $userenv->{branch},
484 'aqbooksellers' => $databookseller,
485 'aqcontacts' => $datacontact,
486 'aqbasket' => $basketno,
488 repeat => $dataorders,
490 ) or return { error => "no_letter" };
492 # Remove the order tag
493 $letter->{content} =~ s/<order>(.*?)<\/order>/$1/gxms;
496 my $library = Koha::Libraries->find( $userenv->{branch} );
497 my $mail = Koha::Email->create(
499 to => join( ',', @email ),
500 cc => join( ',', @cc ),
503 C4::Context->preference("ClaimsBccCopy")
504 && ( $type eq 'claimacquisition'
505 || $type eq 'claimissues' )
507 ? ( bcc => $userenv->{emailaddress} )
510 from => $library->branchemail
511 || C4::Context->preference('KohaAdminEmailAddress'),
512 subject => "" . $letter->{title},
516 if ( $letter->{is_html} ) {
517 $mail->html_body( _wrap_html( $letter->{content}, "" . $letter->{title} ) );
520 $mail->text_body( "" . $letter->{content} );
524 $mail->send_or_die({ transport => $library->smtp_server->transport });
527 # We expect ref($_) eq 'Email::Sender::Failure'
528 $error = $_->message;
534 return { error => $error }
537 my $module = $action eq 'ACQUISITION ORDER' ? 'ACQUISITIONS' : 'CLAIMS';
543 . join( ',', @email )
548 ) if C4::Context->preference("ClaimsLog");
550 # send an "account details" notice to a newly created user
551 elsif ( $type eq 'members' ) {
552 my $library = Koha::Libraries->find( $externalid->{branchcode} );
553 my $letter = GetPreparedLetter (
555 letter_code => $letter_code,
556 branchcode => $externalid->{'branchcode'},
557 lang => $externalid->{lang} || 'default',
559 'branches' => $library->unblessed,
560 'borrowers' => $externalid->{'borrowernumber'},
562 substitute => { 'borrowers.password' => $externalid->{'password'} },
565 return { error => "no_email" } unless $externalid->{'emailaddr'};
569 # FIXME: This 'default' behaviour should be moved to Koha::Email
570 my $mail = Koha::Email->create(
572 to => $externalid->{'emailaddr'},
573 from => $library->branchemail,
574 reply_to => $library->branchreplyto,
575 sender => $library->branchreturnpath,
576 subject => "" . $letter->{'title'},
580 if ( $letter->{is_html} ) {
581 $mail->html_body( _wrap_html( $letter->{content}, "" . $letter->{title} ) );
584 $mail->text_body( $letter->{content} );
587 $mail->send_or_die({ transport => $library->smtp_server->transport });
590 # We expect ref($_) eq 'Email::Sender::Failure'
591 $error = $_->message;
597 return { error => $error }
601 # If we come here, return an OK status
605 =head2 GetPreparedLetter( %params )
608 module => letter module, mandatory
609 letter_code => letter code, mandatory
610 branchcode => for letter selection, if missing default system letter taken
611 tables => a hashref with table names as keys. Values are either:
612 - a scalar - primary key value
613 - an arrayref - primary key values
614 - a hashref - full record
615 substitute => custom substitution key/value pairs
616 repeat => records to be substituted on consecutive lines:
617 - an arrayref - tries to guess what needs substituting by
618 taking remaining << >> tokensr; not recommended
619 - a hashref token => @tables - replaces <token> << >> << >> </token>
620 subtemplate for each @tables row; table is a hashref as above
621 want_librarian => boolean, if set to true triggers librarian details
622 substitution from the userenv
624 letter fields hashref (title & content useful)
628 sub GetPreparedLetter {
631 my $letter = $params{letter};
632 my $lang = $params{lang} || 'default';
635 my $module = $params{module} or croak "No module";
636 my $letter_code = $params{letter_code} or croak "No letter_code";
637 my $branchcode = $params{branchcode} || '';
638 my $mtt = $params{message_transport_type} || 'email';
640 $letter = getletter( $module, $letter_code, $branchcode, $mtt, $lang );
643 $letter = getletter( $module, $letter_code, $branchcode, $mtt, 'default' )
644 or warn( "No $module $letter_code letter transported by " . $mtt ),
649 my $tables = $params{tables} || {};
650 my $substitute = $params{substitute} || {};
651 my $loops = $params{loops} || {}; # loops is not supported for historical notices syntax
652 my $repeat = $params{repeat};
653 %$tables || %$substitute || $repeat || %$loops
654 or carp( "ERROR: nothing to substitute - both 'tables', 'loops' and 'substitute' are empty" ),
656 my $want_librarian = $params{want_librarian};
659 while ( my ($token, $val) = each %$substitute ) {
660 if ( $token eq 'items.content' ) {
661 $val =~ s|\n|<br/>|g if $letter->{is_html};
664 $letter->{title} =~ s/<<$token>>/$val/g;
665 $letter->{content} =~ s/<<$token>>/$val/g;
669 my $OPACBaseURL = C4::Context->preference('OPACBaseURL');
670 $letter->{content} =~ s/<<OPACBaseURL>>/$OPACBaseURL/go;
672 if ($want_librarian) {
673 # parsing librarian name
674 my $userenv = C4::Context->userenv;
675 $letter->{content} =~ s/<<LibrarianFirstname>>/$userenv->{firstname}/go;
676 $letter->{content} =~ s/<<LibrarianSurname>>/$userenv->{surname}/go;
677 $letter->{content} =~ s/<<LibrarianEmailaddress>>/$userenv->{emailaddress}/go;
680 my ($repeat_no_enclosing_tags, $repeat_enclosing_tags);
683 if (ref ($repeat) eq 'ARRAY' ) {
684 $repeat_no_enclosing_tags = $repeat;
686 $repeat_enclosing_tags = $repeat;
690 if ($repeat_enclosing_tags) {
691 while ( my ($tag, $tag_tables) = each %$repeat_enclosing_tags ) {
692 if ( $letter->{content} =~ m!<$tag>(.*)</$tag>!s ) {
695 my %subletter = ( title => '', content => $subcontent );
696 _substitute_tables( \%subletter, $_ );
699 $letter->{content} =~ s!<$tag>.*</$tag>!join( "\n", @lines )!se;
705 _substitute_tables( $letter, $tables );
708 if ($repeat_no_enclosing_tags) {
709 if ( $letter->{content} =~ m/[^\n]*<<.*>>[^\n]*/so ) {
714 $c =~ s/<<count>>/$i/go;
715 foreach my $field ( keys %{$_} ) {
716 $c =~ s/(<<[^\.]+.$field>>)/$_->{$field}/;
720 } @$repeat_no_enclosing_tags;
722 my $replaceby = join( "\n", @lines );
723 $letter->{content} =~ s/\Q$line\E/$replaceby/s;
727 $letter->{content} = _process_tt(
729 content => $letter->{content},
732 substitute => $substitute,
737 $letter->{title} = _process_tt(
739 content => $letter->{title},
742 substitute => $substitute,
746 $letter->{content} =~ s/<<\S*>>//go; #remove any stragglers
751 sub _substitute_tables {
752 my ( $letter, $tables ) = @_;
753 while ( my ($table, $param) = each %$tables ) {
756 my $ref = ref $param;
759 if ($ref && $ref eq 'HASH') {
763 my $sth = _parseletter_sth($table);
765 warn "_parseletter_sth('$table') failed to return a valid sth. No substitution will be done for that table.";
768 $sth->execute( $ref ? @$param : $param );
770 $values = $sth->fetchrow_hashref;
774 _parseletter ( $letter, $table, $values );
778 sub _parseletter_sth {
782 carp "ERROR: _parseletter_sth() called without argument (table)";
785 # NOTE: we used to check whether we had a statement handle cached in
786 # a %handles module-level variable. This was a dumb move and
787 # broke things for the rest of us. prepare_cached is a better
788 # way to cache statement handles anyway.
790 ($table eq 'accountlines' ) ? "SELECT * FROM $table WHERE accountlines_id = ?" :
791 ($table eq 'biblio' ) ? "SELECT * FROM $table WHERE biblionumber = ?" :
792 ($table eq 'biblioitems' ) ? "SELECT * FROM $table WHERE biblionumber = ?" :
793 ($table eq 'credits' ) ? "SELECT * FROM accountlines WHERE accountlines_id = ?" :
794 ($table eq 'debits' ) ? "SELECT * FROM accountlines WHERE accountlines_id = ?" :
795 ($table eq 'items' ) ? "SELECT * FROM $table WHERE itemnumber = ?" :
796 ($table eq 'issues' ) ? "SELECT * FROM $table WHERE itemnumber = ?" :
797 ($table eq 'old_issues' ) ? "SELECT * FROM $table WHERE itemnumber = ? ORDER BY timestamp DESC LIMIT 1" :
798 ($table eq 'reserves' ) ? "SELECT * FROM $table WHERE borrowernumber = ? and biblionumber = ?" :
799 ($table eq 'borrowers' ) ? "SELECT * FROM $table WHERE borrowernumber = ?" :
800 ($table eq 'branches' ) ? "SELECT * FROM $table WHERE branchcode = ?" :
801 ($table eq 'suggestions' ) ? "SELECT * FROM $table WHERE suggestionid = ?" :
802 ($table eq 'aqbooksellers') ? "SELECT * FROM $table WHERE id = ?" :
803 ($table eq 'aqorders' ) ? "SELECT * FROM $table WHERE ordernumber = ?" :
804 ($table eq 'aqbasket' ) ? "SELECT * FROM $table WHERE basketno = ?" :
805 ($table eq 'illrequests' ) ? "SELECT * FROM $table WHERE illrequest_id = ?" :
806 ($table eq 'opac_news' ) ? "SELECT * FROM $table WHERE idnew = ?" :
807 ($table eq 'article_requests') ? "SELECT * FROM $table WHERE id = ?" :
808 ($table eq 'borrower_modifications') ? "SELECT * FROM $table WHERE verification_token = ?" :
809 ($table eq 'subscription') ? "SELECT * FROM $table WHERE subscriptionid = ?" :
810 ($table eq 'serial') ? "SELECT * FROM $table WHERE serialid = ?" :
811 ($table eq 'problem_reports') ? "SELECT * FROM $table WHERE reportid = ?" :
814 warn "ERROR: No _parseletter_sth query for table '$table'";
815 return; # nothing to get
817 unless ($sth = C4::Context->dbh->prepare_cached($query)) {
818 warn "ERROR: Failed to prepare query: '$query'";
821 return $sth; # now cache is populated for that $table
824 =head2 _parseletter($letter, $table, $values)
827 - $letter : a hash to letter fields (title & content useful)
828 - $table : the Koha table to parse.
829 - $values_in : table record hashref
830 parse all fields from a table, and replace values in title & content with the appropriate value
831 (not exported sub, used only internally)
836 my ( $letter, $table, $values_in ) = @_;
838 # Work on a local copy of $values_in (passed by reference) to avoid side effects
839 # in callers ( by changing / formatting values )
840 my $values = $values_in ? { %$values_in } : {};
842 if ( $table eq 'borrowers' && $values->{'dateexpiry'} ){
843 $values->{'dateexpiry'} = output_pref({ dt => dt_from_string( $values->{'dateexpiry'} ), dateonly => 1 });
846 if ( $table eq 'reserves' && $values->{'waitingdate'} ) {
847 $values->{'waitingdate'} = output_pref({ dt => dt_from_string( $values->{'waitingdate'} ), dateonly => 1 });
850 if ($letter->{content} && $letter->{content} =~ /<<today>>/) {
851 my $todaysdate = output_pref( dt_from_string() );
852 $letter->{content} =~ s/<<today>>/$todaysdate/go;
855 while ( my ($field, $val) = each %$values ) {
856 $val =~ s/\p{P}$// if $val && $table=~/biblio/;
857 #BZ 9886: Assuming that we want to eliminate ISBD punctuation here
858 #Therefore adding the test on biblio. This includes biblioitems,
859 #but excludes items. Removed unneeded global and lookahead.
861 if ( $table=~/^borrowers$/ && $field=~/^streettype$/ ) {
862 my $av = Koha::AuthorisedValues->search({ category => 'ROADTYPE', authorised_value => $val });
863 $val = $av->count ? $av->next->lib : '';
867 my $replacedby = defined ($val) ? $val : '';
869 and not $replacedby =~ m|9999-12-31|
870 and $replacedby =~ m|^\d{4}-\d{2}-\d{2}( \d{2}:\d{2}:\d{2})?$| )
872 # If the value is XXXX-YY-ZZ[ AA:BB:CC] we assume it is a date
873 my $dateonly = defined $1 ? 0 : 1; #$1 refers to the capture group wrapped in parentheses. In this case, that's the hours, minutes, seconds.
874 my $re_dateonly_filter = qr{ $field( \s* \| \s* dateonly\s*)?>> }xms;
876 for my $letter_field ( qw( title content ) ) {
877 my $filter_string_used = q{};
878 if ( $letter->{ $letter_field } =~ $re_dateonly_filter ) {
879 # We overwrite $dateonly if the filter exists and we have a time in the datetime
880 $filter_string_used = $1 || q{};
881 $dateonly = $1 unless $dateonly;
883 my $replacedby_date = eval {
884 output_pref({ dt => dt_from_string( $replacedby ), dateonly => $dateonly });
887 if ( $letter->{ $letter_field } ) {
888 $letter->{ $letter_field } =~ s/\Q<<$table.$field$filter_string_used>>\E/$replacedby_date/g;
889 $letter->{ $letter_field } =~ s/\Q<<$field$filter_string_used>>\E/$replacedby_date/g;
893 # Other fields replacement
895 for my $letter_field ( qw( title content ) ) {
896 if ( $letter->{ $letter_field } ) {
897 $letter->{ $letter_field } =~ s/<<$table.$field>>/$replacedby/g;
898 $letter->{ $letter_field } =~ s/<<$field>>/$replacedby/g;
904 if ($table eq 'borrowers' && $letter->{content}) {
905 my $patron = Koha::Patrons->find( $values->{borrowernumber} );
907 my $attributes = $patron->extended_attributes;
909 while ( my $attribute = $attributes->next ) {
910 my $code = $attribute->code;
911 my $val = $attribute->description; # FIXME - we always display intranet description here!
912 $val =~ s/\p{P}(?=$)//g if $val;
913 next unless $val gt '';
915 push @{ $attr{$code} }, $val;
917 while ( my ($code, $val_ar) = each %attr ) {
918 my $replacefield = "<<borrower-attribute:$code>>";
919 my $replacedby = join ',', @$val_ar;
920 $letter->{content} =~ s/$replacefield/$replacedby/g;
929 my $success = EnqueueLetter( { letter => $letter,
930 borrowernumber => '12', message_transport_type => 'email' } )
932 places a letter in the message_queue database table, which will
933 eventually get processed (sent) by the process_message_queue.pl
934 cronjob when it calls SendQueuedMessages.
936 return message_id on success
941 my $params = shift or return;
943 return unless exists $params->{'letter'};
944 # return unless exists $params->{'borrowernumber'};
945 return unless exists $params->{'message_transport_type'};
947 my $content = $params->{letter}->{content};
948 $content =~ s/\s+//g if(defined $content);
949 if ( not defined $content or $content eq '' ) {
950 warn "Trying to add an empty message to the message queue" if $debug;
954 # If we have any attachments we should encode then into the body.
955 if ( $params->{'attachments'} ) {
956 $params->{'letter'} = _add_attachments(
957 { letter => $params->{'letter'},
958 attachments => $params->{'attachments'},
959 message => MIME::Lite->new( Type => 'multipart/mixed' ),
964 my $dbh = C4::Context->dbh();
965 my $statement = << 'ENDSQL';
966 INSERT INTO message_queue
967 ( borrowernumber, subject, content, metadata, letter_code, message_transport_type, status, time_queued, to_address, from_address, reply_address, content_type, delivery_note )
969 ( ?, ?, ?, ?, ?, ?, ?, CAST(NOW() AS DATETIME), ?, ?, ?, ?, ? )
972 my $sth = $dbh->prepare($statement);
973 my $result = $sth->execute(
974 $params->{'borrowernumber'}, # borrowernumber
975 $params->{'letter'}->{'title'}, # subject
976 $params->{'letter'}->{'content'}, # content
977 $params->{'letter'}->{'metadata'} || '', # metadata
978 $params->{'letter'}->{'code'} || '', # letter_code
979 $params->{'message_transport_type'}, # message_transport_type
981 $params->{'to_address'}, # to_address
982 $params->{'from_address'}, # from_address
983 $params->{'reply_address'}, # reply_address
984 $params->{'letter'}->{'content-type'}, # content_type
985 $params->{'delivery_note'} || '', # delivery_note
987 return $dbh->last_insert_id(undef,undef,'message_queue', undef);
990 =head2 SendQueuedMessages ([$hashref])
992 my $sent = SendQueuedMessages({
993 letter_code => $letter_code,
994 borrowernumber => $who_letter_is_for,
1000 Sends all of the 'pending' items in the message queue, unless
1001 parameters are passed.
1003 The letter_code, borrowernumber and limit parameters are used
1004 to build a parameter set for _get_unsent_messages, thus limiting
1005 which pending messages will be processed. They are all optional.
1007 The verbose parameter can be used to generate debugging output.
1008 It is also optional.
1010 Returns number of messages sent.
1014 sub SendQueuedMessages {
1017 my $which_unsent_messages = {
1018 'message_id' => $params->{'message_id'},
1019 'limit' => $params->{'limit'} // 0,
1020 'borrowernumber' => $params->{'borrowernumber'} // q{},
1021 'letter_code' => $params->{'letter_code'} // q{},
1022 'type' => $params->{'type'} // q{},
1024 my $unsent_messages = _get_unsent_messages( $which_unsent_messages );
1025 MESSAGE: foreach my $message ( @$unsent_messages ) {
1026 my $message_object = Koha::Notice::Messages->find( $message->{message_id} );
1027 # If this fails the database is unwritable and we won't manage to send a message that continues to be marked 'pending'
1028 $message_object->make_column_dirty('status');
1029 return unless $message_object->store;
1031 # warn Data::Dumper->Dump( [ $message ], [ 'message' ] );
1032 warn sprintf( 'sending %s message to patron: %s',
1033 $message->{'message_transport_type'},
1034 $message->{'borrowernumber'} || 'Admin' )
1035 if $params->{'verbose'} or $debug;
1036 # This is just begging for subclassing
1037 next MESSAGE if ( lc($message->{'message_transport_type'}) eq 'rss' );
1038 if ( lc( $message->{'message_transport_type'} ) eq 'email' ) {
1039 _send_message_by_email( $message, $params->{'username'}, $params->{'password'}, $params->{'method'} );
1041 elsif ( lc( $message->{'message_transport_type'} ) eq 'sms' ) {
1042 if ( C4::Context->preference('SMSSendDriver') eq 'Email' ) {
1043 my $patron = Koha::Patrons->find( $message->{borrowernumber} );
1044 my $sms_provider = Koha::SMS::Providers->find( $patron->sms_provider_id );
1045 unless ( $sms_provider ) {
1046 warn sprintf( "Patron %s has no sms provider id set!", $message->{'borrowernumber'} ) if $params->{'verbose'} or $debug;
1047 _set_message_status( { message_id => $message->{'message_id'}, status => 'failed' } );
1050 unless ( $patron->smsalertnumber ) {
1051 _set_message_status( { message_id => $message->{'message_id'}, status => 'failed' } );
1052 warn sprintf( "No smsalertnumber found for patron %s!", $message->{'borrowernumber'} ) if $params->{'verbose'} or $debug;
1055 $message->{to_address} = $patron->smsalertnumber; #Sometime this is set to email - sms should always use smsalertnumber
1056 $message->{to_address} .= '@' . $sms_provider->domain();
1058 # Check for possible from_address override
1059 my $from_address = C4::Context->preference('EmailSMSSendDriverFromAddress');
1060 if ($from_address && $message->{from_address} ne $from_address) {
1061 $message->{from_address} = $from_address;
1062 _update_message_from_address($message->{'message_id'}, $message->{from_address});
1065 _update_message_to_address($message->{'message_id'}, $message->{to_address});
1066 _send_message_by_email( $message, $params->{'username'}, $params->{'password'}, $params->{'method'} );
1068 _send_message_by_sms( $message );
1072 return scalar( @$unsent_messages );
1075 =head2 GetRSSMessages
1077 my $message_list = GetRSSMessages( { limit => 10, borrowernumber => '14' } )
1079 returns a listref of all queued RSS messages for a particular person.
1083 sub GetRSSMessages {
1086 return unless $params;
1087 return unless ref $params;
1088 return unless $params->{'borrowernumber'};
1090 return _get_unsent_messages( { message_transport_type => 'rss',
1091 limit => $params->{'limit'},
1092 borrowernumber => $params->{'borrowernumber'}, } );
1095 =head2 GetPrintMessages
1097 my $message_list = GetPrintMessages( { borrowernumber => $borrowernumber } )
1099 Returns a arrayref of all queued print messages (optionally, for a particular
1104 sub GetPrintMessages {
1105 my $params = shift || {};
1107 return _get_unsent_messages( { message_transport_type => 'print',
1108 borrowernumber => $params->{'borrowernumber'},
1112 =head2 GetQueuedMessages ([$hashref])
1114 my $messages = GetQueuedMessage( { borrowernumber => '123', limit => 20 } );
1116 Fetches a list of messages from the message queue optionally filtered by borrowernumber
1117 and limited to specified limit.
1119 Return is an arrayref of hashes, each has represents a message in the message queue.
1123 sub GetQueuedMessages {
1126 my $dbh = C4::Context->dbh();
1127 my $statement = << 'ENDSQL';
1128 SELECT message_id, borrowernumber, subject, content, message_transport_type, status, time_queued, updated_on, delivery_note
1134 if ( exists $params->{'borrowernumber'} ) {
1135 push @whereclauses, ' borrowernumber = ? ';
1136 push @query_params, $params->{'borrowernumber'};
1139 if ( @whereclauses ) {
1140 $statement .= ' WHERE ' . join( 'AND', @whereclauses );
1143 if ( defined $params->{'limit'} ) {
1144 $statement .= ' LIMIT ? ';
1145 push @query_params, $params->{'limit'};
1148 my $sth = $dbh->prepare( $statement );
1149 my $result = $sth->execute( @query_params );
1150 return $sth->fetchall_arrayref({});
1153 =head2 GetMessageTransportTypes
1155 my @mtt = GetMessageTransportTypes();
1157 returns an arrayref of transport types
1161 sub GetMessageTransportTypes {
1162 my $dbh = C4::Context->dbh();
1163 my $mtts = $dbh->selectcol_arrayref("
1164 SELECT message_transport_type
1165 FROM message_transport_types
1166 ORDER BY message_transport_type
1173 my $message = C4::Letters::Message($message_id);
1178 my ( $message_id ) = @_;
1179 return unless $message_id;
1180 my $dbh = C4::Context->dbh;
1181 return $dbh->selectrow_hashref(q|
1182 SELECT message_id, borrowernumber, subject, content, metadata, letter_code, message_transport_type, status, time_queued, updated_on, to_address, from_address, reply_address, content_type, delivery_note
1184 WHERE message_id = ?
1185 |, {}, $message_id );
1188 =head2 ResendMessage
1190 Attempt to resend a message which has failed previously.
1192 my $has_been_resent = C4::Letters::ResendMessage($message_id);
1194 Updates the message to 'pending' status so that
1195 it will be resent later on.
1197 returns 1 on success, 0 on failure, undef if no message was found
1202 my $message_id = shift;
1203 return unless $message_id;
1205 my $message = GetMessage( $message_id );
1206 return unless $message;
1208 if ( $message->{status} ne 'pending' ) {
1209 $rv = C4::Letters::_set_message_status({
1210 message_id => $message_id,
1211 status => 'pending',
1213 $rv = $rv > 0? 1: 0;
1214 # Clear destination email address to force address update
1215 _update_message_to_address( $message_id, undef ) if $rv &&
1216 $message->{message_transport_type} eq 'email';
1221 =head2 _add_attachements
1224 letter - the standard letter hashref
1225 attachments - listref of attachments. each attachment is a hashref of:
1226 type - the mime type, like 'text/plain'
1227 content - the actual attachment
1228 filename - the name of the attachment.
1229 message - a MIME::Lite object to attach these to.
1231 returns your letter object, with the content updated.
1235 sub _add_attachments {
1238 my $letter = $params->{'letter'};
1239 my $attachments = $params->{'attachments'};
1240 return $letter unless @$attachments;
1241 my $message = $params->{'message'};
1243 # First, we have to put the body in as the first attachment
1245 Type => $letter->{'content-type'} || 'TEXT',
1246 Data => $letter->{'is_html'}
1247 ? _wrap_html($letter->{'content'}, $letter->{'title'})
1248 : $letter->{'content'},
1251 foreach my $attachment ( @$attachments ) {
1253 Type => $attachment->{'type'},
1254 Data => $attachment->{'content'},
1255 Filename => $attachment->{'filename'},
1258 # we're forcing list context here to get the header, not the count back from grep.
1259 ( $letter->{'content-type'} ) = grep( /^Content-Type:/, split( /\n/, $params->{'message'}->header_as_string ) );
1260 $letter->{'content-type'} =~ s/^Content-Type:\s+//;
1261 $letter->{'content'} = $message->body_as_string;
1267 =head2 _get_unsent_messages
1269 This function's parameter hash reference takes the following
1270 optional named parameters:
1271 message_transport_type: method of message sending (e.g. email, sms, etc.)
1272 borrowernumber : who the message is to be sent
1273 letter_code : type of message being sent (e.g. PASSWORD_RESET)
1274 message_id : the message_id of the message. In that case the sub will return only 1 result
1275 limit : maximum number of messages to send
1277 This function returns an array of matching hash referenced rows from
1278 message_queue with some borrower information added.
1282 sub _get_unsent_messages {
1285 my $dbh = C4::Context->dbh();
1287 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
1288 FROM message_queue mq
1289 LEFT JOIN borrowers b ON b.borrowernumber = mq.borrowernumber
1293 my @query_params = ('pending');
1294 if ( ref $params ) {
1295 if ( $params->{'message_transport_type'} ) {
1296 $statement .= ' AND mq.message_transport_type = ? ';
1297 push @query_params, $params->{'message_transport_type'};
1299 if ( $params->{'borrowernumber'} ) {
1300 $statement .= ' AND mq.borrowernumber = ? ';
1301 push @query_params, $params->{'borrowernumber'};
1303 if ( $params->{'letter_code'} ) {
1304 $statement .= ' AND mq.letter_code = ? ';
1305 push @query_params, $params->{'letter_code'};
1307 if ( $params->{'type'} ) {
1308 $statement .= ' AND message_transport_type = ? ';
1309 push @query_params, $params->{'type'};
1311 if ( $params->{message_id} ) {
1312 $statement .= ' AND message_id = ?';
1313 push @query_params, $params->{message_id};
1315 if ( $params->{'limit'} ) {
1316 $statement .= ' limit ? ';
1317 push @query_params, $params->{'limit'};
1321 $debug and warn "_get_unsent_messages SQL: $statement";
1322 $debug and warn "_get_unsent_messages params: " . join(',',@query_params);
1323 my $sth = $dbh->prepare( $statement );
1324 my $result = $sth->execute( @query_params );
1325 return $sth->fetchall_arrayref({});
1328 sub _send_message_by_email {
1329 my $message = shift or return;
1330 my ($username, $password, $method) = @_;
1332 my $patron = Koha::Patrons->find( $message->{borrowernumber} );
1333 my $to_address = $message->{'to_address'};
1334 unless ($to_address) {
1336 warn "FAIL: No 'to_address' and INVALID borrowernumber ($message->{borrowernumber})";
1337 _set_message_status( { message_id => $message->{'message_id'},
1339 delivery_note => 'Invalid borrowernumber '.$message->{borrowernumber},
1340 error_code => 'INVALID_BORNUMBER' } );
1343 $to_address = $patron->notice_email_address;
1344 unless ($to_address) {
1345 # warn "FAIL: No 'to_address' and no email for " . ($member->{surname} ||'') . ", borrowernumber ($message->{borrowernumber})";
1346 # warning too verbose for this more common case?
1347 _set_message_status( { message_id => $message->{'message_id'},
1349 delivery_note => 'Unable to find an email address for this borrower',
1350 error_code => 'NO_EMAIL' } );
1355 my $subject = $message->{'subject'};
1357 my $content = $message->{'content'};
1358 my $content_type = $message->{'content_type'} || 'text/plain; charset="UTF-8"';
1359 my $is_html = $content_type =~ m/html/io;
1361 my $branch_email = undef;
1362 my $branch_replyto = undef;
1363 my $branch_returnpath = undef;
1367 $library = $patron->library;
1368 $branch_email = $library->branchemail;
1369 $branch_replyto = $library->branchreplyto;
1370 $branch_returnpath = $library->branchreturnpath;
1373 my $email = Koha::Email->create(
1377 C4::Context->preference('NoticeBcc')
1378 ? ( bcc => C4::Context->preference('NoticeBcc') )
1381 from => $message->{'from_address'} || $branch_email,
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, $activethemes);
1551 my $htdocs = C4::Context->config('intrahtdocs');
1552 ($theme, $lang, $activethemes)= C4::Templates::activethemes( $htdocs, 'about.tt', 'intranet', $lang);
1554 foreach (@$activethemes) {
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";