3 # Copyright 2000-2002 Katipo Communications
5 # This file is part of Koha.
7 # Koha is free software; you can redistribute it and/or modify it
8 # under the terms of the GNU General Public License as published by
9 # the Free Software Foundation; either version 3 of the License, or
10 # (at your option) any later version.
12 # Koha is distributed in the hope that it will be useful, but
13 # WITHOUT ANY WARRANTY; without even the implied warranty of
14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 # GNU General Public License for more details.
17 # You should have received a copy of the GNU General Public License
18 # along with Koha; if not, see <http://www.gnu.org/licenses>.
22 use Carp qw( carp croak );
24 use Module::Load::Conditional qw( can_load );
26 use Try::Tiny qw( catch try );
29 use C4::Log qw( logaction );
32 use Koha::DateUtils qw( dt_from_string output_pref );
33 use Koha::SMS::Providers;
36 use Koha::Notice::Messages;
37 use Koha::Notice::Templates;
38 use Koha::DateUtils qw( dt_from_string output_pref );
40 use Koha::SMTP::Servers;
41 use Koha::Subscriptions;
43 use constant SERIALIZED_EMAIL_CONTENT_TYPE => 'message/rfc822';
45 our (@ISA, @EXPORT_OK);
51 GetLettersAvailableForALibrary
60 GetMessageTransportTypes
70 C4::Letters - Give functions for Letters management
78 "Letters" is the tool used in Koha to manage informations sent to the patrons and/or the library. This include some cron jobs like
79 late issues, as well as other tasks like sending a mail to users that have subscribed to a "serial issue alert" (= being warned every time a new issue has arrived at the library)
81 Letters are managed through "alerts" sent by Koha on some events. All "alert" related functions are in this module too.
83 =head2 GetLetters([$module])
85 $letters = &GetLetters($module);
86 returns informations about letters.
87 if needed, $module filters for letters given module
89 DEPRECATED - You must use Koha::Notice::Templates instead
90 The group by clause is confusing and can lead to issues
96 my $module = $filters->{module};
97 my $code = $filters->{code};
98 my $branchcode = $filters->{branchcode};
99 my $dbh = C4::Context->dbh;
100 my $letters = $dbh->selectall_arrayref(
102 SELECT code, module, name
106 . ( $module ? q| AND module = ?| : q|| )
107 . ( $code ? q| AND code = ?| : q|| )
108 . ( defined $branchcode ? q| AND branchcode = ?| : q|| )
109 . q| GROUP BY code, module, name ORDER BY name|, { Slice => {} }
110 , ( $module ? $module : () )
111 , ( $code ? $code : () )
112 , ( defined $branchcode ? $branchcode : () )
118 =head2 GetLetterTemplates
120 my $letter_templates = GetLetterTemplates(
122 module => 'circulation',
124 branchcode => 'CPL', # '' for default,
128 Return a hashref of letter templates.
132 sub GetLetterTemplates {
135 my $module = $params->{module};
136 my $code = $params->{code};
137 my $branchcode = $params->{branchcode} // '';
138 my $dbh = C4::Context->dbh;
139 return Koha::Notice::Templates->search(
143 branchcode => $branchcode,
145 C4::Context->preference('TranslateNotices')
147 : ( lang => 'default' )
153 =head2 GetLettersAvailableForALibrary
155 my $letters = GetLettersAvailableForALibrary(
157 branchcode => 'CPL', # '' for default
158 module => 'circulation',
162 Return an arrayref of letters, sorted by name.
163 If a specific letter exist for the given branchcode, it will be retrieve.
164 Otherwise the default letter will be.
168 sub GetLettersAvailableForALibrary {
170 my $branchcode = $filters->{branchcode};
171 my $module = $filters->{module};
173 croak "module should be provided" unless $module;
175 my $dbh = C4::Context->dbh;
176 my $default_letters = $dbh->selectall_arrayref(
178 SELECT module, code, branchcode, name
182 . q| AND branchcode = ''|
183 . ( $module ? q| AND module = ?| : q|| )
184 . q| ORDER BY name|, { Slice => {} }
185 , ( $module ? $module : () )
188 my $specific_letters;
190 $specific_letters = $dbh->selectall_arrayref(
192 SELECT module, code, branchcode, name
196 . q| AND branchcode = ?|
197 . ( $module ? q| AND module = ?| : q|| )
198 . q| ORDER BY name|, { Slice => {} }
200 , ( $module ? $module : () )
205 for my $l (@$default_letters) {
206 $letters{ $l->{code} } = $l;
208 for my $l (@$specific_letters) {
209 # Overwrite the default letter with the specific one.
210 $letters{ $l->{code} } = $l;
213 return [ map { $letters{$_} }
214 sort { $letters{$a}->{name} cmp $letters{$b}->{name} }
224 module => 'circulation',
230 Delete the letter. The mtt parameter is facultative.
231 If not given, all templates mathing the other parameters will be removed.
237 my $branchcode = $params->{branchcode};
238 my $module = $params->{module};
239 my $code = $params->{code};
240 my $mtt = $params->{mtt};
241 my $lang = $params->{lang};
242 my $dbh = C4::Context->dbh;
249 . ( $mtt ? q| AND message_transport_type = ?| : q|| )
250 . ( $lang? q| AND lang = ?| : q|| )
251 , undef, $branchcode, $module, $code, ( $mtt ? $mtt : () ), ( $lang ? $lang : () ) );
256 my $err = &SendAlerts($type, $externalid, $letter_code);
259 - $type : the type of alert
260 - $externalid : the id of the "object" to query
261 - $letter_code : the notice template to use
263 C<&SendAlerts> sends an email notice directly to a patron or a vendor.
265 Currently it supports ($type):
266 - claim serial issues (claimissues)
267 - claim acquisition orders (claimacquisition)
268 - send acquisition orders to the vendor (orderacquisition)
269 - notify patrons about newly received serial issues (issue)
270 - notify patrons when their account is created (members)
272 Returns undef or { error => 'message } on failure.
273 Returns true on success.
278 my ( $type, $externalid, $letter_code ) = @_;
279 my $dbh = C4::Context->dbh;
282 if ( $type eq 'issue' ) {
284 # prepare the letter...
285 # search the subscriptionid
288 "SELECT subscriptionid FROM serial WHERE serialid=?");
289 $sth->execute($externalid);
290 my ($subscriptionid) = $sth->fetchrow
291 or warn( "No subscription for '$externalid'" ),
294 # search the biblionumber
297 "SELECT biblionumber FROM subscription WHERE subscriptionid=?");
298 $sth->execute($subscriptionid);
299 my ($biblionumber) = $sth->fetchrow
300 or warn( "No biblionumber for '$subscriptionid'" ),
303 # find the list of subscribers to notify
304 my $subscription = Koha::Subscriptions->find( $subscriptionid );
305 my $subscribers = $subscription->subscribers;
306 while ( my $patron = $subscribers->next ) {
307 my $email = $patron->email or next;
309 # warn "sending issues...";
310 my $userenv = C4::Context->userenv;
311 my $library = $patron->library;
312 my $letter = GetPreparedLetter (
314 letter_code => $letter_code,
315 branchcode => $userenv->{branch},
317 'branches' => $library->branchcode,
318 'biblio' => $biblionumber,
319 'biblioitems' => $biblionumber,
320 'borrowers' => $patron->unblessed,
321 'subscription' => $subscriptionid,
322 'serial' => $externalid,
327 # FIXME: This 'default' behaviour should be moved to Koha::Email
328 my $mail = Koha::Email->create(
331 from => $library->branchemail,
332 reply_to => $library->branchreplyto,
333 sender => $library->branchreturnpath,
334 subject => "" . $letter->{title},
338 if ( $letter->{is_html} ) {
339 $mail->html_body( _wrap_html( $letter->{content}, "" . $letter->{title} ) );
342 $mail->text_body( $letter->{content} );
346 $mail->send_or_die({ transport => $library->smtp_server->transport });
349 # We expect ref($_) eq 'Email::Sender::Failure'
350 $error = $_->message;
356 return { error => $error }
360 elsif ( $type eq 'claimacquisition' or $type eq 'claimissues' or $type eq 'orderacquisition' ) {
362 # prepare the letter...
368 if ( $type eq 'claimacquisition') {
370 SELECT aqorders.*,aqbasket.*,biblio.*,biblioitems.*
372 LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno
373 LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
374 LEFT JOIN biblioitems ON aqorders.biblionumber=biblioitems.biblionumber
375 WHERE aqorders.ordernumber IN (
379 carp "No order selected";
380 return { error => "no_order_selected" };
382 $strsth .= join( ",", ('?') x @$externalid ) . ")";
383 $action = "ACQUISITION CLAIM";
384 $sthorders = $dbh->prepare($strsth);
385 $sthorders->execute( @$externalid );
386 $dataorders = $sthorders->fetchall_arrayref( {} );
389 if ($type eq 'claimissues') {
391 SELECT serial.*,subscription.*, biblio.*, biblioitems.*, aqbooksellers.*,
392 aqbooksellers.id AS booksellerid
394 LEFT JOIN subscription ON serial.subscriptionid=subscription.subscriptionid
395 LEFT JOIN biblio ON serial.biblionumber=biblio.biblionumber
396 LEFT JOIN biblioitems ON serial.biblionumber = biblioitems.biblionumber
397 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id
398 WHERE serial.serialid IN (
402 carp "No issues selected";
403 return { error => "no_issues_selected" };
406 $strsth .= join( ",", ('?') x @$externalid ) . ")";
407 $action = "SERIAL CLAIM";
408 $sthorders = $dbh->prepare($strsth);
409 $sthorders->execute( @$externalid );
410 $dataorders = $sthorders->fetchall_arrayref( {} );
413 if ( $type eq 'orderacquisition') {
414 $basketno = $externalid;
416 SELECT aqorders.*,aqbasket.*,biblio.*,biblioitems.*
418 LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno
419 LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
420 LEFT JOIN biblioitems ON aqorders.biblionumber=biblioitems.biblionumber
421 WHERE aqbasket.basketno = ?
422 AND orderstatus IN ('new','ordered')
425 unless ( $basketno ) {
426 carp "No basketnumber given";
427 return { error => "no_basketno" };
429 $action = "ACQUISITION ORDER";
430 $sthorders = $dbh->prepare($strsth);
431 $sthorders->execute($basketno);
432 $dataorders = $sthorders->fetchall_arrayref( {} );
436 $dbh->prepare("select * from aqbooksellers where id=?");
437 $sthbookseller->execute( $dataorders->[0]->{booksellerid} );
438 my $databookseller = $sthbookseller->fetchrow_hashref;
440 my $addressee = $type eq 'claimacquisition' || $type eq 'orderacquisition' ? 'acqprimary' : 'serialsprimary';
443 $dbh->prepare("SELECT * FROM aqcontacts WHERE booksellerid=? AND $type=1 ORDER BY $addressee DESC");
444 $sthcontact->execute( $dataorders->[0]->{booksellerid} );
445 my $datacontact = $sthcontact->fetchrow_hashref;
449 push @email, $datacontact->{email} if ( $datacontact && $datacontact->{email} );
451 warn "Bookseller $dataorders->[0]->{booksellerid} without emails";
452 return { error => "no_email" };
455 while ($addlcontact = $sthcontact->fetchrow_hashref) {
456 push @cc, $addlcontact->{email} if ( $addlcontact && $addlcontact->{email} );
459 my $userenv = C4::Context->userenv;
460 my $letter = GetPreparedLetter (
462 letter_code => $letter_code,
463 branchcode => $userenv->{branch},
465 'branches' => $userenv->{branch},
466 'aqbooksellers' => $databookseller,
467 'aqcontacts' => $datacontact,
468 'aqbasket' => $basketno,
470 repeat => $dataorders,
472 ) or return { error => "no_letter" };
474 # Remove the order tag
475 $letter->{content} =~ s/<order>(.*?)<\/order>/$1/gxms;
478 my $library = Koha::Libraries->find( $userenv->{branch} );
479 my $mail = Koha::Email->create(
481 to => join( ',', @email ),
482 cc => join( ',', @cc ),
485 C4::Context->preference("ClaimsBccCopy")
486 && ( $type eq 'claimacquisition'
487 || $type eq 'claimissues' )
489 ? ( bcc => $userenv->{emailaddress} )
492 from => $library->branchemail
493 || C4::Context->preference('KohaAdminEmailAddress'),
494 subject => "" . $letter->{title},
498 if ( $letter->{is_html} ) {
499 $mail->html_body( _wrap_html( $letter->{content}, "" . $letter->{title} ) );
502 $mail->text_body( "" . $letter->{content} );
506 $mail->send_or_die({ transport => $library->smtp_server->transport });
509 # We expect ref($_) eq 'Email::Sender::Failure'
510 $error = $_->message;
516 return { error => $error }
519 my $module = $action eq 'ACQUISITION ORDER' ? 'ACQUISITIONS' : 'CLAIMS';
525 . join( ',', @email )
530 ) if C4::Context->preference("ClaimsLog");
533 # If we come here, return an OK status
537 =head2 GetPreparedLetter( %params )
540 module => letter module, mandatory
541 letter_code => letter code, mandatory
542 branchcode => for letter selection, if missing default system letter taken
543 tables => a hashref with table names as keys. Values are either:
544 - a scalar - primary key value
545 - an arrayref - primary key values
546 - a hashref - full record
547 substitute => custom substitution key/value pairs
548 repeat => records to be substituted on consecutive lines:
549 - an arrayref - tries to guess what needs substituting by
550 taking remaining << >> tokensr; not recommended
551 - a hashref token => @tables - replaces <token> << >> << >> </token>
552 subtemplate for each @tables row; table is a hashref as above
553 want_librarian => boolean, if set to true triggers librarian details
554 substitution from the userenv
556 letter fields hashref (title & content useful)
560 sub GetPreparedLetter {
563 my $letter = $params{letter};
564 my $lang = $params{lang} || 'default';
567 my $module = $params{module} or croak "No module";
568 my $letter_code = $params{letter_code} or croak "No letter_code";
569 my $branchcode = $params{branchcode} || '';
570 my $mtt = $params{message_transport_type} || 'email';
572 my $template = Koha::Notice::Templates->find_effective_template(
575 code => $letter_code,
576 branchcode => $branchcode,
577 message_transport_type => $mtt,
582 unless ( $template ) {
583 warn( "No $module $letter_code letter transported by " . $mtt );
587 $letter = $template->unblessed;
588 $letter->{'content-type'} = 'text/html; charset="UTF-8"' if $letter->{is_html};
591 my $tables = $params{tables} || {};
592 my $substitute = $params{substitute} || {};
593 my $loops = $params{loops} || {}; # loops is not supported for historical notices syntax
594 my $repeat = $params{repeat};
595 %$tables || %$substitute || $repeat || %$loops
596 or carp( "ERROR: nothing to substitute - both 'tables', 'loops' and 'substitute' are empty" ),
598 my $want_librarian = $params{want_librarian};
601 while ( my ($token, $val) = each %$substitute ) {
603 if ( $token eq 'items.content' ) {
604 $val =~ s|\n|<br/>|g if $letter->{is_html};
607 $letter->{title} =~ s/<<$token>>/$val/g;
608 $letter->{content} =~ s/<<$token>>/$val/g;
612 my $OPACBaseURL = C4::Context->preference('OPACBaseURL');
613 $letter->{content} =~ s/<<OPACBaseURL>>/$OPACBaseURL/go;
615 if ($want_librarian) {
616 # parsing librarian name
617 my $userenv = C4::Context->userenv;
618 $letter->{content} =~ s/<<LibrarianFirstname>>/$userenv->{firstname}/go;
619 $letter->{content} =~ s/<<LibrarianSurname>>/$userenv->{surname}/go;
620 $letter->{content} =~ s/<<LibrarianEmailaddress>>/$userenv->{emailaddress}/go;
623 my ($repeat_no_enclosing_tags, $repeat_enclosing_tags);
626 if (ref ($repeat) eq 'ARRAY' ) {
627 $repeat_no_enclosing_tags = $repeat;
629 $repeat_enclosing_tags = $repeat;
633 if ($repeat_enclosing_tags) {
634 while ( my ($tag, $tag_tables) = each %$repeat_enclosing_tags ) {
635 if ( $letter->{content} =~ m!<$tag>(.*)</$tag>!s ) {
638 my %subletter = ( title => '', content => $subcontent );
639 _substitute_tables( \%subletter, $_ );
642 $letter->{content} =~ s!<$tag>.*</$tag>!join( "\n", @lines )!se;
648 _substitute_tables( $letter, $tables );
651 if ($repeat_no_enclosing_tags) {
652 if ( $letter->{content} =~ m/[^\n]*<<.*>>[^\n]*/so ) {
657 $c =~ s/<<count>>/$i/go;
658 foreach my $field ( keys %{$_} ) {
659 $c =~ s/(<<[^\.]+.$field>>)/$_->{$field}/;
663 } @$repeat_no_enclosing_tags;
665 my $replaceby = join( "\n", @lines );
666 $letter->{content} =~ s/\Q$line\E/$replaceby/s;
670 $letter->{content} = _process_tt(
672 content => $letter->{content},
675 substitute => $substitute,
680 $letter->{title} = _process_tt(
682 content => $letter->{title},
685 substitute => $substitute,
689 $letter->{content} =~ s/<<\S*>>//go; #remove any stragglers
694 sub _substitute_tables {
695 my ( $letter, $tables ) = @_;
696 while ( my ($table, $param) = each %$tables ) {
699 my $ref = ref $param;
702 if ($ref && $ref eq 'HASH') {
706 my $sth = _parseletter_sth($table);
708 warn "_parseletter_sth('$table') failed to return a valid sth. No substitution will be done for that table.";
711 $sth->execute( $ref ? @$param : $param );
713 $values = $sth->fetchrow_hashref;
717 _parseletter ( $letter, $table, $values );
721 sub _parseletter_sth {
725 carp "ERROR: _parseletter_sth() called without argument (table)";
728 # NOTE: we used to check whether we had a statement handle cached in
729 # a %handles module-level variable. This was a dumb move and
730 # broke things for the rest of us. prepare_cached is a better
731 # way to cache statement handles anyway.
733 ($table eq 'accountlines' ) ? "SELECT * FROM $table WHERE accountlines_id = ?" :
734 ($table eq 'biblio' ) ? "SELECT * FROM $table WHERE biblionumber = ?" :
735 ($table eq 'biblioitems' ) ? "SELECT * FROM $table WHERE biblionumber = ?" :
736 ($table eq 'credits' ) ? "SELECT * FROM accountlines WHERE accountlines_id = ?" :
737 ($table eq 'debits' ) ? "SELECT * FROM accountlines WHERE accountlines_id = ?" :
738 ($table eq 'items' ) ? "SELECT * FROM $table WHERE itemnumber = ?" :
739 ($table eq 'issues' ) ? "SELECT * FROM $table WHERE itemnumber = ?" :
740 ($table eq 'old_issues' ) ? "SELECT * FROM $table WHERE issue_id = ?" :
741 ($table eq 'reserves' ) ? "SELECT * FROM $table WHERE borrowernumber = ? and biblionumber = ?" :
742 ($table eq 'borrowers' ) ? "SELECT * FROM $table WHERE borrowernumber = ?" :
743 ($table eq 'branches' ) ? "SELECT * FROM $table WHERE branchcode = ?" :
744 ($table eq 'suggestions' ) ? "SELECT * FROM $table WHERE suggestionid = ?" :
745 ($table eq 'aqbooksellers') ? "SELECT * FROM $table WHERE id = ?" :
746 ($table eq 'aqorders' ) ? "SELECT * FROM $table WHERE ordernumber = ?" :
747 ($table eq 'aqbasket' ) ? "SELECT * FROM $table WHERE basketno = ?" :
748 ($table eq 'illrequests' ) ? "SELECT * FROM $table WHERE illrequest_id = ?" :
749 ($table eq 'article_requests') ? "SELECT * FROM $table WHERE id = ?" :
750 ($table eq 'borrower_modifications') ? "SELECT * FROM $table WHERE verification_token = ?" :
751 ($table eq 'subscription') ? "SELECT * FROM $table WHERE subscriptionid = ?" :
752 ($table eq 'serial') ? "SELECT * FROM $table WHERE serialid = ?" :
753 ($table eq 'problem_reports') ? "SELECT * FROM $table WHERE reportid = ?" :
754 ($table eq 'additional_contents' || $table eq 'opac_news') ? "SELECT * FROM additional_contents WHERE idnew = ?" :
755 ($table eq 'recalls') ? "SELECT * FROM $table WHERE recall_id = ?" :
758 warn "ERROR: No _parseletter_sth query for table '$table'";
759 return; # nothing to get
761 unless ($sth = C4::Context->dbh->prepare_cached($query)) {
762 warn "ERROR: Failed to prepare query: '$query'";
765 return $sth; # now cache is populated for that $table
768 =head2 _parseletter($letter, $table, $values)
771 - $letter : a hash to letter fields (title & content useful)
772 - $table : the Koha table to parse.
773 - $values_in : table record hashref
774 parse all fields from a table, and replace values in title & content with the appropriate value
775 (not exported sub, used only internally)
780 my ( $letter, $table, $values_in ) = @_;
782 # Work on a local copy of $values_in (passed by reference) to avoid side effects
783 # in callers ( by changing / formatting values )
784 my $values = $values_in ? { %$values_in } : {};
786 if ( $table eq 'borrowers' && $values->{'dateexpiry'} ){
787 $values->{'dateexpiry'} = output_pref({ dt => dt_from_string( $values->{'dateexpiry'} ), dateonly => 1 });
790 if ( $table eq 'reserves' && $values->{'waitingdate'} ) {
791 $values->{'waitingdate'} = output_pref({ dt => dt_from_string( $values->{'waitingdate'} ), dateonly => 1 });
794 if ($letter->{content} && $letter->{content} =~ /<<today>>/) {
795 my $todaysdate = output_pref( dt_from_string() );
796 $letter->{content} =~ s/<<today>>/$todaysdate/go;
799 while ( my ($field, $val) = each %$values ) {
800 $val =~ s/\p{P}$// if $val && $table=~/biblio/;
801 #BZ 9886: Assuming that we want to eliminate ISBD punctuation here
802 #Therefore adding the test on biblio. This includes biblioitems,
803 #but excludes items. Removed unneeded global and lookahead.
805 if ( $table=~/^borrowers$/ && $field=~/^streettype$/ ) {
806 my $av = Koha::AuthorisedValues->search({ category => 'ROADTYPE', authorised_value => $val });
807 $val = $av->count ? $av->next->lib : '';
811 my $replacedby = defined ($val) ? $val : '';
813 and not $replacedby =~ m|9999-12-31|
814 and $replacedby =~ m|^\d{4}-\d{2}-\d{2}( \d{2}:\d{2}:\d{2})?$| )
816 # If the value is XXXX-YY-ZZ[ AA:BB:CC] we assume it is a date
817 my $dateonly = defined $1 ? 0 : 1; #$1 refers to the capture group wrapped in parentheses. In this case, that's the hours, minutes, seconds.
818 my $re_dateonly_filter = qr{ $field( \s* \| \s* dateonly\s*)?>> }xms;
820 for my $letter_field ( qw( title content ) ) {
821 my $filter_string_used = q{};
822 if ( $letter->{ $letter_field } =~ $re_dateonly_filter ) {
823 # We overwrite $dateonly if the filter exists and we have a time in the datetime
824 $filter_string_used = $1 || q{};
825 $dateonly = $1 unless $dateonly;
827 my $replacedby_date = eval {
828 output_pref({ dt => scalar dt_from_string( $replacedby ), dateonly => $dateonly });
830 $replacedby_date //= q{};
832 if ( $letter->{ $letter_field } ) {
833 $letter->{ $letter_field } =~ s/\Q<<$table.$field$filter_string_used>>\E/$replacedby_date/g;
834 $letter->{ $letter_field } =~ s/\Q<<$field$filter_string_used>>\E/$replacedby_date/g;
838 # Other fields replacement
840 for my $letter_field ( qw( title content ) ) {
841 if ( $letter->{ $letter_field } ) {
842 $letter->{ $letter_field } =~ s/<<$table.$field>>/$replacedby/g;
843 $letter->{ $letter_field } =~ s/<<$field>>/$replacedby/g;
849 if ($table eq 'borrowers' && $letter->{content}) {
850 my $patron = Koha::Patrons->find( $values->{borrowernumber} );
852 my $attributes = $patron->extended_attributes;
854 while ( my $attribute = $attributes->next ) {
855 my $code = $attribute->code;
856 my $val = $attribute->description; # FIXME - we always display intranet description here!
857 $val =~ s/\p{P}(?=$)//g if $val;
858 next unless $val gt '';
860 push @{ $attr{$code} }, $val;
862 while ( my ($code, $val_ar) = each %attr ) {
863 my $replacefield = "<<borrower-attribute:$code>>";
864 my $replacedby = join ',', @$val_ar;
865 $letter->{content} =~ s/$replacefield/$replacedby/g;
874 my $success = EnqueueLetter( { letter => $letter,
875 borrowernumber => '12', message_transport_type => 'email' } )
877 Places a letter in the message_queue database table, which will
878 eventually get processed (sent) by the process_message_queue.pl
879 cronjob when it calls SendQueuedMessages.
881 Return message_id on success
884 * letter - required; A letter hashref as returned from GetPreparedLetter
885 * message_transport_type - required; One of the available mtts
886 * borrowernumber - optional if 'to_address' is passed; The borrowernumber of the patron we enqueuing the notice for
887 * to_address - optional if 'borrowernumber' is passed; The destination email address for the notice (defaults to patron->notice_email_address)
888 * from_address - optional; The from address for the notice, defaults to patron->library->from_email_address
889 * reply_address - optional; The reply address for the notice, defaults to patron->library->reply_to
894 my $params = shift or return;
896 return unless exists $params->{'letter'};
897 # return unless exists $params->{'borrowernumber'};
898 return unless exists $params->{'message_transport_type'};
900 my $content = $params->{letter}->{content};
901 $content =~ s/\s+//g if(defined $content);
902 if ( not defined $content or $content eq '' ) {
903 Koha::Logger->get->info("Trying to add an empty message to the message queue");
907 # If we have any attachments we should encode then into the body.
908 if ( $params->{'attachments'} ) {
909 $params->{'letter'} = _add_attachments(
910 { letter => $params->{'letter'},
911 attachments => $params->{'attachments'},
916 my $dbh = C4::Context->dbh();
917 my $statement = << 'ENDSQL';
918 INSERT INTO message_queue
919 ( borrowernumber, subject, content, metadata, letter_code, message_transport_type, status, time_queued, to_address, from_address, reply_address, content_type, failure_code )
921 ( ?, ?, ?, ?, ?, ?, ?, CAST(NOW() AS DATETIME), ?, ?, ?, ?, ? )
924 my $sth = $dbh->prepare($statement);
925 my $result = $sth->execute(
926 $params->{'borrowernumber'}, # borrowernumber
927 $params->{'letter'}->{'title'}, # subject
928 $params->{'letter'}->{'content'}, # content
929 $params->{'letter'}->{'metadata'} || '', # metadata
930 $params->{'letter'}->{'code'} || '', # letter_code
931 $params->{'message_transport_type'}, # message_transport_type
933 $params->{'to_address'}, # to_address
934 $params->{'from_address'}, # from_address
935 $params->{'reply_address'}, # reply_address
936 $params->{'letter'}->{'content-type'}, # content_type
937 $params->{'failure_code'} || '', # failure_code
939 return $dbh->last_insert_id(undef,undef,'message_queue', undef);
942 =head2 SendQueuedMessages ([$hashref])
944 my $sent = SendQueuedMessages({
945 letter_code => $letter_code,
946 borrowernumber => $who_letter_is_for,
952 Sends all of the 'pending' items in the message queue, unless
953 parameters are passed.
955 The letter_code, borrowernumber and limit parameters are used
956 to build a parameter set for _get_unsent_messages, thus limiting
957 which pending messages will be processed. They are all optional.
959 The verbose parameter can be used to generate debugging output.
962 Returns number of messages sent.
966 sub SendQueuedMessages {
969 my $which_unsent_messages = {
970 'message_id' => $params->{'message_id'},
971 'limit' => $params->{'limit'} // 0,
972 'borrowernumber' => $params->{'borrowernumber'} // q{},
973 'letter_code' => $params->{'letter_code'} // q{},
974 'message_transport_type' => $params->{'type'} // q{},
976 my $unsent_messages = _get_unsent_messages( $which_unsent_messages );
977 MESSAGE: foreach my $message ( @$unsent_messages ) {
978 my $message_object = Koha::Notice::Messages->find( $message->{message_id} );
979 # If this fails the database is unwritable and we won't manage to send a message that continues to be marked 'pending'
980 $message_object->make_column_dirty('status');
981 return unless $message_object->store;
983 # warn Data::Dumper->Dump( [ $message ], [ 'message' ] );
984 warn sprintf( 'sending %s message to patron: %s',
985 $message->{'message_transport_type'},
986 $message->{'borrowernumber'} || 'Admin' )
987 if $params->{'verbose'};
988 # This is just begging for subclassing
989 next MESSAGE if ( lc($message->{'message_transport_type'}) eq 'rss' );
990 if ( lc( $message->{'message_transport_type'} ) eq 'email' ) {
991 _send_message_by_email( $message, $params->{'username'}, $params->{'password'}, $params->{'method'} );
993 elsif ( lc( $message->{'message_transport_type'} ) eq 'sms' ) {
994 if ( C4::Context->preference('SMSSendDriver') eq 'Email' ) {
995 my $patron = Koha::Patrons->find( $message->{borrowernumber} );
996 my $sms_provider = Koha::SMS::Providers->find( $patron->sms_provider_id );
997 unless ( $sms_provider ) {
998 warn sprintf( "Patron %s has no sms provider id set!", $message->{'borrowernumber'} ) if $params->{'verbose'};
999 _set_message_status( { message_id => $message->{'message_id'}, status => 'failed' } );
1002 unless ( $patron->smsalertnumber ) {
1003 _set_message_status( { message_id => $message->{'message_id'}, status => 'failed' } );
1004 warn sprintf( "No smsalertnumber found for patron %s!", $message->{'borrowernumber'} ) if $params->{'verbose'};
1007 $message->{to_address} = $patron->smsalertnumber; #Sometime this is set to email - sms should always use smsalertnumber
1008 $message->{to_address} .= '@' . $sms_provider->domain();
1010 # Check for possible from_address override
1011 my $from_address = C4::Context->preference('EmailSMSSendDriverFromAddress');
1012 if ($from_address && $message->{from_address} ne $from_address) {
1013 $message->{from_address} = $from_address;
1014 _update_message_from_address($message->{'message_id'}, $message->{from_address});
1017 _update_message_to_address($message->{'message_id'}, $message->{to_address});
1018 _send_message_by_email( $message, $params->{'username'}, $params->{'password'}, $params->{'method'} );
1020 _send_message_by_sms( $message );
1024 return scalar( @$unsent_messages );
1027 =head2 GetRSSMessages
1029 my $message_list = GetRSSMessages( { limit => 10, borrowernumber => '14' } )
1031 returns a listref of all queued RSS messages for a particular person.
1035 sub GetRSSMessages {
1038 return unless $params;
1039 return unless ref $params;
1040 return unless $params->{'borrowernumber'};
1042 return _get_unsent_messages( { message_transport_type => 'rss',
1043 limit => $params->{'limit'},
1044 borrowernumber => $params->{'borrowernumber'}, } );
1047 =head2 GetPrintMessages
1049 my $message_list = GetPrintMessages( { borrowernumber => $borrowernumber } )
1051 Returns a arrayref of all queued print messages (optionally, for a particular
1056 sub GetPrintMessages {
1057 my $params = shift || {};
1059 return _get_unsent_messages( { message_transport_type => 'print',
1060 borrowernumber => $params->{'borrowernumber'},
1064 =head2 GetQueuedMessages ([$hashref])
1066 my $messages = GetQueuedMessage( { borrowernumber => '123', limit => 20 } );
1068 Fetches a list of messages from the message queue optionally filtered by borrowernumber
1069 and limited to specified limit.
1071 Return is an arrayref of hashes, each has represents a message in the message queue.
1075 sub GetQueuedMessages {
1078 my $dbh = C4::Context->dbh();
1079 my $statement = << 'ENDSQL';
1080 SELECT message_id, borrowernumber, subject, content, message_transport_type, status, time_queued, updated_on, failure_code
1086 if ( exists $params->{'borrowernumber'} ) {
1087 push @whereclauses, ' borrowernumber = ? ';
1088 push @query_params, $params->{'borrowernumber'};
1091 if ( @whereclauses ) {
1092 $statement .= ' WHERE ' . join( 'AND', @whereclauses );
1095 if ( defined $params->{'limit'} ) {
1096 $statement .= ' LIMIT ? ';
1097 push @query_params, $params->{'limit'};
1100 my $sth = $dbh->prepare( $statement );
1101 my $result = $sth->execute( @query_params );
1102 return $sth->fetchall_arrayref({});
1105 =head2 GetMessageTransportTypes
1107 my @mtt = GetMessageTransportTypes();
1109 returns an arrayref of transport types
1113 sub GetMessageTransportTypes {
1114 my $dbh = C4::Context->dbh();
1115 my $mtts = $dbh->selectcol_arrayref("
1116 SELECT message_transport_type
1117 FROM message_transport_types
1118 ORDER BY message_transport_type
1125 my $message = C4::Letters::Message($message_id);
1130 my ( $message_id ) = @_;
1131 return unless $message_id;
1132 my $dbh = C4::Context->dbh;
1133 return $dbh->selectrow_hashref(q|
1134 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
1136 WHERE message_id = ?
1137 |, {}, $message_id );
1140 =head2 ResendMessage
1142 Attempt to resend a message which has failed previously.
1144 my $has_been_resent = C4::Letters::ResendMessage($message_id);
1146 Updates the message to 'pending' status so that
1147 it will be resent later on.
1149 returns 1 on success, 0 on failure, undef if no message was found
1154 my $message_id = shift;
1155 return unless $message_id;
1157 my $message = GetMessage( $message_id );
1158 return unless $message;
1160 if ( $message->{status} ne 'pending' ) {
1161 $rv = C4::Letters::_set_message_status({
1162 message_id => $message_id,
1163 status => 'pending',
1165 $rv = $rv > 0? 1: 0;
1166 # Clear destination email address to force address update
1167 _update_message_to_address( $message_id, undef ) if $rv &&
1168 $message->{message_transport_type} eq 'email';
1173 =head2 _add_attachements
1175 _add_attachments({ letter => $letter, attachments => $attachments });
1178 letter - the standard letter hashref
1179 attachments - listref of attachments. each attachment is a hashref of:
1180 type - the mime type, like 'text/plain'
1181 content - the actual attachment
1182 filename - the name of the attachment.
1184 returns your letter object, with the content updated.
1185 This routine picks the I<content> of I<letter> and generates a MIME
1186 email, attaching the passed I<attachments> using Koha::Email. The
1187 content is replaced by the string representation of the MIME object,
1188 and the content-type is updated for later handling.
1192 sub _add_attachments {
1195 my $letter = $params->{letter};
1196 my $attachments = $params->{attachments};
1197 return $letter unless @$attachments;
1199 my $message = Koha::Email->new;
1201 if ( $letter->{is_html} ) {
1202 $message->html_body( _wrap_html( $letter->{content}, $letter->{title} ) );
1205 $message->text_body( $letter->{content} );
1208 foreach my $attachment ( @$attachments ) {
1210 Encode::encode( "UTF-8", $attachment->{content} ),
1211 content_type => $attachment->{type} || 'application/octet-stream',
1212 name => $attachment->{filename},
1213 disposition => 'attachment',
1217 $letter->{'content-type'} = SERIALIZED_EMAIL_CONTENT_TYPE;
1218 $letter->{content} = $message->as_string;
1224 =head2 _get_unsent_messages
1226 This function's parameter hash reference takes the following
1227 optional named parameters:
1228 message_transport_type: method of message sending (e.g. email, sms, etc.)
1229 Can be a single string, or an arrayref of strings
1230 borrowernumber : who the message is to be sent
1231 letter_code : type of message being sent (e.g. PASSWORD_RESET)
1232 Can be a single string, or an arrayref of strings
1233 message_id : the message_id of the message. In that case the sub will return only 1 result
1234 limit : maximum number of messages to send
1236 This function returns an array of matching hash referenced rows from
1237 message_queue with some borrower information added.
1241 sub _get_unsent_messages {
1244 my $dbh = C4::Context->dbh();
1246 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
1247 FROM message_queue mq
1248 LEFT JOIN borrowers b ON b.borrowernumber = mq.borrowernumber
1252 my @query_params = ('pending');
1253 if ( ref $params ) {
1254 if ( $params->{'borrowernumber'} ) {
1255 $statement .= ' AND mq.borrowernumber = ? ';
1256 push @query_params, $params->{'borrowernumber'};
1258 if ( $params->{'letter_code'} ) {
1259 my @letter_codes = ref $params->{'letter_code'} eq "ARRAY" ? @{$params->{'letter_code'}} : $params->{'letter_code'};
1260 if ( @letter_codes ) {
1261 my $q = join( ",", ("?") x @letter_codes );
1262 $statement .= " AND mq.letter_code IN ( $q ) ";
1263 push @query_params, @letter_codes;
1266 if ( $params->{'message_transport_type'} ) {
1267 my @types = ref $params->{'message_transport_type'} eq "ARRAY" ? @{$params->{'message_transport_type'}} : $params->{'message_transport_type'};
1269 my $q = join( ",", ("?") x @types );
1270 $statement .= " AND message_transport_type IN ( $q ) ";
1271 push @query_params, @types;
1274 if ( $params->{message_id} ) {
1275 $statement .= ' AND message_id = ?';
1276 push @query_params, $params->{message_id};
1278 if ( $params->{'limit'} ) {
1279 $statement .= ' limit ? ';
1280 push @query_params, $params->{'limit'};
1284 my $sth = $dbh->prepare( $statement );
1285 my $result = $sth->execute( @query_params );
1286 return $sth->fetchall_arrayref({});
1289 sub _send_message_by_email {
1290 my $message = shift or return;
1291 my ($username, $password, $method) = @_;
1293 my $patron = Koha::Patrons->find( $message->{borrowernumber} );
1294 my $to_address = $message->{'to_address'};
1295 unless ($to_address) {
1297 warn "FAIL: No 'to_address' and INVALID borrowernumber ($message->{borrowernumber})";
1298 _set_message_status(
1300 message_id => $message->{'message_id'},
1302 failure_code => 'INVALID_BORNUMBER'
1307 $to_address = $patron->notice_email_address;
1308 unless ($to_address) {
1309 # warn "FAIL: No 'to_address' and no email for " . ($member->{surname} ||'') . ", borrowernumber ($message->{borrowernumber})";
1310 # warning too verbose for this more common case?
1311 _set_message_status(
1313 message_id => $message->{'message_id'},
1315 failure_code => 'NO_EMAIL'
1322 my $subject = $message->{'subject'};
1324 my $content = $message->{'content'};
1325 my $content_type = $message->{'content_type'} || 'text/plain; charset="UTF-8"';
1326 my $is_html = $content_type =~ m/html/io;
1328 my $branch_email = undef;
1329 my $branch_replyto = undef;
1330 my $branch_returnpath = undef;
1334 $library = $patron->library;
1335 $branch_email = $library->from_email_address;
1336 $branch_replyto = $library->branchreplyto;
1337 $branch_returnpath = $library->branchreturnpath;
1340 # NOTE: Patron may not be defined above so branch_email may be undefined still
1341 # so we need to fallback to KohaAdminEmailAddress as a last resort.
1343 $message->{'from_address'}
1345 || C4::Context->preference('KohaAdminEmailAddress');
1346 if( !$from_address ) {
1347 _set_message_status(
1349 message_id => $message->{'message_id'},
1351 failure_code => 'NO_FROM',
1363 C4::Context->preference('NoticeBcc')
1364 ? ( bcc => C4::Context->preference('NoticeBcc') )
1367 from => $from_address,
1368 reply_to => $message->{'reply_address'} || $branch_replyto,
1369 sender => $branch_returnpath,
1370 subject => "" . $message->{subject}
1373 if ( $message->{'content_type'} && $message->{'content_type'} eq SERIALIZED_EMAIL_CONTENT_TYPE ) {
1375 # The message has been previously composed as a valid MIME object
1376 # and serialized as a string on the DB
1377 $email = Koha::Email->new_from_string($content);
1378 $email->create($params);
1380 $email = Koha::Email->create($params);
1382 $email->html_body( _wrap_html( $content, $subject ) );
1384 $email->text_body($content);
1389 if ( ref($_) eq 'Koha::Exceptions::BadParameter' ) {
1390 _set_message_status(
1392 message_id => $message->{'message_id'},
1394 failure_code => "INVALID_EMAIL:".$_->parameter
1398 _set_message_status(
1400 message_id => $message->{'message_id'},
1402 failure_code => 'UNKNOWN_ERROR'
1408 return unless $email;
1412 $smtp_server = $library->smtp_server;
1415 $smtp_server = Koha::SMTP::Servers->get_default;
1421 sasl_username => $username,
1422 sasl_password => $password,
1427 # if initial message address was empty, coming here means that a to address was found and
1428 # queue should be updated; same if to address was overriden by Koha::Email->create
1429 _update_message_to_address( $message->{'message_id'}, $email->email->header('To') )
1430 if !$message->{to_address}
1431 || $message->{to_address} ne $email->email->header('To');
1434 $email->send_or_die({ transport => $smtp_server->transport });
1436 _set_message_status(
1438 message_id => $message->{'message_id'},
1446 _set_message_status(
1448 message_id => $message->{'message_id'},
1450 failure_code => 'SENDMAIL'
1454 carp "$Mail::Sendmail::error";
1460 my ($content, $title) = @_;
1462 my $css = C4::Context->preference("NoticeCSS") || '';
1463 $css = qq{<link rel="stylesheet" type="text/css" href="$css">} if $css;
1465 <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
1466 "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
1467 <html lang="en" xml:lang="en" xmlns="http://www.w3.org/1999/xhtml">
1469 <title>$title</title>
1470 <meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
1481 my ( $message ) = @_;
1482 my $dbh = C4::Context->dbh;
1483 my $count = $dbh->selectrow_array(q|
1486 WHERE message_transport_type = ?
1487 AND borrowernumber = ?
1489 AND CAST(updated_on AS date) = CAST(NOW() AS date)
1492 |, {}, $message->{message_transport_type}, $message->{borrowernumber}, $message->{letter_code}, $message->{content} );
1496 sub _send_message_by_sms {
1497 my $message = shift or return;
1498 my $patron = Koha::Patrons->find( $message->{borrowernumber} );
1499 _update_message_to_address($message->{message_id}, $patron->smsalertnumber) if $patron;
1501 unless ( $patron and $patron->smsalertnumber ) {
1502 _set_message_status( { message_id => $message->{'message_id'},
1504 failure_code => 'MISSING_SMS' } );
1508 if ( _is_duplicate( $message ) ) {
1509 _set_message_status(
1511 message_id => $message->{'message_id'},
1513 failure_code => 'DUPLICATE_MESSAGE'
1519 my $success = C4::SMS->send_sms(
1521 destination => $patron->smsalertnumber,
1522 message => $message->{'content'},
1527 _set_message_status(
1529 message_id => $message->{'message_id'},
1536 _set_message_status(
1538 message_id => $message->{'message_id'},
1540 failure_code => 'NO_NOTES'
1548 sub _update_message_to_address {
1550 my $dbh = C4::Context->dbh();
1551 $dbh->do('UPDATE message_queue SET to_address=? WHERE message_id=?',undef,($to,$id));
1554 sub _update_message_from_address {
1555 my ($message_id, $from_address) = @_;
1556 my $dbh = C4::Context->dbh();
1557 $dbh->do('UPDATE message_queue SET from_address = ? WHERE message_id = ?', undef, ($from_address, $message_id));
1560 sub _set_message_status {
1561 my $params = shift or return;
1563 foreach my $required_parameter ( qw( message_id status ) ) {
1564 return unless exists $params->{ $required_parameter };
1567 my $dbh = C4::Context->dbh();
1568 my $statement = 'UPDATE message_queue SET status= ?, failure_code= ? WHERE message_id = ?';
1569 my $sth = $dbh->prepare( $statement );
1570 my $result = $sth->execute( $params->{'status'},
1571 $params->{'failure_code'} || '',
1572 $params->{'message_id'} );
1577 my ( $params ) = @_;
1579 my $content = $params->{content};
1580 my $tables = $params->{tables};
1581 my $loops = $params->{loops};
1582 my $substitute = $params->{substitute} || {};
1583 my $lang = defined($params->{lang}) && $params->{lang} ne 'default' ? $params->{lang} : 'en';
1584 my ($theme, $availablethemes);
1586 my $htdocs = C4::Context->config('intrahtdocs');
1587 ($theme, $lang, $availablethemes)= C4::Templates::availablethemes( $htdocs, 'about.tt', 'intranet', $lang);
1589 foreach (@$availablethemes) {
1590 push @includes, "$htdocs/$_/$lang/includes";
1591 push @includes, "$htdocs/$_/en/includes" unless $lang eq 'en';
1594 my $use_template_cache = C4::Context->config('template_cache_dir') && defined $ENV{GATEWAY_INTERFACE};
1595 my $template = Template->new(
1599 PLUGIN_BASE => 'Koha::Template::Plugin',
1600 COMPILE_EXT => $use_template_cache ? '.ttc' : '',
1601 COMPILE_DIR => $use_template_cache ? C4::Context->config('template_cache_dir') : '',
1602 INCLUDE_PATH => \@includes,
1604 ENCODING => 'UTF-8',
1606 ) or die Template->error();
1608 my $tt_params = { %{ _get_tt_params( $tables ) }, %{ _get_tt_params( $loops, 'is_a_loop' ) }, %$substitute };
1610 $content = add_tt_filters( $content );
1611 $content = qq|[% USE KohaDates %][% USE Remove_MARC_punctuation %]$content|;
1614 $template->process( \$content, $tt_params, \$output ) || croak "ERROR PROCESSING TEMPLATE: " . $template->error();
1619 sub _get_tt_params {
1620 my ($tables, $is_a_loop) = @_;
1626 article_requests => {
1627 module => 'Koha::ArticleRequests',
1628 singular => 'article_request',
1629 plural => 'article_requests',
1633 module => 'Koha::Acquisition::Baskets',
1634 singular => 'basket',
1635 plural => 'baskets',
1639 module => 'Koha::Biblios',
1640 singular => 'biblio',
1641 plural => 'biblios',
1642 pk => 'biblionumber',
1645 module => 'Koha::Biblioitems',
1646 singular => 'biblioitem',
1647 plural => 'biblioitems',
1648 pk => 'biblioitemnumber',
1651 module => 'Koha::Patrons',
1652 singular => 'borrower',
1653 plural => 'borrowers',
1654 pk => 'borrowernumber',
1657 module => 'Koha::Libraries',
1658 singular => 'branch',
1659 plural => 'branches',
1663 module => 'Koha::Account::Lines',
1664 singular => 'credit',
1665 plural => 'credits',
1666 pk => 'accountlines_id',
1669 module => 'Koha::Account::Lines',
1670 singular => 'debit',
1672 pk => 'accountlines_id',
1675 module => 'Koha::Items',
1680 additional_contents => {
1681 module => 'Koha::AdditionalContents',
1682 singular => 'additional_content',
1683 plural => 'additional_contents',
1687 module => 'Koha::AdditionalContents',
1693 module => 'Koha::Acquisition::Orders',
1694 singular => 'order',
1696 pk => 'ordernumber',
1699 module => 'Koha::Holds',
1705 module => 'Koha::Serials',
1706 singular => 'serial',
1707 plural => 'serials',
1711 module => 'Koha::Subscriptions',
1712 singular => 'subscription',
1713 plural => 'subscriptions',
1714 pk => 'subscriptionid',
1717 module => 'Koha::Suggestions',
1718 singular => 'suggestion',
1719 plural => 'suggestions',
1720 pk => 'suggestionid',
1723 module => 'Koha::Checkouts',
1724 singular => 'checkout',
1725 plural => 'checkouts',
1729 module => 'Koha::Old::Checkouts',
1730 singular => 'old_checkout',
1731 plural => 'old_checkouts',
1735 module => 'Koha::Checkouts',
1736 singular => 'overdue',
1737 plural => 'overdues',
1740 borrower_modifications => {
1741 module => 'Koha::Patron::Modifications',
1742 singular => 'patron_modification',
1743 plural => 'patron_modifications',
1744 fk => 'verification_token',
1747 module => 'Koha::Illrequests',
1748 singular => 'illrequest',
1749 plural => 'illrequests',
1750 pk => 'illrequest_id'
1754 foreach my $table ( keys %$tables ) {
1755 next unless $config->{$table};
1757 my $ref = ref( $tables->{$table} ) || q{};
1758 my $module = $config->{$table}->{module};
1760 if ( can_load( modules => { $module => undef } ) ) {
1761 my $pk = $config->{$table}->{pk};
1762 my $fk = $config->{$table}->{fk};
1765 my $values = $tables->{$table} || [];
1766 unless ( ref( $values ) eq 'ARRAY' ) {
1767 croak "ERROR processing table $table. Wrong API call.";
1769 my $key = $pk ? $pk : $fk;
1770 # $key does not come from user input
1771 my $objects = $module->search(
1772 { $key => $values },
1774 # We want to retrieve the data in the same order
1776 # field is a MySQLism, but they are no other way to do it
1777 # To be generic we could do it in perl, but we will need to fetch
1778 # all the data then order them
1779 @$values ? ( order_by => \[ "field($key, " . join( ', ', @$values ) . ")" ] ) : ()
1782 $params->{ $config->{$table}->{plural} } = $objects;
1784 elsif ( $ref eq q{} || $ref eq 'HASH' ) {
1785 my $id = ref $ref eq 'HASH' ? $tables->{$table}->{$pk} : $tables->{$table};
1787 if ( $fk ) { # Using a foreign key for lookup
1788 if ( ref( $fk ) eq 'ARRAY' ) { # Foreign key is multi-column
1790 foreach my $key ( @$fk ) {
1791 $search->{$key} = $id->{$key};
1793 $object = $module->search( $search )->last();
1794 } else { # Foreign key is single column
1795 $object = $module->search( { $fk => $id } )->last();
1797 } else { # using the table's primary key for lookup
1798 $object = $module->find($id);
1800 $params->{ $config->{$table}->{singular} } = $object;
1802 else { # $ref eq 'ARRAY'
1804 if ( @{ $tables->{$table} } == 1 ) { # Param is a single key
1805 $object = $module->search( { $pk => $tables->{$table} } )->last();
1807 else { # Params are mutliple foreign keys
1808 croak "Multiple foreign keys (table $table) should be passed using an hashref";
1810 $params->{ $config->{$table}->{singular} } = $object;
1814 croak "ERROR LOADING MODULE $module: $Module::Load::Conditional::ERROR";
1818 $params->{today} = output_pref({ dt => dt_from_string, dateformat => 'iso' });
1823 =head3 add_tt_filters
1825 $content = add_tt_filters( $content );
1827 Add TT filters to some specific fields if needed.
1829 For now we only add the Remove_MARC_punctuation TT filter to biblio and biblioitem fields
1833 sub add_tt_filters {
1834 my ( $content ) = @_;
1835 $content =~ s|\[%\s*biblio\.(.*?)\s*%\]|[% biblio.$1 \| \$Remove_MARC_punctuation %]|gxms;
1836 $content =~ s|\[%\s*biblioitem\.(.*?)\s*%\]|[% biblioitem.$1 \| \$Remove_MARC_punctuation %]|gxms;
1840 =head2 get_item_content
1842 my $item = Koha::Items->find(...)->unblessed;
1843 my @item_content_fields = qw( date_due title barcode author itemnumber );
1844 my $item_content = C4::Letters::get_item_content({
1846 item_content_fields => \@item_content_fields
1849 This function generates a tab-separated list of values for the passed item. Dates
1850 are formatted following the current setup.
1854 sub get_item_content {
1855 my ( $params ) = @_;
1856 my $item = $params->{item};
1857 my $dateonly = $params->{dateonly} || 0;
1858 my $item_content_fields = $params->{item_content_fields} || [];
1860 return unless $item;
1862 my @item_info = map {
1866 { dt => dt_from_string( $item->{$_} ), dateonly => $dateonly } );
1870 } @$item_content_fields;
1871 return join( "\t", @item_info ) . "\n";