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 }
542 . join( ',', @email )
547 ) if C4::Context->preference("LetterLog");
549 # send an "account details" notice to a newly created user
550 elsif ( $type eq 'members' ) {
551 my $library = Koha::Libraries->find( $externalid->{branchcode} );
552 my $letter = GetPreparedLetter (
554 letter_code => $letter_code,
555 branchcode => $externalid->{'branchcode'},
556 lang => $externalid->{lang} || 'default',
558 'branches' => $library->unblessed,
559 'borrowers' => $externalid->{'borrowernumber'},
561 substitute => { 'borrowers.password' => $externalid->{'password'} },
564 return { error => "no_email" } unless $externalid->{'emailaddr'};
568 # FIXME: This 'default' behaviour should be moved to Koha::Email
569 my $mail = Koha::Email->create(
571 to => $externalid->{'emailaddr'},
572 from => $library->branchemail,
573 reply_to => $library->branchreplyto,
574 sender => $library->branchreturnpath,
575 subject => "" . $letter->{'title'},
579 if ( $letter->{is_html} ) {
580 $mail->html_body( _wrap_html( $letter->{content}, "" . $letter->{title} ) );
583 $mail->text_body( $letter->{content} );
586 $mail->send_or_die({ transport => $library->smtp_server->transport });
589 # We expect ref($_) eq 'Email::Sender::Failure'
590 $error = $_->message;
596 return { error => $error }
600 # If we come here, return an OK status
604 =head2 GetPreparedLetter( %params )
607 module => letter module, mandatory
608 letter_code => letter code, mandatory
609 branchcode => for letter selection, if missing default system letter taken
610 tables => a hashref with table names as keys. Values are either:
611 - a scalar - primary key value
612 - an arrayref - primary key values
613 - a hashref - full record
614 substitute => custom substitution key/value pairs
615 repeat => records to be substituted on consecutive lines:
616 - an arrayref - tries to guess what needs substituting by
617 taking remaining << >> tokensr; not recommended
618 - a hashref token => @tables - replaces <token> << >> << >> </token>
619 subtemplate for each @tables row; table is a hashref as above
620 want_librarian => boolean, if set to true triggers librarian details
621 substitution from the userenv
623 letter fields hashref (title & content useful)
627 sub GetPreparedLetter {
630 my $letter = $params{letter};
631 my $lang = $params{lang} || 'default';
634 my $module = $params{module} or croak "No module";
635 my $letter_code = $params{letter_code} or croak "No letter_code";
636 my $branchcode = $params{branchcode} || '';
637 my $mtt = $params{message_transport_type} || 'email';
639 $letter = getletter( $module, $letter_code, $branchcode, $mtt, $lang );
642 $letter = getletter( $module, $letter_code, $branchcode, $mtt, 'default' )
643 or warn( "No $module $letter_code letter transported by " . $mtt ),
648 my $tables = $params{tables} || {};
649 my $substitute = $params{substitute} || {};
650 my $loops = $params{loops} || {}; # loops is not supported for historical notices syntax
651 my $repeat = $params{repeat};
652 %$tables || %$substitute || $repeat || %$loops
653 or carp( "ERROR: nothing to substitute - both 'tables', 'loops' and 'substitute' are empty" ),
655 my $want_librarian = $params{want_librarian};
658 while ( my ($token, $val) = each %$substitute ) {
659 if ( $token eq 'items.content' ) {
660 $val =~ s|\n|<br/>|g if $letter->{is_html};
663 $letter->{title} =~ s/<<$token>>/$val/g;
664 $letter->{content} =~ s/<<$token>>/$val/g;
668 my $OPACBaseURL = C4::Context->preference('OPACBaseURL');
669 $letter->{content} =~ s/<<OPACBaseURL>>/$OPACBaseURL/go;
671 if ($want_librarian) {
672 # parsing librarian name
673 my $userenv = C4::Context->userenv;
674 $letter->{content} =~ s/<<LibrarianFirstname>>/$userenv->{firstname}/go;
675 $letter->{content} =~ s/<<LibrarianSurname>>/$userenv->{surname}/go;
676 $letter->{content} =~ s/<<LibrarianEmailaddress>>/$userenv->{emailaddress}/go;
679 my ($repeat_no_enclosing_tags, $repeat_enclosing_tags);
682 if (ref ($repeat) eq 'ARRAY' ) {
683 $repeat_no_enclosing_tags = $repeat;
685 $repeat_enclosing_tags = $repeat;
689 if ($repeat_enclosing_tags) {
690 while ( my ($tag, $tag_tables) = each %$repeat_enclosing_tags ) {
691 if ( $letter->{content} =~ m!<$tag>(.*)</$tag>!s ) {
694 my %subletter = ( title => '', content => $subcontent );
695 _substitute_tables( \%subletter, $_ );
698 $letter->{content} =~ s!<$tag>.*</$tag>!join( "\n", @lines )!se;
704 _substitute_tables( $letter, $tables );
707 if ($repeat_no_enclosing_tags) {
708 if ( $letter->{content} =~ m/[^\n]*<<.*>>[^\n]*/so ) {
713 $c =~ s/<<count>>/$i/go;
714 foreach my $field ( keys %{$_} ) {
715 $c =~ s/(<<[^\.]+.$field>>)/$_->{$field}/;
719 } @$repeat_no_enclosing_tags;
721 my $replaceby = join( "\n", @lines );
722 $letter->{content} =~ s/\Q$line\E/$replaceby/s;
726 $letter->{content} = _process_tt(
728 content => $letter->{content},
731 substitute => $substitute,
736 $letter->{title} = _process_tt(
738 content => $letter->{title},
741 substitute => $substitute,
745 $letter->{content} =~ s/<<\S*>>//go; #remove any stragglers
750 sub _substitute_tables {
751 my ( $letter, $tables ) = @_;
752 while ( my ($table, $param) = each %$tables ) {
755 my $ref = ref $param;
758 if ($ref && $ref eq 'HASH') {
762 my $sth = _parseletter_sth($table);
764 warn "_parseletter_sth('$table') failed to return a valid sth. No substitution will be done for that table.";
767 $sth->execute( $ref ? @$param : $param );
769 $values = $sth->fetchrow_hashref;
773 _parseletter ( $letter, $table, $values );
777 sub _parseletter_sth {
781 carp "ERROR: _parseletter_sth() called without argument (table)";
784 # NOTE: we used to check whether we had a statement handle cached in
785 # a %handles module-level variable. This was a dumb move and
786 # broke things for the rest of us. prepare_cached is a better
787 # way to cache statement handles anyway.
789 ($table eq 'accountlines' ) ? "SELECT * FROM $table WHERE accountlines_id = ?" :
790 ($table eq 'biblio' ) ? "SELECT * FROM $table WHERE biblionumber = ?" :
791 ($table eq 'biblioitems' ) ? "SELECT * FROM $table WHERE biblionumber = ?" :
792 ($table eq 'credits' ) ? "SELECT * FROM accountlines WHERE accountlines_id = ?" :
793 ($table eq 'debits' ) ? "SELECT * FROM accountlines WHERE accountlines_id = ?" :
794 ($table eq 'items' ) ? "SELECT * FROM $table WHERE itemnumber = ?" :
795 ($table eq 'issues' ) ? "SELECT * FROM $table WHERE itemnumber = ?" :
796 ($table eq 'old_issues' ) ? "SELECT * FROM $table WHERE itemnumber = ? ORDER BY timestamp DESC LIMIT 1" :
797 ($table eq 'reserves' ) ? "SELECT * FROM $table WHERE borrowernumber = ? and biblionumber = ?" :
798 ($table eq 'borrowers' ) ? "SELECT * FROM $table WHERE borrowernumber = ?" :
799 ($table eq 'branches' ) ? "SELECT * FROM $table WHERE branchcode = ?" :
800 ($table eq 'suggestions' ) ? "SELECT * FROM $table WHERE suggestionid = ?" :
801 ($table eq 'aqbooksellers') ? "SELECT * FROM $table WHERE id = ?" :
802 ($table eq 'aqorders' ) ? "SELECT * FROM $table WHERE ordernumber = ?" :
803 ($table eq 'aqbasket' ) ? "SELECT * FROM $table WHERE basketno = ?" :
804 ($table eq 'illrequests' ) ? "SELECT * FROM $table WHERE illrequest_id = ?" :
805 ($table eq 'opac_news' ) ? "SELECT * FROM $table WHERE idnew = ?" :
806 ($table eq 'article_requests') ? "SELECT * FROM $table WHERE id = ?" :
807 ($table eq 'borrower_modifications') ? "SELECT * FROM $table WHERE verification_token = ?" :
808 ($table eq 'subscription') ? "SELECT * FROM $table WHERE subscriptionid = ?" :
809 ($table eq 'serial') ? "SELECT * FROM $table WHERE serialid = ?" :
810 ($table eq 'problem_reports') ? "SELECT * FROM $table WHERE reportid = ?" :
813 warn "ERROR: No _parseletter_sth query for table '$table'";
814 return; # nothing to get
816 unless ($sth = C4::Context->dbh->prepare_cached($query)) {
817 warn "ERROR: Failed to prepare query: '$query'";
820 return $sth; # now cache is populated for that $table
823 =head2 _parseletter($letter, $table, $values)
826 - $letter : a hash to letter fields (title & content useful)
827 - $table : the Koha table to parse.
828 - $values_in : table record hashref
829 parse all fields from a table, and replace values in title & content with the appropriate value
830 (not exported sub, used only internally)
835 my ( $letter, $table, $values_in ) = @_;
837 # Work on a local copy of $values_in (passed by reference) to avoid side effects
838 # in callers ( by changing / formatting values )
839 my $values = $values_in ? { %$values_in } : {};
841 if ( $table eq 'borrowers' && $values->{'dateexpiry'} ){
842 $values->{'dateexpiry'} = output_pref({ dt => dt_from_string( $values->{'dateexpiry'} ), dateonly => 1 });
845 if ( $table eq 'reserves' && $values->{'waitingdate'} ) {
846 $values->{'waitingdate'} = output_pref({ dt => dt_from_string( $values->{'waitingdate'} ), dateonly => 1 });
849 if ($letter->{content} && $letter->{content} =~ /<<today>>/) {
850 my $todaysdate = output_pref( dt_from_string() );
851 $letter->{content} =~ s/<<today>>/$todaysdate/go;
854 while ( my ($field, $val) = each %$values ) {
855 $val =~ s/\p{P}$// if $val && $table=~/biblio/;
856 #BZ 9886: Assuming that we want to eliminate ISBD punctuation here
857 #Therefore adding the test on biblio. This includes biblioitems,
858 #but excludes items. Removed unneeded global and lookahead.
860 if ( $table=~/^borrowers$/ && $field=~/^streettype$/ ) {
861 my $av = Koha::AuthorisedValues->search({ category => 'ROADTYPE', authorised_value => $val });
862 $val = $av->count ? $av->next->lib : '';
866 my $replacedby = defined ($val) ? $val : '';
868 and not $replacedby =~ m|9999-12-31|
869 and $replacedby =~ m|^\d{4}-\d{2}-\d{2}( \d{2}:\d{2}:\d{2})?$| )
871 # If the value is XXXX-YY-ZZ[ AA:BB:CC] we assume it is a date
872 my $dateonly = defined $1 ? 0 : 1; #$1 refers to the capture group wrapped in parentheses. In this case, that's the hours, minutes, seconds.
873 my $re_dateonly_filter = qr{ $field( \s* \| \s* dateonly\s*)?>> }xms;
875 for my $letter_field ( qw( title content ) ) {
876 my $filter_string_used = q{};
877 if ( $letter->{ $letter_field } =~ $re_dateonly_filter ) {
878 # We overwrite $dateonly if the filter exists and we have a time in the datetime
879 $filter_string_used = $1 || q{};
880 $dateonly = $1 unless $dateonly;
882 my $replacedby_date = eval {
883 output_pref({ dt => dt_from_string( $replacedby ), dateonly => $dateonly });
886 if ( $letter->{ $letter_field } ) {
887 $letter->{ $letter_field } =~ s/\Q<<$table.$field$filter_string_used>>\E/$replacedby_date/g;
888 $letter->{ $letter_field } =~ s/\Q<<$field$filter_string_used>>\E/$replacedby_date/g;
892 # Other fields replacement
894 for my $letter_field ( qw( title content ) ) {
895 if ( $letter->{ $letter_field } ) {
896 $letter->{ $letter_field } =~ s/<<$table.$field>>/$replacedby/g;
897 $letter->{ $letter_field } =~ s/<<$field>>/$replacedby/g;
903 if ($table eq 'borrowers' && $letter->{content}) {
904 my $patron = Koha::Patrons->find( $values->{borrowernumber} );
906 my $attributes = $patron->extended_attributes;
908 while ( my $attribute = $attributes->next ) {
909 my $code = $attribute->code;
910 my $val = $attribute->description; # FIXME - we always display intranet description here!
911 $val =~ s/\p{P}(?=$)//g if $val;
912 next unless $val gt '';
914 push @{ $attr{$code} }, $val;
916 while ( my ($code, $val_ar) = each %attr ) {
917 my $replacefield = "<<borrower-attribute:$code>>";
918 my $replacedby = join ',', @$val_ar;
919 $letter->{content} =~ s/$replacefield/$replacedby/g;
928 my $success = EnqueueLetter( { letter => $letter,
929 borrowernumber => '12', message_transport_type => 'email' } )
931 places a letter in the message_queue database table, which will
932 eventually get processed (sent) by the process_message_queue.pl
933 cronjob when it calls SendQueuedMessages.
935 return message_id on success
940 my $params = shift or return;
942 return unless exists $params->{'letter'};
943 # return unless exists $params->{'borrowernumber'};
944 return unless exists $params->{'message_transport_type'};
946 my $content = $params->{letter}->{content};
947 $content =~ s/\s+//g if(defined $content);
948 if ( not defined $content or $content eq '' ) {
949 warn "Trying to add an empty message to the message queue" if $debug;
953 # If we have any attachments we should encode then into the body.
954 if ( $params->{'attachments'} ) {
955 $params->{'letter'} = _add_attachments(
956 { letter => $params->{'letter'},
957 attachments => $params->{'attachments'},
958 message => MIME::Lite->new( Type => 'multipart/mixed' ),
963 my $dbh = C4::Context->dbh();
964 my $statement = << 'ENDSQL';
965 INSERT INTO message_queue
966 ( borrowernumber, subject, content, metadata, letter_code, message_transport_type, status, time_queued, to_address, from_address, reply_address, content_type, delivery_note )
968 ( ?, ?, ?, ?, ?, ?, ?, CAST(NOW() AS DATE), ?, ?, ?, ?, ? )
971 my $sth = $dbh->prepare($statement);
972 my $result = $sth->execute(
973 $params->{'borrowernumber'}, # borrowernumber
974 $params->{'letter'}->{'title'}, # subject
975 $params->{'letter'}->{'content'}, # content
976 $params->{'letter'}->{'metadata'} || '', # metadata
977 $params->{'letter'}->{'code'} || '', # letter_code
978 $params->{'message_transport_type'}, # message_transport_type
980 $params->{'to_address'}, # to_address
981 $params->{'from_address'}, # from_address
982 $params->{'reply_address'}, # reply_address
983 $params->{'letter'}->{'content-type'}, # content_type
984 $params->{'delivery_note'} || '', # delivery_note
986 return $dbh->last_insert_id(undef,undef,'message_queue', undef);
989 =head2 SendQueuedMessages ([$hashref])
991 my $sent = SendQueuedMessages({
992 letter_code => $letter_code,
993 borrowernumber => $who_letter_is_for,
999 Sends all of the 'pending' items in the message queue, unless
1000 parameters are passed.
1002 The letter_code, borrowernumber and limit parameters are used
1003 to build a parameter set for _get_unsent_messages, thus limiting
1004 which pending messages will be processed. They are all optional.
1006 The verbose parameter can be used to generate debugging output.
1007 It is also optional.
1009 Returns number of messages sent.
1013 sub SendQueuedMessages {
1016 my $which_unsent_messages = {
1017 'message_id' => $params->{'message_id'},
1018 'limit' => $params->{'limit'} // 0,
1019 'borrowernumber' => $params->{'borrowernumber'} // q{},
1020 'letter_code' => $params->{'letter_code'} // q{},
1021 'type' => $params->{'type'} // q{},
1023 my $unsent_messages = _get_unsent_messages( $which_unsent_messages );
1024 MESSAGE: foreach my $message ( @$unsent_messages ) {
1025 my $message_object = Koha::Notice::Messages->find( $message->{message_id} );
1026 # If this fails the database is unwritable and we won't manage to send a message that continues to be marked 'pending'
1027 $message_object->make_column_dirty('status');
1028 return unless $message_object->store;
1030 # warn Data::Dumper->Dump( [ $message ], [ 'message' ] );
1031 warn sprintf( 'sending %s message to patron: %s',
1032 $message->{'message_transport_type'},
1033 $message->{'borrowernumber'} || 'Admin' )
1034 if $params->{'verbose'} or $debug;
1035 # This is just begging for subclassing
1036 next MESSAGE if ( lc($message->{'message_transport_type'}) eq 'rss' );
1037 if ( lc( $message->{'message_transport_type'} ) eq 'email' ) {
1038 _send_message_by_email( $message, $params->{'username'}, $params->{'password'}, $params->{'method'} );
1040 elsif ( lc( $message->{'message_transport_type'} ) eq 'sms' ) {
1041 if ( C4::Context->preference('SMSSendDriver') eq 'Email' ) {
1042 my $patron = Koha::Patrons->find( $message->{borrowernumber} );
1043 my $sms_provider = Koha::SMS::Providers->find( $patron->sms_provider_id );
1044 unless ( $sms_provider ) {
1045 warn sprintf( "Patron %s has no sms provider id set!", $message->{'borrowernumber'} ) if $params->{'verbose'} or $debug;
1046 _set_message_status( { message_id => $message->{'message_id'}, status => 'failed' } );
1049 unless ( $patron->smsalertnumber ) {
1050 _set_message_status( { message_id => $message->{'message_id'}, status => 'failed' } );
1051 warn sprintf( "No smsalertnumber found for patron %s!", $message->{'borrowernumber'} ) if $params->{'verbose'} or $debug;
1054 $message->{to_address} = $patron->smsalertnumber; #Sometime this is set to email - sms should always use smsalertnumber
1055 $message->{to_address} .= '@' . $sms_provider->domain();
1057 # Check for possible from_address override
1058 my $from_address = C4::Context->preference('EmailSMSSendDriverFromAddress');
1059 if ($from_address && $message->{from_address} ne $from_address) {
1060 $message->{from_address} = $from_address;
1061 _update_message_from_address($message->{'message_id'}, $message->{from_address});
1064 _update_message_to_address($message->{'message_id'}, $message->{to_address});
1065 _send_message_by_email( $message, $params->{'username'}, $params->{'password'}, $params->{'method'} );
1067 _send_message_by_sms( $message );
1071 return scalar( @$unsent_messages );
1074 =head2 GetRSSMessages
1076 my $message_list = GetRSSMessages( { limit => 10, borrowernumber => '14' } )
1078 returns a listref of all queued RSS messages for a particular person.
1082 sub GetRSSMessages {
1085 return unless $params;
1086 return unless ref $params;
1087 return unless $params->{'borrowernumber'};
1089 return _get_unsent_messages( { message_transport_type => 'rss',
1090 limit => $params->{'limit'},
1091 borrowernumber => $params->{'borrowernumber'}, } );
1094 =head2 GetPrintMessages
1096 my $message_list = GetPrintMessages( { borrowernumber => $borrowernumber } )
1098 Returns a arrayref of all queued print messages (optionally, for a particular
1103 sub GetPrintMessages {
1104 my $params = shift || {};
1106 return _get_unsent_messages( { message_transport_type => 'print',
1107 borrowernumber => $params->{'borrowernumber'},
1111 =head2 GetQueuedMessages ([$hashref])
1113 my $messages = GetQueuedMessage( { borrowernumber => '123', limit => 20 } );
1115 Fetches a list of messages from the message queue optionally filtered by borrowernumber
1116 and limited to specified limit.
1118 Return is an arrayref of hashes, each has represents a message in the message queue.
1122 sub GetQueuedMessages {
1125 my $dbh = C4::Context->dbh();
1126 my $statement = << 'ENDSQL';
1127 SELECT message_id, borrowernumber, subject, content, message_transport_type, status, time_queued, updated_on, delivery_note
1133 if ( exists $params->{'borrowernumber'} ) {
1134 push @whereclauses, ' borrowernumber = ? ';
1135 push @query_params, $params->{'borrowernumber'};
1138 if ( @whereclauses ) {
1139 $statement .= ' WHERE ' . join( 'AND', @whereclauses );
1142 if ( defined $params->{'limit'} ) {
1143 $statement .= ' LIMIT ? ';
1144 push @query_params, $params->{'limit'};
1147 my $sth = $dbh->prepare( $statement );
1148 my $result = $sth->execute( @query_params );
1149 return $sth->fetchall_arrayref({});
1152 =head2 GetMessageTransportTypes
1154 my @mtt = GetMessageTransportTypes();
1156 returns an arrayref of transport types
1160 sub GetMessageTransportTypes {
1161 my $dbh = C4::Context->dbh();
1162 my $mtts = $dbh->selectcol_arrayref("
1163 SELECT message_transport_type
1164 FROM message_transport_types
1165 ORDER BY message_transport_type
1172 my $message = C4::Letters::Message($message_id);
1177 my ( $message_id ) = @_;
1178 return unless $message_id;
1179 my $dbh = C4::Context->dbh;
1180 return $dbh->selectrow_hashref(q|
1181 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
1183 WHERE message_id = ?
1184 |, {}, $message_id );
1187 =head2 ResendMessage
1189 Attempt to resend a message which has failed previously.
1191 my $has_been_resent = C4::Letters::ResendMessage($message_id);
1193 Updates the message to 'pending' status so that
1194 it will be resent later on.
1196 returns 1 on success, 0 on failure, undef if no message was found
1201 my $message_id = shift;
1202 return unless $message_id;
1204 my $message = GetMessage( $message_id );
1205 return unless $message;
1207 if ( $message->{status} ne 'pending' ) {
1208 $rv = C4::Letters::_set_message_status({
1209 message_id => $message_id,
1210 status => 'pending',
1212 $rv = $rv > 0? 1: 0;
1213 # Clear destination email address to force address update
1214 _update_message_to_address( $message_id, undef ) if $rv &&
1215 $message->{message_transport_type} eq 'email';
1220 =head2 _add_attachements
1223 letter - the standard letter hashref
1224 attachments - listref of attachments. each attachment is a hashref of:
1225 type - the mime type, like 'text/plain'
1226 content - the actual attachment
1227 filename - the name of the attachment.
1228 message - a MIME::Lite object to attach these to.
1230 returns your letter object, with the content updated.
1234 sub _add_attachments {
1237 my $letter = $params->{'letter'};
1238 my $attachments = $params->{'attachments'};
1239 return $letter unless @$attachments;
1240 my $message = $params->{'message'};
1242 # First, we have to put the body in as the first attachment
1244 Type => $letter->{'content-type'} || 'TEXT',
1245 Data => $letter->{'is_html'}
1246 ? _wrap_html($letter->{'content'}, $letter->{'title'})
1247 : $letter->{'content'},
1250 foreach my $attachment ( @$attachments ) {
1252 Type => $attachment->{'type'},
1253 Data => $attachment->{'content'},
1254 Filename => $attachment->{'filename'},
1257 # we're forcing list context here to get the header, not the count back from grep.
1258 ( $letter->{'content-type'} ) = grep( /^Content-Type:/, split( /\n/, $params->{'message'}->header_as_string ) );
1259 $letter->{'content-type'} =~ s/^Content-Type:\s+//;
1260 $letter->{'content'} = $message->body_as_string;
1266 =head2 _get_unsent_messages
1268 This function's parameter hash reference takes the following
1269 optional named parameters:
1270 message_transport_type: method of message sending (e.g. email, sms, etc.)
1271 borrowernumber : who the message is to be sent
1272 letter_code : type of message being sent (e.g. PASSWORD_RESET)
1273 message_id : the message_id of the message. In that case the sub will return only 1 result
1274 limit : maximum number of messages to send
1276 This function returns an array of matching hash referenced rows from
1277 message_queue with some borrower information added.
1281 sub _get_unsent_messages {
1284 my $dbh = C4::Context->dbh();
1286 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
1287 FROM message_queue mq
1288 LEFT JOIN borrowers b ON b.borrowernumber = mq.borrowernumber
1292 my @query_params = ('pending');
1293 if ( ref $params ) {
1294 if ( $params->{'message_transport_type'} ) {
1295 $statement .= ' AND mq.message_transport_type = ? ';
1296 push @query_params, $params->{'message_transport_type'};
1298 if ( $params->{'borrowernumber'} ) {
1299 $statement .= ' AND mq.borrowernumber = ? ';
1300 push @query_params, $params->{'borrowernumber'};
1302 if ( $params->{'letter_code'} ) {
1303 $statement .= ' AND mq.letter_code = ? ';
1304 push @query_params, $params->{'letter_code'};
1306 if ( $params->{'type'} ) {
1307 $statement .= ' AND message_transport_type = ? ';
1308 push @query_params, $params->{'type'};
1310 if ( $params->{message_id} ) {
1311 $statement .= ' AND message_id = ?';
1312 push @query_params, $params->{message_id};
1314 if ( $params->{'limit'} ) {
1315 $statement .= ' limit ? ';
1316 push @query_params, $params->{'limit'};
1320 $debug and warn "_get_unsent_messages SQL: $statement";
1321 $debug and warn "_get_unsent_messages params: " . join(',',@query_params);
1322 my $sth = $dbh->prepare( $statement );
1323 my $result = $sth->execute( @query_params );
1324 return $sth->fetchall_arrayref({});
1327 sub _send_message_by_email {
1328 my $message = shift or return;
1329 my ($username, $password, $method) = @_;
1331 my $patron = Koha::Patrons->find( $message->{borrowernumber} );
1332 my $to_address = $message->{'to_address'};
1333 unless ($to_address) {
1335 warn "FAIL: No 'to_address' and INVALID borrowernumber ($message->{borrowernumber})";
1336 _set_message_status( { message_id => $message->{'message_id'},
1338 delivery_note => 'Invalid borrowernumber '.$message->{borrowernumber} } );
1341 $to_address = $patron->notice_email_address;
1342 unless ($to_address) {
1343 # warn "FAIL: No 'to_address' and no email for " . ($member->{surname} ||'') . ", borrowernumber ($message->{borrowernumber})";
1344 # warning too verbose for this more common case?
1345 _set_message_status( { message_id => $message->{'message_id'},
1347 delivery_note => 'Unable to find an email address for this borrower' } );
1352 my $subject = $message->{'subject'};
1354 my $content = $message->{'content'};
1355 my $content_type = $message->{'content_type'} || 'text/plain; charset="UTF-8"';
1356 my $is_html = $content_type =~ m/html/io;
1358 my $branch_email = undef;
1359 my $branch_replyto = undef;
1360 my $branch_returnpath = undef;
1364 $library = $patron->library;
1365 $branch_email = $library->branchemail;
1366 $branch_replyto = $library->branchreplyto;
1367 $branch_returnpath = $library->branchreturnpath;
1370 my $email = Koha::Email->create(
1374 C4::Context->preference('NoticeBcc')
1375 ? ( bcc => C4::Context->preference('NoticeBcc') )
1378 from => $message->{'from_address'} || $branch_email,
1379 reply_to => $message->{'reply_address'} || $branch_replyto,
1380 sender => $branch_returnpath,
1381 subject => "" . $message->{subject}
1387 _wrap_html( $content, $subject )
1391 $email->text_body( $content );
1396 $smtp_server = $library->smtp_server;
1399 $smtp_server = Koha::SMTP::Servers->get_default;
1405 sasl_username => $username,
1406 sasl_password => $password,
1411 # if initial message address was empty, coming here means that a to address was found and
1412 # queue should be updated; same if to address was overriden by Koha::Email->create
1413 _update_message_to_address( $message->{'message_id'}, $email->email->header('To') )
1414 if !$message->{to_address}
1415 || $message->{to_address} ne $email->email->header('To');
1418 $email->send_or_die({ transport => $smtp_server->transport });
1420 _set_message_status(
1422 message_id => $message->{'message_id'},
1430 _set_message_status(
1432 message_id => $message->{'message_id'},
1434 delivery_note => $Mail::Sendmail::error
1443 my ($content, $title) = @_;
1445 my $css = C4::Context->preference("NoticeCSS") || '';
1446 $css = qq{<link rel="stylesheet" type="text/css" href="$css">} if $css;
1448 <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
1449 "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
1450 <html lang="en" xml:lang="en" xmlns="http://www.w3.org/1999/xhtml">
1452 <title>$title</title>
1453 <meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
1464 my ( $message ) = @_;
1465 my $dbh = C4::Context->dbh;
1466 my $count = $dbh->selectrow_array(q|
1469 WHERE message_transport_type = ?
1470 AND borrowernumber = ?
1472 AND CAST(updated_on AS date) = CAST(NOW() AS date)
1475 |, {}, $message->{message_transport_type}, $message->{borrowernumber}, $message->{letter_code}, $message->{content} );
1479 sub _send_message_by_sms {
1480 my $message = shift or return;
1481 my $patron = Koha::Patrons->find( $message->{borrowernumber} );
1483 unless ( $patron and $patron->smsalertnumber ) {
1484 _set_message_status( { message_id => $message->{'message_id'},
1486 delivery_note => 'Missing SMS number' } );
1490 if ( _is_duplicate( $message ) ) {
1491 _set_message_status( { message_id => $message->{'message_id'},
1493 delivery_note => 'Message is duplicate' } );
1497 my $success = C4::SMS->send_sms( { destination => $patron->smsalertnumber,
1498 message => $message->{'content'},
1500 _set_message_status( { message_id => $message->{'message_id'},
1501 status => ($success ? 'sent' : 'failed'),
1502 delivery_note => ($success ? '' : 'No notes from SMS driver') } );
1507 sub _update_message_to_address {
1509 my $dbh = C4::Context->dbh();
1510 $dbh->do('UPDATE message_queue SET to_address=? WHERE message_id=?',undef,($to,$id));
1513 sub _update_message_from_address {
1514 my ($message_id, $from_address) = @_;
1515 my $dbh = C4::Context->dbh();
1516 $dbh->do('UPDATE message_queue SET from_address = ? WHERE message_id = ?', undef, ($from_address, $message_id));
1519 sub _set_message_status {
1520 my $params = shift or return;
1522 foreach my $required_parameter ( qw( message_id status ) ) {
1523 return unless exists $params->{ $required_parameter };
1526 my $dbh = C4::Context->dbh();
1527 my $statement = 'UPDATE message_queue SET status= ?, delivery_note= ? WHERE message_id = ?';
1528 my $sth = $dbh->prepare( $statement );
1529 my $result = $sth->execute( $params->{'status'},
1530 $params->{'delivery_note'} || '',
1531 $params->{'message_id'} );
1536 my ( $params ) = @_;
1538 my $content = $params->{content};
1539 my $tables = $params->{tables};
1540 my $loops = $params->{loops};
1541 my $substitute = $params->{substitute} || {};
1542 my $lang = defined($params->{lang}) && $params->{lang} ne 'default' ? $params->{lang} : 'en';
1543 my ($theme, $activethemes);
1545 my $htdocs = C4::Context->config('intrahtdocs');
1546 ($theme, $lang, $activethemes)= C4::Templates::activethemes( $htdocs, 'about.tt', 'intranet', $lang);
1548 foreach (@$activethemes) {
1549 push @includes, "$htdocs/$_/$lang/includes";
1550 push @includes, "$htdocs/$_/en/includes" unless $lang eq 'en';
1553 my $use_template_cache = C4::Context->config('template_cache_dir') && defined $ENV{GATEWAY_INTERFACE};
1554 my $template = Template->new(
1558 PLUGIN_BASE => 'Koha::Template::Plugin',
1559 COMPILE_EXT => $use_template_cache ? '.ttc' : '',
1560 COMPILE_DIR => $use_template_cache ? C4::Context->config('template_cache_dir') : '',
1561 INCLUDE_PATH => \@includes,
1563 ENCODING => 'UTF-8',
1565 ) or die Template->error();
1567 my $tt_params = { %{ _get_tt_params( $tables ) }, %{ _get_tt_params( $loops, 'is_a_loop' ) }, %$substitute };
1569 $content = add_tt_filters( $content );
1570 $content = qq|[% USE KohaDates %][% USE Remove_MARC_punctuation %]$content|;
1573 $template->process( \$content, $tt_params, \$output ) || croak "ERROR PROCESSING TEMPLATE: " . $template->error();
1578 sub _get_tt_params {
1579 my ($tables, $is_a_loop) = @_;
1585 article_requests => {
1586 module => 'Koha::ArticleRequests',
1587 singular => 'article_request',
1588 plural => 'article_requests',
1592 module => 'Koha::Acquisition::Baskets',
1593 singular => 'basket',
1594 plural => 'baskets',
1598 module => 'Koha::Biblios',
1599 singular => 'biblio',
1600 plural => 'biblios',
1601 pk => 'biblionumber',
1604 module => 'Koha::Biblioitems',
1605 singular => 'biblioitem',
1606 plural => 'biblioitems',
1607 pk => 'biblioitemnumber',
1610 module => 'Koha::Patrons',
1611 singular => 'borrower',
1612 plural => 'borrowers',
1613 pk => 'borrowernumber',
1616 module => 'Koha::Libraries',
1617 singular => 'branch',
1618 plural => 'branches',
1622 module => 'Koha::Account::Lines',
1623 singular => 'credit',
1624 plural => 'credits',
1625 pk => 'accountlines_id',
1628 module => 'Koha::Account::Lines',
1629 singular => 'debit',
1631 pk => 'accountlines_id',
1634 module => 'Koha::Items',
1640 module => 'Koha::News',
1646 module => 'Koha::Acquisition::Orders',
1647 singular => 'order',
1649 pk => 'ordernumber',
1652 module => 'Koha::Holds',
1658 module => 'Koha::Serials',
1659 singular => 'serial',
1660 plural => 'serials',
1664 module => 'Koha::Subscriptions',
1665 singular => 'subscription',
1666 plural => 'subscriptions',
1667 pk => 'subscriptionid',
1670 module => 'Koha::Suggestions',
1671 singular => 'suggestion',
1672 plural => 'suggestions',
1673 pk => 'suggestionid',
1676 module => 'Koha::Checkouts',
1677 singular => 'checkout',
1678 plural => 'checkouts',
1682 module => 'Koha::Old::Checkouts',
1683 singular => 'old_checkout',
1684 plural => 'old_checkouts',
1688 module => 'Koha::Checkouts',
1689 singular => 'overdue',
1690 plural => 'overdues',
1693 borrower_modifications => {
1694 module => 'Koha::Patron::Modifications',
1695 singular => 'patron_modification',
1696 plural => 'patron_modifications',
1697 fk => 'verification_token',
1700 module => 'Koha::Illrequests',
1701 singular => 'illrequest',
1702 plural => 'illrequests',
1703 pk => 'illrequest_id'
1707 foreach my $table ( keys %$tables ) {
1708 next unless $config->{$table};
1710 my $ref = ref( $tables->{$table} ) || q{};
1711 my $module = $config->{$table}->{module};
1713 if ( can_load( modules => { $module => undef } ) ) {
1714 my $pk = $config->{$table}->{pk};
1715 my $fk = $config->{$table}->{fk};
1718 my $values = $tables->{$table} || [];
1719 unless ( ref( $values ) eq 'ARRAY' ) {
1720 croak "ERROR processing table $table. Wrong API call.";
1722 my $key = $pk ? $pk : $fk;
1723 # $key does not come from user input
1724 my $objects = $module->search(
1725 { $key => $values },
1727 # We want to retrieve the data in the same order
1729 # field is a MySQLism, but they are no other way to do it
1730 # To be generic we could do it in perl, but we will need to fetch
1731 # all the data then order them
1732 @$values ? ( order_by => \[ "field($key, " . join( ', ', @$values ) . ")" ] ) : ()
1735 $params->{ $config->{$table}->{plural} } = $objects;
1737 elsif ( $ref eq q{} || $ref eq 'HASH' ) {
1738 my $id = ref $ref eq 'HASH' ? $tables->{$table}->{$pk} : $tables->{$table};
1740 if ( $fk ) { # Using a foreign key for lookup
1741 if ( ref( $fk ) eq 'ARRAY' ) { # Foreign key is multi-column
1743 foreach my $key ( @$fk ) {
1744 $search->{$key} = $id->{$key};
1746 $object = $module->search( $search )->last();
1747 } else { # Foreign key is single column
1748 $object = $module->search( { $fk => $id } )->last();
1750 } else { # using the table's primary key for lookup
1751 $object = $module->find($id);
1753 $params->{ $config->{$table}->{singular} } = $object;
1755 else { # $ref eq 'ARRAY'
1757 if ( @{ $tables->{$table} } == 1 ) { # Param is a single key
1758 $object = $module->search( { $pk => $tables->{$table} } )->last();
1760 else { # Params are mutliple foreign keys
1761 croak "Multiple foreign keys (table $table) should be passed using an hashref";
1763 $params->{ $config->{$table}->{singular} } = $object;
1767 croak "ERROR LOADING MODULE $module: $Module::Load::Conditional::ERROR";
1771 $params->{today} = output_pref({ dt => dt_from_string, dateformat => 'iso' });
1776 =head3 add_tt_filters
1778 $content = add_tt_filters( $content );
1780 Add TT filters to some specific fields if needed.
1782 For now we only add the Remove_MARC_punctuation TT filter to biblio and biblioitem fields
1786 sub add_tt_filters {
1787 my ( $content ) = @_;
1788 $content =~ s|\[%\s*biblio\.(.*?)\s*%\]|[% biblio.$1 \| \$Remove_MARC_punctuation %]|gxms;
1789 $content =~ s|\[%\s*biblioitem\.(.*?)\s*%\]|[% biblioitem.$1 \| \$Remove_MARC_punctuation %]|gxms;
1793 =head2 get_item_content
1795 my $item = Koha::Items->find(...)->unblessed;
1796 my @item_content_fields = qw( date_due title barcode author itemnumber );
1797 my $item_content = C4::Letters::get_item_content({
1799 item_content_fields => \@item_content_fields
1802 This function generates a tab-separated list of values for the passed item. Dates
1803 are formatted following the current setup.
1807 sub get_item_content {
1808 my ( $params ) = @_;
1809 my $item = $params->{item};
1810 my $dateonly = $params->{dateonly} || 0;
1811 my $item_content_fields = $params->{item_content_fields} || [];
1813 return unless $item;
1815 my @item_info = map {
1819 { dt => dt_from_string( $item->{$_} ), dateonly => $dateonly } );
1823 } @$item_content_fields;
1824 return join( "\t", @item_info ) . "\n";