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),
488 from => $library->branchemail || C4::Context->preference('KohaAdminEmailAddress'),
489 subject => Encode::encode( "UTF-8", "" . $letter->{title} ),
490 message => $letter->{'is_html'}
491 ? _wrap_html( Encode::encode( "UTF-8", $letter->{'content'} ),
492 Encode::encode( "UTF-8", "" . $letter->{'title'} ))
493 : Encode::encode( "UTF-8", "" . $letter->{'content'} ),
494 contenttype => $letter->{'is_html'}
495 ? 'text/html; charset="utf-8"'
496 : 'text/plain; charset="utf-8"',
500 if ($type eq 'claimacquisition' || $type eq 'claimissues' ) {
501 $mail{'Reply-to'} = C4::Context->preference('ReplytoDefault')
502 if C4::Context->preference('ReplytoDefault');
503 $mail{'Sender'} = C4::Context->preference('ReturnpathDefault')
504 if C4::Context->preference('ReturnpathDefault');
505 $mail{'Bcc'} = $userenv->{emailaddress}
506 if C4::Context->preference("ClaimsBccCopy") and not C4::Context->preference("SendAllEmailsTo");
509 unless ( Mail::Sendmail::sendmail(%mail) ) {
510 carp $Mail::Sendmail::error;
511 return { error => $Mail::Sendmail::error };
519 . join( ',', @email )
524 ) if C4::Context->preference("LetterLog");
526 # send an "account details" notice to a newly created user
527 elsif ( $type eq 'members' ) {
528 my $library = Koha::Libraries->find( $externalid->{branchcode} )->unblessed;
529 my $letter = GetPreparedLetter (
531 letter_code => $letter_code,
532 branchcode => $externalid->{'branchcode'},
533 lang => $externalid->{lang} || 'default',
535 'branches' => $library,
536 'borrowers' => $externalid->{'borrowernumber'},
538 substitute => { 'borrowers.password' => $externalid->{'password'} },
541 return { error => "no_email" } unless $externalid->{'emailaddr'};
542 my $email = Koha::Email->new();
543 my %mail = $email->create_message_headers(
545 to => $externalid->{'emailaddr'},
546 from => $library->{branchemail},
547 replyto => $library->{branchreplyto},
548 sender => $library->{branchreturnpath},
549 subject => Encode::encode( "UTF-8", "" . $letter->{'title'} ),
550 message => $letter->{'is_html'}
551 ? _wrap_html( Encode::encode( "UTF-8", $letter->{'content'} ),
552 Encode::encode( "UTF-8", "" . $letter->{'title'} ) )
553 : Encode::encode( "UTF-8", "" . $letter->{'content'} ),
554 contenttype => $letter->{'is_html'}
555 ? 'text/html; charset="utf-8"'
556 : 'text/plain; charset="utf-8"',
559 unless( Mail::Sendmail::sendmail(%mail) ) {
560 carp $Mail::Sendmail::error;
561 return { error => $Mail::Sendmail::error };
565 # If we come here, return an OK status
569 =head2 GetPreparedLetter( %params )
572 module => letter module, mandatory
573 letter_code => letter code, mandatory
574 branchcode => for letter selection, if missing default system letter taken
575 tables => a hashref with table names as keys. Values are either:
576 - a scalar - primary key value
577 - an arrayref - primary key values
578 - a hashref - full record
579 substitute => custom substitution key/value pairs
580 repeat => records to be substituted on consecutive lines:
581 - an arrayref - tries to guess what needs substituting by
582 taking remaining << >> tokensr; not recommended
583 - a hashref token => @tables - replaces <token> << >> << >> </token>
584 subtemplate for each @tables row; table is a hashref as above
585 want_librarian => boolean, if set to true triggers librarian details
586 substitution from the userenv
588 letter fields hashref (title & content useful)
592 sub GetPreparedLetter {
595 my $letter = $params{letter};
598 my $module = $params{module} or croak "No module";
599 my $letter_code = $params{letter_code} or croak "No letter_code";
600 my $branchcode = $params{branchcode} || '';
601 my $mtt = $params{message_transport_type} || 'email';
602 my $lang = $params{lang} || 'default';
604 $letter = getletter( $module, $letter_code, $branchcode, $mtt, $lang );
607 $letter = getletter( $module, $letter_code, $branchcode, $mtt, 'default' )
608 or warn( "No $module $letter_code letter transported by " . $mtt ),
613 my $tables = $params{tables} || {};
614 my $substitute = $params{substitute} || {};
615 my $loops = $params{loops} || {}; # loops is not supported for historical notices syntax
616 my $repeat = $params{repeat};
617 %$tables || %$substitute || $repeat || %$loops
618 or carp( "ERROR: nothing to substitute - both 'tables', 'loops' and 'substitute' are empty" ),
620 my $want_librarian = $params{want_librarian};
623 while ( my ($token, $val) = each %$substitute ) {
624 if ( $token eq 'items.content' ) {
625 $val =~ s|\n|<br/>|g if $letter->{is_html};
628 $letter->{title} =~ s/<<$token>>/$val/g;
629 $letter->{content} =~ s/<<$token>>/$val/g;
633 my $OPACBaseURL = C4::Context->preference('OPACBaseURL');
634 $letter->{content} =~ s/<<OPACBaseURL>>/$OPACBaseURL/go;
636 if ($want_librarian) {
637 # parsing librarian name
638 my $userenv = C4::Context->userenv;
639 $letter->{content} =~ s/<<LibrarianFirstname>>/$userenv->{firstname}/go;
640 $letter->{content} =~ s/<<LibrarianSurname>>/$userenv->{surname}/go;
641 $letter->{content} =~ s/<<LibrarianEmailaddress>>/$userenv->{emailaddress}/go;
644 my ($repeat_no_enclosing_tags, $repeat_enclosing_tags);
647 if (ref ($repeat) eq 'ARRAY' ) {
648 $repeat_no_enclosing_tags = $repeat;
650 $repeat_enclosing_tags = $repeat;
654 if ($repeat_enclosing_tags) {
655 while ( my ($tag, $tag_tables) = each %$repeat_enclosing_tags ) {
656 if ( $letter->{content} =~ m!<$tag>(.*)</$tag>!s ) {
659 my %subletter = ( title => '', content => $subcontent );
660 _substitute_tables( \%subletter, $_ );
663 $letter->{content} =~ s!<$tag>.*</$tag>!join( "\n", @lines )!se;
669 _substitute_tables( $letter, $tables );
672 if ($repeat_no_enclosing_tags) {
673 if ( $letter->{content} =~ m/[^\n]*<<.*>>[^\n]*/so ) {
678 $c =~ s/<<count>>/$i/go;
679 foreach my $field ( keys %{$_} ) {
680 $c =~ s/(<<[^\.]+.$field>>)/$_->{$field}/;
684 } @$repeat_no_enclosing_tags;
686 my $replaceby = join( "\n", @lines );
687 $letter->{content} =~ s/\Q$line\E/$replaceby/s;
691 $letter->{content} = _process_tt(
693 content => $letter->{content},
696 substitute => $substitute,
700 $letter->{content} =~ s/<<\S*>>//go; #remove any stragglers
705 sub _substitute_tables {
706 my ( $letter, $tables ) = @_;
707 while ( my ($table, $param) = each %$tables ) {
710 my $ref = ref $param;
713 if ($ref && $ref eq 'HASH') {
717 my $sth = _parseletter_sth($table);
719 warn "_parseletter_sth('$table') failed to return a valid sth. No substitution will be done for that table.";
722 $sth->execute( $ref ? @$param : $param );
724 $values = $sth->fetchrow_hashref;
728 _parseletter ( $letter, $table, $values );
732 sub _parseletter_sth {
736 carp "ERROR: _parseletter_sth() called without argument (table)";
739 # NOTE: we used to check whether we had a statement handle cached in
740 # a %handles module-level variable. This was a dumb move and
741 # broke things for the rest of us. prepare_cached is a better
742 # way to cache statement handles anyway.
744 ($table eq 'biblio' ) ? "SELECT * FROM $table WHERE biblionumber = ?" :
745 ($table eq 'biblioitems' ) ? "SELECT * FROM $table WHERE biblionumber = ?" :
746 ($table eq 'items' ) ? "SELECT * FROM $table WHERE itemnumber = ?" :
747 ($table eq 'issues' ) ? "SELECT * FROM $table WHERE itemnumber = ?" :
748 ($table eq 'old_issues' ) ? "SELECT * FROM $table WHERE itemnumber = ? ORDER BY timestamp DESC LIMIT 1" :
749 ($table eq 'reserves' ) ? "SELECT * FROM $table WHERE borrowernumber = ? and biblionumber = ?" :
750 ($table eq 'borrowers' ) ? "SELECT * FROM $table WHERE borrowernumber = ?" :
751 ($table eq 'branches' ) ? "SELECT * FROM $table WHERE branchcode = ?" :
752 ($table eq 'suggestions' ) ? "SELECT * FROM $table WHERE suggestionid = ?" :
753 ($table eq 'aqbooksellers') ? "SELECT * FROM $table WHERE id = ?" :
754 ($table eq 'aqorders' ) ? "SELECT * FROM $table WHERE ordernumber = ?" :
755 ($table eq 'opac_news' ) ? "SELECT * FROM $table WHERE idnew = ?" :
756 ($table eq 'article_requests') ? "SELECT * FROM $table WHERE id = ?" :
757 ($table eq 'borrower_modifications') ? "SELECT * FROM $table WHERE verification_token = ?" :
758 ($table eq 'subscription') ? "SELECT * FROM $table WHERE subscriptionid = ?" :
759 ($table eq 'serial') ? "SELECT * FROM $table WHERE serialid = ?" :
762 warn "ERROR: No _parseletter_sth query for table '$table'";
763 return; # nothing to get
765 unless ($sth = C4::Context->dbh->prepare_cached($query)) {
766 warn "ERROR: Failed to prepare query: '$query'";
769 return $sth; # now cache is populated for that $table
772 =head2 _parseletter($letter, $table, $values)
775 - $letter : a hash to letter fields (title & content useful)
776 - $table : the Koha table to parse.
777 - $values_in : table record hashref
778 parse all fields from a table, and replace values in title & content with the appropriate value
779 (not exported sub, used only internally)
784 my ( $letter, $table, $values_in ) = @_;
786 # Work on a local copy of $values_in (passed by reference) to avoid side effects
787 # in callers ( by changing / formatting values )
788 my $values = $values_in ? { %$values_in } : {};
790 if ( $table eq 'borrowers' && $values->{'dateexpiry'} ){
791 $values->{'dateexpiry'} = output_pref({ dt => dt_from_string( $values->{'dateexpiry'} ), dateonly => 1 });
794 if ( $table eq 'reserves' && $values->{'waitingdate'} ) {
795 $values->{'waitingdate'} = output_pref({ dt => dt_from_string( $values->{'waitingdate'} ), dateonly => 1 });
798 if ($letter->{content} && $letter->{content} =~ /<<today>>/) {
799 my $todaysdate = output_pref( DateTime->now() );
800 $letter->{content} =~ s/<<today>>/$todaysdate/go;
803 while ( my ($field, $val) = each %$values ) {
804 $val =~ s/\p{P}$// if $val && $table=~/biblio/;
805 #BZ 9886: Assuming that we want to eliminate ISBD punctuation here
806 #Therefore adding the test on biblio. This includes biblioitems,
807 #but excludes items. Removed unneeded global and lookahead.
809 if ( $table=~/^borrowers$/ && $field=~/^streettype$/ ) {
810 my $av = Koha::AuthorisedValues->search({ category => 'ROADTYPE', authorised_value => $val });
811 $val = $av->count ? $av->next->lib : '';
815 my $replacedby = defined ($val) ? $val : '';
817 and not $replacedby =~ m|0000-00-00|
818 and not $replacedby =~ m|9999-12-31|
819 and $replacedby =~ m|^\d{4}-\d{2}-\d{2}( \d{2}:\d{2}:\d{2})?$| )
821 # If the value is XXXX-YY-ZZ[ AA:BB:CC] we assume it is a date
822 my $dateonly = defined $1 ? 0 : 1; #$1 refers to the capture group wrapped in parentheses. In this case, that's the hours, minutes, seconds.
823 my $re_dateonly_filter = qr{ $field( \s* \| \s* dateonly\s*)?>> }xms;
825 for my $letter_field ( qw( title content ) ) {
826 my $filter_string_used = q{};
827 if ( $letter->{ $letter_field } =~ $re_dateonly_filter ) {
828 # We overwrite $dateonly if the filter exists and we have a time in the datetime
829 $filter_string_used = $1 || q{};
830 $dateonly = $1 unless $dateonly;
832 my $replacedby_date = eval {
833 output_pref({ dt => dt_from_string( $replacedby ), dateonly => $dateonly });
836 if ( $letter->{ $letter_field } ) {
837 $letter->{ $letter_field } =~ s/\Q<<$table.$field$filter_string_used>>\E/$replacedby_date/g;
838 $letter->{ $letter_field } =~ s/\Q<<$field$filter_string_used>>\E/$replacedby_date/g;
842 # Other fields replacement
844 for my $letter_field ( qw( title content ) ) {
845 if ( $letter->{ $letter_field } ) {
846 $letter->{ $letter_field } =~ s/<<$table.$field>>/$replacedby/g;
847 $letter->{ $letter_field } =~ s/<<$field>>/$replacedby/g;
853 if ($table eq 'borrowers' && $letter->{content}) {
854 if ( my $attributes = GetBorrowerAttributes($values->{borrowernumber}) ) {
856 foreach (@$attributes) {
857 my $code = $_->{code};
858 my $val = $_->{value_description} || $_->{value};
859 $val =~ s/\p{P}(?=$)//g if $val;
860 next unless $val gt '';
862 push @{ $attr{$code} }, $val;
864 while ( my ($code, $val_ar) = each %attr ) {
865 my $replacefield = "<<borrower-attribute:$code>>";
866 my $replacedby = join ',', @$val_ar;
867 $letter->{content} =~ s/$replacefield/$replacedby/g;
876 my $success = EnqueueLetter( { letter => $letter,
877 borrowernumber => '12', message_transport_type => 'email' } )
879 places a letter in the message_queue database table, which will
880 eventually get processed (sent) by the process_message_queue.pl
881 cronjob when it calls SendQueuedMessages.
883 return message_id on success
888 my $params = shift or return;
890 return unless exists $params->{'letter'};
891 # return unless exists $params->{'borrowernumber'};
892 return unless exists $params->{'message_transport_type'};
894 my $content = $params->{letter}->{content};
895 $content =~ s/\s+//g if(defined $content);
896 if ( not defined $content or $content eq '' ) {
897 warn "Trying to add an empty message to the message queue" if $debug;
901 # If we have any attachments we should encode then into the body.
902 if ( $params->{'attachments'} ) {
903 $params->{'letter'} = _add_attachments(
904 { letter => $params->{'letter'},
905 attachments => $params->{'attachments'},
906 message => MIME::Lite->new( Type => 'multipart/mixed' ),
911 my $dbh = C4::Context->dbh();
912 my $statement = << 'ENDSQL';
913 INSERT INTO message_queue
914 ( borrowernumber, subject, content, metadata, letter_code, message_transport_type, status, time_queued, to_address, from_address, content_type )
916 ( ?, ?, ?, ?, ?, ?, ?, NOW(), ?, ?, ? )
919 my $sth = $dbh->prepare($statement);
920 my $result = $sth->execute(
921 $params->{'borrowernumber'}, # borrowernumber
922 $params->{'letter'}->{'title'}, # subject
923 $params->{'letter'}->{'content'}, # content
924 $params->{'letter'}->{'metadata'} || '', # metadata
925 $params->{'letter'}->{'code'} || '', # letter_code
926 $params->{'message_transport_type'}, # message_transport_type
928 $params->{'to_address'}, # to_address
929 $params->{'from_address'}, # from_address
930 $params->{'letter'}->{'content-type'}, # content_type
932 return $dbh->last_insert_id(undef,undef,'message_queue', undef);
935 =head2 SendQueuedMessages ([$hashref])
937 my $sent = SendQueuedMessages({
938 letter_code => $letter_code,
939 borrowernumber => $who_letter_is_for,
945 Sends all of the 'pending' items in the message queue, unless
946 parameters are passed.
948 The letter_code, borrowernumber and limit parameters are used
949 to build a parameter set for _get_unsent_messages, thus limiting
950 which pending messages will be processed. They are all optional.
952 The verbose parameter can be used to generate debugging output.
955 Returns number of messages sent.
959 sub SendQueuedMessages {
962 my $which_unsent_messages = {
963 'limit' => $params->{'limit'} // 0,
964 'borrowernumber' => $params->{'borrowernumber'} // q{},
965 'letter_code' => $params->{'letter_code'} // q{},
966 'type' => $params->{'type'} // q{},
968 my $unsent_messages = _get_unsent_messages( $which_unsent_messages );
969 MESSAGE: foreach my $message ( @$unsent_messages ) {
970 my $message_object = Koha::Notice::Messages->find( $message->{message_id} );
971 # If this fails the database is unwritable and we won't manage to send a message that continues to be marked 'pending'
972 $message_object->make_column_dirty('status');
973 return unless $message_object->store;
975 # warn Data::Dumper->Dump( [ $message ], [ 'message' ] );
976 warn sprintf( 'sending %s message to patron: %s',
977 $message->{'message_transport_type'},
978 $message->{'borrowernumber'} || 'Admin' )
979 if $params->{'verbose'} or $debug;
980 # This is just begging for subclassing
981 next MESSAGE if ( lc($message->{'message_transport_type'}) eq 'rss' );
982 if ( lc( $message->{'message_transport_type'} ) eq 'email' ) {
983 _send_message_by_email( $message, $params->{'username'}, $params->{'password'}, $params->{'method'} );
985 elsif ( lc( $message->{'message_transport_type'} ) eq 'sms' ) {
986 if ( C4::Context->preference('SMSSendDriver') eq 'Email' ) {
987 my $patron = Koha::Patrons->find( $message->{borrowernumber} );
988 my $sms_provider = Koha::SMS::Providers->find( $patron->sms_provider_id );
989 unless ( $sms_provider ) {
990 warn sprintf( "Patron %s has no sms provider id set!", $message->{'borrowernumber'} ) if $params->{'verbose'} or $debug;
991 _set_message_status( { message_id => $message->{'message_id'}, status => 'failed' } );
994 unless ( $patron->smsalertnumber ) {
995 _set_message_status( { message_id => $message->{'message_id'}, status => 'failed' } );
996 warn sprintf( "No smsalertnumber found for patron %s!", $message->{'borrowernumber'} ) if $params->{'verbose'} or $debug;
999 $message->{to_address} = $patron->smsalertnumber; #Sometime this is set to email - sms should always use smsalertnumber
1000 $message->{to_address} .= '@' . $sms_provider->domain();
1002 # Check for possible from_address override
1003 my $from_address = C4::Context->preference('EmailSMSSendDriverFromAddress');
1004 if ($from_address && $message->{from_address} ne $from_address) {
1005 $message->{from_address} = $from_address;
1006 _update_message_from_address($message->{'message_id'}, $message->{from_address});
1009 _update_message_to_address($message->{'message_id'}, $message->{to_address});
1010 _send_message_by_email( $message, $params->{'username'}, $params->{'password'}, $params->{'method'} );
1012 _send_message_by_sms( $message );
1016 return scalar( @$unsent_messages );
1019 =head2 GetRSSMessages
1021 my $message_list = GetRSSMessages( { limit => 10, borrowernumber => '14' } )
1023 returns a listref of all queued RSS messages for a particular person.
1027 sub GetRSSMessages {
1030 return unless $params;
1031 return unless ref $params;
1032 return unless $params->{'borrowernumber'};
1034 return _get_unsent_messages( { message_transport_type => 'rss',
1035 limit => $params->{'limit'},
1036 borrowernumber => $params->{'borrowernumber'}, } );
1039 =head2 GetPrintMessages
1041 my $message_list = GetPrintMessages( { borrowernumber => $borrowernumber } )
1043 Returns a arrayref of all queued print messages (optionally, for a particular
1048 sub GetPrintMessages {
1049 my $params = shift || {};
1051 return _get_unsent_messages( { message_transport_type => 'print',
1052 borrowernumber => $params->{'borrowernumber'},
1056 =head2 GetQueuedMessages ([$hashref])
1058 my $messages = GetQueuedMessage( { borrowernumber => '123', limit => 20 } );
1060 fetches messages out of the message queue.
1063 list of hashes, each has represents a message in the message queue.
1067 sub GetQueuedMessages {
1070 my $dbh = C4::Context->dbh();
1071 my $statement = << 'ENDSQL';
1072 SELECT message_id, borrowernumber, subject, content, message_transport_type, status, time_queued
1078 if ( exists $params->{'borrowernumber'} ) {
1079 push @whereclauses, ' borrowernumber = ? ';
1080 push @query_params, $params->{'borrowernumber'};
1083 if ( @whereclauses ) {
1084 $statement .= ' WHERE ' . join( 'AND', @whereclauses );
1087 if ( defined $params->{'limit'} ) {
1088 $statement .= ' LIMIT ? ';
1089 push @query_params, $params->{'limit'};
1092 my $sth = $dbh->prepare( $statement );
1093 my $result = $sth->execute( @query_params );
1094 return $sth->fetchall_arrayref({});
1097 =head2 GetMessageTransportTypes
1099 my @mtt = GetMessageTransportTypes();
1101 returns an arrayref of transport types
1105 sub GetMessageTransportTypes {
1106 my $dbh = C4::Context->dbh();
1107 my $mtts = $dbh->selectcol_arrayref("
1108 SELECT message_transport_type
1109 FROM message_transport_types
1110 ORDER BY message_transport_type
1117 my $message = C4::Letters::Message($message_id);
1122 my ( $message_id ) = @_;
1123 return unless $message_id;
1124 my $dbh = C4::Context->dbh;
1125 return $dbh->selectrow_hashref(q|
1126 SELECT message_id, borrowernumber, subject, content, metadata, letter_code, message_transport_type, status, time_queued, to_address, from_address, content_type
1128 WHERE message_id = ?
1129 |, {}, $message_id );
1132 =head2 ResendMessage
1134 Attempt to resend a message which has failed previously.
1136 my $has_been_resent = C4::Letters::ResendMessage($message_id);
1138 Updates the message to 'pending' status so that
1139 it will be resent later on.
1141 returns 1 on success, 0 on failure, undef if no message was found
1146 my $message_id = shift;
1147 return unless $message_id;
1149 my $message = GetMessage( $message_id );
1150 return unless $message;
1152 if ( $message->{status} ne 'pending' ) {
1153 $rv = C4::Letters::_set_message_status({
1154 message_id => $message_id,
1155 status => 'pending',
1157 $rv = $rv > 0? 1: 0;
1158 # Clear destination email address to force address update
1159 _update_message_to_address( $message_id, undef ) if $rv &&
1160 $message->{message_transport_type} eq 'email';
1165 =head2 _add_attachements
1168 letter - the standard letter hashref
1169 attachments - listref of attachments. each attachment is a hashref of:
1170 type - the mime type, like 'text/plain'
1171 content - the actual attachment
1172 filename - the name of the attachment.
1173 message - a MIME::Lite object to attach these to.
1175 returns your letter object, with the content updated.
1179 sub _add_attachments {
1182 my $letter = $params->{'letter'};
1183 my $attachments = $params->{'attachments'};
1184 return $letter unless @$attachments;
1185 my $message = $params->{'message'};
1187 # First, we have to put the body in as the first attachment
1189 Type => $letter->{'content-type'} || 'TEXT',
1190 Data => $letter->{'is_html'}
1191 ? _wrap_html($letter->{'content'}, $letter->{'title'})
1192 : $letter->{'content'},
1195 foreach my $attachment ( @$attachments ) {
1197 Type => $attachment->{'type'},
1198 Data => $attachment->{'content'},
1199 Filename => $attachment->{'filename'},
1202 # we're forcing list context here to get the header, not the count back from grep.
1203 ( $letter->{'content-type'} ) = grep( /^Content-Type:/, split( /\n/, $params->{'message'}->header_as_string ) );
1204 $letter->{'content-type'} =~ s/^Content-Type:\s+//;
1205 $letter->{'content'} = $message->body_as_string;
1211 =head2 _get_unsent_messages
1213 This function's parameter hash reference takes the following
1214 optional named parameters:
1215 message_transport_type: method of message sending (e.g. email, sms, etc.)
1216 borrowernumber : who the message is to be sent
1217 letter_code : type of message being sent (e.g. PASSWORD_RESET)
1218 limit : maximum number of messages to send
1220 This function returns an array of matching hash referenced rows from
1221 message_queue with some borrower information added.
1225 sub _get_unsent_messages {
1228 my $dbh = C4::Context->dbh();
1230 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
1231 FROM message_queue mq
1232 LEFT JOIN borrowers b ON b.borrowernumber = mq.borrowernumber
1236 my @query_params = ('pending');
1237 if ( ref $params ) {
1238 if ( $params->{'message_transport_type'} ) {
1239 $statement .= ' AND mq.message_transport_type = ? ';
1240 push @query_params, $params->{'message_transport_type'};
1242 if ( $params->{'borrowernumber'} ) {
1243 $statement .= ' AND mq.borrowernumber = ? ';
1244 push @query_params, $params->{'borrowernumber'};
1246 if ( $params->{'letter_code'} ) {
1247 $statement .= ' AND mq.letter_code = ? ';
1248 push @query_params, $params->{'letter_code'};
1250 if ( $params->{'type'} ) {
1251 $statement .= ' AND message_transport_type = ? ';
1252 push @query_params, $params->{'type'};
1254 if ( $params->{'limit'} ) {
1255 $statement .= ' limit ? ';
1256 push @query_params, $params->{'limit'};
1260 $debug and warn "_get_unsent_messages SQL: $statement";
1261 $debug and warn "_get_unsent_messages params: " . join(',',@query_params);
1262 my $sth = $dbh->prepare( $statement );
1263 my $result = $sth->execute( @query_params );
1264 return $sth->fetchall_arrayref({});
1267 sub _send_message_by_email {
1268 my $message = shift or return;
1269 my ($username, $password, $method) = @_;
1271 my $patron = Koha::Patrons->find( $message->{borrowernumber} );
1272 my $to_address = $message->{'to_address'};
1273 unless ($to_address) {
1275 warn "FAIL: No 'to_address' and INVALID borrowernumber ($message->{borrowernumber})";
1276 _set_message_status( { message_id => $message->{'message_id'},
1277 status => 'failed' } );
1280 $to_address = $patron->notice_email_address;
1281 unless ($to_address) {
1282 # warn "FAIL: No 'to_address' and no email for " . ($member->{surname} ||'') . ", borrowernumber ($message->{borrowernumber})";
1283 # warning too verbose for this more common case?
1284 _set_message_status( { message_id => $message->{'message_id'},
1285 status => 'failed' } );
1290 # Encode subject line separately
1291 $message->{subject} = encode('MIME-Header', $message->{'subject'} );
1292 my $subject = $message->{'subject'};
1294 my $content = encode('UTF-8', $message->{'content'});
1295 my $content_type = $message->{'content_type'} || 'text/plain; charset="UTF-8"';
1296 my $is_html = $content_type =~ m/html/io;
1297 my $branch_email = undef;
1298 my $branch_replyto = undef;
1299 my $branch_returnpath = undef;
1301 my $library = $patron->library;
1302 $branch_email = $library->branchemail;
1303 $branch_replyto = $library->branchreplyto;
1304 $branch_returnpath = $library->branchreturnpath;
1306 my $email = Koha::Email->new();
1307 my %sendmail_params = $email->create_message_headers(
1310 from => $message->{'from_address'} || $branch_email,
1311 replyto => $branch_replyto,
1312 sender => $branch_returnpath,
1313 subject => $subject,
1314 message => $is_html ? _wrap_html( $content, $subject ) : $content,
1315 contenttype => $content_type
1319 $sendmail_params{'Auth'} = {user => $username, pass => $password, method => $method} if $username;
1320 if ( my $bcc = C4::Context->preference('NoticeBcc') ) {
1321 $sendmail_params{ Bcc } = C4::Context->preference("SendAllEmailsTo") || $bcc;
1324 _update_message_to_address($message->{'message_id'},$to_address) unless $message->{to_address}; #if initial message address was empty, coming here means that a to address was found and queue should be updated
1326 if ( Mail::Sendmail::sendmail( %sendmail_params ) ) {
1327 _set_message_status( { message_id => $message->{'message_id'},
1328 status => 'sent' } );
1331 _set_message_status( { message_id => $message->{'message_id'},
1332 status => 'failed' } );
1333 carp $Mail::Sendmail::error;
1339 my ($content, $title) = @_;
1341 my $css = C4::Context->preference("NoticeCSS") || '';
1342 $css = qq{<link rel="stylesheet" type="text/css" href="$css">} if $css;
1344 <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
1345 "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
1346 <html lang="en" xml:lang="en" xmlns="http://www.w3.org/1999/xhtml">
1348 <title>$title</title>
1349 <meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
1360 my ( $message ) = @_;
1361 my $dbh = C4::Context->dbh;
1362 my $count = $dbh->selectrow_array(q|
1365 WHERE message_transport_type = ?
1366 AND borrowernumber = ?
1368 AND CAST(time_queued AS date) = CAST(NOW() AS date)
1371 |, {}, $message->{message_transport_type}, $message->{borrowernumber}, $message->{letter_code}, $message->{content} );
1375 sub _send_message_by_sms {
1376 my $message = shift or return;
1377 my $patron = Koha::Patrons->find( $message->{borrowernumber} );
1379 unless ( $patron and $patron->smsalertnumber ) {
1380 _set_message_status( { message_id => $message->{'message_id'},
1381 status => 'failed' } );
1385 if ( _is_duplicate( $message ) ) {
1386 _set_message_status( { message_id => $message->{'message_id'},
1387 status => 'failed' } );
1391 my $success = C4::SMS->send_sms( { destination => $patron->smsalertnumber,
1392 message => $message->{'content'},
1394 _set_message_status( { message_id => $message->{'message_id'},
1395 status => ($success ? 'sent' : 'failed') } );
1399 sub _update_message_to_address {
1401 my $dbh = C4::Context->dbh();
1402 $dbh->do('UPDATE message_queue SET to_address=? WHERE message_id=?',undef,($to,$id));
1405 sub _update_message_from_address {
1406 my ($message_id, $from_address) = @_;
1407 my $dbh = C4::Context->dbh();
1408 $dbh->do('UPDATE message_queue SET from_address = ? WHERE message_id = ?', undef, ($from_address, $message_id));
1411 sub _set_message_status {
1412 my $params = shift or return;
1414 foreach my $required_parameter ( qw( message_id status ) ) {
1415 return unless exists $params->{ $required_parameter };
1418 my $dbh = C4::Context->dbh();
1419 my $statement = 'UPDATE message_queue SET status= ? WHERE message_id = ?';
1420 my $sth = $dbh->prepare( $statement );
1421 my $result = $sth->execute( $params->{'status'},
1422 $params->{'message_id'} );
1427 my ( $params ) = @_;
1429 my $content = $params->{content};
1430 my $tables = $params->{tables};
1431 my $loops = $params->{loops};
1432 my $substitute = $params->{substitute} || {};
1434 my $use_template_cache = C4::Context->config('template_cache_dir') && defined $ENV{GATEWAY_INTERFACE};
1435 my $template = Template->new(
1439 PLUGIN_BASE => 'Koha::Template::Plugin',
1440 COMPILE_EXT => $use_template_cache ? '.ttc' : '',
1441 COMPILE_DIR => $use_template_cache ? C4::Context->config('template_cache_dir') : '',
1443 ENCODING => 'UTF-8',
1445 ) or die Template->error();
1447 my $tt_params = { %{ _get_tt_params( $tables ) }, %{ _get_tt_params( $loops, 'is_a_loop' ) }, %$substitute };
1449 $content = add_tt_filters( $content );
1450 $content = qq|[% USE KohaDates %][% USE Remove_MARC_punctuation %]$content|;
1453 $template->process( \$content, $tt_params, \$output ) || croak "ERROR PROCESSING TEMPLATE: " . $template->error();
1458 sub _get_tt_params {
1459 my ($tables, $is_a_loop) = @_;
1465 article_requests => {
1466 module => 'Koha::ArticleRequests',
1467 singular => 'article_request',
1468 plural => 'article_requests',
1472 module => 'Koha::Biblios',
1473 singular => 'biblio',
1474 plural => 'biblios',
1475 pk => 'biblionumber',
1478 module => 'Koha::Biblioitems',
1479 singular => 'biblioitem',
1480 plural => 'biblioitems',
1481 pk => 'biblioitemnumber',
1484 module => 'Koha::Patrons',
1485 singular => 'borrower',
1486 plural => 'borrowers',
1487 pk => 'borrowernumber',
1490 module => 'Koha::Libraries',
1491 singular => 'branch',
1492 plural => 'branches',
1496 module => 'Koha::Items',
1502 module => 'Koha::News',
1508 module => 'Koha::Acquisition::Orders',
1509 singular => 'order',
1511 pk => 'ordernumber',
1514 module => 'Koha::Holds',
1517 fk => [ 'borrowernumber', 'biblionumber' ],
1520 module => 'Koha::Serials',
1521 singular => 'serial',
1522 plural => 'serials',
1526 module => 'Koha::Subscriptions',
1527 singular => 'subscription',
1528 plural => 'subscriptions',
1529 pk => 'subscriptionid',
1532 module => 'Koha::Suggestions',
1533 singular => 'suggestion',
1534 plural => 'suggestions',
1535 pk => 'suggestionid',
1538 module => 'Koha::Checkouts',
1539 singular => 'checkout',
1540 plural => 'checkouts',
1544 module => 'Koha::Old::Checkouts',
1545 singular => 'old_checkout',
1546 plural => 'old_checkouts',
1550 module => 'Koha::Checkouts',
1551 singular => 'overdue',
1552 plural => 'overdues',
1555 borrower_modifications => {
1556 module => 'Koha::Patron::Modifications',
1557 singular => 'patron_modification',
1558 plural => 'patron_modifications',
1559 fk => 'verification_token',
1563 foreach my $table ( keys %$tables ) {
1564 next unless $config->{$table};
1566 my $ref = ref( $tables->{$table} ) || q{};
1567 my $module = $config->{$table}->{module};
1569 if ( can_load( modules => { $module => undef } ) ) {
1570 my $pk = $config->{$table}->{pk};
1571 my $fk = $config->{$table}->{fk};
1574 my $values = $tables->{$table} || [];
1575 unless ( ref( $values ) eq 'ARRAY' ) {
1576 croak "ERROR processing table $table. Wrong API call.";
1578 my $key = $pk ? $pk : $fk;
1579 # $key does not come from user input
1580 my $objects = $module->search(
1581 { $key => $values },
1583 # We want to retrieve the data in the same order
1585 # field is a MySQLism, but they are no other way to do it
1586 # To be generic we could do it in perl, but we will need to fetch
1587 # all the data then order them
1588 @$values ? ( order_by => \[ "field($key, " . join( ', ', @$values ) . ")" ] ) : ()
1591 $params->{ $config->{$table}->{plural} } = $objects;
1593 elsif ( $ref eq q{} || $ref eq 'HASH' ) {
1594 my $id = ref $ref eq 'HASH' ? $tables->{$table}->{$pk} : $tables->{$table};
1596 if ( $fk ) { # Using a foreign key for lookup
1597 if ( ref( $fk ) eq 'ARRAY' ) { # Foreign key is multi-column
1599 foreach my $key ( @$fk ) {
1600 $search->{$key} = $id->{$key};
1602 $object = $module->search( $search )->last();
1603 } else { # Foreign key is single column
1604 $object = $module->search( { $fk => $id } )->last();
1606 } else { # using the table's primary key for lookup
1607 $object = $module->find($id);
1609 $params->{ $config->{$table}->{singular} } = $object;
1611 else { # $ref eq 'ARRAY'
1613 if ( @{ $tables->{$table} } == 1 ) { # Param is a single key
1614 $object = $module->search( { $pk => $tables->{$table} } )->last();
1616 else { # Params are mutliple foreign keys
1617 croak "Multiple foreign keys (table $table) should be passed using an hashref";
1619 $params->{ $config->{$table}->{singular} } = $object;
1623 croak "ERROR LOADING MODULE $module: $Module::Load::Conditional::ERROR";
1627 $params->{today} = output_pref({ dt => dt_from_string, dateformat => 'iso' });
1632 =head3 add_tt_filters
1634 $content = add_tt_filters( $content );
1636 Add TT filters to some specific fields if needed.
1638 For now we only add the Remove_MARC_punctuation TT filter to biblio and biblioitem fields
1642 sub add_tt_filters {
1643 my ( $content ) = @_;
1644 $content =~ s|\[%\s*biblio\.(.*?)\s*%\]|[% biblio.$1 \| \$Remove_MARC_punctuation %]|gxms;
1645 $content =~ s|\[%\s*biblioitem\.(.*?)\s*%\]|[% biblioitem.$1 \| \$Remove_MARC_punctuation %]|gxms;
1649 =head2 get_item_content
1651 my $item = Koha::Items->find(...)->unblessed;
1652 my @item_content_fields = qw( date_due title barcode author itemnumber );
1653 my $item_content = C4::Letters::get_item_content({
1655 item_content_fields => \@item_content_fields
1658 This function generates a tab-separated list of values for the passed item. Dates
1659 are formatted following the current setup.
1663 sub get_item_content {
1664 my ( $params ) = @_;
1665 my $item = $params->{item};
1666 my $dateonly = $params->{dateonly} || 0;
1667 my $item_content_fields = $params->{item_content_fields} || [];
1669 return unless $item;
1671 my @item_info = map {
1675 { dt => dt_from_string( $item->{$_} ), dateonly => $dateonly } );
1679 } @$item_content_fields;
1680 return join( "\t", @item_info ) . "\n";