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...
377 if ( $type eq 'claimacquisition') {
379 SELECT aqorders.*,aqbasket.*,biblio.*,biblioitems.*
381 LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno
382 LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
383 LEFT JOIN biblioitems ON aqorders.biblionumber=biblioitems.biblionumber
384 WHERE aqorders.ordernumber IN (
388 carp "No order selected";
389 return { error => "no_order_selected" };
391 $strsth .= join( ",", ('?') x @$externalid ) . ")";
392 $action = "ACQUISITION CLAIM";
393 $sthorders = $dbh->prepare($strsth);
394 $sthorders->execute( @$externalid );
395 $dataorders = $sthorders->fetchall_arrayref( {} );
398 if ($type eq 'claimissues') {
400 SELECT serial.*,subscription.*, biblio.*, biblioitems.*, aqbooksellers.*,
401 aqbooksellers.id AS booksellerid
403 LEFT JOIN subscription ON serial.subscriptionid=subscription.subscriptionid
404 LEFT JOIN biblio ON serial.biblionumber=biblio.biblionumber
405 LEFT JOIN biblioitems ON serial.biblionumber = biblioitems.biblionumber
406 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id
407 WHERE serial.serialid IN (
411 carp "No issues selected";
412 return { error => "no_issues_selected" };
415 $strsth .= join( ",", ('?') x @$externalid ) . ")";
416 $action = "SERIAL CLAIM";
417 $sthorders = $dbh->prepare($strsth);
418 $sthorders->execute( @$externalid );
419 $dataorders = $sthorders->fetchall_arrayref( {} );
422 if ( $type eq 'orderacquisition') {
423 my $basketno = $externalid;
425 SELECT aqorders.*,aqbasket.*,biblio.*,biblioitems.*
427 LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno
428 LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
429 LEFT JOIN biblioitems ON aqorders.biblionumber=biblioitems.biblionumber
430 WHERE aqbasket.basketno = ?
431 AND orderstatus IN ('new','ordered')
434 unless ( $basketno ) {
435 carp "No basketnumber given";
436 return { error => "no_basketno" };
438 $action = "ACQUISITION ORDER";
439 $sthorders = $dbh->prepare($strsth);
440 $sthorders->execute($basketno);
441 $dataorders = $sthorders->fetchall_arrayref( {} );
445 $dbh->prepare("select * from aqbooksellers where id=?");
446 $sthbookseller->execute( $dataorders->[0]->{booksellerid} );
447 my $databookseller = $sthbookseller->fetchrow_hashref;
449 my $addressee = $type eq 'claimacquisition' || $type eq 'orderacquisition' ? 'acqprimary' : 'serialsprimary';
452 $dbh->prepare("SELECT * FROM aqcontacts WHERE booksellerid=? AND $type=1 ORDER BY $addressee DESC");
453 $sthcontact->execute( $dataorders->[0]->{booksellerid} );
454 my $datacontact = $sthcontact->fetchrow_hashref;
458 push @email, $datacontact->{email} if ( $datacontact && $datacontact->{email} );
460 warn "Bookseller $dataorders->[0]->{booksellerid} without emails";
461 return { error => "no_email" };
464 while ($addlcontact = $sthcontact->fetchrow_hashref) {
465 push @cc, $addlcontact->{email} if ( $addlcontact && $addlcontact->{email} );
468 my $userenv = C4::Context->userenv;
469 my $letter = GetPreparedLetter (
471 letter_code => $letter_code,
472 branchcode => $userenv->{branch},
474 'branches' => $userenv->{branch},
475 'aqbooksellers' => $databookseller,
476 'aqcontacts' => $datacontact,
477 'aqbasket' => $basketno,
479 repeat => $dataorders,
481 ) or return { error => "no_letter" };
483 # Remove the order tag
484 $letter->{content} =~ s/<order>(.*?)<\/order>/$1/gxms;
487 my $library = Koha::Libraries->find( $userenv->{branch} );
488 my $mail = Koha::Email->create(
490 to => join( ',', @email ),
491 cc => join( ',', @cc ),
494 C4::Context->preference("ClaimsBccCopy")
495 && ( $type eq 'claimacquisition'
496 || $type eq 'claimissues' )
498 ? ( bcc => $userenv->{emailaddress} )
501 from => $library->branchemail
502 || C4::Context->preference('KohaAdminEmailAddress'),
503 subject => "" . $letter->{title},
507 if ( $letter->{is_html} ) {
508 $mail->html_body( _wrap_html( $letter->{content}, "" . $letter->{title} ) );
511 $mail->text_body( "" . $letter->{content} );
515 $mail->send_or_die({ transport => $library->smtp_server->transport });
519 return { error => "$_" };
527 . join( ',', @email )
532 ) if C4::Context->preference("LetterLog");
534 # send an "account details" notice to a newly created user
535 elsif ( $type eq 'members' ) {
536 my $library = Koha::Libraries->find( $externalid->{branchcode} );
537 my $letter = GetPreparedLetter (
539 letter_code => $letter_code,
540 branchcode => $externalid->{'branchcode'},
541 lang => $externalid->{lang} || 'default',
543 'branches' => $library->unblessed,
544 'borrowers' => $externalid->{'borrowernumber'},
546 substitute => { 'borrowers.password' => $externalid->{'password'} },
549 return { error => "no_email" } unless $externalid->{'emailaddr'};
552 # FIXME: This 'default' behaviour should be moved to Koha::Email
553 my $mail = Koha::Email->create(
555 to => $externalid->{'emailaddr'},
556 from => $library->branchemail,
557 reply_to => $library->branchreplyto,
558 sender => $library->branchreturnpath,
559 subject => "" . $letter->{'title'},
563 if ( $letter->{is_html} ) {
564 $mail->html_body( _wrap_html( $letter->{content}, "" . $letter->{title} ) );
567 $mail->text_body( $letter->{content} );
570 $mail->send_or_die({ transport => $library->smtp_server->transport });
574 return { error => "$_" };
578 # If we come here, return an OK status
582 =head2 GetPreparedLetter( %params )
585 module => letter module, mandatory
586 letter_code => letter code, mandatory
587 branchcode => for letter selection, if missing default system letter taken
588 tables => a hashref with table names as keys. Values are either:
589 - a scalar - primary key value
590 - an arrayref - primary key values
591 - a hashref - full record
592 substitute => custom substitution key/value pairs
593 repeat => records to be substituted on consecutive lines:
594 - an arrayref - tries to guess what needs substituting by
595 taking remaining << >> tokensr; not recommended
596 - a hashref token => @tables - replaces <token> << >> << >> </token>
597 subtemplate for each @tables row; table is a hashref as above
598 want_librarian => boolean, if set to true triggers librarian details
599 substitution from the userenv
601 letter fields hashref (title & content useful)
605 sub GetPreparedLetter {
608 my $letter = $params{letter};
611 my $module = $params{module} or croak "No module";
612 my $letter_code = $params{letter_code} or croak "No letter_code";
613 my $branchcode = $params{branchcode} || '';
614 my $mtt = $params{message_transport_type} || 'email';
615 my $lang = $params{lang} || 'default';
617 $letter = getletter( $module, $letter_code, $branchcode, $mtt, $lang );
620 $letter = getletter( $module, $letter_code, $branchcode, $mtt, 'default' )
621 or warn( "No $module $letter_code letter transported by " . $mtt ),
626 my $tables = $params{tables} || {};
627 my $substitute = $params{substitute} || {};
628 my $loops = $params{loops} || {}; # loops is not supported for historical notices syntax
629 my $repeat = $params{repeat};
630 %$tables || %$substitute || $repeat || %$loops
631 or carp( "ERROR: nothing to substitute - both 'tables', 'loops' and 'substitute' are empty" ),
633 my $want_librarian = $params{want_librarian};
636 while ( my ($token, $val) = each %$substitute ) {
637 if ( $token eq 'items.content' ) {
638 $val =~ s|\n|<br/>|g if $letter->{is_html};
641 $letter->{title} =~ s/<<$token>>/$val/g;
642 $letter->{content} =~ s/<<$token>>/$val/g;
646 my $OPACBaseURL = C4::Context->preference('OPACBaseURL');
647 $letter->{content} =~ s/<<OPACBaseURL>>/$OPACBaseURL/go;
649 if ($want_librarian) {
650 # parsing librarian name
651 my $userenv = C4::Context->userenv;
652 $letter->{content} =~ s/<<LibrarianFirstname>>/$userenv->{firstname}/go;
653 $letter->{content} =~ s/<<LibrarianSurname>>/$userenv->{surname}/go;
654 $letter->{content} =~ s/<<LibrarianEmailaddress>>/$userenv->{emailaddress}/go;
657 my ($repeat_no_enclosing_tags, $repeat_enclosing_tags);
660 if (ref ($repeat) eq 'ARRAY' ) {
661 $repeat_no_enclosing_tags = $repeat;
663 $repeat_enclosing_tags = $repeat;
667 if ($repeat_enclosing_tags) {
668 while ( my ($tag, $tag_tables) = each %$repeat_enclosing_tags ) {
669 if ( $letter->{content} =~ m!<$tag>(.*)</$tag>!s ) {
672 my %subletter = ( title => '', content => $subcontent );
673 _substitute_tables( \%subletter, $_ );
676 $letter->{content} =~ s!<$tag>.*</$tag>!join( "\n", @lines )!se;
682 _substitute_tables( $letter, $tables );
685 if ($repeat_no_enclosing_tags) {
686 if ( $letter->{content} =~ m/[^\n]*<<.*>>[^\n]*/so ) {
691 $c =~ s/<<count>>/$i/go;
692 foreach my $field ( keys %{$_} ) {
693 $c =~ s/(<<[^\.]+.$field>>)/$_->{$field}/;
697 } @$repeat_no_enclosing_tags;
699 my $replaceby = join( "\n", @lines );
700 $letter->{content} =~ s/\Q$line\E/$replaceby/s;
704 $letter->{content} = _process_tt(
706 content => $letter->{content},
709 substitute => $substitute,
713 $letter->{title} = _process_tt(
715 content => $letter->{title},
718 substitute => $substitute,
722 $letter->{content} =~ s/<<\S*>>//go; #remove any stragglers
727 sub _substitute_tables {
728 my ( $letter, $tables ) = @_;
729 while ( my ($table, $param) = each %$tables ) {
732 my $ref = ref $param;
735 if ($ref && $ref eq 'HASH') {
739 my $sth = _parseletter_sth($table);
741 warn "_parseletter_sth('$table') failed to return a valid sth. No substitution will be done for that table.";
744 $sth->execute( $ref ? @$param : $param );
746 $values = $sth->fetchrow_hashref;
750 _parseletter ( $letter, $table, $values );
754 sub _parseletter_sth {
758 carp "ERROR: _parseletter_sth() called without argument (table)";
761 # NOTE: we used to check whether we had a statement handle cached in
762 # a %handles module-level variable. This was a dumb move and
763 # broke things for the rest of us. prepare_cached is a better
764 # way to cache statement handles anyway.
766 ($table eq 'biblio' ) ? "SELECT * FROM $table WHERE biblionumber = ?" :
767 ($table eq 'biblioitems' ) ? "SELECT * FROM $table WHERE biblionumber = ?" :
768 ($table eq 'items' ) ? "SELECT * FROM $table WHERE itemnumber = ?" :
769 ($table eq 'issues' ) ? "SELECT * FROM $table WHERE itemnumber = ?" :
770 ($table eq 'old_issues' ) ? "SELECT * FROM $table WHERE itemnumber = ? ORDER BY timestamp DESC LIMIT 1" :
771 ($table eq 'reserves' ) ? "SELECT * FROM $table WHERE borrowernumber = ? and biblionumber = ?" :
772 ($table eq 'borrowers' ) ? "SELECT * FROM $table WHERE borrowernumber = ?" :
773 ($table eq 'branches' ) ? "SELECT * FROM $table WHERE branchcode = ?" :
774 ($table eq 'suggestions' ) ? "SELECT * FROM $table WHERE suggestionid = ?" :
775 ($table eq 'aqbooksellers') ? "SELECT * FROM $table WHERE id = ?" :
776 ($table eq 'aqorders' ) ? "SELECT * FROM $table WHERE ordernumber = ?" :
777 ($table eq 'aqbasket' ) ? "SELECT * FROM $table WHERE basketno = ?" :
778 ($table eq 'illrequests' ) ? "SELECT * FROM $table WHERE illrequest_id = ?" :
779 ($table eq 'opac_news' ) ? "SELECT * FROM $table WHERE idnew = ?" :
780 ($table eq 'article_requests') ? "SELECT * FROM $table WHERE id = ?" :
781 ($table eq 'borrower_modifications') ? "SELECT * FROM $table WHERE verification_token = ?" :
782 ($table eq 'subscription') ? "SELECT * FROM $table WHERE subscriptionid = ?" :
783 ($table eq 'serial') ? "SELECT * FROM $table WHERE serialid = ?" :
784 ($table eq 'problem_reports') ? "SELECT * FROM $table WHERE reportid = ?" :
787 warn "ERROR: No _parseletter_sth query for table '$table'";
788 return; # nothing to get
790 unless ($sth = C4::Context->dbh->prepare_cached($query)) {
791 warn "ERROR: Failed to prepare query: '$query'";
794 return $sth; # now cache is populated for that $table
797 =head2 _parseletter($letter, $table, $values)
800 - $letter : a hash to letter fields (title & content useful)
801 - $table : the Koha table to parse.
802 - $values_in : table record hashref
803 parse all fields from a table, and replace values in title & content with the appropriate value
804 (not exported sub, used only internally)
809 my ( $letter, $table, $values_in ) = @_;
811 # Work on a local copy of $values_in (passed by reference) to avoid side effects
812 # in callers ( by changing / formatting values )
813 my $values = $values_in ? { %$values_in } : {};
815 if ( $table eq 'borrowers' && $values->{'dateexpiry'} ){
816 $values->{'dateexpiry'} = output_pref({ dt => dt_from_string( $values->{'dateexpiry'} ), dateonly => 1 });
819 if ( $table eq 'reserves' && $values->{'waitingdate'} ) {
820 $values->{'waitingdate'} = output_pref({ dt => dt_from_string( $values->{'waitingdate'} ), dateonly => 1 });
823 if ($letter->{content} && $letter->{content} =~ /<<today>>/) {
824 my $todaysdate = output_pref( dt_from_string() );
825 $letter->{content} =~ s/<<today>>/$todaysdate/go;
828 while ( my ($field, $val) = each %$values ) {
829 $val =~ s/\p{P}$// if $val && $table=~/biblio/;
830 #BZ 9886: Assuming that we want to eliminate ISBD punctuation here
831 #Therefore adding the test on biblio. This includes biblioitems,
832 #but excludes items. Removed unneeded global and lookahead.
834 if ( $table=~/^borrowers$/ && $field=~/^streettype$/ ) {
835 my $av = Koha::AuthorisedValues->search({ category => 'ROADTYPE', authorised_value => $val });
836 $val = $av->count ? $av->next->lib : '';
840 my $replacedby = defined ($val) ? $val : '';
842 and not $replacedby =~ m|0000-00-00|
843 and not $replacedby =~ m|9999-12-31|
844 and $replacedby =~ m|^\d{4}-\d{2}-\d{2}( \d{2}:\d{2}:\d{2})?$| )
846 # If the value is XXXX-YY-ZZ[ AA:BB:CC] we assume it is a date
847 my $dateonly = defined $1 ? 0 : 1; #$1 refers to the capture group wrapped in parentheses. In this case, that's the hours, minutes, seconds.
848 my $re_dateonly_filter = qr{ $field( \s* \| \s* dateonly\s*)?>> }xms;
850 for my $letter_field ( qw( title content ) ) {
851 my $filter_string_used = q{};
852 if ( $letter->{ $letter_field } =~ $re_dateonly_filter ) {
853 # We overwrite $dateonly if the filter exists and we have a time in the datetime
854 $filter_string_used = $1 || q{};
855 $dateonly = $1 unless $dateonly;
857 my $replacedby_date = eval {
858 output_pref({ dt => dt_from_string( $replacedby ), dateonly => $dateonly });
861 if ( $letter->{ $letter_field } ) {
862 $letter->{ $letter_field } =~ s/\Q<<$table.$field$filter_string_used>>\E/$replacedby_date/g;
863 $letter->{ $letter_field } =~ s/\Q<<$field$filter_string_used>>\E/$replacedby_date/g;
867 # Other fields replacement
869 for my $letter_field ( qw( title content ) ) {
870 if ( $letter->{ $letter_field } ) {
871 $letter->{ $letter_field } =~ s/<<$table.$field>>/$replacedby/g;
872 $letter->{ $letter_field } =~ s/<<$field>>/$replacedby/g;
878 if ($table eq 'borrowers' && $letter->{content}) {
879 my $patron = Koha::Patrons->find( $values->{borrowernumber} );
881 my $attributes = $patron->extended_attributes;
883 while ( my $attribute = $attributes->next ) {
884 my $code = $attribute->code;
885 my $val = $attribute->description; # FIXME - we always display intranet description here!
886 $val =~ s/\p{P}(?=$)//g if $val;
887 next unless $val gt '';
889 push @{ $attr{$code} }, $val;
891 while ( my ($code, $val_ar) = each %attr ) {
892 my $replacefield = "<<borrower-attribute:$code>>";
893 my $replacedby = join ',', @$val_ar;
894 $letter->{content} =~ s/$replacefield/$replacedby/g;
903 my $success = EnqueueLetter( { letter => $letter,
904 borrowernumber => '12', message_transport_type => 'email' } )
906 places a letter in the message_queue database table, which will
907 eventually get processed (sent) by the process_message_queue.pl
908 cronjob when it calls SendQueuedMessages.
910 return message_id on success
915 my $params = shift or return;
917 return unless exists $params->{'letter'};
918 # return unless exists $params->{'borrowernumber'};
919 return unless exists $params->{'message_transport_type'};
921 my $content = $params->{letter}->{content};
922 $content =~ s/\s+//g if(defined $content);
923 if ( not defined $content or $content eq '' ) {
924 warn "Trying to add an empty message to the message queue" if $debug;
928 # If we have any attachments we should encode then into the body.
929 if ( $params->{'attachments'} ) {
930 $params->{'letter'} = _add_attachments(
931 { letter => $params->{'letter'},
932 attachments => $params->{'attachments'},
933 message => MIME::Lite->new( Type => 'multipart/mixed' ),
938 my $dbh = C4::Context->dbh();
939 my $statement = << 'ENDSQL';
940 INSERT INTO message_queue
941 ( borrowernumber, subject, content, metadata, letter_code, message_transport_type, status, time_queued, to_address, from_address, reply_address, content_type )
943 ( ?, ?, ?, ?, ?, ?, ?, NOW(), ?, ?, ?, ? )
946 my $sth = $dbh->prepare($statement);
947 my $result = $sth->execute(
948 $params->{'borrowernumber'}, # borrowernumber
949 $params->{'letter'}->{'title'}, # subject
950 $params->{'letter'}->{'content'}, # content
951 $params->{'letter'}->{'metadata'} || '', # metadata
952 $params->{'letter'}->{'code'} || '', # letter_code
953 $params->{'message_transport_type'}, # message_transport_type
955 $params->{'to_address'}, # to_address
956 $params->{'from_address'}, # from_address
957 $params->{'reply_address'}, # reply_address
958 $params->{'letter'}->{'content-type'}, # content_type
960 return $dbh->last_insert_id(undef,undef,'message_queue', undef);
963 =head2 SendQueuedMessages ([$hashref])
965 my $sent = SendQueuedMessages({
966 letter_code => $letter_code,
967 borrowernumber => $who_letter_is_for,
973 Sends all of the 'pending' items in the message queue, unless
974 parameters are passed.
976 The letter_code, borrowernumber and limit parameters are used
977 to build a parameter set for _get_unsent_messages, thus limiting
978 which pending messages will be processed. They are all optional.
980 The verbose parameter can be used to generate debugging output.
983 Returns number of messages sent.
987 sub SendQueuedMessages {
990 my $which_unsent_messages = {
991 'limit' => $params->{'limit'} // 0,
992 'borrowernumber' => $params->{'borrowernumber'} // q{},
993 'letter_code' => $params->{'letter_code'} // q{},
994 'type' => $params->{'type'} // q{},
996 my $unsent_messages = _get_unsent_messages( $which_unsent_messages );
997 MESSAGE: foreach my $message ( @$unsent_messages ) {
998 my $message_object = Koha::Notice::Messages->find( $message->{message_id} );
999 # If this fails the database is unwritable and we won't manage to send a message that continues to be marked 'pending'
1000 $message_object->make_column_dirty('status');
1001 return unless $message_object->store;
1003 # warn Data::Dumper->Dump( [ $message ], [ 'message' ] );
1004 warn sprintf( 'sending %s message to patron: %s',
1005 $message->{'message_transport_type'},
1006 $message->{'borrowernumber'} || 'Admin' )
1007 if $params->{'verbose'} or $debug;
1008 # This is just begging for subclassing
1009 next MESSAGE if ( lc($message->{'message_transport_type'}) eq 'rss' );
1010 if ( lc( $message->{'message_transport_type'} ) eq 'email' ) {
1011 _send_message_by_email( $message, $params->{'username'}, $params->{'password'}, $params->{'method'} );
1013 elsif ( lc( $message->{'message_transport_type'} ) eq 'sms' ) {
1014 if ( C4::Context->preference('SMSSendDriver') eq 'Email' ) {
1015 my $patron = Koha::Patrons->find( $message->{borrowernumber} );
1016 my $sms_provider = Koha::SMS::Providers->find( $patron->sms_provider_id );
1017 unless ( $sms_provider ) {
1018 warn sprintf( "Patron %s has no sms provider id set!", $message->{'borrowernumber'} ) if $params->{'verbose'} or $debug;
1019 _set_message_status( { message_id => $message->{'message_id'}, status => 'failed' } );
1022 unless ( $patron->smsalertnumber ) {
1023 _set_message_status( { message_id => $message->{'message_id'}, status => 'failed' } );
1024 warn sprintf( "No smsalertnumber found for patron %s!", $message->{'borrowernumber'} ) if $params->{'verbose'} or $debug;
1027 $message->{to_address} = $patron->smsalertnumber; #Sometime this is set to email - sms should always use smsalertnumber
1028 $message->{to_address} .= '@' . $sms_provider->domain();
1030 # Check for possible from_address override
1031 my $from_address = C4::Context->preference('EmailSMSSendDriverFromAddress');
1032 if ($from_address && $message->{from_address} ne $from_address) {
1033 $message->{from_address} = $from_address;
1034 _update_message_from_address($message->{'message_id'}, $message->{from_address});
1037 _update_message_to_address($message->{'message_id'}, $message->{to_address});
1038 _send_message_by_email( $message, $params->{'username'}, $params->{'password'}, $params->{'method'} );
1040 _send_message_by_sms( $message );
1044 return scalar( @$unsent_messages );
1047 =head2 GetRSSMessages
1049 my $message_list = GetRSSMessages( { limit => 10, borrowernumber => '14' } )
1051 returns a listref of all queued RSS messages for a particular person.
1055 sub GetRSSMessages {
1058 return unless $params;
1059 return unless ref $params;
1060 return unless $params->{'borrowernumber'};
1062 return _get_unsent_messages( { message_transport_type => 'rss',
1063 limit => $params->{'limit'},
1064 borrowernumber => $params->{'borrowernumber'}, } );
1067 =head2 GetPrintMessages
1069 my $message_list = GetPrintMessages( { borrowernumber => $borrowernumber } )
1071 Returns a arrayref of all queued print messages (optionally, for a particular
1076 sub GetPrintMessages {
1077 my $params = shift || {};
1079 return _get_unsent_messages( { message_transport_type => 'print',
1080 borrowernumber => $params->{'borrowernumber'},
1084 =head2 GetQueuedMessages ([$hashref])
1086 my $messages = GetQueuedMessage( { borrowernumber => '123', limit => 20 } );
1088 Fetches a list of messages from the message queue optionally filtered by borrowernumber
1089 and limited to specified limit.
1091 Return is an arrayref of hashes, each has represents a message in the message queue.
1095 sub GetQueuedMessages {
1098 my $dbh = C4::Context->dbh();
1099 my $statement = << 'ENDSQL';
1100 SELECT message_id, borrowernumber, subject, content, message_transport_type, status, time_queued, updated_on
1106 if ( exists $params->{'borrowernumber'} ) {
1107 push @whereclauses, ' borrowernumber = ? ';
1108 push @query_params, $params->{'borrowernumber'};
1111 if ( @whereclauses ) {
1112 $statement .= ' WHERE ' . join( 'AND', @whereclauses );
1115 if ( defined $params->{'limit'} ) {
1116 $statement .= ' LIMIT ? ';
1117 push @query_params, $params->{'limit'};
1120 my $sth = $dbh->prepare( $statement );
1121 my $result = $sth->execute( @query_params );
1122 return $sth->fetchall_arrayref({});
1125 =head2 GetMessageTransportTypes
1127 my @mtt = GetMessageTransportTypes();
1129 returns an arrayref of transport types
1133 sub GetMessageTransportTypes {
1134 my $dbh = C4::Context->dbh();
1135 my $mtts = $dbh->selectcol_arrayref("
1136 SELECT message_transport_type
1137 FROM message_transport_types
1138 ORDER BY message_transport_type
1145 my $message = C4::Letters::Message($message_id);
1150 my ( $message_id ) = @_;
1151 return unless $message_id;
1152 my $dbh = C4::Context->dbh;
1153 return $dbh->selectrow_hashref(q|
1154 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
1156 WHERE message_id = ?
1157 |, {}, $message_id );
1160 =head2 ResendMessage
1162 Attempt to resend a message which has failed previously.
1164 my $has_been_resent = C4::Letters::ResendMessage($message_id);
1166 Updates the message to 'pending' status so that
1167 it will be resent later on.
1169 returns 1 on success, 0 on failure, undef if no message was found
1174 my $message_id = shift;
1175 return unless $message_id;
1177 my $message = GetMessage( $message_id );
1178 return unless $message;
1180 if ( $message->{status} ne 'pending' ) {
1181 $rv = C4::Letters::_set_message_status({
1182 message_id => $message_id,
1183 status => 'pending',
1185 $rv = $rv > 0? 1: 0;
1186 # Clear destination email address to force address update
1187 _update_message_to_address( $message_id, undef ) if $rv &&
1188 $message->{message_transport_type} eq 'email';
1193 =head2 _add_attachements
1196 letter - the standard letter hashref
1197 attachments - listref of attachments. each attachment is a hashref of:
1198 type - the mime type, like 'text/plain'
1199 content - the actual attachment
1200 filename - the name of the attachment.
1201 message - a MIME::Lite object to attach these to.
1203 returns your letter object, with the content updated.
1207 sub _add_attachments {
1210 my $letter = $params->{'letter'};
1211 my $attachments = $params->{'attachments'};
1212 return $letter unless @$attachments;
1213 my $message = $params->{'message'};
1215 # First, we have to put the body in as the first attachment
1217 Type => $letter->{'content-type'} || 'TEXT',
1218 Data => $letter->{'is_html'}
1219 ? _wrap_html($letter->{'content'}, $letter->{'title'})
1220 : $letter->{'content'},
1223 foreach my $attachment ( @$attachments ) {
1225 Type => $attachment->{'type'},
1226 Data => $attachment->{'content'},
1227 Filename => $attachment->{'filename'},
1230 # we're forcing list context here to get the header, not the count back from grep.
1231 ( $letter->{'content-type'} ) = grep( /^Content-Type:/, split( /\n/, $params->{'message'}->header_as_string ) );
1232 $letter->{'content-type'} =~ s/^Content-Type:\s+//;
1233 $letter->{'content'} = $message->body_as_string;
1239 =head2 _get_unsent_messages
1241 This function's parameter hash reference takes the following
1242 optional named parameters:
1243 message_transport_type: method of message sending (e.g. email, sms, etc.)
1244 borrowernumber : who the message is to be sent
1245 letter_code : type of message being sent (e.g. PASSWORD_RESET)
1246 limit : maximum number of messages to send
1248 This function returns an array of matching hash referenced rows from
1249 message_queue with some borrower information added.
1253 sub _get_unsent_messages {
1256 my $dbh = C4::Context->dbh();
1258 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
1259 FROM message_queue mq
1260 LEFT JOIN borrowers b ON b.borrowernumber = mq.borrowernumber
1264 my @query_params = ('pending');
1265 if ( ref $params ) {
1266 if ( $params->{'message_transport_type'} ) {
1267 $statement .= ' AND mq.message_transport_type = ? ';
1268 push @query_params, $params->{'message_transport_type'};
1270 if ( $params->{'borrowernumber'} ) {
1271 $statement .= ' AND mq.borrowernumber = ? ';
1272 push @query_params, $params->{'borrowernumber'};
1274 if ( $params->{'letter_code'} ) {
1275 $statement .= ' AND mq.letter_code = ? ';
1276 push @query_params, $params->{'letter_code'};
1278 if ( $params->{'type'} ) {
1279 $statement .= ' AND message_transport_type = ? ';
1280 push @query_params, $params->{'type'};
1282 if ( $params->{'limit'} ) {
1283 $statement .= ' limit ? ';
1284 push @query_params, $params->{'limit'};
1288 $debug and warn "_get_unsent_messages SQL: $statement";
1289 $debug and warn "_get_unsent_messages params: " . join(',',@query_params);
1290 my $sth = $dbh->prepare( $statement );
1291 my $result = $sth->execute( @query_params );
1292 return $sth->fetchall_arrayref({});
1295 sub _send_message_by_email {
1296 my $message = shift or return;
1297 my ($username, $password, $method) = @_;
1299 my $patron = Koha::Patrons->find( $message->{borrowernumber} );
1300 my $to_address = $message->{'to_address'};
1301 unless ($to_address) {
1303 warn "FAIL: No 'to_address' and INVALID borrowernumber ($message->{borrowernumber})";
1304 _set_message_status( { message_id => $message->{'message_id'},
1305 status => 'failed' } );
1308 $to_address = $patron->notice_email_address;
1309 unless ($to_address) {
1310 # warn "FAIL: No 'to_address' and no email for " . ($member->{surname} ||'') . ", borrowernumber ($message->{borrowernumber})";
1311 # warning too verbose for this more common case?
1312 _set_message_status( { message_id => $message->{'message_id'},
1313 status => 'failed' } );
1318 my $subject = $message->{'subject'};
1320 my $content = $message->{'content'};
1321 my $content_type = $message->{'content_type'} || 'text/plain; charset="UTF-8"';
1322 my $is_html = $content_type =~ m/html/io;
1324 my $branch_email = undef;
1325 my $branch_replyto = undef;
1326 my $branch_returnpath = undef;
1330 $library = $patron->library;
1331 $branch_email = $library->branchemail;
1332 $branch_replyto = $library->branchreplyto;
1333 $branch_returnpath = $library->branchreturnpath;
1336 my $email = Koha::Email->create(
1340 C4::Context->preference('NoticeBcc')
1341 ? ( bcc => C4::Context->preference('NoticeBcc') )
1344 from => $message->{'from_address'} || $branch_email,
1345 reply_to => $message->{'reply_address'} || $branch_replyto,
1346 sender => $branch_returnpath,
1347 subject => "" . $message->{subject}
1353 _wrap_html( $content, $subject )
1357 $email->text_body( $content );
1362 $smtp_server = $library->smtp_server;
1365 $smtp_server = Koha::SMTP::Servers->get_default;
1371 sasl_username => $username,
1372 sasl_password => $password,
1377 # if initial message address was empty, coming here means that a to address was found and
1378 # queue should be updated; same if to address was overriden by Koha::Email->create
1379 _update_message_to_address( $message->{'message_id'}, $email->email->header('To') )
1380 if !$message->{to_address}
1381 || $message->{to_address} ne $email->email->header('To');
1384 $email->send_or_die({ transport => $smtp_server->transport });
1386 _set_message_status(
1388 message_id => $message->{'message_id'},
1395 _set_message_status(
1397 message_id => $message->{'message_id'},
1407 my ($content, $title) = @_;
1409 my $css = C4::Context->preference("NoticeCSS") || '';
1410 $css = qq{<link rel="stylesheet" type="text/css" href="$css">} if $css;
1412 <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
1413 "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
1414 <html lang="en" xml:lang="en" xmlns="http://www.w3.org/1999/xhtml">
1416 <title>$title</title>
1417 <meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
1428 my ( $message ) = @_;
1429 my $dbh = C4::Context->dbh;
1430 my $count = $dbh->selectrow_array(q|
1433 WHERE message_transport_type = ?
1434 AND borrowernumber = ?
1436 AND CAST(updated_on AS date) = CAST(NOW() AS date)
1439 |, {}, $message->{message_transport_type}, $message->{borrowernumber}, $message->{letter_code}, $message->{content} );
1443 sub _send_message_by_sms {
1444 my $message = shift or return;
1445 my $patron = Koha::Patrons->find( $message->{borrowernumber} );
1447 unless ( $patron and $patron->smsalertnumber ) {
1448 _set_message_status( { message_id => $message->{'message_id'},
1449 status => 'failed' } );
1453 if ( _is_duplicate( $message ) ) {
1454 _set_message_status( { message_id => $message->{'message_id'},
1455 status => 'failed' } );
1459 my $success = C4::SMS->send_sms( { destination => $patron->smsalertnumber,
1460 message => $message->{'content'},
1462 _set_message_status( { message_id => $message->{'message_id'},
1463 status => ($success ? 'sent' : 'failed') } );
1467 sub _update_message_to_address {
1469 my $dbh = C4::Context->dbh();
1470 $dbh->do('UPDATE message_queue SET to_address=? WHERE message_id=?',undef,($to,$id));
1473 sub _update_message_from_address {
1474 my ($message_id, $from_address) = @_;
1475 my $dbh = C4::Context->dbh();
1476 $dbh->do('UPDATE message_queue SET from_address = ? WHERE message_id = ?', undef, ($from_address, $message_id));
1479 sub _set_message_status {
1480 my $params = shift or return;
1482 foreach my $required_parameter ( qw( message_id status ) ) {
1483 return unless exists $params->{ $required_parameter };
1486 my $dbh = C4::Context->dbh();
1487 my $statement = 'UPDATE message_queue SET status= ? WHERE message_id = ?';
1488 my $sth = $dbh->prepare( $statement );
1489 my $result = $sth->execute( $params->{'status'},
1490 $params->{'message_id'} );
1495 my ( $params ) = @_;
1497 my $content = $params->{content};
1498 my $tables = $params->{tables};
1499 my $loops = $params->{loops};
1500 my $substitute = $params->{substitute} || {};
1502 my $use_template_cache = C4::Context->config('template_cache_dir') && defined $ENV{GATEWAY_INTERFACE};
1503 my $template = Template->new(
1507 PLUGIN_BASE => 'Koha::Template::Plugin',
1508 COMPILE_EXT => $use_template_cache ? '.ttc' : '',
1509 COMPILE_DIR => $use_template_cache ? C4::Context->config('template_cache_dir') : '',
1511 ENCODING => 'UTF-8',
1513 ) or die Template->error();
1515 my $tt_params = { %{ _get_tt_params( $tables ) }, %{ _get_tt_params( $loops, 'is_a_loop' ) }, %$substitute };
1517 $content = add_tt_filters( $content );
1518 $content = qq|[% USE KohaDates %][% USE Remove_MARC_punctuation %]$content|;
1521 $template->process( \$content, $tt_params, \$output ) || croak "ERROR PROCESSING TEMPLATE: " . $template->error();
1526 sub _get_tt_params {
1527 my ($tables, $is_a_loop) = @_;
1533 article_requests => {
1534 module => 'Koha::ArticleRequests',
1535 singular => 'article_request',
1536 plural => 'article_requests',
1540 module => 'Koha::Acquisition::Baskets',
1541 singular => 'basket',
1542 plural => 'baskets',
1546 module => 'Koha::Biblios',
1547 singular => 'biblio',
1548 plural => 'biblios',
1549 pk => 'biblionumber',
1552 module => 'Koha::Biblioitems',
1553 singular => 'biblioitem',
1554 plural => 'biblioitems',
1555 pk => 'biblioitemnumber',
1558 module => 'Koha::Patrons',
1559 singular => 'borrower',
1560 plural => 'borrowers',
1561 pk => 'borrowernumber',
1564 module => 'Koha::Libraries',
1565 singular => 'branch',
1566 plural => 'branches',
1570 module => 'Koha::Items',
1576 module => 'Koha::News',
1582 module => 'Koha::Acquisition::Orders',
1583 singular => 'order',
1585 pk => 'ordernumber',
1588 module => 'Koha::Holds',
1594 module => 'Koha::Serials',
1595 singular => 'serial',
1596 plural => 'serials',
1600 module => 'Koha::Subscriptions',
1601 singular => 'subscription',
1602 plural => 'subscriptions',
1603 pk => 'subscriptionid',
1606 module => 'Koha::Suggestions',
1607 singular => 'suggestion',
1608 plural => 'suggestions',
1609 pk => 'suggestionid',
1612 module => 'Koha::Checkouts',
1613 singular => 'checkout',
1614 plural => 'checkouts',
1618 module => 'Koha::Old::Checkouts',
1619 singular => 'old_checkout',
1620 plural => 'old_checkouts',
1624 module => 'Koha::Checkouts',
1625 singular => 'overdue',
1626 plural => 'overdues',
1629 borrower_modifications => {
1630 module => 'Koha::Patron::Modifications',
1631 singular => 'patron_modification',
1632 plural => 'patron_modifications',
1633 fk => 'verification_token',
1636 module => 'Koha::Illrequests',
1637 singular => 'illrequest',
1638 plural => 'illrequests',
1639 pk => 'illrequest_id'
1643 foreach my $table ( keys %$tables ) {
1644 next unless $config->{$table};
1646 my $ref = ref( $tables->{$table} ) || q{};
1647 my $module = $config->{$table}->{module};
1649 if ( can_load( modules => { $module => undef } ) ) {
1650 my $pk = $config->{$table}->{pk};
1651 my $fk = $config->{$table}->{fk};
1654 my $values = $tables->{$table} || [];
1655 unless ( ref( $values ) eq 'ARRAY' ) {
1656 croak "ERROR processing table $table. Wrong API call.";
1658 my $key = $pk ? $pk : $fk;
1659 # $key does not come from user input
1660 my $objects = $module->search(
1661 { $key => $values },
1663 # We want to retrieve the data in the same order
1665 # field is a MySQLism, but they are no other way to do it
1666 # To be generic we could do it in perl, but we will need to fetch
1667 # all the data then order them
1668 @$values ? ( order_by => \[ "field($key, " . join( ', ', @$values ) . ")" ] ) : ()
1671 $params->{ $config->{$table}->{plural} } = $objects;
1673 elsif ( $ref eq q{} || $ref eq 'HASH' ) {
1674 my $id = ref $ref eq 'HASH' ? $tables->{$table}->{$pk} : $tables->{$table};
1676 if ( $fk ) { # Using a foreign key for lookup
1677 if ( ref( $fk ) eq 'ARRAY' ) { # Foreign key is multi-column
1679 foreach my $key ( @$fk ) {
1680 $search->{$key} = $id->{$key};
1682 $object = $module->search( $search )->last();
1683 } else { # Foreign key is single column
1684 $object = $module->search( { $fk => $id } )->last();
1686 } else { # using the table's primary key for lookup
1687 $object = $module->find($id);
1689 $params->{ $config->{$table}->{singular} } = $object;
1691 else { # $ref eq 'ARRAY'
1693 if ( @{ $tables->{$table} } == 1 ) { # Param is a single key
1694 $object = $module->search( { $pk => $tables->{$table} } )->last();
1696 else { # Params are mutliple foreign keys
1697 croak "Multiple foreign keys (table $table) should be passed using an hashref";
1699 $params->{ $config->{$table}->{singular} } = $object;
1703 croak "ERROR LOADING MODULE $module: $Module::Load::Conditional::ERROR";
1707 $params->{today} = output_pref({ dt => dt_from_string, dateformat => 'iso' });
1712 =head3 add_tt_filters
1714 $content = add_tt_filters( $content );
1716 Add TT filters to some specific fields if needed.
1718 For now we only add the Remove_MARC_punctuation TT filter to biblio and biblioitem fields
1722 sub add_tt_filters {
1723 my ( $content ) = @_;
1724 $content =~ s|\[%\s*biblio\.(.*?)\s*%\]|[% biblio.$1 \| \$Remove_MARC_punctuation %]|gxms;
1725 $content =~ s|\[%\s*biblioitem\.(.*?)\s*%\]|[% biblioitem.$1 \| \$Remove_MARC_punctuation %]|gxms;
1729 =head2 get_item_content
1731 my $item = Koha::Items->find(...)->unblessed;
1732 my @item_content_fields = qw( date_due title barcode author itemnumber );
1733 my $item_content = C4::Letters::get_item_content({
1735 item_content_fields => \@item_content_fields
1738 This function generates a tab-separated list of values for the passed item. Dates
1739 are formatted following the current setup.
1743 sub get_item_content {
1744 my ( $params ) = @_;
1745 my $item = $params->{item};
1746 my $dateonly = $params->{dateonly} || 0;
1747 my $item_content_fields = $params->{item_content_fields} || [];
1749 return unless $item;
1751 my @item_info = map {
1755 { dt => dt_from_string( $item->{$_} ), dateonly => $dateonly } );
1759 } @$item_content_fields;
1760 return join( "\t", @item_info ) . "\n";