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
939 * letter - required; A letter hashref as returned from GetPreparedLetter
940 * message_transport_type - required; One of the available mtts
941 * borrowernumber - optional if 'to_address' is passed; The borrowernumber of the patron we enqueuing the notice for
942 * to_address - optional if 'borrowernumber' is passed; The destination email address for the notice (defaults to patron->notice_email_address)
943 * from_address - optional; The from address for the notice, defaults to patron->library->from_email_address
944 * reply_address - optional; The reply address for the notice, defaults to patron->library->reply_to
949 my $params = shift or return;
951 return unless exists $params->{'letter'};
952 # return unless exists $params->{'borrowernumber'};
953 return unless exists $params->{'message_transport_type'};
955 my $content = $params->{letter}->{content};
956 $content =~ s/\s+//g if(defined $content);
957 if ( not defined $content or $content eq '' ) {
958 warn "Trying to add an empty message to the message queue" if $debug;
962 # If we have any attachments we should encode then into the body.
963 if ( $params->{'attachments'} ) {
964 $params->{'letter'} = _add_attachments(
965 { letter => $params->{'letter'},
966 attachments => $params->{'attachments'},
967 message => MIME::Lite->new( Type => 'multipart/mixed' ),
972 my $dbh = C4::Context->dbh();
973 my $statement = << 'ENDSQL';
974 INSERT INTO message_queue
975 ( borrowernumber, subject, content, metadata, letter_code, message_transport_type, status, time_queued, to_address, from_address, reply_address, content_type, failure_code )
977 ( ?, ?, ?, ?, ?, ?, ?, CAST(NOW() AS DATETIME), ?, ?, ?, ?, ? )
980 my $sth = $dbh->prepare($statement);
981 my $result = $sth->execute(
982 $params->{'borrowernumber'}, # borrowernumber
983 $params->{'letter'}->{'title'}, # subject
984 $params->{'letter'}->{'content'}, # content
985 $params->{'letter'}->{'metadata'} || '', # metadata
986 $params->{'letter'}->{'code'} || '', # letter_code
987 $params->{'message_transport_type'}, # message_transport_type
989 $params->{'to_address'}, # to_address
990 $params->{'from_address'}, # from_address
991 $params->{'reply_address'}, # reply_address
992 $params->{'letter'}->{'content-type'}, # content_type
993 $params->{'failure_code'} || '', # failure_code
995 return $dbh->last_insert_id(undef,undef,'message_queue', undef);
998 =head2 SendQueuedMessages ([$hashref])
1000 my $sent = SendQueuedMessages({
1001 letter_code => $letter_code,
1002 borrowernumber => $who_letter_is_for,
1008 Sends all of the 'pending' items in the message queue, unless
1009 parameters are passed.
1011 The letter_code, borrowernumber and limit parameters are used
1012 to build a parameter set for _get_unsent_messages, thus limiting
1013 which pending messages will be processed. They are all optional.
1015 The verbose parameter can be used to generate debugging output.
1016 It is also optional.
1018 Returns number of messages sent.
1022 sub SendQueuedMessages {
1025 my $which_unsent_messages = {
1026 'message_id' => $params->{'message_id'},
1027 'limit' => $params->{'limit'} // 0,
1028 'borrowernumber' => $params->{'borrowernumber'} // q{},
1029 'letter_code' => $params->{'letter_code'} // q{},
1030 'type' => $params->{'type'} // q{},
1032 my $unsent_messages = _get_unsent_messages( $which_unsent_messages );
1033 MESSAGE: foreach my $message ( @$unsent_messages ) {
1034 my $message_object = Koha::Notice::Messages->find( $message->{message_id} );
1035 # If this fails the database is unwritable and we won't manage to send a message that continues to be marked 'pending'
1036 $message_object->make_column_dirty('status');
1037 return unless $message_object->store;
1039 # warn Data::Dumper->Dump( [ $message ], [ 'message' ] );
1040 warn sprintf( 'sending %s message to patron: %s',
1041 $message->{'message_transport_type'},
1042 $message->{'borrowernumber'} || 'Admin' )
1043 if $params->{'verbose'} or $debug;
1044 # This is just begging for subclassing
1045 next MESSAGE if ( lc($message->{'message_transport_type'}) eq 'rss' );
1046 if ( lc( $message->{'message_transport_type'} ) eq 'email' ) {
1047 _send_message_by_email( $message, $params->{'username'}, $params->{'password'}, $params->{'method'} );
1049 elsif ( lc( $message->{'message_transport_type'} ) eq 'sms' ) {
1050 if ( C4::Context->preference('SMSSendDriver') eq 'Email' ) {
1051 my $patron = Koha::Patrons->find( $message->{borrowernumber} );
1052 my $sms_provider = Koha::SMS::Providers->find( $patron->sms_provider_id );
1053 unless ( $sms_provider ) {
1054 warn sprintf( "Patron %s has no sms provider id set!", $message->{'borrowernumber'} ) if $params->{'verbose'} or $debug;
1055 _set_message_status( { message_id => $message->{'message_id'}, status => 'failed' } );
1058 unless ( $patron->smsalertnumber ) {
1059 _set_message_status( { message_id => $message->{'message_id'}, status => 'failed' } );
1060 warn sprintf( "No smsalertnumber found for patron %s!", $message->{'borrowernumber'} ) if $params->{'verbose'} or $debug;
1063 $message->{to_address} = $patron->smsalertnumber; #Sometime this is set to email - sms should always use smsalertnumber
1064 $message->{to_address} .= '@' . $sms_provider->domain();
1066 # Check for possible from_address override
1067 my $from_address = C4::Context->preference('EmailSMSSendDriverFromAddress');
1068 if ($from_address && $message->{from_address} ne $from_address) {
1069 $message->{from_address} = $from_address;
1070 _update_message_from_address($message->{'message_id'}, $message->{from_address});
1073 _update_message_to_address($message->{'message_id'}, $message->{to_address});
1074 _send_message_by_email( $message, $params->{'username'}, $params->{'password'}, $params->{'method'} );
1076 _send_message_by_sms( $message );
1080 return scalar( @$unsent_messages );
1083 =head2 GetRSSMessages
1085 my $message_list = GetRSSMessages( { limit => 10, borrowernumber => '14' } )
1087 returns a listref of all queued RSS messages for a particular person.
1091 sub GetRSSMessages {
1094 return unless $params;
1095 return unless ref $params;
1096 return unless $params->{'borrowernumber'};
1098 return _get_unsent_messages( { message_transport_type => 'rss',
1099 limit => $params->{'limit'},
1100 borrowernumber => $params->{'borrowernumber'}, } );
1103 =head2 GetPrintMessages
1105 my $message_list = GetPrintMessages( { borrowernumber => $borrowernumber } )
1107 Returns a arrayref of all queued print messages (optionally, for a particular
1112 sub GetPrintMessages {
1113 my $params = shift || {};
1115 return _get_unsent_messages( { message_transport_type => 'print',
1116 borrowernumber => $params->{'borrowernumber'},
1120 =head2 GetQueuedMessages ([$hashref])
1122 my $messages = GetQueuedMessage( { borrowernumber => '123', limit => 20 } );
1124 Fetches a list of messages from the message queue optionally filtered by borrowernumber
1125 and limited to specified limit.
1127 Return is an arrayref of hashes, each has represents a message in the message queue.
1131 sub GetQueuedMessages {
1134 my $dbh = C4::Context->dbh();
1135 my $statement = << 'ENDSQL';
1136 SELECT message_id, borrowernumber, subject, content, message_transport_type, status, time_queued, updated_on, failure_code
1142 if ( exists $params->{'borrowernumber'} ) {
1143 push @whereclauses, ' borrowernumber = ? ';
1144 push @query_params, $params->{'borrowernumber'};
1147 if ( @whereclauses ) {
1148 $statement .= ' WHERE ' . join( 'AND', @whereclauses );
1151 if ( defined $params->{'limit'} ) {
1152 $statement .= ' LIMIT ? ';
1153 push @query_params, $params->{'limit'};
1156 my $sth = $dbh->prepare( $statement );
1157 my $result = $sth->execute( @query_params );
1158 return $sth->fetchall_arrayref({});
1161 =head2 GetMessageTransportTypes
1163 my @mtt = GetMessageTransportTypes();
1165 returns an arrayref of transport types
1169 sub GetMessageTransportTypes {
1170 my $dbh = C4::Context->dbh();
1171 my $mtts = $dbh->selectcol_arrayref("
1172 SELECT message_transport_type
1173 FROM message_transport_types
1174 ORDER BY message_transport_type
1181 my $message = C4::Letters::Message($message_id);
1186 my ( $message_id ) = @_;
1187 return unless $message_id;
1188 my $dbh = C4::Context->dbh;
1189 return $dbh->selectrow_hashref(q|
1190 SELECT message_id, borrowernumber, subject, content, metadata, letter_code, message_transport_type, status, time_queued, updated_on, to_address, from_address, reply_address, content_type, failure_code
1192 WHERE message_id = ?
1193 |, {}, $message_id );
1196 =head2 ResendMessage
1198 Attempt to resend a message which has failed previously.
1200 my $has_been_resent = C4::Letters::ResendMessage($message_id);
1202 Updates the message to 'pending' status so that
1203 it will be resent later on.
1205 returns 1 on success, 0 on failure, undef if no message was found
1210 my $message_id = shift;
1211 return unless $message_id;
1213 my $message = GetMessage( $message_id );
1214 return unless $message;
1216 if ( $message->{status} ne 'pending' ) {
1217 $rv = C4::Letters::_set_message_status({
1218 message_id => $message_id,
1219 status => 'pending',
1221 $rv = $rv > 0? 1: 0;
1222 # Clear destination email address to force address update
1223 _update_message_to_address( $message_id, undef ) if $rv &&
1224 $message->{message_transport_type} eq 'email';
1229 =head2 _add_attachements
1232 letter - the standard letter hashref
1233 attachments - listref of attachments. each attachment is a hashref of:
1234 type - the mime type, like 'text/plain'
1235 content - the actual attachment
1236 filename - the name of the attachment.
1237 message - a MIME::Lite object to attach these to.
1239 returns your letter object, with the content updated.
1243 sub _add_attachments {
1246 my $letter = $params->{'letter'};
1247 my $attachments = $params->{'attachments'};
1248 return $letter unless @$attachments;
1249 my $message = $params->{'message'};
1251 # First, we have to put the body in as the first attachment
1253 Type => $letter->{'content-type'} || 'TEXT',
1254 Data => $letter->{'is_html'}
1255 ? _wrap_html($letter->{'content'}, $letter->{'title'})
1256 : $letter->{'content'},
1259 foreach my $attachment ( @$attachments ) {
1261 Type => $attachment->{'type'},
1262 Data => $attachment->{'content'},
1263 Filename => $attachment->{'filename'},
1266 # we're forcing list context here to get the header, not the count back from grep.
1267 ( $letter->{'content-type'} ) = grep( /^Content-Type:/, split( /\n/, $params->{'message'}->header_as_string ) );
1268 $letter->{'content-type'} =~ s/^Content-Type:\s+//;
1269 $letter->{'content'} = $message->body_as_string;
1275 =head2 _get_unsent_messages
1277 This function's parameter hash reference takes the following
1278 optional named parameters:
1279 message_transport_type: method of message sending (e.g. email, sms, etc.)
1280 borrowernumber : who the message is to be sent
1281 letter_code : type of message being sent (e.g. PASSWORD_RESET)
1282 message_id : the message_id of the message. In that case the sub will return only 1 result
1283 limit : maximum number of messages to send
1285 This function returns an array of matching hash referenced rows from
1286 message_queue with some borrower information added.
1290 sub _get_unsent_messages {
1293 my $dbh = C4::Context->dbh();
1295 SELECT mq.message_id, mq.borrowernumber, mq.subject, mq.content, mq.message_transport_type, mq.status, mq.time_queued, mq.from_address, mq.reply_address, mq.to_address, mq.content_type, b.branchcode, mq.letter_code, mq.failure_code
1296 FROM message_queue mq
1297 LEFT JOIN borrowers b ON b.borrowernumber = mq.borrowernumber
1301 my @query_params = ('pending');
1302 if ( ref $params ) {
1303 if ( $params->{'message_transport_type'} ) {
1304 $statement .= ' AND mq.message_transport_type = ? ';
1305 push @query_params, $params->{'message_transport_type'};
1307 if ( $params->{'borrowernumber'} ) {
1308 $statement .= ' AND mq.borrowernumber = ? ';
1309 push @query_params, $params->{'borrowernumber'};
1311 if ( $params->{'letter_code'} ) {
1312 $statement .= ' AND mq.letter_code = ? ';
1313 push @query_params, $params->{'letter_code'};
1315 if ( $params->{'type'} ) {
1316 $statement .= ' AND message_transport_type = ? ';
1317 push @query_params, $params->{'type'};
1319 if ( $params->{message_id} ) {
1320 $statement .= ' AND message_id = ?';
1321 push @query_params, $params->{message_id};
1323 if ( $params->{'limit'} ) {
1324 $statement .= ' limit ? ';
1325 push @query_params, $params->{'limit'};
1329 $debug and warn "_get_unsent_messages SQL: $statement";
1330 $debug and warn "_get_unsent_messages params: " . join(',',@query_params);
1331 my $sth = $dbh->prepare( $statement );
1332 my $result = $sth->execute( @query_params );
1333 return $sth->fetchall_arrayref({});
1336 sub _send_message_by_email {
1337 my $message = shift or return;
1338 my ($username, $password, $method) = @_;
1340 my $patron = Koha::Patrons->find( $message->{borrowernumber} );
1341 my $to_address = $message->{'to_address'};
1342 unless ($to_address) {
1344 warn "FAIL: No 'to_address' and INVALID borrowernumber ($message->{borrowernumber})";
1345 _set_message_status(
1347 message_id => $message->{'message_id'},
1349 failure_code => 'INVALID_BORNUMBER'
1354 $to_address = $patron->notice_email_address;
1355 unless ($to_address) {
1356 # warn "FAIL: No 'to_address' and no email for " . ($member->{surname} ||'') . ", borrowernumber ($message->{borrowernumber})";
1357 # warning too verbose for this more common case?
1358 _set_message_status(
1360 message_id => $message->{'message_id'},
1362 failure_code => 'NO_EMAIL'
1369 my $subject = $message->{'subject'};
1371 my $content = $message->{'content'};
1372 my $content_type = $message->{'content_type'} || 'text/plain; charset="UTF-8"';
1373 my $is_html = $content_type =~ m/html/io;
1375 my $branch_email = undef;
1376 my $branch_replyto = undef;
1377 my $branch_returnpath = undef;
1381 $library = $patron->library;
1382 $branch_email = $library->from_email_address;
1383 $branch_replyto = $library->branchreplyto;
1384 $branch_returnpath = $library->branchreturnpath;
1387 # NOTE: Patron may not be defined above so branch_email may be undefined still
1388 # so we need to fallback to KohaAdminEmailAddress as a last resort.
1390 $message->{'from_address'}
1392 || C4::Context->preference('KohaAdminEmailAddress');
1393 if( !$from_address ) {
1394 _set_message_status(
1396 message_id => $message->{'message_id'},
1398 failure_code => 'NO_FROM',
1403 my $email = Koha::Email->create(
1407 C4::Context->preference('NoticeBcc')
1408 ? ( bcc => C4::Context->preference('NoticeBcc') )
1411 from => $from_address,
1412 reply_to => $message->{'reply_address'} || $branch_replyto,
1413 sender => $branch_returnpath,
1414 subject => "" . $message->{subject}
1420 _wrap_html( $content, $subject )
1424 $email->text_body( $content );
1429 $smtp_server = $library->smtp_server;
1432 $smtp_server = Koha::SMTP::Servers->get_default;
1438 sasl_username => $username,
1439 sasl_password => $password,
1444 # if initial message address was empty, coming here means that a to address was found and
1445 # queue should be updated; same if to address was overriden by Koha::Email->create
1446 _update_message_to_address( $message->{'message_id'}, $email->email->header('To') )
1447 if !$message->{to_address}
1448 || $message->{to_address} ne $email->email->header('To');
1451 $email->send_or_die({ transport => $smtp_server->transport });
1453 _set_message_status(
1455 message_id => $message->{'message_id'},
1463 _set_message_status(
1465 message_id => $message->{'message_id'},
1467 failure_code => 'SENDMAIL'
1471 carp "$Mail::Sendmail::error";
1477 my ($content, $title) = @_;
1479 my $css = C4::Context->preference("NoticeCSS") || '';
1480 $css = qq{<link rel="stylesheet" type="text/css" href="$css">} if $css;
1482 <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
1483 "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
1484 <html lang="en" xml:lang="en" xmlns="http://www.w3.org/1999/xhtml">
1486 <title>$title</title>
1487 <meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
1498 my ( $message ) = @_;
1499 my $dbh = C4::Context->dbh;
1500 my $count = $dbh->selectrow_array(q|
1503 WHERE message_transport_type = ?
1504 AND borrowernumber = ?
1506 AND CAST(updated_on AS date) = CAST(NOW() AS date)
1509 |, {}, $message->{message_transport_type}, $message->{borrowernumber}, $message->{letter_code}, $message->{content} );
1513 sub _send_message_by_sms {
1514 my $message = shift or return;
1515 my $patron = Koha::Patrons->find( $message->{borrowernumber} );
1517 unless ( $patron and $patron->smsalertnumber ) {
1518 _set_message_status( { message_id => $message->{'message_id'},
1520 failure_code => 'MISSING_SMS' } );
1524 if ( _is_duplicate( $message ) ) {
1525 _set_message_status(
1527 message_id => $message->{'message_id'},
1529 failure_code => 'DUPLICATE_MESSAGE'
1535 my $success = C4::SMS->send_sms(
1537 destination => $patron->smsalertnumber,
1538 message => $message->{'content'},
1543 _set_message_status(
1545 message_id => $message->{'message_id'},
1552 _set_message_status(
1554 message_id => $message->{'message_id'},
1556 failure_code => 'NO_NOTES'
1564 sub _update_message_to_address {
1566 my $dbh = C4::Context->dbh();
1567 $dbh->do('UPDATE message_queue SET to_address=? WHERE message_id=?',undef,($to,$id));
1570 sub _update_message_from_address {
1571 my ($message_id, $from_address) = @_;
1572 my $dbh = C4::Context->dbh();
1573 $dbh->do('UPDATE message_queue SET from_address = ? WHERE message_id = ?', undef, ($from_address, $message_id));
1576 sub _set_message_status {
1577 my $params = shift or return;
1579 foreach my $required_parameter ( qw( message_id status ) ) {
1580 return unless exists $params->{ $required_parameter };
1583 my $dbh = C4::Context->dbh();
1584 my $statement = 'UPDATE message_queue SET status= ?, failure_code= ? WHERE message_id = ?';
1585 my $sth = $dbh->prepare( $statement );
1586 my $result = $sth->execute( $params->{'status'},
1587 $params->{'failure_code'} || '',
1588 $params->{'message_id'} );
1593 my ( $params ) = @_;
1595 my $content = $params->{content};
1596 my $tables = $params->{tables};
1597 my $loops = $params->{loops};
1598 my $substitute = $params->{substitute} || {};
1599 my $lang = defined($params->{lang}) && $params->{lang} ne 'default' ? $params->{lang} : 'en';
1600 my ($theme, $availablethemes);
1602 my $htdocs = C4::Context->config('intrahtdocs');
1603 ($theme, $lang, $availablethemes)= C4::Templates::availablethemes( $htdocs, 'about.tt', 'intranet', $lang);
1605 foreach (@$availablethemes) {
1606 push @includes, "$htdocs/$_/$lang/includes";
1607 push @includes, "$htdocs/$_/en/includes" unless $lang eq 'en';
1610 my $use_template_cache = C4::Context->config('template_cache_dir') && defined $ENV{GATEWAY_INTERFACE};
1611 my $template = Template->new(
1615 PLUGIN_BASE => 'Koha::Template::Plugin',
1616 COMPILE_EXT => $use_template_cache ? '.ttc' : '',
1617 COMPILE_DIR => $use_template_cache ? C4::Context->config('template_cache_dir') : '',
1618 INCLUDE_PATH => \@includes,
1620 ENCODING => 'UTF-8',
1622 ) or die Template->error();
1624 my $tt_params = { %{ _get_tt_params( $tables ) }, %{ _get_tt_params( $loops, 'is_a_loop' ) }, %$substitute };
1626 $content = add_tt_filters( $content );
1627 $content = qq|[% USE KohaDates %][% USE Remove_MARC_punctuation %]$content|;
1630 $template->process( \$content, $tt_params, \$output ) || croak "ERROR PROCESSING TEMPLATE: " . $template->error();
1635 sub _get_tt_params {
1636 my ($tables, $is_a_loop) = @_;
1642 article_requests => {
1643 module => 'Koha::ArticleRequests',
1644 singular => 'article_request',
1645 plural => 'article_requests',
1649 module => 'Koha::Acquisition::Baskets',
1650 singular => 'basket',
1651 plural => 'baskets',
1655 module => 'Koha::Biblios',
1656 singular => 'biblio',
1657 plural => 'biblios',
1658 pk => 'biblionumber',
1661 module => 'Koha::Biblioitems',
1662 singular => 'biblioitem',
1663 plural => 'biblioitems',
1664 pk => 'biblioitemnumber',
1667 module => 'Koha::Patrons',
1668 singular => 'borrower',
1669 plural => 'borrowers',
1670 pk => 'borrowernumber',
1673 module => 'Koha::Libraries',
1674 singular => 'branch',
1675 plural => 'branches',
1679 module => 'Koha::Account::Lines',
1680 singular => 'credit',
1681 plural => 'credits',
1682 pk => 'accountlines_id',
1685 module => 'Koha::Account::Lines',
1686 singular => 'debit',
1688 pk => 'accountlines_id',
1691 module => 'Koha::Items',
1697 module => 'Koha::News',
1703 module => 'Koha::Acquisition::Orders',
1704 singular => 'order',
1706 pk => 'ordernumber',
1709 module => 'Koha::Holds',
1715 module => 'Koha::Serials',
1716 singular => 'serial',
1717 plural => 'serials',
1721 module => 'Koha::Subscriptions',
1722 singular => 'subscription',
1723 plural => 'subscriptions',
1724 pk => 'subscriptionid',
1727 module => 'Koha::Suggestions',
1728 singular => 'suggestion',
1729 plural => 'suggestions',
1730 pk => 'suggestionid',
1733 module => 'Koha::Checkouts',
1734 singular => 'checkout',
1735 plural => 'checkouts',
1739 module => 'Koha::Old::Checkouts',
1740 singular => 'old_checkout',
1741 plural => 'old_checkouts',
1745 module => 'Koha::Checkouts',
1746 singular => 'overdue',
1747 plural => 'overdues',
1750 borrower_modifications => {
1751 module => 'Koha::Patron::Modifications',
1752 singular => 'patron_modification',
1753 plural => 'patron_modifications',
1754 fk => 'verification_token',
1757 module => 'Koha::Illrequests',
1758 singular => 'illrequest',
1759 plural => 'illrequests',
1760 pk => 'illrequest_id'
1764 foreach my $table ( keys %$tables ) {
1765 next unless $config->{$table};
1767 my $ref = ref( $tables->{$table} ) || q{};
1768 my $module = $config->{$table}->{module};
1770 if ( can_load( modules => { $module => undef } ) ) {
1771 my $pk = $config->{$table}->{pk};
1772 my $fk = $config->{$table}->{fk};
1775 my $values = $tables->{$table} || [];
1776 unless ( ref( $values ) eq 'ARRAY' ) {
1777 croak "ERROR processing table $table. Wrong API call.";
1779 my $key = $pk ? $pk : $fk;
1780 # $key does not come from user input
1781 my $objects = $module->search(
1782 { $key => $values },
1784 # We want to retrieve the data in the same order
1786 # field is a MySQLism, but they are no other way to do it
1787 # To be generic we could do it in perl, but we will need to fetch
1788 # all the data then order them
1789 @$values ? ( order_by => \[ "field($key, " . join( ', ', @$values ) . ")" ] ) : ()
1792 $params->{ $config->{$table}->{plural} } = $objects;
1794 elsif ( $ref eq q{} || $ref eq 'HASH' ) {
1795 my $id = ref $ref eq 'HASH' ? $tables->{$table}->{$pk} : $tables->{$table};
1797 if ( $fk ) { # Using a foreign key for lookup
1798 if ( ref( $fk ) eq 'ARRAY' ) { # Foreign key is multi-column
1800 foreach my $key ( @$fk ) {
1801 $search->{$key} = $id->{$key};
1803 $object = $module->search( $search )->last();
1804 } else { # Foreign key is single column
1805 $object = $module->search( { $fk => $id } )->last();
1807 } else { # using the table's primary key for lookup
1808 $object = $module->find($id);
1810 $params->{ $config->{$table}->{singular} } = $object;
1812 else { # $ref eq 'ARRAY'
1814 if ( @{ $tables->{$table} } == 1 ) { # Param is a single key
1815 $object = $module->search( { $pk => $tables->{$table} } )->last();
1817 else { # Params are mutliple foreign keys
1818 croak "Multiple foreign keys (table $table) should be passed using an hashref";
1820 $params->{ $config->{$table}->{singular} } = $object;
1824 croak "ERROR LOADING MODULE $module: $Module::Load::Conditional::ERROR";
1828 $params->{today} = output_pref({ dt => dt_from_string, dateformat => 'iso' });
1833 =head3 add_tt_filters
1835 $content = add_tt_filters( $content );
1837 Add TT filters to some specific fields if needed.
1839 For now we only add the Remove_MARC_punctuation TT filter to biblio and biblioitem fields
1843 sub add_tt_filters {
1844 my ( $content ) = @_;
1845 $content =~ s|\[%\s*biblio\.(.*?)\s*%\]|[% biblio.$1 \| \$Remove_MARC_punctuation %]|gxms;
1846 $content =~ s|\[%\s*biblioitem\.(.*?)\s*%\]|[% biblioitem.$1 \| \$Remove_MARC_punctuation %]|gxms;
1850 =head2 get_item_content
1852 my $item = Koha::Items->find(...)->unblessed;
1853 my @item_content_fields = qw( date_due title barcode author itemnumber );
1854 my $item_content = C4::Letters::get_item_content({
1856 item_content_fields => \@item_content_fields
1859 This function generates a tab-separated list of values for the passed item. Dates
1860 are formatted following the current setup.
1864 sub get_item_content {
1865 my ( $params ) = @_;
1866 my $item = $params->{item};
1867 my $dateonly = $params->{dateonly} || 0;
1868 my $item_content_fields = $params->{item_content_fields} || [];
1870 return unless $item;
1872 my @item_info = map {
1876 { dt => dt_from_string( $item->{$_} ), dateonly => $dateonly } );
1880 } @$item_content_fields;
1881 return join( "\t", @item_info ) . "\n";