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->{content} =~ s/<<\S*>>//go; #remove any stragglers
716 sub _substitute_tables {
717 my ( $letter, $tables ) = @_;
718 while ( my ($table, $param) = each %$tables ) {
721 my $ref = ref $param;
724 if ($ref && $ref eq 'HASH') {
728 my $sth = _parseletter_sth($table);
730 warn "_parseletter_sth('$table') failed to return a valid sth. No substitution will be done for that table.";
733 $sth->execute( $ref ? @$param : $param );
735 $values = $sth->fetchrow_hashref;
739 _parseletter ( $letter, $table, $values );
743 sub _parseletter_sth {
747 carp "ERROR: _parseletter_sth() called without argument (table)";
750 # NOTE: we used to check whether we had a statement handle cached in
751 # a %handles module-level variable. This was a dumb move and
752 # broke things for the rest of us. prepare_cached is a better
753 # way to cache statement handles anyway.
755 ($table eq 'biblio' ) ? "SELECT * FROM $table WHERE biblionumber = ?" :
756 ($table eq 'biblioitems' ) ? "SELECT * FROM $table WHERE biblionumber = ?" :
757 ($table eq 'items' ) ? "SELECT * FROM $table WHERE itemnumber = ?" :
758 ($table eq 'issues' ) ? "SELECT * FROM $table WHERE itemnumber = ?" :
759 ($table eq 'old_issues' ) ? "SELECT * FROM $table WHERE itemnumber = ? ORDER BY timestamp DESC LIMIT 1" :
760 ($table eq 'reserves' ) ? "SELECT * FROM $table WHERE borrowernumber = ? and biblionumber = ?" :
761 ($table eq 'borrowers' ) ? "SELECT * FROM $table WHERE borrowernumber = ?" :
762 ($table eq 'branches' ) ? "SELECT * FROM $table WHERE branchcode = ?" :
763 ($table eq 'suggestions' ) ? "SELECT * FROM $table WHERE suggestionid = ?" :
764 ($table eq 'aqbooksellers') ? "SELECT * FROM $table WHERE id = ?" :
765 ($table eq 'aqorders' ) ? "SELECT * FROM $table WHERE ordernumber = ?" :
766 ($table eq 'aqbasket' ) ? "SELECT * FROM $table WHERE basketno = ?" :
767 ($table eq 'opac_news' ) ? "SELECT * FROM $table WHERE idnew = ?" :
768 ($table eq 'article_requests') ? "SELECT * FROM $table WHERE id = ?" :
769 ($table eq 'borrower_modifications') ? "SELECT * FROM $table WHERE verification_token = ?" :
770 ($table eq 'subscription') ? "SELECT * FROM $table WHERE subscriptionid = ?" :
771 ($table eq 'serial') ? "SELECT * FROM $table WHERE serialid = ?" :
772 ($table eq 'problem_reports') ? "SELECT * FROM $table WHERE reportid = ?" :
775 warn "ERROR: No _parseletter_sth query for table '$table'";
776 return; # nothing to get
778 unless ($sth = C4::Context->dbh->prepare_cached($query)) {
779 warn "ERROR: Failed to prepare query: '$query'";
782 return $sth; # now cache is populated for that $table
785 =head2 _parseletter($letter, $table, $values)
788 - $letter : a hash to letter fields (title & content useful)
789 - $table : the Koha table to parse.
790 - $values_in : table record hashref
791 parse all fields from a table, and replace values in title & content with the appropriate value
792 (not exported sub, used only internally)
797 my ( $letter, $table, $values_in ) = @_;
799 # Work on a local copy of $values_in (passed by reference) to avoid side effects
800 # in callers ( by changing / formatting values )
801 my $values = $values_in ? { %$values_in } : {};
803 if ( $table eq 'borrowers' && $values->{'dateexpiry'} ){
804 $values->{'dateexpiry'} = output_pref({ dt => dt_from_string( $values->{'dateexpiry'} ), dateonly => 1 });
807 if ( $table eq 'reserves' && $values->{'waitingdate'} ) {
808 $values->{'waitingdate'} = output_pref({ dt => dt_from_string( $values->{'waitingdate'} ), dateonly => 1 });
811 if ($letter->{content} && $letter->{content} =~ /<<today>>/) {
812 my $todaysdate = output_pref( dt_from_string() );
813 $letter->{content} =~ s/<<today>>/$todaysdate/go;
816 while ( my ($field, $val) = each %$values ) {
817 $val =~ s/\p{P}$// if $val && $table=~/biblio/;
818 #BZ 9886: Assuming that we want to eliminate ISBD punctuation here
819 #Therefore adding the test on biblio. This includes biblioitems,
820 #but excludes items. Removed unneeded global and lookahead.
822 if ( $table=~/^borrowers$/ && $field=~/^streettype$/ ) {
823 my $av = Koha::AuthorisedValues->search({ category => 'ROADTYPE', authorised_value => $val });
824 $val = $av->count ? $av->next->lib : '';
828 my $replacedby = defined ($val) ? $val : '';
830 and not $replacedby =~ m|0000-00-00|
831 and not $replacedby =~ m|9999-12-31|
832 and $replacedby =~ m|^\d{4}-\d{2}-\d{2}( \d{2}:\d{2}:\d{2})?$| )
834 # If the value is XXXX-YY-ZZ[ AA:BB:CC] we assume it is a date
835 my $dateonly = defined $1 ? 0 : 1; #$1 refers to the capture group wrapped in parentheses. In this case, that's the hours, minutes, seconds.
836 my $re_dateonly_filter = qr{ $field( \s* \| \s* dateonly\s*)?>> }xms;
838 for my $letter_field ( qw( title content ) ) {
839 my $filter_string_used = q{};
840 if ( $letter->{ $letter_field } =~ $re_dateonly_filter ) {
841 # We overwrite $dateonly if the filter exists and we have a time in the datetime
842 $filter_string_used = $1 || q{};
843 $dateonly = $1 unless $dateonly;
845 my $replacedby_date = eval {
846 output_pref({ dt => dt_from_string( $replacedby ), dateonly => $dateonly });
849 if ( $letter->{ $letter_field } ) {
850 $letter->{ $letter_field } =~ s/\Q<<$table.$field$filter_string_used>>\E/$replacedby_date/g;
851 $letter->{ $letter_field } =~ s/\Q<<$field$filter_string_used>>\E/$replacedby_date/g;
855 # Other fields replacement
857 for my $letter_field ( qw( title content ) ) {
858 if ( $letter->{ $letter_field } ) {
859 $letter->{ $letter_field } =~ s/<<$table.$field>>/$replacedby/g;
860 $letter->{ $letter_field } =~ s/<<$field>>/$replacedby/g;
866 if ($table eq 'borrowers' && $letter->{content}) {
867 my $patron = Koha::Patrons->find( $values->{borrowernumber} );
869 my $attributes = $patron->extended_attributes;
871 while ( my $attribute = $attributes->next ) {
872 my $code = $attribute->code;
873 my $val = $attribute->description; # FIXME - we always display intranet description here!
874 $val =~ s/\p{P}(?=$)//g if $val;
875 next unless $val gt '';
877 push @{ $attr{$code} }, $val;
879 while ( my ($code, $val_ar) = each %attr ) {
880 my $replacefield = "<<borrower-attribute:$code>>";
881 my $replacedby = join ',', @$val_ar;
882 $letter->{content} =~ s/$replacefield/$replacedby/g;
891 my $success = EnqueueLetter( { letter => $letter,
892 borrowernumber => '12', message_transport_type => 'email' } )
894 places a letter in the message_queue database table, which will
895 eventually get processed (sent) by the process_message_queue.pl
896 cronjob when it calls SendQueuedMessages.
898 return message_id on success
903 my $params = shift or return;
905 return unless exists $params->{'letter'};
906 # return unless exists $params->{'borrowernumber'};
907 return unless exists $params->{'message_transport_type'};
909 my $content = $params->{letter}->{content};
910 $content =~ s/\s+//g if(defined $content);
911 if ( not defined $content or $content eq '' ) {
912 warn "Trying to add an empty message to the message queue" if $debug;
916 # If we have any attachments we should encode then into the body.
917 if ( $params->{'attachments'} ) {
918 $params->{'letter'} = _add_attachments(
919 { letter => $params->{'letter'},
920 attachments => $params->{'attachments'},
921 message => MIME::Lite->new( Type => 'multipart/mixed' ),
926 my $dbh = C4::Context->dbh();
927 my $statement = << 'ENDSQL';
928 INSERT INTO message_queue
929 ( borrowernumber, subject, content, metadata, letter_code, message_transport_type, status, time_queued, to_address, from_address, reply_address, content_type )
931 ( ?, ?, ?, ?, ?, ?, ?, NOW(), ?, ?, ?, ? )
934 my $sth = $dbh->prepare($statement);
935 my $result = $sth->execute(
936 $params->{'borrowernumber'}, # borrowernumber
937 $params->{'letter'}->{'title'}, # subject
938 $params->{'letter'}->{'content'}, # content
939 $params->{'letter'}->{'metadata'} || '', # metadata
940 $params->{'letter'}->{'code'} || '', # letter_code
941 $params->{'message_transport_type'}, # message_transport_type
943 $params->{'to_address'}, # to_address
944 $params->{'from_address'}, # from_address
945 $params->{'reply_address'}, # reply_address
946 $params->{'letter'}->{'content-type'}, # content_type
948 return $dbh->last_insert_id(undef,undef,'message_queue', undef);
951 =head2 SendQueuedMessages ([$hashref])
953 my $sent = SendQueuedMessages({
954 letter_code => $letter_code,
955 borrowernumber => $who_letter_is_for,
961 Sends all of the 'pending' items in the message queue, unless
962 parameters are passed.
964 The letter_code, borrowernumber and limit parameters are used
965 to build a parameter set for _get_unsent_messages, thus limiting
966 which pending messages will be processed. They are all optional.
968 The verbose parameter can be used to generate debugging output.
971 Returns number of messages sent.
975 sub SendQueuedMessages {
978 my $which_unsent_messages = {
979 'limit' => $params->{'limit'} // 0,
980 'borrowernumber' => $params->{'borrowernumber'} // q{},
981 'letter_code' => $params->{'letter_code'} // q{},
982 'type' => $params->{'type'} // q{},
984 my $unsent_messages = _get_unsent_messages( $which_unsent_messages );
985 MESSAGE: foreach my $message ( @$unsent_messages ) {
986 my $message_object = Koha::Notice::Messages->find( $message->{message_id} );
987 # If this fails the database is unwritable and we won't manage to send a message that continues to be marked 'pending'
988 $message_object->make_column_dirty('status');
989 return unless $message_object->store;
991 # warn Data::Dumper->Dump( [ $message ], [ 'message' ] );
992 warn sprintf( 'sending %s message to patron: %s',
993 $message->{'message_transport_type'},
994 $message->{'borrowernumber'} || 'Admin' )
995 if $params->{'verbose'} or $debug;
996 # This is just begging for subclassing
997 next MESSAGE if ( lc($message->{'message_transport_type'}) eq 'rss' );
998 if ( lc( $message->{'message_transport_type'} ) eq 'email' ) {
999 _send_message_by_email( $message, $params->{'username'}, $params->{'password'}, $params->{'method'} );
1001 elsif ( lc( $message->{'message_transport_type'} ) eq 'sms' ) {
1002 if ( C4::Context->preference('SMSSendDriver') eq 'Email' ) {
1003 my $patron = Koha::Patrons->find( $message->{borrowernumber} );
1004 my $sms_provider = Koha::SMS::Providers->find( $patron->sms_provider_id );
1005 unless ( $sms_provider ) {
1006 warn sprintf( "Patron %s has no sms provider id set!", $message->{'borrowernumber'} ) if $params->{'verbose'} or $debug;
1007 _set_message_status( { message_id => $message->{'message_id'}, status => 'failed' } );
1010 unless ( $patron->smsalertnumber ) {
1011 _set_message_status( { message_id => $message->{'message_id'}, status => 'failed' } );
1012 warn sprintf( "No smsalertnumber found for patron %s!", $message->{'borrowernumber'} ) if $params->{'verbose'} or $debug;
1015 $message->{to_address} = $patron->smsalertnumber; #Sometime this is set to email - sms should always use smsalertnumber
1016 $message->{to_address} .= '@' . $sms_provider->domain();
1018 # Check for possible from_address override
1019 my $from_address = C4::Context->preference('EmailSMSSendDriverFromAddress');
1020 if ($from_address && $message->{from_address} ne $from_address) {
1021 $message->{from_address} = $from_address;
1022 _update_message_from_address($message->{'message_id'}, $message->{from_address});
1025 _update_message_to_address($message->{'message_id'}, $message->{to_address});
1026 _send_message_by_email( $message, $params->{'username'}, $params->{'password'}, $params->{'method'} );
1028 _send_message_by_sms( $message );
1032 return scalar( @$unsent_messages );
1035 =head2 GetRSSMessages
1037 my $message_list = GetRSSMessages( { limit => 10, borrowernumber => '14' } )
1039 returns a listref of all queued RSS messages for a particular person.
1043 sub GetRSSMessages {
1046 return unless $params;
1047 return unless ref $params;
1048 return unless $params->{'borrowernumber'};
1050 return _get_unsent_messages( { message_transport_type => 'rss',
1051 limit => $params->{'limit'},
1052 borrowernumber => $params->{'borrowernumber'}, } );
1055 =head2 GetPrintMessages
1057 my $message_list = GetPrintMessages( { borrowernumber => $borrowernumber } )
1059 Returns a arrayref of all queued print messages (optionally, for a particular
1064 sub GetPrintMessages {
1065 my $params = shift || {};
1067 return _get_unsent_messages( { message_transport_type => 'print',
1068 borrowernumber => $params->{'borrowernumber'},
1072 =head2 GetQueuedMessages ([$hashref])
1074 my $messages = GetQueuedMessage( { borrowernumber => '123', limit => 20 } );
1076 Fetches a list of messages from the message queue optionally filtered by borrowernumber
1077 and limited to specified limit.
1079 Return is an arrayref of hashes, each has represents a message in the message queue.
1083 sub GetQueuedMessages {
1086 my $dbh = C4::Context->dbh();
1087 my $statement = << 'ENDSQL';
1088 SELECT message_id, borrowernumber, subject, content, message_transport_type, status, time_queued, updated_on
1094 if ( exists $params->{'borrowernumber'} ) {
1095 push @whereclauses, ' borrowernumber = ? ';
1096 push @query_params, $params->{'borrowernumber'};
1099 if ( @whereclauses ) {
1100 $statement .= ' WHERE ' . join( 'AND', @whereclauses );
1103 if ( defined $params->{'limit'} ) {
1104 $statement .= ' LIMIT ? ';
1105 push @query_params, $params->{'limit'};
1108 my $sth = $dbh->prepare( $statement );
1109 my $result = $sth->execute( @query_params );
1110 return $sth->fetchall_arrayref({});
1113 =head2 GetMessageTransportTypes
1115 my @mtt = GetMessageTransportTypes();
1117 returns an arrayref of transport types
1121 sub GetMessageTransportTypes {
1122 my $dbh = C4::Context->dbh();
1123 my $mtts = $dbh->selectcol_arrayref("
1124 SELECT message_transport_type
1125 FROM message_transport_types
1126 ORDER BY message_transport_type
1133 my $message = C4::Letters::Message($message_id);
1138 my ( $message_id ) = @_;
1139 return unless $message_id;
1140 my $dbh = C4::Context->dbh;
1141 return $dbh->selectrow_hashref(q|
1142 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
1144 WHERE message_id = ?
1145 |, {}, $message_id );
1148 =head2 ResendMessage
1150 Attempt to resend a message which has failed previously.
1152 my $has_been_resent = C4::Letters::ResendMessage($message_id);
1154 Updates the message to 'pending' status so that
1155 it will be resent later on.
1157 returns 1 on success, 0 on failure, undef if no message was found
1162 my $message_id = shift;
1163 return unless $message_id;
1165 my $message = GetMessage( $message_id );
1166 return unless $message;
1168 if ( $message->{status} ne 'pending' ) {
1169 $rv = C4::Letters::_set_message_status({
1170 message_id => $message_id,
1171 status => 'pending',
1173 $rv = $rv > 0? 1: 0;
1174 # Clear destination email address to force address update
1175 _update_message_to_address( $message_id, undef ) if $rv &&
1176 $message->{message_transport_type} eq 'email';
1181 =head2 _add_attachements
1184 letter - the standard letter hashref
1185 attachments - listref of attachments. each attachment is a hashref of:
1186 type - the mime type, like 'text/plain'
1187 content - the actual attachment
1188 filename - the name of the attachment.
1189 message - a MIME::Lite object to attach these to.
1191 returns your letter object, with the content updated.
1195 sub _add_attachments {
1198 my $letter = $params->{'letter'};
1199 my $attachments = $params->{'attachments'};
1200 return $letter unless @$attachments;
1201 my $message = $params->{'message'};
1203 # First, we have to put the body in as the first attachment
1205 Type => $letter->{'content-type'} || 'TEXT',
1206 Data => $letter->{'is_html'}
1207 ? _wrap_html($letter->{'content'}, $letter->{'title'})
1208 : $letter->{'content'},
1211 foreach my $attachment ( @$attachments ) {
1213 Type => $attachment->{'type'},
1214 Data => $attachment->{'content'},
1215 Filename => $attachment->{'filename'},
1218 # we're forcing list context here to get the header, not the count back from grep.
1219 ( $letter->{'content-type'} ) = grep( /^Content-Type:/, split( /\n/, $params->{'message'}->header_as_string ) );
1220 $letter->{'content-type'} =~ s/^Content-Type:\s+//;
1221 $letter->{'content'} = $message->body_as_string;
1227 =head2 _get_unsent_messages
1229 This function's parameter hash reference takes the following
1230 optional named parameters:
1231 message_transport_type: method of message sending (e.g. email, sms, etc.)
1232 borrowernumber : who the message is to be sent
1233 letter_code : type of message being sent (e.g. PASSWORD_RESET)
1234 limit : maximum number of messages to send
1236 This function returns an array of matching hash referenced rows from
1237 message_queue with some borrower information added.
1241 sub _get_unsent_messages {
1244 my $dbh = C4::Context->dbh();
1246 SELECT mq.message_id, mq.borrowernumber, mq.subject, mq.content, mq.message_transport_type, mq.status, mq.time_queued, mq.from_address, mq.reply_address, mq.to_address, mq.content_type, b.branchcode, mq.letter_code
1247 FROM message_queue mq
1248 LEFT JOIN borrowers b ON b.borrowernumber = mq.borrowernumber
1252 my @query_params = ('pending');
1253 if ( ref $params ) {
1254 if ( $params->{'message_transport_type'} ) {
1255 $statement .= ' AND mq.message_transport_type = ? ';
1256 push @query_params, $params->{'message_transport_type'};
1258 if ( $params->{'borrowernumber'} ) {
1259 $statement .= ' AND mq.borrowernumber = ? ';
1260 push @query_params, $params->{'borrowernumber'};
1262 if ( $params->{'letter_code'} ) {
1263 $statement .= ' AND mq.letter_code = ? ';
1264 push @query_params, $params->{'letter_code'};
1266 if ( $params->{'type'} ) {
1267 $statement .= ' AND message_transport_type = ? ';
1268 push @query_params, $params->{'type'};
1270 if ( $params->{'limit'} ) {
1271 $statement .= ' limit ? ';
1272 push @query_params, $params->{'limit'};
1276 $debug and warn "_get_unsent_messages SQL: $statement";
1277 $debug and warn "_get_unsent_messages params: " . join(',',@query_params);
1278 my $sth = $dbh->prepare( $statement );
1279 my $result = $sth->execute( @query_params );
1280 return $sth->fetchall_arrayref({});
1283 sub _send_message_by_email {
1284 my $message = shift or return;
1285 my ($username, $password, $method) = @_;
1287 my $patron = Koha::Patrons->find( $message->{borrowernumber} );
1288 my $to_address = $message->{'to_address'};
1289 unless ($to_address) {
1291 warn "FAIL: No 'to_address' and INVALID borrowernumber ($message->{borrowernumber})";
1292 _set_message_status( { message_id => $message->{'message_id'},
1293 status => 'failed' } );
1296 $to_address = $patron->notice_email_address;
1297 unless ($to_address) {
1298 # warn "FAIL: No 'to_address' and no email for " . ($member->{surname} ||'') . ", borrowernumber ($message->{borrowernumber})";
1299 # warning too verbose for this more common case?
1300 _set_message_status( { message_id => $message->{'message_id'},
1301 status => 'failed' } );
1306 # Encode subject line separately
1307 $message->{subject} = encode('MIME-Header', $message->{'subject'} );
1308 my $subject = $message->{'subject'};
1310 my $content = encode('UTF-8', $message->{'content'});
1311 my $content_type = $message->{'content_type'} || 'text/plain; charset="UTF-8"';
1312 my $is_html = $content_type =~ m/html/io;
1314 my $branch_email = undef;
1315 my $branch_replyto = undef;
1316 my $branch_returnpath = undef;
1320 $library = $patron->library;
1321 $branch_email = $library->branchemail;
1322 $branch_replyto = $library->branchreplyto;
1323 $branch_returnpath = $library->branchreturnpath;
1326 my $email = Koha::Email->create(
1330 C4::Context->preference('NoticeBcc')
1331 ? ( bcc => C4::Context->preference('NoticeBcc') )
1334 from => $message->{'from_address'} || $branch_email,
1335 reply_to => $message->{'reply_address'} || $branch_replyto,
1336 sender => $branch_returnpath,
1337 subject => "" . $message->{subject}
1343 _wrap_html( $content, $subject )
1347 $email->text_body( $content );
1352 $smtp_server = $library->smtp_server;
1355 $smtp_server = Koha::SMTP::Servers->get_default;
1361 sasl_username => $username,
1362 sasl_password => $password,
1367 # if initial message address was empty, coming here means that a to address was found and
1368 # queue should be updated; same if to address was overriden by Koha::Email->create
1369 _update_message_to_address( $message->{'message_id'}, $email->email->header('To') )
1370 if !$message->{to_address}
1371 || $message->{to_address} ne $email->email->header('To');
1374 $email->send_or_die({ transport => $smtp_server->transport });
1376 _set_message_status(
1378 message_id => $message->{'message_id'},
1385 _set_message_status(
1387 message_id => $message->{'message_id'},
1397 my ($content, $title) = @_;
1399 my $css = C4::Context->preference("NoticeCSS") || '';
1400 $css = qq{<link rel="stylesheet" type="text/css" href="$css">} if $css;
1402 <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
1403 "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
1404 <html lang="en" xml:lang="en" xmlns="http://www.w3.org/1999/xhtml">
1406 <title>$title</title>
1407 <meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
1418 my ( $message ) = @_;
1419 my $dbh = C4::Context->dbh;
1420 my $count = $dbh->selectrow_array(q|
1423 WHERE message_transport_type = ?
1424 AND borrowernumber = ?
1426 AND CAST(updated_on AS date) = CAST(NOW() AS date)
1429 |, {}, $message->{message_transport_type}, $message->{borrowernumber}, $message->{letter_code}, $message->{content} );
1433 sub _send_message_by_sms {
1434 my $message = shift or return;
1435 my $patron = Koha::Patrons->find( $message->{borrowernumber} );
1437 unless ( $patron and $patron->smsalertnumber ) {
1438 _set_message_status( { message_id => $message->{'message_id'},
1439 status => 'failed' } );
1443 if ( _is_duplicate( $message ) ) {
1444 _set_message_status( { message_id => $message->{'message_id'},
1445 status => 'failed' } );
1449 my $success = C4::SMS->send_sms( { destination => $patron->smsalertnumber,
1450 message => $message->{'content'},
1452 _set_message_status( { message_id => $message->{'message_id'},
1453 status => ($success ? 'sent' : 'failed') } );
1457 sub _update_message_to_address {
1459 my $dbh = C4::Context->dbh();
1460 $dbh->do('UPDATE message_queue SET to_address=? WHERE message_id=?',undef,($to,$id));
1463 sub _update_message_from_address {
1464 my ($message_id, $from_address) = @_;
1465 my $dbh = C4::Context->dbh();
1466 $dbh->do('UPDATE message_queue SET from_address = ? WHERE message_id = ?', undef, ($from_address, $message_id));
1469 sub _set_message_status {
1470 my $params = shift or return;
1472 foreach my $required_parameter ( qw( message_id status ) ) {
1473 return unless exists $params->{ $required_parameter };
1476 my $dbh = C4::Context->dbh();
1477 my $statement = 'UPDATE message_queue SET status= ? WHERE message_id = ?';
1478 my $sth = $dbh->prepare( $statement );
1479 my $result = $sth->execute( $params->{'status'},
1480 $params->{'message_id'} );
1485 my ( $params ) = @_;
1487 my $content = $params->{content};
1488 my $tables = $params->{tables};
1489 my $loops = $params->{loops};
1490 my $substitute = $params->{substitute} || {};
1492 my $use_template_cache = C4::Context->config('template_cache_dir') && defined $ENV{GATEWAY_INTERFACE};
1493 my $template = Template->new(
1497 PLUGIN_BASE => 'Koha::Template::Plugin',
1498 COMPILE_EXT => $use_template_cache ? '.ttc' : '',
1499 COMPILE_DIR => $use_template_cache ? C4::Context->config('template_cache_dir') : '',
1501 ENCODING => 'UTF-8',
1503 ) or die Template->error();
1505 my $tt_params = { %{ _get_tt_params( $tables ) }, %{ _get_tt_params( $loops, 'is_a_loop' ) }, %$substitute };
1507 $content = add_tt_filters( $content );
1508 $content = qq|[% USE KohaDates %][% USE Remove_MARC_punctuation %]$content|;
1511 $template->process( \$content, $tt_params, \$output ) || croak "ERROR PROCESSING TEMPLATE: " . $template->error();
1516 sub _get_tt_params {
1517 my ($tables, $is_a_loop) = @_;
1523 article_requests => {
1524 module => 'Koha::ArticleRequests',
1525 singular => 'article_request',
1526 plural => 'article_requests',
1530 module => 'Koha::Biblios',
1531 singular => 'biblio',
1532 plural => 'biblios',
1533 pk => 'biblionumber',
1536 module => 'Koha::Biblioitems',
1537 singular => 'biblioitem',
1538 plural => 'biblioitems',
1539 pk => 'biblioitemnumber',
1542 module => 'Koha::Patrons',
1543 singular => 'borrower',
1544 plural => 'borrowers',
1545 pk => 'borrowernumber',
1548 module => 'Koha::Libraries',
1549 singular => 'branch',
1550 plural => 'branches',
1554 module => 'Koha::Items',
1560 module => 'Koha::News',
1566 module => 'Koha::Acquisition::Orders',
1567 singular => 'order',
1569 pk => 'ordernumber',
1572 module => 'Koha::Holds',
1578 module => 'Koha::Serials',
1579 singular => 'serial',
1580 plural => 'serials',
1584 module => 'Koha::Subscriptions',
1585 singular => 'subscription',
1586 plural => 'subscriptions',
1587 pk => 'subscriptionid',
1590 module => 'Koha::Suggestions',
1591 singular => 'suggestion',
1592 plural => 'suggestions',
1593 pk => 'suggestionid',
1596 module => 'Koha::Checkouts',
1597 singular => 'checkout',
1598 plural => 'checkouts',
1602 module => 'Koha::Old::Checkouts',
1603 singular => 'old_checkout',
1604 plural => 'old_checkouts',
1608 module => 'Koha::Checkouts',
1609 singular => 'overdue',
1610 plural => 'overdues',
1613 borrower_modifications => {
1614 module => 'Koha::Patron::Modifications',
1615 singular => 'patron_modification',
1616 plural => 'patron_modifications',
1617 fk => 'verification_token',
1621 foreach my $table ( keys %$tables ) {
1622 next unless $config->{$table};
1624 my $ref = ref( $tables->{$table} ) || q{};
1625 my $module = $config->{$table}->{module};
1627 if ( can_load( modules => { $module => undef } ) ) {
1628 my $pk = $config->{$table}->{pk};
1629 my $fk = $config->{$table}->{fk};
1632 my $values = $tables->{$table} || [];
1633 unless ( ref( $values ) eq 'ARRAY' ) {
1634 croak "ERROR processing table $table. Wrong API call.";
1636 my $key = $pk ? $pk : $fk;
1637 # $key does not come from user input
1638 my $objects = $module->search(
1639 { $key => $values },
1641 # We want to retrieve the data in the same order
1643 # field is a MySQLism, but they are no other way to do it
1644 # To be generic we could do it in perl, but we will need to fetch
1645 # all the data then order them
1646 @$values ? ( order_by => \[ "field($key, " . join( ', ', @$values ) . ")" ] ) : ()
1649 $params->{ $config->{$table}->{plural} } = $objects;
1651 elsif ( $ref eq q{} || $ref eq 'HASH' ) {
1652 my $id = ref $ref eq 'HASH' ? $tables->{$table}->{$pk} : $tables->{$table};
1654 if ( $fk ) { # Using a foreign key for lookup
1655 if ( ref( $fk ) eq 'ARRAY' ) { # Foreign key is multi-column
1657 foreach my $key ( @$fk ) {
1658 $search->{$key} = $id->{$key};
1660 $object = $module->search( $search )->last();
1661 } else { # Foreign key is single column
1662 $object = $module->search( { $fk => $id } )->last();
1664 } else { # using the table's primary key for lookup
1665 $object = $module->find($id);
1667 $params->{ $config->{$table}->{singular} } = $object;
1669 else { # $ref eq 'ARRAY'
1671 if ( @{ $tables->{$table} } == 1 ) { # Param is a single key
1672 $object = $module->search( { $pk => $tables->{$table} } )->last();
1674 else { # Params are mutliple foreign keys
1675 croak "Multiple foreign keys (table $table) should be passed using an hashref";
1677 $params->{ $config->{$table}->{singular} } = $object;
1681 croak "ERROR LOADING MODULE $module: $Module::Load::Conditional::ERROR";
1685 $params->{today} = output_pref({ dt => dt_from_string, dateformat => 'iso' });
1690 =head3 add_tt_filters
1692 $content = add_tt_filters( $content );
1694 Add TT filters to some specific fields if needed.
1696 For now we only add the Remove_MARC_punctuation TT filter to biblio and biblioitem fields
1700 sub add_tt_filters {
1701 my ( $content ) = @_;
1702 $content =~ s|\[%\s*biblio\.(.*?)\s*%\]|[% biblio.$1 \| \$Remove_MARC_punctuation %]|gxms;
1703 $content =~ s|\[%\s*biblioitem\.(.*?)\s*%\]|[% biblioitem.$1 \| \$Remove_MARC_punctuation %]|gxms;
1707 =head2 get_item_content
1709 my $item = Koha::Items->find(...)->unblessed;
1710 my @item_content_fields = qw( date_due title barcode author itemnumber );
1711 my $item_content = C4::Letters::get_item_content({
1713 item_content_fields => \@item_content_fields
1716 This function generates a tab-separated list of values for the passed item. Dates
1717 are formatted following the current setup.
1721 sub get_item_content {
1722 my ( $params ) = @_;
1723 my $item = $params->{item};
1724 my $dateonly = $params->{dateonly} || 0;
1725 my $item_content_fields = $params->{item_content_fields} || [];
1727 return unless $item;
1729 my @item_info = map {
1733 { dt => dt_from_string( $item->{$_} ), dateonly => $dateonly } );
1737 } @$item_content_fields;
1738 return join( "\t", @item_info ) . "\n";