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>.
24 use Date::Calc qw( Add_Delta_Days );
28 use Module::Load::Conditional qw(can_load);
31 use C4::Members::Attributes qw(GetBorrowerAttributes);
36 use Koha::SMS::Providers;
39 use Koha::Notice::Messages;
40 use Koha::DateUtils qw( format_sqldatetime dt_from_string );
42 use Koha::Subscriptions;
44 use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
50 &GetLetters &GetLettersAvailableForALibrary &GetLetterTemplates &DelLetter &GetPreparedLetter &GetWrappedLetter &SendAlerts &GetPrintMessages &GetMessageTransportTypes
56 C4::Letters - Give functions for Letters management
64 "Letters" is the tool used in Koha to manage informations sent to the patrons and/or the library. This include some cron jobs like
65 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)
67 Letters are managed through "alerts" sent by Koha on some events. All "alert" related functions are in this module too.
69 =head2 GetLetters([$module])
71 $letters = &GetLetters($module);
72 returns informations about letters.
73 if needed, $module filters for letters given module
75 DEPRECATED - You must use Koha::Notice::Templates instead
76 The group by clause is confusing and can lead to issues
82 my $module = $filters->{module};
83 my $code = $filters->{code};
84 my $branchcode = $filters->{branchcode};
85 my $dbh = C4::Context->dbh;
86 my $letters = $dbh->selectall_arrayref(
88 SELECT code, module, name
92 . ( $module ? q| AND module = ?| : q|| )
93 . ( $code ? q| AND code = ?| : q|| )
94 . ( defined $branchcode ? q| AND branchcode = ?| : q|| )
95 . q| GROUP BY code, module, name ORDER BY name|, { Slice => {} }
96 , ( $module ? $module : () )
97 , ( $code ? $code : () )
98 , ( defined $branchcode ? $branchcode : () )
104 =head2 GetLetterTemplates
106 my $letter_templates = GetLetterTemplates(
108 module => 'circulation',
110 branchcode => 'CPL', # '' for default,
114 Return a hashref of letter templates.
118 sub GetLetterTemplates {
121 my $module = $params->{module};
122 my $code = $params->{code};
123 my $branchcode = $params->{branchcode} // '';
124 my $dbh = C4::Context->dbh;
125 my $letters = $dbh->selectall_arrayref(
127 SELECT module, code, branchcode, name, is_html, title, content, message_transport_type, lang
134 , $module, $code, $branchcode
140 =head2 GetLettersAvailableForALibrary
142 my $letters = GetLettersAvailableForALibrary(
144 branchcode => 'CPL', # '' for default
145 module => 'circulation',
149 Return an arrayref of letters, sorted by name.
150 If a specific letter exist for the given branchcode, it will be retrieve.
151 Otherwise the default letter will be.
155 sub GetLettersAvailableForALibrary {
157 my $branchcode = $filters->{branchcode};
158 my $module = $filters->{module};
160 croak "module should be provided" unless $module;
162 my $dbh = C4::Context->dbh;
163 my $default_letters = $dbh->selectall_arrayref(
165 SELECT module, code, branchcode, name
169 . q| AND branchcode = ''|
170 . ( $module ? q| AND module = ?| : q|| )
171 . q| ORDER BY name|, { Slice => {} }
172 , ( $module ? $module : () )
175 my $specific_letters;
177 $specific_letters = $dbh->selectall_arrayref(
179 SELECT module, code, branchcode, name
183 . q| AND branchcode = ?|
184 . ( $module ? q| AND module = ?| : q|| )
185 . q| ORDER BY name|, { Slice => {} }
187 , ( $module ? $module : () )
192 for my $l (@$default_letters) {
193 $letters{ $l->{code} } = $l;
195 for my $l (@$specific_letters) {
196 # Overwrite the default letter with the specific one.
197 $letters{ $l->{code} } = $l;
200 return [ map { $letters{$_} }
201 sort { $letters{$a}->{name} cmp $letters{$b}->{name} }
207 my ( $module, $code, $branchcode, $message_transport_type, $lang) = @_;
208 $message_transport_type //= '%';
209 $lang = 'default' unless( $lang && C4::Context->preference('TranslateNotices') );
212 my $only_my_library = C4::Context->only_my_library;
213 if ( $only_my_library and $branchcode ) {
214 $branchcode = C4::Context::mybranch();
218 my $dbh = C4::Context->dbh;
219 my $sth = $dbh->prepare(q{
222 WHERE module=? AND code=? AND (branchcode = ? OR branchcode = '')
223 AND message_transport_type LIKE ?
225 ORDER BY branchcode DESC LIMIT 1
227 $sth->execute( $module, $code, $branchcode, $message_transport_type, $lang );
228 my $line = $sth->fetchrow_hashref
230 $line->{'content-type'} = 'text/html; charset="UTF-8"' if $line->{is_html};
240 module => 'circulation',
246 Delete the letter. The mtt parameter is facultative.
247 If not given, all templates mathing the other parameters will be removed.
253 my $branchcode = $params->{branchcode};
254 my $module = $params->{module};
255 my $code = $params->{code};
256 my $mtt = $params->{mtt};
257 my $lang = $params->{lang};
258 my $dbh = C4::Context->dbh;
265 . ( $mtt ? q| AND message_transport_type = ?| : q|| )
266 . ( $lang? q| AND lang = ?| : q|| )
267 , undef, $branchcode, $module, $code, ( $mtt ? $mtt : () ), ( $lang ? $lang : () ) );
272 my $err = &SendAlerts($type, $externalid, $letter_code);
275 - $type : the type of alert
276 - $externalid : the id of the "object" to query
277 - $letter_code : the notice template to use
279 C<&SendAlerts> sends an email notice directly to a patron or a vendor.
281 Currently it supports ($type):
282 - claim serial issues (claimissues)
283 - claim acquisition orders (claimacquisition)
284 - send acquisition orders to the vendor (orderacquisition)
285 - notify patrons about newly received serial issues (issue)
286 - notify patrons when their account is created (members)
288 Returns undef or { error => 'message } on failure.
289 Returns true on success.
294 my ( $type, $externalid, $letter_code ) = @_;
295 my $dbh = C4::Context->dbh;
296 if ( $type eq 'issue' ) {
298 # prepare the letter...
299 # search the subscriptionid
302 "SELECT subscriptionid FROM serial WHERE serialid=?");
303 $sth->execute($externalid);
304 my ($subscriptionid) = $sth->fetchrow
305 or warn( "No subscription for '$externalid'" ),
308 # search the biblionumber
311 "SELECT biblionumber FROM subscription WHERE subscriptionid=?");
312 $sth->execute($subscriptionid);
313 my ($biblionumber) = $sth->fetchrow
314 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,
343 my $message = Koha::Email->new();
344 my %mail = $message->create_message_headers(
347 from => $library->branchemail,
348 replyto => $library->branchreplyto,
349 sender => $library->branchreturnpath,
350 subject => Encode::encode( "UTF-8", "" . $letter->{title} ),
351 message => $letter->{'is_html'}
352 ? _wrap_html( Encode::encode( "UTF-8", $letter->{'content'} ),
353 Encode::encode( "UTF-8", "" . $letter->{'title'} ))
354 : Encode::encode( "UTF-8", "" . $letter->{'content'} ),
355 contenttype => $letter->{'is_html'}
356 ? 'text/html; charset="utf-8"'
357 : 'text/plain; charset="utf-8"',
360 unless( Mail::Sendmail::sendmail(%mail) ) {
361 carp $Mail::Sendmail::error;
362 return { error => $Mail::Sendmail::error };
366 elsif ( $type eq 'claimacquisition' or $type eq 'claimissues' or $type eq 'orderacquisition' ) {
368 # prepare the letter...
373 if ( $type eq 'claimacquisition') {
375 SELECT aqorders.*,aqbasket.*,biblio.*,biblioitems.*
377 LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno
378 LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
379 LEFT JOIN biblioitems ON aqorders.biblionumber=biblioitems.biblionumber
380 WHERE aqorders.ordernumber IN (
384 carp "No order selected";
385 return { error => "no_order_selected" };
387 $strsth .= join( ",", ('?') x @$externalid ) . ")";
388 $action = "ACQUISITION CLAIM";
389 $sthorders = $dbh->prepare($strsth);
390 $sthorders->execute( @$externalid );
391 $dataorders = $sthorders->fetchall_arrayref( {} );
394 if ($type eq 'claimissues') {
396 SELECT serial.*,subscription.*, biblio.*, biblioitems.*, aqbooksellers.*,
397 aqbooksellers.id AS booksellerid
399 LEFT JOIN subscription ON serial.subscriptionid=subscription.subscriptionid
400 LEFT JOIN biblio ON serial.biblionumber=biblio.biblionumber
401 LEFT JOIN biblioitems ON serial.biblionumber = biblioitems.biblionumber
402 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id
403 WHERE serial.serialid IN (
407 carp "No issues selected";
408 return { error => "no_issues_selected" };
411 $strsth .= join( ",", ('?') x @$externalid ) . ")";
412 $action = "SERIAL CLAIM";
413 $sthorders = $dbh->prepare($strsth);
414 $sthorders->execute( @$externalid );
415 $dataorders = $sthorders->fetchall_arrayref( {} );
418 if ( $type eq 'orderacquisition') {
420 SELECT aqorders.*,aqbasket.*,biblio.*,biblioitems.*
422 LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno
423 LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
424 LEFT JOIN biblioitems ON aqorders.biblionumber=biblioitems.biblionumber
425 WHERE aqbasket.basketno = ?
426 AND orderstatus IN ('new','ordered')
430 carp "No basketnumber given";
431 return { error => "no_basketno" };
433 $action = "ACQUISITION ORDER";
434 $sthorders = $dbh->prepare($strsth);
435 $sthorders->execute($externalid);
436 $dataorders = $sthorders->fetchall_arrayref( {} );
440 $dbh->prepare("select * from aqbooksellers where id=?");
441 $sthbookseller->execute( $dataorders->[0]->{booksellerid} );
442 my $databookseller = $sthbookseller->fetchrow_hashref;
444 my $addressee = $type eq 'claimacquisition' || $type eq 'orderacquisition' ? 'acqprimary' : 'serialsprimary';
447 $dbh->prepare("SELECT * FROM aqcontacts WHERE booksellerid=? AND $type=1 ORDER BY $addressee DESC");
448 $sthcontact->execute( $dataorders->[0]->{booksellerid} );
449 my $datacontact = $sthcontact->fetchrow_hashref;
453 push @email, $databookseller->{bookselleremail} if $databookseller->{bookselleremail};
454 push @email, $datacontact->{email} if ( $datacontact && $datacontact->{email} );
456 warn "Bookseller $dataorders->[0]->{booksellerid} without emails";
457 return { error => "no_email" };
460 while ($addlcontact = $sthcontact->fetchrow_hashref) {
461 push @cc, $addlcontact->{email} if ( $addlcontact && $addlcontact->{email} );
464 my $userenv = C4::Context->userenv;
465 my $letter = GetPreparedLetter (
467 letter_code => $letter_code,
468 branchcode => $userenv->{branch},
470 'branches' => $userenv->{branch},
471 'aqbooksellers' => $databookseller,
472 'aqcontacts' => $datacontact,
474 repeat => $dataorders,
476 ) or return { error => "no_letter" };
478 # Remove the order tag
479 $letter->{content} =~ s/<order>(.*?)<\/order>/$1/gxms;
482 my $library = Koha::Libraries->find( $userenv->{branch} );
483 my $email = Koha::Email->new();
484 my %mail = $email->create_message_headers(
486 to => join( ',', @email ),
487 cc => join( ',', @cc ),
490 C4::Context->preference("ClaimsBccCopy")
491 && ( $type eq 'claimacquisition'
492 || $type eq 'claimissues' )
493 ) ? ( bcc => $userenv->{emailaddress} )
496 from => $library->branchemail
497 || C4::Context->preference('KohaAdminEmailAddress'),
498 subject => Encode::encode( "UTF-8", "" . $letter->{title} ),
499 message => $letter->{'is_html'} ? _wrap_html(
500 Encode::encode( "UTF-8", $letter->{'content'} ),
501 Encode::encode( "UTF-8", "" . $letter->{'title'} )
503 : Encode::encode( "UTF-8", "" . $letter->{'content'} ),
504 contenttype => $letter->{'is_html'}
505 ? 'text/html; charset="utf-8"'
506 : 'text/plain; charset="utf-8"',
510 unless ( Mail::Sendmail::sendmail(%mail) ) {
511 carp $Mail::Sendmail::error;
512 return { error => $Mail::Sendmail::error };
520 . join( ',', @email )
525 ) if C4::Context->preference("LetterLog");
527 # send an "account details" notice to a newly created user
528 elsif ( $type eq 'members' ) {
529 my $library = Koha::Libraries->find( $externalid->{branchcode} )->unblessed;
530 my $letter = GetPreparedLetter (
532 letter_code => $letter_code,
533 branchcode => $externalid->{'branchcode'},
534 lang => $externalid->{lang} || 'default',
536 'branches' => $library,
537 'borrowers' => $externalid->{'borrowernumber'},
539 substitute => { 'borrowers.password' => $externalid->{'password'} },
542 return { error => "no_email" } unless $externalid->{'emailaddr'};
543 my $email = Koha::Email->new();
544 my %mail = $email->create_message_headers(
546 to => $externalid->{'emailaddr'},
547 from => $library->{branchemail},
548 replyto => $library->{branchreplyto},
549 sender => $library->{branchreturnpath},
550 subject => Encode::encode( "UTF-8", "" . $letter->{'title'} ),
551 message => $letter->{'is_html'}
552 ? _wrap_html( Encode::encode( "UTF-8", $letter->{'content'} ),
553 Encode::encode( "UTF-8", "" . $letter->{'title'} ) )
554 : Encode::encode( "UTF-8", "" . $letter->{'content'} ),
555 contenttype => $letter->{'is_html'}
556 ? 'text/html; charset="utf-8"'
557 : 'text/plain; charset="utf-8"',
560 unless( Mail::Sendmail::sendmail(%mail) ) {
561 carp $Mail::Sendmail::error;
562 return { error => $Mail::Sendmail::error };
566 # If we come here, return an OK status
570 =head2 GetPreparedLetter( %params )
573 module => letter module, mandatory
574 letter_code => letter code, mandatory
575 branchcode => for letter selection, if missing default system letter taken
576 tables => a hashref with table names as keys. Values are either:
577 - a scalar - primary key value
578 - an arrayref - primary key values
579 - a hashref - full record
580 substitute => custom substitution key/value pairs
581 repeat => records to be substituted on consecutive lines:
582 - an arrayref - tries to guess what needs substituting by
583 taking remaining << >> tokensr; not recommended
584 - a hashref token => @tables - replaces <token> << >> << >> </token>
585 subtemplate for each @tables row; table is a hashref as above
586 want_librarian => boolean, if set to true triggers librarian details
587 substitution from the userenv
589 letter fields hashref (title & content useful)
593 sub GetPreparedLetter {
596 my $letter = $params{letter};
599 my $module = $params{module} or croak "No module";
600 my $letter_code = $params{letter_code} or croak "No letter_code";
601 my $branchcode = $params{branchcode} || '';
602 my $mtt = $params{message_transport_type} || 'email';
603 my $lang = $params{lang} || 'default';
605 $letter = getletter( $module, $letter_code, $branchcode, $mtt, $lang );
608 $letter = getletter( $module, $letter_code, $branchcode, $mtt, 'default' )
609 or warn( "No $module $letter_code letter transported by " . $mtt ),
614 my $tables = $params{tables} || {};
615 my $substitute = $params{substitute} || {};
616 my $loops = $params{loops} || {}; # loops is not supported for historical notices syntax
617 my $repeat = $params{repeat};
618 %$tables || %$substitute || $repeat || %$loops
619 or carp( "ERROR: nothing to substitute - both 'tables', 'loops' and 'substitute' are empty" ),
621 my $want_librarian = $params{want_librarian};
624 while ( my ($token, $val) = each %$substitute ) {
625 if ( $token eq 'items.content' ) {
626 $val =~ s|\n|<br/>|g if $letter->{is_html};
629 $letter->{title} =~ s/<<$token>>/$val/g;
630 $letter->{content} =~ s/<<$token>>/$val/g;
634 my $OPACBaseURL = C4::Context->preference('OPACBaseURL');
635 $letter->{content} =~ s/<<OPACBaseURL>>/$OPACBaseURL/go;
637 if ($want_librarian) {
638 # parsing librarian name
639 my $userenv = C4::Context->userenv;
640 $letter->{content} =~ s/<<LibrarianFirstname>>/$userenv->{firstname}/go;
641 $letter->{content} =~ s/<<LibrarianSurname>>/$userenv->{surname}/go;
642 $letter->{content} =~ s/<<LibrarianEmailaddress>>/$userenv->{emailaddress}/go;
645 my ($repeat_no_enclosing_tags, $repeat_enclosing_tags);
648 if (ref ($repeat) eq 'ARRAY' ) {
649 $repeat_no_enclosing_tags = $repeat;
651 $repeat_enclosing_tags = $repeat;
655 if ($repeat_enclosing_tags) {
656 while ( my ($tag, $tag_tables) = each %$repeat_enclosing_tags ) {
657 if ( $letter->{content} =~ m!<$tag>(.*)</$tag>!s ) {
660 my %subletter = ( title => '', content => $subcontent );
661 _substitute_tables( \%subletter, $_ );
664 $letter->{content} =~ s!<$tag>.*</$tag>!join( "\n", @lines )!se;
670 _substitute_tables( $letter, $tables );
673 if ($repeat_no_enclosing_tags) {
674 if ( $letter->{content} =~ m/[^\n]*<<.*>>[^\n]*/so ) {
679 $c =~ s/<<count>>/$i/go;
680 foreach my $field ( keys %{$_} ) {
681 $c =~ s/(<<[^\.]+.$field>>)/$_->{$field}/;
685 } @$repeat_no_enclosing_tags;
687 my $replaceby = join( "\n", @lines );
688 $letter->{content} =~ s/\Q$line\E/$replaceby/s;
692 $letter->{content} = _process_tt(
694 content => $letter->{content},
697 substitute => $substitute,
701 $letter->{content} =~ s/<<\S*>>//go; #remove any stragglers
706 sub _substitute_tables {
707 my ( $letter, $tables ) = @_;
708 while ( my ($table, $param) = each %$tables ) {
711 my $ref = ref $param;
714 if ($ref && $ref eq 'HASH') {
718 my $sth = _parseletter_sth($table);
720 warn "_parseletter_sth('$table') failed to return a valid sth. No substitution will be done for that table.";
723 $sth->execute( $ref ? @$param : $param );
725 $values = $sth->fetchrow_hashref;
729 _parseletter ( $letter, $table, $values );
733 sub _parseletter_sth {
737 carp "ERROR: _parseletter_sth() called without argument (table)";
740 # NOTE: we used to check whether we had a statement handle cached in
741 # a %handles module-level variable. This was a dumb move and
742 # broke things for the rest of us. prepare_cached is a better
743 # way to cache statement handles anyway.
745 ($table eq 'biblio' ) ? "SELECT * FROM $table WHERE biblionumber = ?" :
746 ($table eq 'biblioitems' ) ? "SELECT * FROM $table WHERE biblionumber = ?" :
747 ($table eq 'items' ) ? "SELECT * FROM $table WHERE itemnumber = ?" :
748 ($table eq 'issues' ) ? "SELECT * FROM $table WHERE itemnumber = ?" :
749 ($table eq 'old_issues' ) ? "SELECT * FROM $table WHERE itemnumber = ? ORDER BY timestamp DESC LIMIT 1" :
750 ($table eq 'reserves' ) ? "SELECT * FROM $table WHERE borrowernumber = ? and biblionumber = ?" :
751 ($table eq 'borrowers' ) ? "SELECT * FROM $table WHERE borrowernumber = ?" :
752 ($table eq 'branches' ) ? "SELECT * FROM $table WHERE branchcode = ?" :
753 ($table eq 'suggestions' ) ? "SELECT * FROM $table WHERE suggestionid = ?" :
754 ($table eq 'aqbooksellers') ? "SELECT * FROM $table WHERE id = ?" :
755 ($table eq 'aqorders' ) ? "SELECT * FROM $table WHERE ordernumber = ?" :
756 ($table eq 'opac_news' ) ? "SELECT * FROM $table WHERE idnew = ?" :
757 ($table eq 'article_requests') ? "SELECT * FROM $table WHERE id = ?" :
758 ($table eq 'borrower_modifications') ? "SELECT * FROM $table WHERE verification_token = ?" :
759 ($table eq 'subscription') ? "SELECT * FROM $table WHERE subscriptionid = ?" :
760 ($table eq 'serial') ? "SELECT * FROM $table WHERE serialid = ?" :
763 warn "ERROR: No _parseletter_sth query for table '$table'";
764 return; # nothing to get
766 unless ($sth = C4::Context->dbh->prepare_cached($query)) {
767 warn "ERROR: Failed to prepare query: '$query'";
770 return $sth; # now cache is populated for that $table
773 =head2 _parseletter($letter, $table, $values)
776 - $letter : a hash to letter fields (title & content useful)
777 - $table : the Koha table to parse.
778 - $values_in : table record hashref
779 parse all fields from a table, and replace values in title & content with the appropriate value
780 (not exported sub, used only internally)
785 my ( $letter, $table, $values_in ) = @_;
787 # Work on a local copy of $values_in (passed by reference) to avoid side effects
788 # in callers ( by changing / formatting values )
789 my $values = $values_in ? { %$values_in } : {};
791 if ( $table eq 'borrowers' && $values->{'dateexpiry'} ){
792 $values->{'dateexpiry'} = output_pref({ dt => dt_from_string( $values->{'dateexpiry'} ), dateonly => 1 });
795 if ( $table eq 'reserves' && $values->{'waitingdate'} ) {
796 $values->{'waitingdate'} = output_pref({ dt => dt_from_string( $values->{'waitingdate'} ), dateonly => 1 });
799 if ($letter->{content} && $letter->{content} =~ /<<today>>/) {
800 my $todaysdate = output_pref( DateTime->now() );
801 $letter->{content} =~ s/<<today>>/$todaysdate/go;
804 while ( my ($field, $val) = each %$values ) {
805 $val =~ s/\p{P}$// if $val && $table=~/biblio/;
806 #BZ 9886: Assuming that we want to eliminate ISBD punctuation here
807 #Therefore adding the test on biblio. This includes biblioitems,
808 #but excludes items. Removed unneeded global and lookahead.
810 if ( $table=~/^borrowers$/ && $field=~/^streettype$/ ) {
811 my $av = Koha::AuthorisedValues->search({ category => 'ROADTYPE', authorised_value => $val });
812 $val = $av->count ? $av->next->lib : '';
816 my $replacedby = defined ($val) ? $val : '';
818 and not $replacedby =~ m|0000-00-00|
819 and not $replacedby =~ m|9999-12-31|
820 and $replacedby =~ m|^\d{4}-\d{2}-\d{2}( \d{2}:\d{2}:\d{2})?$| )
822 # If the value is XXXX-YY-ZZ[ AA:BB:CC] we assume it is a date
823 my $dateonly = defined $1 ? 0 : 1; #$1 refers to the capture group wrapped in parentheses. In this case, that's the hours, minutes, seconds.
824 my $re_dateonly_filter = qr{ $field( \s* \| \s* dateonly\s*)?>> }xms;
826 for my $letter_field ( qw( title content ) ) {
827 my $filter_string_used = q{};
828 if ( $letter->{ $letter_field } =~ $re_dateonly_filter ) {
829 # We overwrite $dateonly if the filter exists and we have a time in the datetime
830 $filter_string_used = $1 || q{};
831 $dateonly = $1 unless $dateonly;
833 my $replacedby_date = eval {
834 output_pref({ dt => dt_from_string( $replacedby ), dateonly => $dateonly });
837 if ( $letter->{ $letter_field } ) {
838 $letter->{ $letter_field } =~ s/\Q<<$table.$field$filter_string_used>>\E/$replacedby_date/g;
839 $letter->{ $letter_field } =~ s/\Q<<$field$filter_string_used>>\E/$replacedby_date/g;
843 # Other fields replacement
845 for my $letter_field ( qw( title content ) ) {
846 if ( $letter->{ $letter_field } ) {
847 $letter->{ $letter_field } =~ s/<<$table.$field>>/$replacedby/g;
848 $letter->{ $letter_field } =~ s/<<$field>>/$replacedby/g;
854 if ($table eq 'borrowers' && $letter->{content}) {
855 if ( my $attributes = GetBorrowerAttributes($values->{borrowernumber}) ) {
857 foreach (@$attributes) {
858 my $code = $_->{code};
859 my $val = $_->{value_description} || $_->{value};
860 $val =~ s/\p{P}(?=$)//g if $val;
861 next unless $val gt '';
863 push @{ $attr{$code} }, $val;
865 while ( my ($code, $val_ar) = each %attr ) {
866 my $replacefield = "<<borrower-attribute:$code>>";
867 my $replacedby = join ',', @$val_ar;
868 $letter->{content} =~ s/$replacefield/$replacedby/g;
877 my $success = EnqueueLetter( { letter => $letter,
878 borrowernumber => '12', message_transport_type => 'email' } )
880 places a letter in the message_queue database table, which will
881 eventually get processed (sent) by the process_message_queue.pl
882 cronjob when it calls SendQueuedMessages.
884 return message_id on success
889 my $params = shift or return;
891 return unless exists $params->{'letter'};
892 # return unless exists $params->{'borrowernumber'};
893 return unless exists $params->{'message_transport_type'};
895 my $content = $params->{letter}->{content};
896 $content =~ s/\s+//g if(defined $content);
897 if ( not defined $content or $content eq '' ) {
898 warn "Trying to add an empty message to the message queue" if $debug;
902 # If we have any attachments we should encode then into the body.
903 if ( $params->{'attachments'} ) {
904 $params->{'letter'} = _add_attachments(
905 { letter => $params->{'letter'},
906 attachments => $params->{'attachments'},
907 message => MIME::Lite->new( Type => 'multipart/mixed' ),
912 my $dbh = C4::Context->dbh();
913 my $statement = << 'ENDSQL';
914 INSERT INTO message_queue
915 ( borrowernumber, subject, content, metadata, letter_code, message_transport_type, status, time_queued, to_address, from_address, content_type )
917 ( ?, ?, ?, ?, ?, ?, ?, NOW(), ?, ?, ? )
920 my $sth = $dbh->prepare($statement);
921 my $result = $sth->execute(
922 $params->{'borrowernumber'}, # borrowernumber
923 $params->{'letter'}->{'title'}, # subject
924 $params->{'letter'}->{'content'}, # content
925 $params->{'letter'}->{'metadata'} || '', # metadata
926 $params->{'letter'}->{'code'} || '', # letter_code
927 $params->{'message_transport_type'}, # message_transport_type
929 $params->{'to_address'}, # to_address
930 $params->{'from_address'}, # from_address
931 $params->{'letter'}->{'content-type'}, # content_type
933 return $dbh->last_insert_id(undef,undef,'message_queue', undef);
936 =head2 SendQueuedMessages ([$hashref])
938 my $sent = SendQueuedMessages({
939 letter_code => $letter_code,
940 borrowernumber => $who_letter_is_for,
946 Sends all of the 'pending' items in the message queue, unless
947 parameters are passed.
949 The letter_code, borrowernumber and limit parameters are used
950 to build a parameter set for _get_unsent_messages, thus limiting
951 which pending messages will be processed. They are all optional.
953 The verbose parameter can be used to generate debugging output.
956 Returns number of messages sent.
960 sub SendQueuedMessages {
963 my $which_unsent_messages = {
964 'limit' => $params->{'limit'} // 0,
965 'borrowernumber' => $params->{'borrowernumber'} // q{},
966 'letter_code' => $params->{'letter_code'} // q{},
967 'type' => $params->{'type'} // q{},
969 my $unsent_messages = _get_unsent_messages( $which_unsent_messages );
970 MESSAGE: foreach my $message ( @$unsent_messages ) {
971 my $message_object = Koha::Notice::Messages->find( $message->{message_id} );
972 # If this fails the database is unwritable and we won't manage to send a message that continues to be marked 'pending'
973 $message_object->make_column_dirty('status');
974 return unless $message_object->store;
976 # warn Data::Dumper->Dump( [ $message ], [ 'message' ] );
977 warn sprintf( 'sending %s message to patron: %s',
978 $message->{'message_transport_type'},
979 $message->{'borrowernumber'} || 'Admin' )
980 if $params->{'verbose'} or $debug;
981 # This is just begging for subclassing
982 next MESSAGE if ( lc($message->{'message_transport_type'}) eq 'rss' );
983 if ( lc( $message->{'message_transport_type'} ) eq 'email' ) {
984 _send_message_by_email( $message, $params->{'username'}, $params->{'password'}, $params->{'method'} );
986 elsif ( lc( $message->{'message_transport_type'} ) eq 'sms' ) {
987 if ( C4::Context->preference('SMSSendDriver') eq 'Email' ) {
988 my $patron = Koha::Patrons->find( $message->{borrowernumber} );
989 my $sms_provider = Koha::SMS::Providers->find( $patron->sms_provider_id );
990 unless ( $sms_provider ) {
991 warn sprintf( "Patron %s has no sms provider id set!", $message->{'borrowernumber'} ) if $params->{'verbose'} or $debug;
992 _set_message_status( { message_id => $message->{'message_id'}, status => 'failed' } );
995 unless ( $patron->smsalertnumber ) {
996 _set_message_status( { message_id => $message->{'message_id'}, status => 'failed' } );
997 warn sprintf( "No smsalertnumber found for patron %s!", $message->{'borrowernumber'} ) if $params->{'verbose'} or $debug;
1000 $message->{to_address} = $patron->smsalertnumber; #Sometime this is set to email - sms should always use smsalertnumber
1001 $message->{to_address} .= '@' . $sms_provider->domain();
1003 # Check for possible from_address override
1004 my $from_address = C4::Context->preference('EmailSMSSendDriverFromAddress');
1005 if ($from_address && $message->{from_address} ne $from_address) {
1006 $message->{from_address} = $from_address;
1007 _update_message_from_address($message->{'message_id'}, $message->{from_address});
1010 _update_message_to_address($message->{'message_id'}, $message->{to_address});
1011 _send_message_by_email( $message, $params->{'username'}, $params->{'password'}, $params->{'method'} );
1013 _send_message_by_sms( $message );
1017 return scalar( @$unsent_messages );
1020 =head2 GetRSSMessages
1022 my $message_list = GetRSSMessages( { limit => 10, borrowernumber => '14' } )
1024 returns a listref of all queued RSS messages for a particular person.
1028 sub GetRSSMessages {
1031 return unless $params;
1032 return unless ref $params;
1033 return unless $params->{'borrowernumber'};
1035 return _get_unsent_messages( { message_transport_type => 'rss',
1036 limit => $params->{'limit'},
1037 borrowernumber => $params->{'borrowernumber'}, } );
1040 =head2 GetPrintMessages
1042 my $message_list = GetPrintMessages( { borrowernumber => $borrowernumber } )
1044 Returns a arrayref of all queued print messages (optionally, for a particular
1049 sub GetPrintMessages {
1050 my $params = shift || {};
1052 return _get_unsent_messages( { message_transport_type => 'print',
1053 borrowernumber => $params->{'borrowernumber'},
1057 =head2 GetQueuedMessages ([$hashref])
1059 my $messages = GetQueuedMessage( { borrowernumber => '123', limit => 20 } );
1061 fetches messages out of the message queue.
1064 list of hashes, each has represents a message in the message queue.
1068 sub GetQueuedMessages {
1071 my $dbh = C4::Context->dbh();
1072 my $statement = << 'ENDSQL';
1073 SELECT message_id, borrowernumber, subject, content, message_transport_type, status, time_queued
1079 if ( exists $params->{'borrowernumber'} ) {
1080 push @whereclauses, ' borrowernumber = ? ';
1081 push @query_params, $params->{'borrowernumber'};
1084 if ( exists $params->{'letter_code'} ) {
1085 push @whereclauses, ' letter_code = ? ';
1086 push @query_params, $params->{'letter_code'};
1089 if ( @whereclauses ) {
1090 $statement .= ' WHERE ' . join( 'AND', @whereclauses );
1093 if ( defined $params->{'limit'} ) {
1094 $statement .= ' LIMIT ? ';
1095 push @query_params, $params->{'limit'};
1098 my $sth = $dbh->prepare( $statement );
1099 my $result = $sth->execute( @query_params );
1100 return $sth->fetchall_arrayref({});
1103 =head2 GetMessageTransportTypes
1105 my @mtt = GetMessageTransportTypes();
1107 returns an arrayref of transport types
1111 sub GetMessageTransportTypes {
1112 my $dbh = C4::Context->dbh();
1113 my $mtts = $dbh->selectcol_arrayref("
1114 SELECT message_transport_type
1115 FROM message_transport_types
1116 ORDER BY message_transport_type
1123 my $message = C4::Letters::Message($message_id);
1128 my ( $message_id ) = @_;
1129 return unless $message_id;
1130 my $dbh = C4::Context->dbh;
1131 return $dbh->selectrow_hashref(q|
1132 SELECT message_id, borrowernumber, subject, content, metadata, letter_code, message_transport_type, status, time_queued, to_address, from_address, content_type
1134 WHERE message_id = ?
1135 |, {}, $message_id );
1138 =head2 ResendMessage
1140 Attempt to resend a message which has failed previously.
1142 my $has_been_resent = C4::Letters::ResendMessage($message_id);
1144 Updates the message to 'pending' status so that
1145 it will be resent later on.
1147 returns 1 on success, 0 on failure, undef if no message was found
1152 my $message_id = shift;
1153 return unless $message_id;
1155 my $message = GetMessage( $message_id );
1156 return unless $message;
1158 if ( $message->{status} ne 'pending' ) {
1159 $rv = C4::Letters::_set_message_status({
1160 message_id => $message_id,
1161 status => 'pending',
1163 $rv = $rv > 0? 1: 0;
1164 # Clear destination email address to force address update
1165 _update_message_to_address( $message_id, undef ) if $rv &&
1166 $message->{message_transport_type} eq 'email';
1171 =head2 _add_attachements
1174 letter - the standard letter hashref
1175 attachments - listref of attachments. each attachment is a hashref of:
1176 type - the mime type, like 'text/plain'
1177 content - the actual attachment
1178 filename - the name of the attachment.
1179 message - a MIME::Lite object to attach these to.
1181 returns your letter object, with the content updated.
1185 sub _add_attachments {
1188 my $letter = $params->{'letter'};
1189 my $attachments = $params->{'attachments'};
1190 return $letter unless @$attachments;
1191 my $message = $params->{'message'};
1193 # First, we have to put the body in as the first attachment
1195 Type => $letter->{'content-type'} || 'TEXT',
1196 Data => $letter->{'is_html'}
1197 ? _wrap_html($letter->{'content'}, $letter->{'title'})
1198 : $letter->{'content'},
1201 foreach my $attachment ( @$attachments ) {
1203 Type => $attachment->{'type'},
1204 Data => $attachment->{'content'},
1205 Filename => $attachment->{'filename'},
1208 # we're forcing list context here to get the header, not the count back from grep.
1209 ( $letter->{'content-type'} ) = grep( /^Content-Type:/, split( /\n/, $params->{'message'}->header_as_string ) );
1210 $letter->{'content-type'} =~ s/^Content-Type:\s+//;
1211 $letter->{'content'} = $message->body_as_string;
1217 =head2 _get_unsent_messages
1219 This function's parameter hash reference takes the following
1220 optional named parameters:
1221 message_transport_type: method of message sending (e.g. email, sms, etc.)
1222 borrowernumber : who the message is to be sent
1223 letter_code : type of message being sent (e.g. PASSWORD_RESET)
1224 limit : maximum number of messages to send
1226 This function returns an array of matching hash referenced rows from
1227 message_queue with some borrower information added.
1231 sub _get_unsent_messages {
1234 my $dbh = C4::Context->dbh();
1236 SELECT mq.message_id, mq.borrowernumber, mq.subject, mq.content, mq.message_transport_type, mq.status, mq.time_queued, mq.from_address, mq.to_address, mq.content_type, b.branchcode, mq.letter_code
1237 FROM message_queue mq
1238 LEFT JOIN borrowers b ON b.borrowernumber = mq.borrowernumber
1242 my @query_params = ('pending');
1243 if ( ref $params ) {
1244 if ( $params->{'message_transport_type'} ) {
1245 $statement .= ' AND mq.message_transport_type = ? ';
1246 push @query_params, $params->{'message_transport_type'};
1248 if ( $params->{'borrowernumber'} ) {
1249 $statement .= ' AND mq.borrowernumber = ? ';
1250 push @query_params, $params->{'borrowernumber'};
1252 if ( $params->{'letter_code'} ) {
1253 $statement .= ' AND mq.letter_code = ? ';
1254 push @query_params, $params->{'letter_code'};
1256 if ( $params->{'type'} ) {
1257 $statement .= ' AND message_transport_type = ? ';
1258 push @query_params, $params->{'type'};
1260 if ( $params->{'limit'} ) {
1261 $statement .= ' limit ? ';
1262 push @query_params, $params->{'limit'};
1266 $debug and warn "_get_unsent_messages SQL: $statement";
1267 $debug and warn "_get_unsent_messages params: " . join(',',@query_params);
1268 my $sth = $dbh->prepare( $statement );
1269 my $result = $sth->execute( @query_params );
1270 return $sth->fetchall_arrayref({});
1273 sub _send_message_by_email {
1274 my $message = shift or return;
1275 my ($username, $password, $method) = @_;
1277 my $patron = Koha::Patrons->find( $message->{borrowernumber} );
1278 my $to_address = $message->{'to_address'};
1279 unless ($to_address) {
1281 warn "FAIL: No 'to_address' and INVALID borrowernumber ($message->{borrowernumber})";
1282 _set_message_status( { message_id => $message->{'message_id'},
1283 status => 'failed' } );
1286 $to_address = $patron->notice_email_address;
1287 unless ($to_address) {
1288 # warn "FAIL: No 'to_address' and no email for " . ($member->{surname} ||'') . ", borrowernumber ($message->{borrowernumber})";
1289 # warning too verbose for this more common case?
1290 _set_message_status( { message_id => $message->{'message_id'},
1291 status => 'failed' } );
1296 # Encode subject line separately
1297 $message->{subject} = encode('MIME-Header', $message->{'subject'} );
1298 my $subject = $message->{'subject'};
1300 my $content = encode('UTF-8', $message->{'content'});
1301 my $content_type = $message->{'content_type'} || 'text/plain; charset="UTF-8"';
1302 my $is_html = $content_type =~ m/html/io;
1303 my $branch_email = undef;
1304 my $branch_replyto = undef;
1305 my $branch_returnpath = undef;
1307 my $library = $patron->library;
1308 $branch_email = $library->branchemail;
1309 $branch_replyto = $library->branchreplyto;
1310 $branch_returnpath = $library->branchreturnpath;
1312 my $email = Koha::Email->new();
1313 my %sendmail_params = $email->create_message_headers(
1317 C4::Context->preference('NoticeBcc')
1318 ? ( bcc => C4::Context->preference('NoticeBcc') )
1321 from => $message->{'from_address'} || $branch_email,
1322 replyto => $branch_replyto,
1323 sender => $branch_returnpath,
1324 subject => $subject,
1325 message => $is_html ? _wrap_html( $content, $subject ) : $content,
1326 contenttype => $content_type
1330 $sendmail_params{'Auth'} = {user => $username, pass => $password, method => $method} if $username;
1332 _update_message_to_address($message->{'message_id'},$sendmail_params{To}) if !$message->{to_address} || $message->{to_address} ne $sendmail_params{To}; #if initial message address was empty, coming here means that a to address was found and queue should be updated; same if to address was overriden by create_message_headers
1334 if ( Mail::Sendmail::sendmail( %sendmail_params ) ) {
1335 _set_message_status( { message_id => $message->{'message_id'},
1336 status => 'sent' } );
1339 _set_message_status( { message_id => $message->{'message_id'},
1340 status => 'failed' } );
1341 carp $Mail::Sendmail::error;
1347 my ($content, $title) = @_;
1349 my $css = C4::Context->preference("NoticeCSS") || '';
1350 $css = qq{<link rel="stylesheet" type="text/css" href="$css">} if $css;
1352 <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
1353 "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
1354 <html lang="en" xml:lang="en" xmlns="http://www.w3.org/1999/xhtml">
1356 <title>$title</title>
1357 <meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
1368 my ( $message ) = @_;
1369 my $dbh = C4::Context->dbh;
1370 my $count = $dbh->selectrow_array(q|
1373 WHERE message_transport_type = ?
1374 AND borrowernumber = ?
1376 AND CAST(time_queued AS date) = CAST(NOW() AS date)
1379 |, {}, $message->{message_transport_type}, $message->{borrowernumber}, $message->{letter_code}, $message->{content} );
1383 sub _send_message_by_sms {
1384 my $message = shift or return;
1385 my $patron = Koha::Patrons->find( $message->{borrowernumber} );
1387 unless ( $patron and $patron->smsalertnumber ) {
1388 _set_message_status( { message_id => $message->{'message_id'},
1389 status => 'failed' } );
1393 if ( _is_duplicate( $message ) ) {
1394 _set_message_status( { message_id => $message->{'message_id'},
1395 status => 'failed' } );
1399 my $success = C4::SMS->send_sms( { destination => $patron->smsalertnumber,
1400 message => $message->{'content'},
1402 _set_message_status( { message_id => $message->{'message_id'},
1403 status => ($success ? 'sent' : 'failed') } );
1407 sub _update_message_to_address {
1409 my $dbh = C4::Context->dbh();
1410 $dbh->do('UPDATE message_queue SET to_address=? WHERE message_id=?',undef,($to,$id));
1413 sub _update_message_from_address {
1414 my ($message_id, $from_address) = @_;
1415 my $dbh = C4::Context->dbh();
1416 $dbh->do('UPDATE message_queue SET from_address = ? WHERE message_id = ?', undef, ($from_address, $message_id));
1419 sub _set_message_status {
1420 my $params = shift or return;
1422 foreach my $required_parameter ( qw( message_id status ) ) {
1423 return unless exists $params->{ $required_parameter };
1426 my $dbh = C4::Context->dbh();
1427 my $statement = 'UPDATE message_queue SET status= ? WHERE message_id = ?';
1428 my $sth = $dbh->prepare( $statement );
1429 my $result = $sth->execute( $params->{'status'},
1430 $params->{'message_id'} );
1435 my ( $params ) = @_;
1437 my $content = $params->{content};
1438 my $tables = $params->{tables};
1439 my $loops = $params->{loops};
1440 my $substitute = $params->{substitute} || {};
1442 my $use_template_cache = C4::Context->config('template_cache_dir') && defined $ENV{GATEWAY_INTERFACE};
1443 my $template = Template->new(
1447 PLUGIN_BASE => 'Koha::Template::Plugin',
1448 COMPILE_EXT => $use_template_cache ? '.ttc' : '',
1449 COMPILE_DIR => $use_template_cache ? C4::Context->config('template_cache_dir') : '',
1451 ENCODING => 'UTF-8',
1453 ) or die Template->error();
1455 my $tt_params = { %{ _get_tt_params( $tables ) }, %{ _get_tt_params( $loops, 'is_a_loop' ) }, %$substitute };
1457 $content = add_tt_filters( $content );
1458 $content = qq|[% USE KohaDates %][% USE Remove_MARC_punctuation %]$content|;
1461 $template->process( \$content, $tt_params, \$output ) || croak "ERROR PROCESSING TEMPLATE: " . $template->error();
1466 sub _get_tt_params {
1467 my ($tables, $is_a_loop) = @_;
1473 article_requests => {
1474 module => 'Koha::ArticleRequests',
1475 singular => 'article_request',
1476 plural => 'article_requests',
1480 module => 'Koha::Biblios',
1481 singular => 'biblio',
1482 plural => 'biblios',
1483 pk => 'biblionumber',
1486 module => 'Koha::Biblioitems',
1487 singular => 'biblioitem',
1488 plural => 'biblioitems',
1489 pk => 'biblioitemnumber',
1492 module => 'Koha::Patrons',
1493 singular => 'borrower',
1494 plural => 'borrowers',
1495 pk => 'borrowernumber',
1498 module => 'Koha::Libraries',
1499 singular => 'branch',
1500 plural => 'branches',
1504 module => 'Koha::Items',
1510 module => 'Koha::News',
1516 module => 'Koha::Acquisition::Orders',
1517 singular => 'order',
1519 pk => 'ordernumber',
1522 module => 'Koha::Holds',
1525 fk => [ 'borrowernumber', 'biblionumber' ],
1528 module => 'Koha::Serials',
1529 singular => 'serial',
1530 plural => 'serials',
1534 module => 'Koha::Subscriptions',
1535 singular => 'subscription',
1536 plural => 'subscriptions',
1537 pk => 'subscriptionid',
1540 module => 'Koha::Suggestions',
1541 singular => 'suggestion',
1542 plural => 'suggestions',
1543 pk => 'suggestionid',
1546 module => 'Koha::Checkouts',
1547 singular => 'checkout',
1548 plural => 'checkouts',
1552 module => 'Koha::Old::Checkouts',
1553 singular => 'old_checkout',
1554 plural => 'old_checkouts',
1558 module => 'Koha::Checkouts',
1559 singular => 'overdue',
1560 plural => 'overdues',
1563 borrower_modifications => {
1564 module => 'Koha::Patron::Modifications',
1565 singular => 'patron_modification',
1566 plural => 'patron_modifications',
1567 fk => 'verification_token',
1571 foreach my $table ( keys %$tables ) {
1572 next unless $config->{$table};
1574 my $ref = ref( $tables->{$table} ) || q{};
1575 my $module = $config->{$table}->{module};
1577 if ( can_load( modules => { $module => undef } ) ) {
1578 my $pk = $config->{$table}->{pk};
1579 my $fk = $config->{$table}->{fk};
1582 my $values = $tables->{$table} || [];
1583 unless ( ref( $values ) eq 'ARRAY' ) {
1584 croak "ERROR processing table $table. Wrong API call.";
1586 my $key = $pk ? $pk : $fk;
1587 # $key does not come from user input
1588 my $objects = $module->search(
1589 { $key => $values },
1591 # We want to retrieve the data in the same order
1593 # field is a MySQLism, but they are no other way to do it
1594 # To be generic we could do it in perl, but we will need to fetch
1595 # all the data then order them
1596 @$values ? ( order_by => \[ "field($key, " . join( ', ', @$values ) . ")" ] ) : ()
1599 $params->{ $config->{$table}->{plural} } = $objects;
1601 elsif ( $ref eq q{} || $ref eq 'HASH' ) {
1602 my $id = ref $ref eq 'HASH' ? $tables->{$table}->{$pk} : $tables->{$table};
1604 if ( $fk ) { # Using a foreign key for lookup
1605 if ( ref( $fk ) eq 'ARRAY' ) { # Foreign key is multi-column
1607 foreach my $key ( @$fk ) {
1608 $search->{$key} = $id->{$key};
1610 $object = $module->search( $search )->last();
1611 } else { # Foreign key is single column
1612 $object = $module->search( { $fk => $id } )->last();
1614 } else { # using the table's primary key for lookup
1615 $object = $module->find($id);
1617 $params->{ $config->{$table}->{singular} } = $object;
1619 else { # $ref eq 'ARRAY'
1621 if ( @{ $tables->{$table} } == 1 ) { # Param is a single key
1622 $object = $module->search( { $pk => $tables->{$table} } )->last();
1624 else { # Params are mutliple foreign keys
1625 croak "Multiple foreign keys (table $table) should be passed using an hashref";
1627 $params->{ $config->{$table}->{singular} } = $object;
1631 croak "ERROR LOADING MODULE $module: $Module::Load::Conditional::ERROR";
1635 $params->{today} = output_pref({ dt => dt_from_string, dateformat => 'iso' });
1640 =head3 add_tt_filters
1642 $content = add_tt_filters( $content );
1644 Add TT filters to some specific fields if needed.
1646 For now we only add the Remove_MARC_punctuation TT filter to biblio and biblioitem fields
1650 sub add_tt_filters {
1651 my ( $content ) = @_;
1652 $content =~ s|\[%\s*biblio\.(.*?)\s*%\]|[% biblio.$1 \| \$Remove_MARC_punctuation %]|gxms;
1653 $content =~ s|\[%\s*biblioitem\.(.*?)\s*%\]|[% biblioitem.$1 \| \$Remove_MARC_punctuation %]|gxms;
1657 =head2 get_item_content
1659 my $item = Koha::Items->find(...)->unblessed;
1660 my @item_content_fields = qw( date_due title barcode author itemnumber );
1661 my $item_content = C4::Letters::get_item_content({
1663 item_content_fields => \@item_content_fields
1666 This function generates a tab-separated list of values for the passed item. Dates
1667 are formatted following the current setup.
1671 sub get_item_content {
1672 my ( $params ) = @_;
1673 my $item = $params->{item};
1674 my $dateonly = $params->{dateonly} || 0;
1675 my $item_content_fields = $params->{item_content_fields} || [];
1677 return unless $item;
1679 my @item_info = map {
1683 { dt => dt_from_string( $item->{$_} ), dateonly => $dateonly } );
1687 } @$item_content_fields;
1688 return join( "\t", @item_info ) . "\n";