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::Notice::Templates;
41 use Koha::DateUtils qw( format_sqldatetime dt_from_string );
43 use Koha::Subscriptions;
45 use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
51 &GetLetters &GetLettersAvailableForALibrary &GetLetterTemplates &DelLetter &GetPreparedLetter &GetWrappedLetter &SendAlerts &GetPrintMessages &GetMessageTransportTypes
57 C4::Letters - Give functions for Letters management
65 "Letters" is the tool used in Koha to manage informations sent to the patrons and/or the library. This include some cron jobs like
66 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)
68 Letters are managed through "alerts" sent by Koha on some events. All "alert" related functions are in this module too.
70 =head2 GetLetters([$module])
72 $letters = &GetLetters($module);
73 returns informations about letters.
74 if needed, $module filters for letters given module
76 DEPRECATED - You must use Koha::Notice::Templates instead
77 The group by clause is confusing and can lead to issues
83 my $module = $filters->{module};
84 my $code = $filters->{code};
85 my $branchcode = $filters->{branchcode};
86 my $dbh = C4::Context->dbh;
87 my $letters = $dbh->selectall_arrayref(
89 SELECT code, module, name
93 . ( $module ? q| AND module = ?| : q|| )
94 . ( $code ? q| AND code = ?| : q|| )
95 . ( defined $branchcode ? q| AND branchcode = ?| : q|| )
96 . q| GROUP BY code, module, name ORDER BY name|, { Slice => {} }
97 , ( $module ? $module : () )
98 , ( $code ? $code : () )
99 , ( defined $branchcode ? $branchcode : () )
105 =head2 GetLetterTemplates
107 my $letter_templates = GetLetterTemplates(
109 module => 'circulation',
111 branchcode => 'CPL', # '' for default,
115 Return a hashref of letter templates.
119 sub GetLetterTemplates {
122 my $module = $params->{module};
123 my $code = $params->{code};
124 my $branchcode = $params->{branchcode} // '';
125 my $dbh = C4::Context->dbh;
126 return Koha::Notice::Templates->search(
130 branchcode => $branchcode,
132 C4::Context->preference('TranslateNotices')
134 : ( lang => 'default' )
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, reply_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->{'reply_address'}, # reply_address
932 $params->{'letter'}->{'content-type'}, # content_type
934 return $dbh->last_insert_id(undef,undef,'message_queue', undef);
937 =head2 SendQueuedMessages ([$hashref])
939 my $sent = SendQueuedMessages({
940 letter_code => $letter_code,
941 borrowernumber => $who_letter_is_for,
947 Sends all of the 'pending' items in the message queue, unless
948 parameters are passed.
950 The letter_code, borrowernumber and limit parameters are used
951 to build a parameter set for _get_unsent_messages, thus limiting
952 which pending messages will be processed. They are all optional.
954 The verbose parameter can be used to generate debugging output.
957 Returns number of messages sent.
961 sub SendQueuedMessages {
964 my $which_unsent_messages = {
965 'limit' => $params->{'limit'} // 0,
966 'borrowernumber' => $params->{'borrowernumber'} // q{},
967 'letter_code' => $params->{'letter_code'} // q{},
968 'type' => $params->{'type'} // q{},
970 my $unsent_messages = _get_unsent_messages( $which_unsent_messages );
971 MESSAGE: foreach my $message ( @$unsent_messages ) {
972 my $message_object = Koha::Notice::Messages->find( $message->{message_id} );
973 # If this fails the database is unwritable and we won't manage to send a message that continues to be marked 'pending'
974 $message_object->make_column_dirty('status');
975 return unless $message_object->store;
977 # warn Data::Dumper->Dump( [ $message ], [ 'message' ] );
978 warn sprintf( 'sending %s message to patron: %s',
979 $message->{'message_transport_type'},
980 $message->{'borrowernumber'} || 'Admin' )
981 if $params->{'verbose'} or $debug;
982 # This is just begging for subclassing
983 next MESSAGE if ( lc($message->{'message_transport_type'}) eq 'rss' );
984 if ( lc( $message->{'message_transport_type'} ) eq 'email' ) {
985 _send_message_by_email( $message, $params->{'username'}, $params->{'password'}, $params->{'method'} );
987 elsif ( lc( $message->{'message_transport_type'} ) eq 'sms' ) {
988 if ( C4::Context->preference('SMSSendDriver') eq 'Email' ) {
989 my $patron = Koha::Patrons->find( $message->{borrowernumber} );
990 my $sms_provider = Koha::SMS::Providers->find( $patron->sms_provider_id );
991 unless ( $sms_provider ) {
992 warn sprintf( "Patron %s has no sms provider id set!", $message->{'borrowernumber'} ) if $params->{'verbose'} or $debug;
993 _set_message_status( { message_id => $message->{'message_id'}, status => 'failed' } );
996 unless ( $patron->smsalertnumber ) {
997 _set_message_status( { message_id => $message->{'message_id'}, status => 'failed' } );
998 warn sprintf( "No smsalertnumber found for patron %s!", $message->{'borrowernumber'} ) if $params->{'verbose'} or $debug;
1001 $message->{to_address} = $patron->smsalertnumber; #Sometime this is set to email - sms should always use smsalertnumber
1002 $message->{to_address} .= '@' . $sms_provider->domain();
1004 # Check for possible from_address override
1005 my $from_address = C4::Context->preference('EmailSMSSendDriverFromAddress');
1006 if ($from_address && $message->{from_address} ne $from_address) {
1007 $message->{from_address} = $from_address;
1008 _update_message_from_address($message->{'message_id'}, $message->{from_address});
1011 _update_message_to_address($message->{'message_id'}, $message->{to_address});
1012 _send_message_by_email( $message, $params->{'username'}, $params->{'password'}, $params->{'method'} );
1014 _send_message_by_sms( $message );
1018 return scalar( @$unsent_messages );
1021 =head2 GetRSSMessages
1023 my $message_list = GetRSSMessages( { limit => 10, borrowernumber => '14' } )
1025 returns a listref of all queued RSS messages for a particular person.
1029 sub GetRSSMessages {
1032 return unless $params;
1033 return unless ref $params;
1034 return unless $params->{'borrowernumber'};
1036 return _get_unsent_messages( { message_transport_type => 'rss',
1037 limit => $params->{'limit'},
1038 borrowernumber => $params->{'borrowernumber'}, } );
1041 =head2 GetPrintMessages
1043 my $message_list = GetPrintMessages( { borrowernumber => $borrowernumber } )
1045 Returns a arrayref of all queued print messages (optionally, for a particular
1050 sub GetPrintMessages {
1051 my $params = shift || {};
1053 return _get_unsent_messages( { message_transport_type => 'print',
1054 borrowernumber => $params->{'borrowernumber'},
1058 =head2 GetQueuedMessages ([$hashref])
1060 my $messages = GetQueuedMessage( { borrowernumber => '123', limit => 20 } );
1062 Fetches a list of messages from the message queue optionally filtered by borrowernumber
1063 and limited to specified limit.
1065 Return is an arrayref of hashes, each has represents a message in the message queue.
1069 sub GetQueuedMessages {
1072 my $dbh = C4::Context->dbh();
1073 my $statement = << 'ENDSQL';
1074 SELECT message_id, borrowernumber, subject, content, message_transport_type, status, time_queued, updated_on
1080 if ( exists $params->{'borrowernumber'} ) {
1081 push @whereclauses, ' borrowernumber = ? ';
1082 push @query_params, $params->{'borrowernumber'};
1085 if ( @whereclauses ) {
1086 $statement .= ' WHERE ' . join( 'AND', @whereclauses );
1089 if ( defined $params->{'limit'} ) {
1090 $statement .= ' LIMIT ? ';
1091 push @query_params, $params->{'limit'};
1094 my $sth = $dbh->prepare( $statement );
1095 my $result = $sth->execute( @query_params );
1096 return $sth->fetchall_arrayref({});
1099 =head2 GetMessageTransportTypes
1101 my @mtt = GetMessageTransportTypes();
1103 returns an arrayref of transport types
1107 sub GetMessageTransportTypes {
1108 my $dbh = C4::Context->dbh();
1109 my $mtts = $dbh->selectcol_arrayref("
1110 SELECT message_transport_type
1111 FROM message_transport_types
1112 ORDER BY message_transport_type
1119 my $message = C4::Letters::Message($message_id);
1124 my ( $message_id ) = @_;
1125 return unless $message_id;
1126 my $dbh = C4::Context->dbh;
1127 return $dbh->selectrow_hashref(q|
1128 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
1130 WHERE message_id = ?
1131 |, {}, $message_id );
1134 =head2 ResendMessage
1136 Attempt to resend a message which has failed previously.
1138 my $has_been_resent = C4::Letters::ResendMessage($message_id);
1140 Updates the message to 'pending' status so that
1141 it will be resent later on.
1143 returns 1 on success, 0 on failure, undef if no message was found
1148 my $message_id = shift;
1149 return unless $message_id;
1151 my $message = GetMessage( $message_id );
1152 return unless $message;
1154 if ( $message->{status} ne 'pending' ) {
1155 $rv = C4::Letters::_set_message_status({
1156 message_id => $message_id,
1157 status => 'pending',
1159 $rv = $rv > 0? 1: 0;
1160 # Clear destination email address to force address update
1161 _update_message_to_address( $message_id, undef ) if $rv &&
1162 $message->{message_transport_type} eq 'email';
1167 =head2 _add_attachements
1170 letter - the standard letter hashref
1171 attachments - listref of attachments. each attachment is a hashref of:
1172 type - the mime type, like 'text/plain'
1173 content - the actual attachment
1174 filename - the name of the attachment.
1175 message - a MIME::Lite object to attach these to.
1177 returns your letter object, with the content updated.
1181 sub _add_attachments {
1184 my $letter = $params->{'letter'};
1185 my $attachments = $params->{'attachments'};
1186 return $letter unless @$attachments;
1187 my $message = $params->{'message'};
1189 # First, we have to put the body in as the first attachment
1191 Type => $letter->{'content-type'} || 'TEXT',
1192 Data => $letter->{'is_html'}
1193 ? _wrap_html($letter->{'content'}, $letter->{'title'})
1194 : $letter->{'content'},
1197 foreach my $attachment ( @$attachments ) {
1199 Type => $attachment->{'type'},
1200 Data => $attachment->{'content'},
1201 Filename => $attachment->{'filename'},
1204 # we're forcing list context here to get the header, not the count back from grep.
1205 ( $letter->{'content-type'} ) = grep( /^Content-Type:/, split( /\n/, $params->{'message'}->header_as_string ) );
1206 $letter->{'content-type'} =~ s/^Content-Type:\s+//;
1207 $letter->{'content'} = $message->body_as_string;
1213 =head2 _get_unsent_messages
1215 This function's parameter hash reference takes the following
1216 optional named parameters:
1217 message_transport_type: method of message sending (e.g. email, sms, etc.)
1218 borrowernumber : who the message is to be sent
1219 letter_code : type of message being sent (e.g. PASSWORD_RESET)
1220 limit : maximum number of messages to send
1222 This function returns an array of matching hash referenced rows from
1223 message_queue with some borrower information added.
1227 sub _get_unsent_messages {
1230 my $dbh = C4::Context->dbh();
1232 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
1233 FROM message_queue mq
1234 LEFT JOIN borrowers b ON b.borrowernumber = mq.borrowernumber
1238 my @query_params = ('pending');
1239 if ( ref $params ) {
1240 if ( $params->{'message_transport_type'} ) {
1241 $statement .= ' AND mq.message_transport_type = ? ';
1242 push @query_params, $params->{'message_transport_type'};
1244 if ( $params->{'borrowernumber'} ) {
1245 $statement .= ' AND mq.borrowernumber = ? ';
1246 push @query_params, $params->{'borrowernumber'};
1248 if ( $params->{'letter_code'} ) {
1249 $statement .= ' AND mq.letter_code = ? ';
1250 push @query_params, $params->{'letter_code'};
1252 if ( $params->{'type'} ) {
1253 $statement .= ' AND message_transport_type = ? ';
1254 push @query_params, $params->{'type'};
1256 if ( $params->{'limit'} ) {
1257 $statement .= ' limit ? ';
1258 push @query_params, $params->{'limit'};
1262 $debug and warn "_get_unsent_messages SQL: $statement";
1263 $debug and warn "_get_unsent_messages params: " . join(',',@query_params);
1264 my $sth = $dbh->prepare( $statement );
1265 my $result = $sth->execute( @query_params );
1266 return $sth->fetchall_arrayref({});
1269 sub _send_message_by_email {
1270 my $message = shift or return;
1271 my ($username, $password, $method) = @_;
1273 my $patron = Koha::Patrons->find( $message->{borrowernumber} );
1274 my $to_address = $message->{'to_address'};
1275 unless ($to_address) {
1277 warn "FAIL: No 'to_address' and INVALID borrowernumber ($message->{borrowernumber})";
1278 _set_message_status( { message_id => $message->{'message_id'},
1279 status => 'failed' } );
1282 $to_address = $patron->notice_email_address;
1283 unless ($to_address) {
1284 # warn "FAIL: No 'to_address' and no email for " . ($member->{surname} ||'') . ", borrowernumber ($message->{borrowernumber})";
1285 # warning too verbose for this more common case?
1286 _set_message_status( { message_id => $message->{'message_id'},
1287 status => 'failed' } );
1292 # Encode subject line separately
1293 $message->{subject} = encode('MIME-Header', $message->{'subject'} );
1294 my $subject = $message->{'subject'};
1296 my $content = encode('UTF-8', $message->{'content'});
1297 my $content_type = $message->{'content_type'} || 'text/plain; charset="UTF-8"';
1298 my $is_html = $content_type =~ m/html/io;
1299 my $branch_email = undef;
1300 my $branch_replyto = undef;
1301 my $branch_returnpath = undef;
1303 my $library = $patron->library;
1304 $branch_email = $library->branchemail;
1305 $branch_replyto = $library->branchreplyto;
1306 $branch_returnpath = $library->branchreturnpath;
1308 my $email = Koha::Email->new();
1309 my %sendmail_params = $email->create_message_headers(
1313 C4::Context->preference('NoticeBcc')
1314 ? ( bcc => C4::Context->preference('NoticeBcc') )
1317 from => $message->{'from_address'} || $branch_email,
1318 replyto => $message->{'reply_address'} || $branch_replyto,
1319 sender => $branch_returnpath,
1320 subject => $subject,
1321 message => $is_html ? _wrap_html( $content, $subject ) : $content,
1322 contenttype => $content_type
1326 $sendmail_params{'Auth'} = {user => $username, pass => $password, method => $method} if $username;
1328 _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
1330 if ( Mail::Sendmail::sendmail( %sendmail_params ) ) {
1331 _set_message_status( { message_id => $message->{'message_id'},
1332 status => 'sent' } );
1335 _set_message_status( { message_id => $message->{'message_id'},
1336 status => 'failed' } );
1337 carp $Mail::Sendmail::error;
1343 my ($content, $title) = @_;
1345 my $css = C4::Context->preference("NoticeCSS") || '';
1346 $css = qq{<link rel="stylesheet" type="text/css" href="$css">} if $css;
1348 <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
1349 "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
1350 <html lang="en" xml:lang="en" xmlns="http://www.w3.org/1999/xhtml">
1352 <title>$title</title>
1353 <meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
1364 my ( $message ) = @_;
1365 my $dbh = C4::Context->dbh;
1366 my $count = $dbh->selectrow_array(q|
1369 WHERE message_transport_type = ?
1370 AND borrowernumber = ?
1372 AND CAST(updated_on AS date) = CAST(NOW() AS date)
1375 |, {}, $message->{message_transport_type}, $message->{borrowernumber}, $message->{letter_code}, $message->{content} );
1379 sub _send_message_by_sms {
1380 my $message = shift or return;
1381 my $patron = Koha::Patrons->find( $message->{borrowernumber} );
1383 unless ( $patron and $patron->smsalertnumber ) {
1384 _set_message_status( { message_id => $message->{'message_id'},
1385 status => 'failed' } );
1389 if ( _is_duplicate( $message ) ) {
1390 _set_message_status( { message_id => $message->{'message_id'},
1391 status => 'failed' } );
1395 my $success = C4::SMS->send_sms( { destination => $patron->smsalertnumber,
1396 message => $message->{'content'},
1398 _set_message_status( { message_id => $message->{'message_id'},
1399 status => ($success ? 'sent' : 'failed') } );
1403 sub _update_message_to_address {
1405 my $dbh = C4::Context->dbh();
1406 $dbh->do('UPDATE message_queue SET to_address=? WHERE message_id=?',undef,($to,$id));
1409 sub _update_message_from_address {
1410 my ($message_id, $from_address) = @_;
1411 my $dbh = C4::Context->dbh();
1412 $dbh->do('UPDATE message_queue SET from_address = ? WHERE message_id = ?', undef, ($from_address, $message_id));
1415 sub _set_message_status {
1416 my $params = shift or return;
1418 foreach my $required_parameter ( qw( message_id status ) ) {
1419 return unless exists $params->{ $required_parameter };
1422 my $dbh = C4::Context->dbh();
1423 my $statement = 'UPDATE message_queue SET status= ? WHERE message_id = ?';
1424 my $sth = $dbh->prepare( $statement );
1425 my $result = $sth->execute( $params->{'status'},
1426 $params->{'message_id'} );
1431 my ( $params ) = @_;
1433 my $content = $params->{content};
1434 my $tables = $params->{tables};
1435 my $loops = $params->{loops};
1436 my $substitute = $params->{substitute} || {};
1438 my $use_template_cache = C4::Context->config('template_cache_dir') && defined $ENV{GATEWAY_INTERFACE};
1439 my $template = Template->new(
1443 PLUGIN_BASE => 'Koha::Template::Plugin',
1444 COMPILE_EXT => $use_template_cache ? '.ttc' : '',
1445 COMPILE_DIR => $use_template_cache ? C4::Context->config('template_cache_dir') : '',
1447 ENCODING => 'UTF-8',
1449 ) or die Template->error();
1451 my $tt_params = { %{ _get_tt_params( $tables ) }, %{ _get_tt_params( $loops, 'is_a_loop' ) }, %$substitute };
1453 $content = add_tt_filters( $content );
1454 $content = qq|[% USE KohaDates %][% USE Remove_MARC_punctuation %]$content|;
1457 $template->process( \$content, $tt_params, \$output ) || croak "ERROR PROCESSING TEMPLATE: " . $template->error();
1462 sub _get_tt_params {
1463 my ($tables, $is_a_loop) = @_;
1469 article_requests => {
1470 module => 'Koha::ArticleRequests',
1471 singular => 'article_request',
1472 plural => 'article_requests',
1476 module => 'Koha::Biblios',
1477 singular => 'biblio',
1478 plural => 'biblios',
1479 pk => 'biblionumber',
1482 module => 'Koha::Biblioitems',
1483 singular => 'biblioitem',
1484 plural => 'biblioitems',
1485 pk => 'biblioitemnumber',
1488 module => 'Koha::Patrons',
1489 singular => 'borrower',
1490 plural => 'borrowers',
1491 pk => 'borrowernumber',
1494 module => 'Koha::Libraries',
1495 singular => 'branch',
1496 plural => 'branches',
1500 module => 'Koha::Items',
1506 module => 'Koha::News',
1512 module => 'Koha::Acquisition::Orders',
1513 singular => 'order',
1515 pk => 'ordernumber',
1518 module => 'Koha::Holds',
1521 fk => [ 'borrowernumber', 'biblionumber' ],
1524 module => 'Koha::Serials',
1525 singular => 'serial',
1526 plural => 'serials',
1530 module => 'Koha::Subscriptions',
1531 singular => 'subscription',
1532 plural => 'subscriptions',
1533 pk => 'subscriptionid',
1536 module => 'Koha::Suggestions',
1537 singular => 'suggestion',
1538 plural => 'suggestions',
1539 pk => 'suggestionid',
1542 module => 'Koha::Checkouts',
1543 singular => 'checkout',
1544 plural => 'checkouts',
1548 module => 'Koha::Old::Checkouts',
1549 singular => 'old_checkout',
1550 plural => 'old_checkouts',
1554 module => 'Koha::Checkouts',
1555 singular => 'overdue',
1556 plural => 'overdues',
1559 borrower_modifications => {
1560 module => 'Koha::Patron::Modifications',
1561 singular => 'patron_modification',
1562 plural => 'patron_modifications',
1563 fk => 'verification_token',
1567 foreach my $table ( keys %$tables ) {
1568 next unless $config->{$table};
1570 my $ref = ref( $tables->{$table} ) || q{};
1571 my $module = $config->{$table}->{module};
1573 if ( can_load( modules => { $module => undef } ) ) {
1574 my $pk = $config->{$table}->{pk};
1575 my $fk = $config->{$table}->{fk};
1578 my $values = $tables->{$table} || [];
1579 unless ( ref( $values ) eq 'ARRAY' ) {
1580 croak "ERROR processing table $table. Wrong API call.";
1582 my $key = $pk ? $pk : $fk;
1583 # $key does not come from user input
1584 my $objects = $module->search(
1585 { $key => $values },
1587 # We want to retrieve the data in the same order
1589 # field is a MySQLism, but they are no other way to do it
1590 # To be generic we could do it in perl, but we will need to fetch
1591 # all the data then order them
1592 @$values ? ( order_by => \[ "field($key, " . join( ', ', @$values ) . ")" ] ) : ()
1595 $params->{ $config->{$table}->{plural} } = $objects;
1597 elsif ( $ref eq q{} || $ref eq 'HASH' ) {
1598 my $id = ref $ref eq 'HASH' ? $tables->{$table}->{$pk} : $tables->{$table};
1600 if ( $fk ) { # Using a foreign key for lookup
1601 if ( ref( $fk ) eq 'ARRAY' ) { # Foreign key is multi-column
1603 foreach my $key ( @$fk ) {
1604 $search->{$key} = $id->{$key};
1606 $object = $module->search( $search )->last();
1607 } else { # Foreign key is single column
1608 $object = $module->search( { $fk => $id } )->last();
1610 } else { # using the table's primary key for lookup
1611 $object = $module->find($id);
1613 $params->{ $config->{$table}->{singular} } = $object;
1615 else { # $ref eq 'ARRAY'
1617 if ( @{ $tables->{$table} } == 1 ) { # Param is a single key
1618 $object = $module->search( { $pk => $tables->{$table} } )->last();
1620 else { # Params are mutliple foreign keys
1621 croak "Multiple foreign keys (table $table) should be passed using an hashref";
1623 $params->{ $config->{$table}->{singular} } = $object;
1627 croak "ERROR LOADING MODULE $module: $Module::Load::Conditional::ERROR";
1631 $params->{today} = output_pref({ dt => dt_from_string, dateformat => 'iso' });
1636 =head3 add_tt_filters
1638 $content = add_tt_filters( $content );
1640 Add TT filters to some specific fields if needed.
1642 For now we only add the Remove_MARC_punctuation TT filter to biblio and biblioitem fields
1646 sub add_tt_filters {
1647 my ( $content ) = @_;
1648 $content =~ s|\[%\s*biblio\.(.*?)\s*%\]|[% biblio.$1 \| \$Remove_MARC_punctuation %]|gxms;
1649 $content =~ s|\[%\s*biblioitem\.(.*?)\s*%\]|[% biblioitem.$1 \| \$Remove_MARC_punctuation %]|gxms;
1653 =head2 get_item_content
1655 my $item = Koha::Items->find(...)->unblessed;
1656 my @item_content_fields = qw( date_due title barcode author itemnumber );
1657 my $item_content = C4::Letters::get_item_content({
1659 item_content_fields => \@item_content_fields
1662 This function generates a tab-separated list of values for the passed item. Dates
1663 are formatted following the current setup.
1667 sub get_item_content {
1668 my ( $params ) = @_;
1669 my $item = $params->{item};
1670 my $dateonly = $params->{dateonly} || 0;
1671 my $item_content_fields = $params->{item_content_fields} || [];
1673 return unless $item;
1675 my @item_info = map {
1679 { dt => dt_from_string( $item->{$_} ), dateonly => $dateonly } );
1683 } @$item_content_fields;
1684 return join( "\t", @item_info ) . "\n";