3 # Copyright 2000-2002 Katipo Communications
5 # This file is part of Koha.
7 # Koha is free software; you can redistribute it and/or modify it
8 # under the terms of the GNU General Public License as published by
9 # the Free Software Foundation; either version 3 of the License, or
10 # (at your option) any later version.
12 # Koha is distributed in the hope that it will be useful, but
13 # WITHOUT ANY WARRANTY; without even the implied warranty of
14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 # GNU General Public License for more details.
17 # You should have received a copy of the GNU General Public License
18 # along with Koha; if not, see <http://www.gnu.org/licenses>.
23 use Date::Calc qw( Add_Delta_Days );
27 use Module::Load::Conditional qw(can_load);
36 use Koha::SMS::Providers;
39 use Koha::Notice::Messages;
40 use Koha::Notice::Templates;
41 use Koha::DateUtils qw( format_sqldatetime dt_from_string );
43 use Koha::SMTP::Servers;
44 use Koha::Subscriptions;
46 use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
52 &GetLetters &GetLettersAvailableForALibrary &GetLetterTemplates &DelLetter &GetPreparedLetter &GetWrappedLetter &SendAlerts &GetPrintMessages &GetMessageTransportTypes
58 C4::Letters - Give functions for Letters management
66 "Letters" is the tool used in Koha to manage informations sent to the patrons and/or the library. This include some cron jobs like
67 late issues, as well as other tasks like sending a mail to users that have subscribed to a "serial issue alert" (= being warned every time a new issue has arrived at the library)
69 Letters are managed through "alerts" sent by Koha on some events. All "alert" related functions are in this module too.
71 =head2 GetLetters([$module])
73 $letters = &GetLetters($module);
74 returns informations about letters.
75 if needed, $module filters for letters given module
77 DEPRECATED - You must use Koha::Notice::Templates instead
78 The group by clause is confusing and can lead to issues
84 my $module = $filters->{module};
85 my $code = $filters->{code};
86 my $branchcode = $filters->{branchcode};
87 my $dbh = C4::Context->dbh;
88 my $letters = $dbh->selectall_arrayref(
90 SELECT code, module, name
94 . ( $module ? q| AND module = ?| : q|| )
95 . ( $code ? q| AND code = ?| : q|| )
96 . ( defined $branchcode ? q| AND branchcode = ?| : q|| )
97 . q| GROUP BY code, module, name ORDER BY name|, { Slice => {} }
98 , ( $module ? $module : () )
99 , ( $code ? $code : () )
100 , ( defined $branchcode ? $branchcode : () )
106 =head2 GetLetterTemplates
108 my $letter_templates = GetLetterTemplates(
110 module => 'circulation',
112 branchcode => 'CPL', # '' for default,
116 Return a hashref of letter templates.
120 sub GetLetterTemplates {
123 my $module = $params->{module};
124 my $code = $params->{code};
125 my $branchcode = $params->{branchcode} // '';
126 my $dbh = C4::Context->dbh;
127 return Koha::Notice::Templates->search(
131 branchcode => $branchcode,
133 C4::Context->preference('TranslateNotices')
135 : ( lang => 'default' )
141 =head2 GetLettersAvailableForALibrary
143 my $letters = GetLettersAvailableForALibrary(
145 branchcode => 'CPL', # '' for default
146 module => 'circulation',
150 Return an arrayref of letters, sorted by name.
151 If a specific letter exist for the given branchcode, it will be retrieve.
152 Otherwise the default letter will be.
156 sub GetLettersAvailableForALibrary {
158 my $branchcode = $filters->{branchcode};
159 my $module = $filters->{module};
161 croak "module should be provided" unless $module;
163 my $dbh = C4::Context->dbh;
164 my $default_letters = $dbh->selectall_arrayref(
166 SELECT module, code, branchcode, name
170 . q| AND branchcode = ''|
171 . ( $module ? q| AND module = ?| : q|| )
172 . q| ORDER BY name|, { Slice => {} }
173 , ( $module ? $module : () )
176 my $specific_letters;
178 $specific_letters = $dbh->selectall_arrayref(
180 SELECT module, code, branchcode, name
184 . q| AND branchcode = ?|
185 . ( $module ? q| AND module = ?| : q|| )
186 . q| ORDER BY name|, { Slice => {} }
188 , ( $module ? $module : () )
193 for my $l (@$default_letters) {
194 $letters{ $l->{code} } = $l;
196 for my $l (@$specific_letters) {
197 # Overwrite the default letter with the specific one.
198 $letters{ $l->{code} } = $l;
201 return [ map { $letters{$_} }
202 sort { $letters{$a}->{name} cmp $letters{$b}->{name} }
208 my ( $module, $code, $branchcode, $message_transport_type, $lang) = @_;
209 $message_transport_type //= '%';
210 $lang = 'default' unless( $lang && C4::Context->preference('TranslateNotices') );
213 my $only_my_library = C4::Context->only_my_library;
214 if ( $only_my_library and $branchcode ) {
215 $branchcode = C4::Context::mybranch();
219 my $dbh = C4::Context->dbh;
220 my $sth = $dbh->prepare(q{
223 WHERE module=? AND code=? AND (branchcode = ? OR branchcode = '')
224 AND message_transport_type LIKE ?
226 ORDER BY branchcode DESC LIMIT 1
228 $sth->execute( $module, $code, $branchcode, $message_transport_type, $lang );
229 my $line = $sth->fetchrow_hashref
231 $line->{'content-type'} = 'text/html; charset="UTF-8"' if $line->{is_html};
241 module => 'circulation',
247 Delete the letter. The mtt parameter is facultative.
248 If not given, all templates mathing the other parameters will be removed.
254 my $branchcode = $params->{branchcode};
255 my $module = $params->{module};
256 my $code = $params->{code};
257 my $mtt = $params->{mtt};
258 my $lang = $params->{lang};
259 my $dbh = C4::Context->dbh;
266 . ( $mtt ? q| AND message_transport_type = ?| : q|| )
267 . ( $lang? q| AND lang = ?| : q|| )
268 , undef, $branchcode, $module, $code, ( $mtt ? $mtt : () ), ( $lang ? $lang : () ) );
273 my $err = &SendAlerts($type, $externalid, $letter_code);
276 - $type : the type of alert
277 - $externalid : the id of the "object" to query
278 - $letter_code : the notice template to use
280 C<&SendAlerts> sends an email notice directly to a patron or a vendor.
282 Currently it supports ($type):
283 - claim serial issues (claimissues)
284 - claim acquisition orders (claimacquisition)
285 - send acquisition orders to the vendor (orderacquisition)
286 - notify patrons about newly received serial issues (issue)
287 - notify patrons when their account is created (members)
289 Returns undef or { error => 'message } on failure.
290 Returns true on success.
295 my ( $type, $externalid, $letter_code ) = @_;
296 my $dbh = C4::Context->dbh;
297 if ( $type eq 'issue' ) {
299 # prepare the letter...
300 # search the subscriptionid
303 "SELECT subscriptionid FROM serial WHERE serialid=?");
304 $sth->execute($externalid);
305 my ($subscriptionid) = $sth->fetchrow
306 or warn( "No subscription for '$externalid'" ),
309 # search the biblionumber
312 "SELECT biblionumber FROM subscription WHERE subscriptionid=?");
313 $sth->execute($subscriptionid);
314 my ($biblionumber) = $sth->fetchrow
315 or warn( "No biblionumber for '$subscriptionid'" ),
318 # find the list of subscribers to notify
319 my $subscription = Koha::Subscriptions->find( $subscriptionid );
320 my $subscribers = $subscription->subscribers;
321 while ( my $patron = $subscribers->next ) {
322 my $email = $patron->email or next;
324 # warn "sending issues...";
325 my $userenv = C4::Context->userenv;
326 my $library = $patron->library;
327 my $letter = GetPreparedLetter (
329 letter_code => $letter_code,
330 branchcode => $userenv->{branch},
332 'branches' => $library->branchcode,
333 'biblio' => $biblionumber,
334 'biblioitems' => $biblionumber,
335 'borrowers' => $patron->unblessed,
336 'subscription' => $subscriptionid,
337 'serial' => $externalid,
342 # FIXME: This 'default' behaviour should be moved to Koha::Email
343 my $mail = Koha::Email->create(
346 from => $library->branchemail,
347 reply_to => $library->branchreplyto,
348 sender => $library->branchreturnpath,
349 subject => "" . $letter->{title},
353 if ( $letter->{is_html} ) {
354 $mail->html_body( _wrap_html( $letter->{content}, "" . $letter->{title} ) );
357 $mail->text_body( $letter->{content} );
361 $mail->send_or_die({ transport => $library->smtp_server->transport });
365 return { error => "$_" };
369 elsif ( $type eq 'claimacquisition' or $type eq 'claimissues' or $type eq 'orderacquisition' ) {
371 # prepare the letter...
376 if ( $type eq 'claimacquisition') {
378 SELECT aqorders.*,aqbasket.*,biblio.*,biblioitems.*
380 LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno
381 LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
382 LEFT JOIN biblioitems ON aqorders.biblionumber=biblioitems.biblionumber
383 WHERE aqorders.ordernumber IN (
387 carp "No order selected";
388 return { error => "no_order_selected" };
390 $strsth .= join( ",", ('?') x @$externalid ) . ")";
391 $action = "ACQUISITION CLAIM";
392 $sthorders = $dbh->prepare($strsth);
393 $sthorders->execute( @$externalid );
394 $dataorders = $sthorders->fetchall_arrayref( {} );
397 if ($type eq 'claimissues') {
399 SELECT serial.*,subscription.*, biblio.*, biblioitems.*, aqbooksellers.*,
400 aqbooksellers.id AS booksellerid
402 LEFT JOIN subscription ON serial.subscriptionid=subscription.subscriptionid
403 LEFT JOIN biblio ON serial.biblionumber=biblio.biblionumber
404 LEFT JOIN biblioitems ON serial.biblionumber = biblioitems.biblionumber
405 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id
406 WHERE serial.serialid IN (
410 carp "No issues selected";
411 return { error => "no_issues_selected" };
414 $strsth .= join( ",", ('?') x @$externalid ) . ")";
415 $action = "SERIAL CLAIM";
416 $sthorders = $dbh->prepare($strsth);
417 $sthorders->execute( @$externalid );
418 $dataorders = $sthorders->fetchall_arrayref( {} );
421 if ( $type eq 'orderacquisition') {
423 SELECT aqorders.*,aqbasket.*,biblio.*,biblioitems.*
425 LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno
426 LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
427 LEFT JOIN biblioitems ON aqorders.biblionumber=biblioitems.biblionumber
428 WHERE aqbasket.basketno = ?
429 AND orderstatus IN ('new','ordered')
433 carp "No basketnumber given";
434 return { error => "no_basketno" };
436 $action = "ACQUISITION ORDER";
437 $sthorders = $dbh->prepare($strsth);
438 $sthorders->execute($externalid);
439 $dataorders = $sthorders->fetchall_arrayref( {} );
443 $dbh->prepare("select * from aqbooksellers where id=?");
444 $sthbookseller->execute( $dataorders->[0]->{booksellerid} );
445 my $databookseller = $sthbookseller->fetchrow_hashref;
447 my $addressee = $type eq 'claimacquisition' || $type eq 'orderacquisition' ? 'acqprimary' : 'serialsprimary';
450 $dbh->prepare("SELECT * FROM aqcontacts WHERE booksellerid=? AND $type=1 ORDER BY $addressee DESC");
451 $sthcontact->execute( $dataorders->[0]->{booksellerid} );
452 my $datacontact = $sthcontact->fetchrow_hashref;
456 push @email, $datacontact->{email} if ( $datacontact && $datacontact->{email} );
458 warn "Bookseller $dataorders->[0]->{booksellerid} without emails";
459 return { error => "no_email" };
462 while ($addlcontact = $sthcontact->fetchrow_hashref) {
463 push @cc, $addlcontact->{email} if ( $addlcontact && $addlcontact->{email} );
466 my $userenv = C4::Context->userenv;
467 my $letter = GetPreparedLetter (
469 letter_code => $letter_code,
470 branchcode => $userenv->{branch},
472 'branches' => $userenv->{branch},
473 'aqbooksellers' => $databookseller,
474 'aqcontacts' => $datacontact,
475 'aqbasket' => $externalid,
477 repeat => $dataorders,
479 ) or return { error => "no_letter" };
481 # Remove the order tag
482 $letter->{content} =~ s/<order>(.*?)<\/order>/$1/gxms;
485 my $library = Koha::Libraries->find( $userenv->{branch} );
486 my $mail = Koha::Email->create(
488 to => join( ',', @email ),
489 cc => join( ',', @cc ),
492 C4::Context->preference("ClaimsBccCopy")
493 && ( $type eq 'claimacquisition'
494 || $type eq 'claimissues' )
496 ? ( bcc => $userenv->{emailaddress} )
499 from => $library->branchemail
500 || C4::Context->preference('KohaAdminEmailAddress'),
501 subject => "" . $letter->{title},
505 if ( $letter->{is_html} ) {
506 $mail->html_body( _wrap_html( $letter->{content}, "" . $letter->{title} ) );
509 $mail->text_body( "" . $letter->{content} );
513 $mail->send_or_die({ transport => $library->smtp_server->transport });
517 return { error => "$_" };
525 . join( ',', @email )
530 ) if C4::Context->preference("LetterLog");
532 # send an "account details" notice to a newly created user
533 elsif ( $type eq 'members' ) {
534 my $library = Koha::Libraries->find( $externalid->{branchcode} );
535 my $letter = GetPreparedLetter (
537 letter_code => $letter_code,
538 branchcode => $externalid->{'branchcode'},
539 lang => $externalid->{lang} || 'default',
541 'branches' => $library->unblessed,
542 'borrowers' => $externalid->{'borrowernumber'},
544 substitute => { 'borrowers.password' => $externalid->{'password'} },
547 return { error => "no_email" } unless $externalid->{'emailaddr'};
550 # FIXME: This 'default' behaviour should be moved to Koha::Email
551 my $mail = Koha::Email->create(
553 to => $externalid->{'emailaddr'},
554 from => $library->branchemail,
555 reply_to => $library->branchreplyto,
556 sender => $library->branchreturnpath,
557 subject => "" . $letter->{'title'},
561 if ( $letter->{is_html} ) {
562 $mail->html_body( _wrap_html( $letter->{content}, "" . $letter->{title} ) );
565 $mail->text_body( $letter->{content} );
568 $mail->send_or_die({ transport => $library->smtp_server->transport });
572 return { error => "$_" };
576 # If we come here, return an OK status
580 =head2 GetPreparedLetter( %params )
583 module => letter module, mandatory
584 letter_code => letter code, mandatory
585 branchcode => for letter selection, if missing default system letter taken
586 tables => a hashref with table names as keys. Values are either:
587 - a scalar - primary key value
588 - an arrayref - primary key values
589 - a hashref - full record
590 substitute => custom substitution key/value pairs
591 repeat => records to be substituted on consecutive lines:
592 - an arrayref - tries to guess what needs substituting by
593 taking remaining << >> tokensr; not recommended
594 - a hashref token => @tables - replaces <token> << >> << >> </token>
595 subtemplate for each @tables row; table is a hashref as above
596 want_librarian => boolean, if set to true triggers librarian details
597 substitution from the userenv
599 letter fields hashref (title & content useful)
603 sub GetPreparedLetter {
606 my $letter = $params{letter};
609 my $module = $params{module} or croak "No module";
610 my $letter_code = $params{letter_code} or croak "No letter_code";
611 my $branchcode = $params{branchcode} || '';
612 my $mtt = $params{message_transport_type} || 'email';
613 my $lang = $params{lang} || 'default';
615 $letter = getletter( $module, $letter_code, $branchcode, $mtt, $lang );
618 $letter = getletter( $module, $letter_code, $branchcode, $mtt, 'default' )
619 or warn( "No $module $letter_code letter transported by " . $mtt ),
624 my $tables = $params{tables} || {};
625 my $substitute = $params{substitute} || {};
626 my $loops = $params{loops} || {}; # loops is not supported for historical notices syntax
627 my $repeat = $params{repeat};
628 %$tables || %$substitute || $repeat || %$loops
629 or carp( "ERROR: nothing to substitute - both 'tables', 'loops' and 'substitute' are empty" ),
631 my $want_librarian = $params{want_librarian};
634 while ( my ($token, $val) = each %$substitute ) {
635 if ( $token eq 'items.content' ) {
636 $val =~ s|\n|<br/>|g if $letter->{is_html};
639 $letter->{title} =~ s/<<$token>>/$val/g;
640 $letter->{content} =~ s/<<$token>>/$val/g;
644 my $OPACBaseURL = C4::Context->preference('OPACBaseURL');
645 $letter->{content} =~ s/<<OPACBaseURL>>/$OPACBaseURL/go;
647 if ($want_librarian) {
648 # parsing librarian name
649 my $userenv = C4::Context->userenv;
650 $letter->{content} =~ s/<<LibrarianFirstname>>/$userenv->{firstname}/go;
651 $letter->{content} =~ s/<<LibrarianSurname>>/$userenv->{surname}/go;
652 $letter->{content} =~ s/<<LibrarianEmailaddress>>/$userenv->{emailaddress}/go;
655 my ($repeat_no_enclosing_tags, $repeat_enclosing_tags);
658 if (ref ($repeat) eq 'ARRAY' ) {
659 $repeat_no_enclosing_tags = $repeat;
661 $repeat_enclosing_tags = $repeat;
665 if ($repeat_enclosing_tags) {
666 while ( my ($tag, $tag_tables) = each %$repeat_enclosing_tags ) {
667 if ( $letter->{content} =~ m!<$tag>(.*)</$tag>!s ) {
670 my %subletter = ( title => '', content => $subcontent );
671 _substitute_tables( \%subletter, $_ );
674 $letter->{content} =~ s!<$tag>.*</$tag>!join( "\n", @lines )!se;
680 _substitute_tables( $letter, $tables );
683 if ($repeat_no_enclosing_tags) {
684 if ( $letter->{content} =~ m/[^\n]*<<.*>>[^\n]*/so ) {
689 $c =~ s/<<count>>/$i/go;
690 foreach my $field ( keys %{$_} ) {
691 $c =~ s/(<<[^\.]+.$field>>)/$_->{$field}/;
695 } @$repeat_no_enclosing_tags;
697 my $replaceby = join( "\n", @lines );
698 $letter->{content} =~ s/\Q$line\E/$replaceby/s;
702 $letter->{content} = _process_tt(
704 content => $letter->{content},
707 substitute => $substitute,
711 $letter->{title} = _process_tt(
713 content => $letter->{title},
716 substitute => $substitute,
720 $letter->{content} =~ s/<<\S*>>//go; #remove any stragglers
725 sub _substitute_tables {
726 my ( $letter, $tables ) = @_;
727 while ( my ($table, $param) = each %$tables ) {
730 my $ref = ref $param;
733 if ($ref && $ref eq 'HASH') {
737 my $sth = _parseletter_sth($table);
739 warn "_parseletter_sth('$table') failed to return a valid sth. No substitution will be done for that table.";
742 $sth->execute( $ref ? @$param : $param );
744 $values = $sth->fetchrow_hashref;
748 _parseletter ( $letter, $table, $values );
752 sub _parseletter_sth {
756 carp "ERROR: _parseletter_sth() called without argument (table)";
759 # NOTE: we used to check whether we had a statement handle cached in
760 # a %handles module-level variable. This was a dumb move and
761 # broke things for the rest of us. prepare_cached is a better
762 # way to cache statement handles anyway.
764 ($table eq 'biblio' ) ? "SELECT * FROM $table WHERE biblionumber = ?" :
765 ($table eq 'biblioitems' ) ? "SELECT * FROM $table WHERE biblionumber = ?" :
766 ($table eq 'items' ) ? "SELECT * FROM $table WHERE itemnumber = ?" :
767 ($table eq 'issues' ) ? "SELECT * FROM $table WHERE itemnumber = ?" :
768 ($table eq 'old_issues' ) ? "SELECT * FROM $table WHERE itemnumber = ? ORDER BY timestamp DESC LIMIT 1" :
769 ($table eq 'reserves' ) ? "SELECT * FROM $table WHERE borrowernumber = ? and biblionumber = ?" :
770 ($table eq 'borrowers' ) ? "SELECT * FROM $table WHERE borrowernumber = ?" :
771 ($table eq 'branches' ) ? "SELECT * FROM $table WHERE branchcode = ?" :
772 ($table eq 'suggestions' ) ? "SELECT * FROM $table WHERE suggestionid = ?" :
773 ($table eq 'aqbooksellers') ? "SELECT * FROM $table WHERE id = ?" :
774 ($table eq 'aqorders' ) ? "SELECT * FROM $table WHERE ordernumber = ?" :
775 ($table eq 'aqbasket' ) ? "SELECT * FROM $table WHERE basketno = ?" :
776 ($table eq 'opac_news' ) ? "SELECT * FROM $table WHERE idnew = ?" :
777 ($table eq 'article_requests') ? "SELECT * FROM $table WHERE id = ?" :
778 ($table eq 'borrower_modifications') ? "SELECT * FROM $table WHERE verification_token = ?" :
779 ($table eq 'subscription') ? "SELECT * FROM $table WHERE subscriptionid = ?" :
780 ($table eq 'serial') ? "SELECT * FROM $table WHERE serialid = ?" :
781 ($table eq 'problem_reports') ? "SELECT * FROM $table WHERE reportid = ?" :
784 warn "ERROR: No _parseletter_sth query for table '$table'";
785 return; # nothing to get
787 unless ($sth = C4::Context->dbh->prepare_cached($query)) {
788 warn "ERROR: Failed to prepare query: '$query'";
791 return $sth; # now cache is populated for that $table
794 =head2 _parseletter($letter, $table, $values)
797 - $letter : a hash to letter fields (title & content useful)
798 - $table : the Koha table to parse.
799 - $values_in : table record hashref
800 parse all fields from a table, and replace values in title & content with the appropriate value
801 (not exported sub, used only internally)
806 my ( $letter, $table, $values_in ) = @_;
808 # Work on a local copy of $values_in (passed by reference) to avoid side effects
809 # in callers ( by changing / formatting values )
810 my $values = $values_in ? { %$values_in } : {};
812 if ( $table eq 'borrowers' && $values->{'dateexpiry'} ){
813 $values->{'dateexpiry'} = output_pref({ dt => dt_from_string( $values->{'dateexpiry'} ), dateonly => 1 });
816 if ( $table eq 'reserves' && $values->{'waitingdate'} ) {
817 $values->{'waitingdate'} = output_pref({ dt => dt_from_string( $values->{'waitingdate'} ), dateonly => 1 });
820 if ($letter->{content} && $letter->{content} =~ /<<today>>/) {
821 my $todaysdate = output_pref( dt_from_string() );
822 $letter->{content} =~ s/<<today>>/$todaysdate/go;
825 while ( my ($field, $val) = each %$values ) {
826 $val =~ s/\p{P}$// if $val && $table=~/biblio/;
827 #BZ 9886: Assuming that we want to eliminate ISBD punctuation here
828 #Therefore adding the test on biblio. This includes biblioitems,
829 #but excludes items. Removed unneeded global and lookahead.
831 if ( $table=~/^borrowers$/ && $field=~/^streettype$/ ) {
832 my $av = Koha::AuthorisedValues->search({ category => 'ROADTYPE', authorised_value => $val });
833 $val = $av->count ? $av->next->lib : '';
837 my $replacedby = defined ($val) ? $val : '';
839 and not $replacedby =~ m|0000-00-00|
840 and not $replacedby =~ m|9999-12-31|
841 and $replacedby =~ m|^\d{4}-\d{2}-\d{2}( \d{2}:\d{2}:\d{2})?$| )
843 # If the value is XXXX-YY-ZZ[ AA:BB:CC] we assume it is a date
844 my $dateonly = defined $1 ? 0 : 1; #$1 refers to the capture group wrapped in parentheses. In this case, that's the hours, minutes, seconds.
845 my $re_dateonly_filter = qr{ $field( \s* \| \s* dateonly\s*)?>> }xms;
847 for my $letter_field ( qw( title content ) ) {
848 my $filter_string_used = q{};
849 if ( $letter->{ $letter_field } =~ $re_dateonly_filter ) {
850 # We overwrite $dateonly if the filter exists and we have a time in the datetime
851 $filter_string_used = $1 || q{};
852 $dateonly = $1 unless $dateonly;
854 my $replacedby_date = eval {
855 output_pref({ dt => dt_from_string( $replacedby ), dateonly => $dateonly });
858 if ( $letter->{ $letter_field } ) {
859 $letter->{ $letter_field } =~ s/\Q<<$table.$field$filter_string_used>>\E/$replacedby_date/g;
860 $letter->{ $letter_field } =~ s/\Q<<$field$filter_string_used>>\E/$replacedby_date/g;
864 # Other fields replacement
866 for my $letter_field ( qw( title content ) ) {
867 if ( $letter->{ $letter_field } ) {
868 $letter->{ $letter_field } =~ s/<<$table.$field>>/$replacedby/g;
869 $letter->{ $letter_field } =~ s/<<$field>>/$replacedby/g;
875 if ($table eq 'borrowers' && $letter->{content}) {
876 my $patron = Koha::Patrons->find( $values->{borrowernumber} );
878 my $attributes = $patron->extended_attributes;
880 while ( my $attribute = $attributes->next ) {
881 my $code = $attribute->code;
882 my $val = $attribute->description; # FIXME - we always display intranet description here!
883 $val =~ s/\p{P}(?=$)//g if $val;
884 next unless $val gt '';
886 push @{ $attr{$code} }, $val;
888 while ( my ($code, $val_ar) = each %attr ) {
889 my $replacefield = "<<borrower-attribute:$code>>";
890 my $replacedby = join ',', @$val_ar;
891 $letter->{content} =~ s/$replacefield/$replacedby/g;
900 my $success = EnqueueLetter( { letter => $letter,
901 borrowernumber => '12', message_transport_type => 'email' } )
903 places a letter in the message_queue database table, which will
904 eventually get processed (sent) by the process_message_queue.pl
905 cronjob when it calls SendQueuedMessages.
907 return message_id on success
912 my $params = shift or return;
914 return unless exists $params->{'letter'};
915 # return unless exists $params->{'borrowernumber'};
916 return unless exists $params->{'message_transport_type'};
918 my $content = $params->{letter}->{content};
919 $content =~ s/\s+//g if(defined $content);
920 if ( not defined $content or $content eq '' ) {
921 warn "Trying to add an empty message to the message queue" if $debug;
925 # If we have any attachments we should encode then into the body.
926 if ( $params->{'attachments'} ) {
927 $params->{'letter'} = _add_attachments(
928 { letter => $params->{'letter'},
929 attachments => $params->{'attachments'},
930 message => MIME::Lite->new( Type => 'multipart/mixed' ),
935 my $dbh = C4::Context->dbh();
936 my $statement = << 'ENDSQL';
937 INSERT INTO message_queue
938 ( borrowernumber, subject, content, metadata, letter_code, message_transport_type, status, time_queued, to_address, from_address, reply_address, content_type )
940 ( ?, ?, ?, ?, ?, ?, ?, NOW(), ?, ?, ?, ? )
943 my $sth = $dbh->prepare($statement);
944 my $result = $sth->execute(
945 $params->{'borrowernumber'}, # borrowernumber
946 $params->{'letter'}->{'title'}, # subject
947 $params->{'letter'}->{'content'}, # content
948 $params->{'letter'}->{'metadata'} || '', # metadata
949 $params->{'letter'}->{'code'} || '', # letter_code
950 $params->{'message_transport_type'}, # message_transport_type
952 $params->{'to_address'}, # to_address
953 $params->{'from_address'}, # from_address
954 $params->{'reply_address'}, # reply_address
955 $params->{'letter'}->{'content-type'}, # content_type
957 return $dbh->last_insert_id(undef,undef,'message_queue', undef);
960 =head2 SendQueuedMessages ([$hashref])
962 my $sent = SendQueuedMessages({
963 letter_code => $letter_code,
964 borrowernumber => $who_letter_is_for,
970 Sends all of the 'pending' items in the message queue, unless
971 parameters are passed.
973 The letter_code, borrowernumber and limit parameters are used
974 to build a parameter set for _get_unsent_messages, thus limiting
975 which pending messages will be processed. They are all optional.
977 The verbose parameter can be used to generate debugging output.
980 Returns number of messages sent.
984 sub SendQueuedMessages {
987 my $which_unsent_messages = {
988 'limit' => $params->{'limit'} // 0,
989 'borrowernumber' => $params->{'borrowernumber'} // q{},
990 'letter_code' => $params->{'letter_code'} // q{},
991 'type' => $params->{'type'} // q{},
993 my $unsent_messages = _get_unsent_messages( $which_unsent_messages );
994 MESSAGE: foreach my $message ( @$unsent_messages ) {
995 my $message_object = Koha::Notice::Messages->find( $message->{message_id} );
996 # If this fails the database is unwritable and we won't manage to send a message that continues to be marked 'pending'
997 $message_object->make_column_dirty('status');
998 return unless $message_object->store;
1000 # warn Data::Dumper->Dump( [ $message ], [ 'message' ] );
1001 warn sprintf( 'sending %s message to patron: %s',
1002 $message->{'message_transport_type'},
1003 $message->{'borrowernumber'} || 'Admin' )
1004 if $params->{'verbose'} or $debug;
1005 # This is just begging for subclassing
1006 next MESSAGE if ( lc($message->{'message_transport_type'}) eq 'rss' );
1007 if ( lc( $message->{'message_transport_type'} ) eq 'email' ) {
1008 _send_message_by_email( $message, $params->{'username'}, $params->{'password'}, $params->{'method'} );
1010 elsif ( lc( $message->{'message_transport_type'} ) eq 'sms' ) {
1011 if ( C4::Context->preference('SMSSendDriver') eq 'Email' ) {
1012 my $patron = Koha::Patrons->find( $message->{borrowernumber} );
1013 my $sms_provider = Koha::SMS::Providers->find( $patron->sms_provider_id );
1014 unless ( $sms_provider ) {
1015 warn sprintf( "Patron %s has no sms provider id set!", $message->{'borrowernumber'} ) if $params->{'verbose'} or $debug;
1016 _set_message_status( { message_id => $message->{'message_id'}, status => 'failed' } );
1019 unless ( $patron->smsalertnumber ) {
1020 _set_message_status( { message_id => $message->{'message_id'}, status => 'failed' } );
1021 warn sprintf( "No smsalertnumber found for patron %s!", $message->{'borrowernumber'} ) if $params->{'verbose'} or $debug;
1024 $message->{to_address} = $patron->smsalertnumber; #Sometime this is set to email - sms should always use smsalertnumber
1025 $message->{to_address} .= '@' . $sms_provider->domain();
1027 # Check for possible from_address override
1028 my $from_address = C4::Context->preference('EmailSMSSendDriverFromAddress');
1029 if ($from_address && $message->{from_address} ne $from_address) {
1030 $message->{from_address} = $from_address;
1031 _update_message_from_address($message->{'message_id'}, $message->{from_address});
1034 _update_message_to_address($message->{'message_id'}, $message->{to_address});
1035 _send_message_by_email( $message, $params->{'username'}, $params->{'password'}, $params->{'method'} );
1037 _send_message_by_sms( $message );
1041 return scalar( @$unsent_messages );
1044 =head2 GetRSSMessages
1046 my $message_list = GetRSSMessages( { limit => 10, borrowernumber => '14' } )
1048 returns a listref of all queued RSS messages for a particular person.
1052 sub GetRSSMessages {
1055 return unless $params;
1056 return unless ref $params;
1057 return unless $params->{'borrowernumber'};
1059 return _get_unsent_messages( { message_transport_type => 'rss',
1060 limit => $params->{'limit'},
1061 borrowernumber => $params->{'borrowernumber'}, } );
1064 =head2 GetPrintMessages
1066 my $message_list = GetPrintMessages( { borrowernumber => $borrowernumber } )
1068 Returns a arrayref of all queued print messages (optionally, for a particular
1073 sub GetPrintMessages {
1074 my $params = shift || {};
1076 return _get_unsent_messages( { message_transport_type => 'print',
1077 borrowernumber => $params->{'borrowernumber'},
1081 =head2 GetQueuedMessages ([$hashref])
1083 my $messages = GetQueuedMessage( { borrowernumber => '123', limit => 20 } );
1085 Fetches a list of messages from the message queue optionally filtered by borrowernumber
1086 and limited to specified limit.
1088 Return is an arrayref of hashes, each has represents a message in the message queue.
1092 sub GetQueuedMessages {
1095 my $dbh = C4::Context->dbh();
1096 my $statement = << 'ENDSQL';
1097 SELECT message_id, borrowernumber, subject, content, message_transport_type, status, time_queued, updated_on
1103 if ( exists $params->{'borrowernumber'} ) {
1104 push @whereclauses, ' borrowernumber = ? ';
1105 push @query_params, $params->{'borrowernumber'};
1108 if ( @whereclauses ) {
1109 $statement .= ' WHERE ' . join( 'AND', @whereclauses );
1112 if ( defined $params->{'limit'} ) {
1113 $statement .= ' LIMIT ? ';
1114 push @query_params, $params->{'limit'};
1117 my $sth = $dbh->prepare( $statement );
1118 my $result = $sth->execute( @query_params );
1119 return $sth->fetchall_arrayref({});
1122 =head2 GetMessageTransportTypes
1124 my @mtt = GetMessageTransportTypes();
1126 returns an arrayref of transport types
1130 sub GetMessageTransportTypes {
1131 my $dbh = C4::Context->dbh();
1132 my $mtts = $dbh->selectcol_arrayref("
1133 SELECT message_transport_type
1134 FROM message_transport_types
1135 ORDER BY message_transport_type
1142 my $message = C4::Letters::Message($message_id);
1147 my ( $message_id ) = @_;
1148 return unless $message_id;
1149 my $dbh = C4::Context->dbh;
1150 return $dbh->selectrow_hashref(q|
1151 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
1153 WHERE message_id = ?
1154 |, {}, $message_id );
1157 =head2 ResendMessage
1159 Attempt to resend a message which has failed previously.
1161 my $has_been_resent = C4::Letters::ResendMessage($message_id);
1163 Updates the message to 'pending' status so that
1164 it will be resent later on.
1166 returns 1 on success, 0 on failure, undef if no message was found
1171 my $message_id = shift;
1172 return unless $message_id;
1174 my $message = GetMessage( $message_id );
1175 return unless $message;
1177 if ( $message->{status} ne 'pending' ) {
1178 $rv = C4::Letters::_set_message_status({
1179 message_id => $message_id,
1180 status => 'pending',
1182 $rv = $rv > 0? 1: 0;
1183 # Clear destination email address to force address update
1184 _update_message_to_address( $message_id, undef ) if $rv &&
1185 $message->{message_transport_type} eq 'email';
1190 =head2 _add_attachements
1193 letter - the standard letter hashref
1194 attachments - listref of attachments. each attachment is a hashref of:
1195 type - the mime type, like 'text/plain'
1196 content - the actual attachment
1197 filename - the name of the attachment.
1198 message - a MIME::Lite object to attach these to.
1200 returns your letter object, with the content updated.
1204 sub _add_attachments {
1207 my $letter = $params->{'letter'};
1208 my $attachments = $params->{'attachments'};
1209 return $letter unless @$attachments;
1210 my $message = $params->{'message'};
1212 # First, we have to put the body in as the first attachment
1214 Type => $letter->{'content-type'} || 'TEXT',
1215 Data => $letter->{'is_html'}
1216 ? _wrap_html($letter->{'content'}, $letter->{'title'})
1217 : $letter->{'content'},
1220 foreach my $attachment ( @$attachments ) {
1222 Type => $attachment->{'type'},
1223 Data => $attachment->{'content'},
1224 Filename => $attachment->{'filename'},
1227 # we're forcing list context here to get the header, not the count back from grep.
1228 ( $letter->{'content-type'} ) = grep( /^Content-Type:/, split( /\n/, $params->{'message'}->header_as_string ) );
1229 $letter->{'content-type'} =~ s/^Content-Type:\s+//;
1230 $letter->{'content'} = $message->body_as_string;
1236 =head2 _get_unsent_messages
1238 This function's parameter hash reference takes the following
1239 optional named parameters:
1240 message_transport_type: method of message sending (e.g. email, sms, etc.)
1241 borrowernumber : who the message is to be sent
1242 letter_code : type of message being sent (e.g. PASSWORD_RESET)
1243 limit : maximum number of messages to send
1245 This function returns an array of matching hash referenced rows from
1246 message_queue with some borrower information added.
1250 sub _get_unsent_messages {
1253 my $dbh = C4::Context->dbh();
1255 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
1256 FROM message_queue mq
1257 LEFT JOIN borrowers b ON b.borrowernumber = mq.borrowernumber
1261 my @query_params = ('pending');
1262 if ( ref $params ) {
1263 if ( $params->{'message_transport_type'} ) {
1264 $statement .= ' AND mq.message_transport_type = ? ';
1265 push @query_params, $params->{'message_transport_type'};
1267 if ( $params->{'borrowernumber'} ) {
1268 $statement .= ' AND mq.borrowernumber = ? ';
1269 push @query_params, $params->{'borrowernumber'};
1271 if ( $params->{'letter_code'} ) {
1272 $statement .= ' AND mq.letter_code = ? ';
1273 push @query_params, $params->{'letter_code'};
1275 if ( $params->{'type'} ) {
1276 $statement .= ' AND message_transport_type = ? ';
1277 push @query_params, $params->{'type'};
1279 if ( $params->{'limit'} ) {
1280 $statement .= ' limit ? ';
1281 push @query_params, $params->{'limit'};
1285 $debug and warn "_get_unsent_messages SQL: $statement";
1286 $debug and warn "_get_unsent_messages params: " . join(',',@query_params);
1287 my $sth = $dbh->prepare( $statement );
1288 my $result = $sth->execute( @query_params );
1289 return $sth->fetchall_arrayref({});
1292 sub _send_message_by_email {
1293 my $message = shift or return;
1294 my ($username, $password, $method) = @_;
1296 my $patron = Koha::Patrons->find( $message->{borrowernumber} );
1297 my $to_address = $message->{'to_address'};
1298 unless ($to_address) {
1300 warn "FAIL: No 'to_address' and INVALID borrowernumber ($message->{borrowernumber})";
1301 _set_message_status( { message_id => $message->{'message_id'},
1302 status => 'failed' } );
1305 $to_address = $patron->notice_email_address;
1306 unless ($to_address) {
1307 # warn "FAIL: No 'to_address' and no email for " . ($member->{surname} ||'') . ", borrowernumber ($message->{borrowernumber})";
1308 # warning too verbose for this more common case?
1309 _set_message_status( { message_id => $message->{'message_id'},
1310 status => 'failed' } );
1315 # Encode subject line separately
1316 $message->{subject} = encode('MIME-Header', $message->{'subject'} );
1317 my $subject = $message->{'subject'};
1319 my $content = encode('UTF-8', $message->{'content'});
1320 my $content_type = $message->{'content_type'} || 'text/plain; charset="UTF-8"';
1321 my $is_html = $content_type =~ m/html/io;
1323 my $branch_email = undef;
1324 my $branch_replyto = undef;
1325 my $branch_returnpath = undef;
1329 $library = $patron->library;
1330 $branch_email = $library->branchemail;
1331 $branch_replyto = $library->branchreplyto;
1332 $branch_returnpath = $library->branchreturnpath;
1335 my $email = Koha::Email->create(
1339 C4::Context->preference('NoticeBcc')
1340 ? ( bcc => C4::Context->preference('NoticeBcc') )
1343 from => $message->{'from_address'} || $branch_email,
1344 reply_to => $message->{'reply_address'} || $branch_replyto,
1345 sender => $branch_returnpath,
1346 subject => "" . $message->{subject}
1352 _wrap_html( $content, $subject )
1356 $email->text_body( $content );
1361 $smtp_server = $library->smtp_server;
1364 $smtp_server = Koha::SMTP::Servers->get_default;
1370 sasl_username => $username,
1371 sasl_password => $password,
1376 # if initial message address was empty, coming here means that a to address was found and
1377 # queue should be updated; same if to address was overriden by Koha::Email->create
1378 _update_message_to_address( $message->{'message_id'}, $email->email->header('To') )
1379 if !$message->{to_address}
1380 || $message->{to_address} ne $email->email->header('To');
1383 $email->send_or_die({ transport => $smtp_server->transport });
1385 _set_message_status(
1387 message_id => $message->{'message_id'},
1394 _set_message_status(
1396 message_id => $message->{'message_id'},
1406 my ($content, $title) = @_;
1408 my $css = C4::Context->preference("NoticeCSS") || '';
1409 $css = qq{<link rel="stylesheet" type="text/css" href="$css">} if $css;
1411 <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
1412 "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
1413 <html lang="en" xml:lang="en" xmlns="http://www.w3.org/1999/xhtml">
1415 <title>$title</title>
1416 <meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
1427 my ( $message ) = @_;
1428 my $dbh = C4::Context->dbh;
1429 my $count = $dbh->selectrow_array(q|
1432 WHERE message_transport_type = ?
1433 AND borrowernumber = ?
1435 AND CAST(updated_on AS date) = CAST(NOW() AS date)
1438 |, {}, $message->{message_transport_type}, $message->{borrowernumber}, $message->{letter_code}, $message->{content} );
1442 sub _send_message_by_sms {
1443 my $message = shift or return;
1444 my $patron = Koha::Patrons->find( $message->{borrowernumber} );
1446 unless ( $patron and $patron->smsalertnumber ) {
1447 _set_message_status( { message_id => $message->{'message_id'},
1448 status => 'failed' } );
1452 if ( _is_duplicate( $message ) ) {
1453 _set_message_status( { message_id => $message->{'message_id'},
1454 status => 'failed' } );
1458 my $success = C4::SMS->send_sms( { destination => $patron->smsalertnumber,
1459 message => $message->{'content'},
1461 _set_message_status( { message_id => $message->{'message_id'},
1462 status => ($success ? 'sent' : 'failed') } );
1466 sub _update_message_to_address {
1468 my $dbh = C4::Context->dbh();
1469 $dbh->do('UPDATE message_queue SET to_address=? WHERE message_id=?',undef,($to,$id));
1472 sub _update_message_from_address {
1473 my ($message_id, $from_address) = @_;
1474 my $dbh = C4::Context->dbh();
1475 $dbh->do('UPDATE message_queue SET from_address = ? WHERE message_id = ?', undef, ($from_address, $message_id));
1478 sub _set_message_status {
1479 my $params = shift or return;
1481 foreach my $required_parameter ( qw( message_id status ) ) {
1482 return unless exists $params->{ $required_parameter };
1485 my $dbh = C4::Context->dbh();
1486 my $statement = 'UPDATE message_queue SET status= ? WHERE message_id = ?';
1487 my $sth = $dbh->prepare( $statement );
1488 my $result = $sth->execute( $params->{'status'},
1489 $params->{'message_id'} );
1494 my ( $params ) = @_;
1496 my $content = $params->{content};
1497 my $tables = $params->{tables};
1498 my $loops = $params->{loops};
1499 my $substitute = $params->{substitute} || {};
1501 my $use_template_cache = C4::Context->config('template_cache_dir') && defined $ENV{GATEWAY_INTERFACE};
1502 my $template = Template->new(
1506 PLUGIN_BASE => 'Koha::Template::Plugin',
1507 COMPILE_EXT => $use_template_cache ? '.ttc' : '',
1508 COMPILE_DIR => $use_template_cache ? C4::Context->config('template_cache_dir') : '',
1510 ENCODING => 'UTF-8',
1512 ) or die Template->error();
1514 my $tt_params = { %{ _get_tt_params( $tables ) }, %{ _get_tt_params( $loops, 'is_a_loop' ) }, %$substitute };
1516 $content = add_tt_filters( $content );
1517 $content = qq|[% USE KohaDates %][% USE Remove_MARC_punctuation %]$content|;
1520 $template->process( \$content, $tt_params, \$output ) || croak "ERROR PROCESSING TEMPLATE: " . $template->error();
1525 sub _get_tt_params {
1526 my ($tables, $is_a_loop) = @_;
1532 article_requests => {
1533 module => 'Koha::ArticleRequests',
1534 singular => 'article_request',
1535 plural => 'article_requests',
1539 module => 'Koha::Acquisition::Baskets',
1540 singular => 'basket',
1541 plural => 'baskets',
1545 module => 'Koha::Biblios',
1546 singular => 'biblio',
1547 plural => 'biblios',
1548 pk => 'biblionumber',
1551 module => 'Koha::Biblioitems',
1552 singular => 'biblioitem',
1553 plural => 'biblioitems',
1554 pk => 'biblioitemnumber',
1557 module => 'Koha::Patrons',
1558 singular => 'borrower',
1559 plural => 'borrowers',
1560 pk => 'borrowernumber',
1563 module => 'Koha::Libraries',
1564 singular => 'branch',
1565 plural => 'branches',
1569 module => 'Koha::Items',
1575 module => 'Koha::News',
1581 module => 'Koha::Acquisition::Orders',
1582 singular => 'order',
1584 pk => 'ordernumber',
1587 module => 'Koha::Holds',
1593 module => 'Koha::Serials',
1594 singular => 'serial',
1595 plural => 'serials',
1599 module => 'Koha::Subscriptions',
1600 singular => 'subscription',
1601 plural => 'subscriptions',
1602 pk => 'subscriptionid',
1605 module => 'Koha::Suggestions',
1606 singular => 'suggestion',
1607 plural => 'suggestions',
1608 pk => 'suggestionid',
1611 module => 'Koha::Checkouts',
1612 singular => 'checkout',
1613 plural => 'checkouts',
1617 module => 'Koha::Old::Checkouts',
1618 singular => 'old_checkout',
1619 plural => 'old_checkouts',
1623 module => 'Koha::Checkouts',
1624 singular => 'overdue',
1625 plural => 'overdues',
1628 borrower_modifications => {
1629 module => 'Koha::Patron::Modifications',
1630 singular => 'patron_modification',
1631 plural => 'patron_modifications',
1632 fk => 'verification_token',
1636 foreach my $table ( keys %$tables ) {
1637 next unless $config->{$table};
1639 my $ref = ref( $tables->{$table} ) || q{};
1640 my $module = $config->{$table}->{module};
1642 if ( can_load( modules => { $module => undef } ) ) {
1643 my $pk = $config->{$table}->{pk};
1644 my $fk = $config->{$table}->{fk};
1647 my $values = $tables->{$table} || [];
1648 unless ( ref( $values ) eq 'ARRAY' ) {
1649 croak "ERROR processing table $table. Wrong API call.";
1651 my $key = $pk ? $pk : $fk;
1652 # $key does not come from user input
1653 my $objects = $module->search(
1654 { $key => $values },
1656 # We want to retrieve the data in the same order
1658 # field is a MySQLism, but they are no other way to do it
1659 # To be generic we could do it in perl, but we will need to fetch
1660 # all the data then order them
1661 @$values ? ( order_by => \[ "field($key, " . join( ', ', @$values ) . ")" ] ) : ()
1664 $params->{ $config->{$table}->{plural} } = $objects;
1666 elsif ( $ref eq q{} || $ref eq 'HASH' ) {
1667 my $id = ref $ref eq 'HASH' ? $tables->{$table}->{$pk} : $tables->{$table};
1669 if ( $fk ) { # Using a foreign key for lookup
1670 if ( ref( $fk ) eq 'ARRAY' ) { # Foreign key is multi-column
1672 foreach my $key ( @$fk ) {
1673 $search->{$key} = $id->{$key};
1675 $object = $module->search( $search )->last();
1676 } else { # Foreign key is single column
1677 $object = $module->search( { $fk => $id } )->last();
1679 } else { # using the table's primary key for lookup
1680 $object = $module->find($id);
1682 $params->{ $config->{$table}->{singular} } = $object;
1684 else { # $ref eq 'ARRAY'
1686 if ( @{ $tables->{$table} } == 1 ) { # Param is a single key
1687 $object = $module->search( { $pk => $tables->{$table} } )->last();
1689 else { # Params are mutliple foreign keys
1690 croak "Multiple foreign keys (table $table) should be passed using an hashref";
1692 $params->{ $config->{$table}->{singular} } = $object;
1696 croak "ERROR LOADING MODULE $module: $Module::Load::Conditional::ERROR";
1700 $params->{today} = output_pref({ dt => dt_from_string, dateformat => 'iso' });
1705 =head3 add_tt_filters
1707 $content = add_tt_filters( $content );
1709 Add TT filters to some specific fields if needed.
1711 For now we only add the Remove_MARC_punctuation TT filter to biblio and biblioitem fields
1715 sub add_tt_filters {
1716 my ( $content ) = @_;
1717 $content =~ s|\[%\s*biblio\.(.*?)\s*%\]|[% biblio.$1 \| \$Remove_MARC_punctuation %]|gxms;
1718 $content =~ s|\[%\s*biblioitem\.(.*?)\s*%\]|[% biblioitem.$1 \| \$Remove_MARC_punctuation %]|gxms;
1722 =head2 get_item_content
1724 my $item = Koha::Items->find(...)->unblessed;
1725 my @item_content_fields = qw( date_due title barcode author itemnumber );
1726 my $item_content = C4::Letters::get_item_content({
1728 item_content_fields => \@item_content_fields
1731 This function generates a tab-separated list of values for the passed item. Dates
1732 are formatted following the current setup.
1736 sub get_item_content {
1737 my ( $params ) = @_;
1738 my $item = $params->{item};
1739 my $dateonly = $params->{dateonly} || 0;
1740 my $item_content_fields = $params->{item_content_fields} || [];
1742 return unless $item;
1744 my @item_info = map {
1748 { dt => dt_from_string( $item->{$_} ), dateonly => $dateonly } );
1752 } @$item_content_fields;
1753 return join( "\t", @item_info ) . "\n";