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::DateUtils qw( format_sqldatetime dt_from_string );
42 use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
48 &GetLetters &GetLettersAvailableForALibrary &GetLetterTemplates &DelLetter &GetPreparedLetter &GetWrappedLetter &addalert &getalert &delalert &findrelatedto &SendAlerts &GetPrintMessages &GetMessageTransportTypes
54 C4::Letters - Give functions for Letters management
62 "Letters" is the tool used in Koha to manage informations sent to the patrons and/or the library. This include some cron jobs like
63 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)
65 Letters are managed through "alerts" sent by Koha on some events. All "alert" related functions are in this module too.
67 =head2 GetLetters([$module])
69 $letters = &GetLetters($module);
70 returns informations about letters.
71 if needed, $module filters for letters given module
73 DEPRECATED - You must use Koha::Notice::Templates instead
74 The group by clause is confusing and can lead to issues
80 my $module = $filters->{module};
81 my $code = $filters->{code};
82 my $branchcode = $filters->{branchcode};
83 my $dbh = C4::Context->dbh;
84 my $letters = $dbh->selectall_arrayref(
86 SELECT code, module, name
90 . ( $module ? q| AND module = ?| : q|| )
91 . ( $code ? q| AND code = ?| : q|| )
92 . ( defined $branchcode ? q| AND branchcode = ?| : q|| )
93 . q| GROUP BY code, module, name ORDER BY name|, { Slice => {} }
94 , ( $module ? $module : () )
95 , ( $code ? $code : () )
96 , ( defined $branchcode ? $branchcode : () )
102 =head2 GetLetterTemplates
104 my $letter_templates = GetLetterTemplates(
106 module => 'circulation',
108 branchcode => 'CPL', # '' for default,
112 Return a hashref of letter templates.
116 sub GetLetterTemplates {
119 my $module = $params->{module};
120 my $code = $params->{code};
121 my $branchcode = $params->{branchcode} // '';
122 my $dbh = C4::Context->dbh;
123 my $letters = $dbh->selectall_arrayref(
125 SELECT module, code, branchcode, name, is_html, title, content, message_transport_type, lang
132 , $module, $code, $branchcode
138 =head2 GetLettersAvailableForALibrary
140 my $letters = GetLettersAvailableForALibrary(
142 branchcode => 'CPL', # '' for default
143 module => 'circulation',
147 Return an arrayref of letters, sorted by name.
148 If a specific letter exist for the given branchcode, it will be retrieve.
149 Otherwise the default letter will be.
153 sub GetLettersAvailableForALibrary {
155 my $branchcode = $filters->{branchcode};
156 my $module = $filters->{module};
158 croak "module should be provided" unless $module;
160 my $dbh = C4::Context->dbh;
161 my $default_letters = $dbh->selectall_arrayref(
163 SELECT module, code, branchcode, name
167 . q| AND branchcode = ''|
168 . ( $module ? q| AND module = ?| : q|| )
169 . q| ORDER BY name|, { Slice => {} }
170 , ( $module ? $module : () )
173 my $specific_letters;
175 $specific_letters = $dbh->selectall_arrayref(
177 SELECT module, code, branchcode, name
181 . q| AND branchcode = ?|
182 . ( $module ? q| AND module = ?| : q|| )
183 . q| ORDER BY name|, { Slice => {} }
185 , ( $module ? $module : () )
190 for my $l (@$default_letters) {
191 $letters{ $l->{code} } = $l;
193 for my $l (@$specific_letters) {
194 # Overwrite the default letter with the specific one.
195 $letters{ $l->{code} } = $l;
198 return [ map { $letters{$_} }
199 sort { $letters{$a}->{name} cmp $letters{$b}->{name} }
205 my ( $module, $code, $branchcode, $message_transport_type, $lang) = @_;
206 $message_transport_type //= '%';
207 $lang = 'default' unless( $lang && C4::Context->preference('TranslateNotices') );
210 my $only_my_library = C4::Context->only_my_library;
211 if ( $only_my_library and $branchcode ) {
212 $branchcode = C4::Context::mybranch();
216 my $dbh = C4::Context->dbh;
217 my $sth = $dbh->prepare(q{
220 WHERE module=? AND code=? AND (branchcode = ? OR branchcode = '')
221 AND message_transport_type LIKE ?
223 ORDER BY branchcode DESC LIMIT 1
225 $sth->execute( $module, $code, $branchcode, $message_transport_type, $lang );
226 my $line = $sth->fetchrow_hashref
228 $line->{'content-type'} = 'text/html; charset="UTF-8"' if $line->{is_html};
238 module => 'circulation',
244 Delete the letter. The mtt parameter is facultative.
245 If not given, all templates mathing the other parameters will be removed.
251 my $branchcode = $params->{branchcode};
252 my $module = $params->{module};
253 my $code = $params->{code};
254 my $mtt = $params->{mtt};
255 my $lang = $params->{lang};
256 my $dbh = C4::Context->dbh;
263 . ( $mtt ? q| AND message_transport_type = ?| : q|| )
264 . ( $lang? q| AND lang = ?| : q|| )
265 , undef, $branchcode, $module, $code, ( $mtt ? $mtt : () ), ( $lang ? $lang : () ) );
268 =head2 addalert ($borrowernumber, $type, $externalid)
271 - $borrowernumber : the number of the borrower subscribing to the alert
272 - $type : the type of alert.
273 - $externalid : the primary key of the object to put alert on. For issues, the alert is made on subscriptionid.
275 create an alert and return the alertid (primary key)
280 my ( $borrowernumber, $type, $externalid ) = @_;
281 my $dbh = C4::Context->dbh;
284 "insert into alert (borrowernumber, type, externalid) values (?,?,?)");
285 $sth->execute( $borrowernumber, $type, $externalid );
287 # get the alert number newly created and return it
288 my $alertid = $dbh->{'mysql_insertid'};
292 =head2 delalert ($alertid)
295 - alertid : the alert id
301 my $alertid = shift or die "delalert() called without valid argument (alertid)"; # it's gonna die anyway.
302 $debug and warn "delalert: deleting alertid $alertid";
303 my $sth = C4::Context->dbh->prepare("delete from alert where alertid=?");
304 $sth->execute($alertid);
307 =head2 getalert ([$borrowernumber], [$type], [$externalid])
310 - $borrowernumber : the number of the borrower subscribing to the alert
311 - $type : the type of alert.
312 - $externalid : the primary key of the object to put alert on. For issues, the alert is made on subscriptionid.
313 all parameters NON mandatory. If a parameter is omitted, the query is done without the corresponding parameter. For example, without $externalid, returns all alerts for a borrower on a topic.
318 my ( $borrowernumber, $type, $externalid ) = @_;
319 my $dbh = C4::Context->dbh;
320 my $query = "SELECT a.*, b.branchcode FROM alert a JOIN borrowers b USING(borrowernumber) WHERE 1";
322 if ($borrowernumber and $borrowernumber =~ /^\d+$/) {
323 $query .= " AND borrowernumber=?";
324 push @bind, $borrowernumber;
327 $query .= " AND type=?";
331 $query .= " AND externalid=?";
332 push @bind, $externalid;
334 my $sth = $dbh->prepare($query);
335 $sth->execute(@bind);
336 return $sth->fetchall_arrayref({});
339 =head2 findrelatedto($type, $externalid)
342 - $type : the type of alert
343 - $externalid : the id of the "object" to query
345 In the table alert, a "id" is stored in the externalid field. This "id" is related to another table, depending on the type of the alert.
346 When type=issue, the id is related to a subscriptionid and this sub returns the name of the biblio.
351 # When type=virtual, the id is related to a virtual shelf and this sub returns the name of the sub
354 my $type = shift or return;
355 my $externalid = shift or return;
356 my $q = ($type eq 'issue' ) ?
357 "select title as result from subscription left join biblio on subscription.biblionumber=biblio.biblionumber where subscriptionid=?" :
358 ($type eq 'borrower') ?
359 "select concat(firstname,' ',surname) from borrowers where borrowernumber=?" : undef;
361 warn "findrelatedto(): Illegal type '$type'";
364 my $sth = C4::Context->dbh->prepare($q);
365 $sth->execute($externalid);
366 my ($result) = $sth->fetchrow;
372 my $err = &SendAlerts($type, $externalid, $letter_code);
375 - $type : the type of alert
376 - $externalid : the id of the "object" to query
377 - $letter_code : the notice template to use
379 C<&SendAlerts> sends an email notice directly to a patron or a vendor.
381 Currently it supports ($type):
382 - claim serial issues (claimissues)
383 - claim acquisition orders (claimacquisition)
384 - send acquisition orders to the vendor (orderacquisition)
385 - notify patrons about newly received serial issues (issue)
386 - notify patrons when their account is created (members)
388 Returns undef or { error => 'message } on failure.
389 Returns true on success.
394 my ( $type, $externalid, $letter_code ) = @_;
395 my $dbh = C4::Context->dbh;
396 if ( $type eq 'issue' ) {
398 # prepare the letter...
399 # search the subscriptionid
402 "SELECT subscriptionid FROM serial WHERE serialid=?");
403 $sth->execute($externalid);
404 my ($subscriptionid) = $sth->fetchrow
405 or warn( "No subscription for '$externalid'" ),
408 # search the biblionumber
411 "SELECT biblionumber FROM subscription WHERE subscriptionid=?");
412 $sth->execute($subscriptionid);
413 my ($biblionumber) = $sth->fetchrow
414 or warn( "No biblionumber for '$subscriptionid'" ),
418 # find the list of borrowers to alert
419 my $alerts = getalert( '', 'issue', $subscriptionid );
421 my $patron = Koha::Patrons->find( $_->{borrowernumber} );
422 next unless $patron; # Just in case
423 my $email = $patron->email or next;
425 # warn "sending issues...";
426 my $userenv = C4::Context->userenv;
427 my $library = Koha::Libraries->find( $_->{branchcode} );
428 my $letter = GetPreparedLetter (
430 letter_code => $letter_code,
431 branchcode => $userenv->{branch},
433 'branches' => $_->{branchcode},
434 'biblio' => $biblionumber,
435 'biblioitems' => $biblionumber,
436 'borrowers' => $patron->unblessed,
437 'subscription' => $subscriptionid,
438 'serial' => $externalid,
444 my $message = Koha::Email->new();
445 my %mail = $message->create_message_headers(
448 from => $library->branchemail,
449 replyto => $library->branchreplyto,
450 sender => $library->branchreturnpath,
451 subject => Encode::encode( "UTF-8", "" . $letter->{title} ),
452 message => $letter->{'is_html'}
453 ? _wrap_html( Encode::encode( "UTF-8", $letter->{'content'} ),
454 Encode::encode( "UTF-8", "" . $letter->{'title'} ))
455 : Encode::encode( "UTF-8", "" . $letter->{'content'} ),
456 contenttype => $letter->{'is_html'}
457 ? 'text/html; charset="utf-8"'
458 : 'text/plain; charset="utf-8"',
461 unless( Mail::Sendmail::sendmail(%mail) ) {
462 carp $Mail::Sendmail::error;
463 return { error => $Mail::Sendmail::error };
467 elsif ( $type eq 'claimacquisition' or $type eq 'claimissues' or $type eq 'orderacquisition' ) {
469 # prepare the letter...
474 if ( $type eq 'claimacquisition') {
476 SELECT aqorders.*,aqbasket.*,biblio.*,biblioitems.*
478 LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno
479 LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
480 LEFT JOIN biblioitems ON aqorders.biblionumber=biblioitems.biblionumber
481 WHERE aqorders.ordernumber IN (
485 carp "No order selected";
486 return { error => "no_order_selected" };
488 $strsth .= join( ",", ('?') x @$externalid ) . ")";
489 $action = "ACQUISITION CLAIM";
490 $sthorders = $dbh->prepare($strsth);
491 $sthorders->execute( @$externalid );
492 $dataorders = $sthorders->fetchall_arrayref( {} );
495 if ($type eq 'claimissues') {
497 SELECT serial.*,subscription.*, biblio.*, aqbooksellers.*,
498 aqbooksellers.id AS booksellerid
500 LEFT JOIN subscription ON serial.subscriptionid=subscription.subscriptionid
501 LEFT JOIN biblio ON serial.biblionumber=biblio.biblionumber
502 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id
503 WHERE serial.serialid IN (
507 carp "No Order selected";
508 return { error => "no_order_selected" };
511 $strsth .= join( ",", ('?') x @$externalid ) . ")";
512 $action = "CLAIM ISSUE";
513 $sthorders = $dbh->prepare($strsth);
514 $sthorders->execute( @$externalid );
515 $dataorders = $sthorders->fetchall_arrayref( {} );
518 if ( $type eq 'orderacquisition') {
520 SELECT aqorders.*,aqbasket.*,biblio.*,biblioitems.*
522 LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno
523 LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
524 LEFT JOIN biblioitems ON aqorders.biblionumber=biblioitems.biblionumber
525 WHERE aqbasket.basketno = ?
526 AND orderstatus IN ('new','ordered')
530 carp "No basketnumber given";
531 return { error => "no_basketno" };
533 $action = "ACQUISITION ORDER";
534 $sthorders = $dbh->prepare($strsth);
535 $sthorders->execute($externalid);
536 $dataorders = $sthorders->fetchall_arrayref( {} );
540 $dbh->prepare("select * from aqbooksellers where id=?");
541 $sthbookseller->execute( $dataorders->[0]->{booksellerid} );
542 my $databookseller = $sthbookseller->fetchrow_hashref;
544 my $addressee = $type eq 'claimacquisition' || $type eq 'orderacquisition' ? 'acqprimary' : 'serialsprimary';
547 $dbh->prepare("SELECT * FROM aqcontacts WHERE booksellerid=? AND $type=1 ORDER BY $addressee DESC");
548 $sthcontact->execute( $dataorders->[0]->{booksellerid} );
549 my $datacontact = $sthcontact->fetchrow_hashref;
553 push @email, $databookseller->{bookselleremail} if $databookseller->{bookselleremail};
554 push @email, $datacontact->{email} if ( $datacontact && $datacontact->{email} );
556 warn "Bookseller $dataorders->[0]->{booksellerid} without emails";
557 return { error => "no_email" };
560 while ($addlcontact = $sthcontact->fetchrow_hashref) {
561 push @cc, $addlcontact->{email} if ( $addlcontact && $addlcontact->{email} );
564 my $userenv = C4::Context->userenv;
565 my $letter = GetPreparedLetter (
567 letter_code => $letter_code,
568 branchcode => $userenv->{branch},
570 'branches' => $userenv->{branch},
571 'aqbooksellers' => $databookseller,
572 'aqcontacts' => $datacontact,
574 repeat => $dataorders,
576 ) or return { error => "no_letter" };
578 # Remove the order tag
579 $letter->{content} =~ s/<order>(.*?)<\/order>/$1/gxms;
582 my $library = Koha::Libraries->find( $userenv->{branch} );
584 To => join( ',', @email),
585 Cc => join( ',', @cc),
586 From => $library->branchemail || C4::Context->preference('KohaAdminEmailAddress'),
587 Subject => Encode::encode( "UTF-8", "" . $letter->{title} ),
588 Message => $letter->{'is_html'}
589 ? _wrap_html( Encode::encode( "UTF-8", $letter->{'content'} ),
590 Encode::encode( "UTF-8", "" . $letter->{'title'} ))
591 : Encode::encode( "UTF-8", "" . $letter->{'content'} ),
592 'Content-Type' => $letter->{'is_html'}
593 ? 'text/html; charset="utf-8"'
594 : 'text/plain; charset="utf-8"',
597 if ($type eq 'claimacquisition' || $type eq 'claimissues' ) {
598 $mail{'Reply-to'} = C4::Context->preference('ReplytoDefault')
599 if C4::Context->preference('ReplytoDefault');
600 $mail{'Sender'} = C4::Context->preference('ReturnpathDefault')
601 if C4::Context->preference('ReturnpathDefault');
602 $mail{'Bcc'} = $userenv->{emailaddress}
603 if C4::Context->preference("ClaimsBccCopy");
606 unless ( Mail::Sendmail::sendmail(%mail) ) {
607 carp $Mail::Sendmail::error;
608 return { error => $Mail::Sendmail::error };
616 . join( ',', @email )
621 ) if C4::Context->preference("LetterLog");
623 # send an "account details" notice to a newly created user
624 elsif ( $type eq 'members' ) {
625 my $library = Koha::Libraries->find( $externalid->{branchcode} )->unblessed;
626 my $letter = GetPreparedLetter (
628 letter_code => $letter_code,
629 branchcode => $externalid->{'branchcode'},
631 'branches' => $library,
632 'borrowers' => $externalid->{'borrowernumber'},
634 substitute => { 'borrowers.password' => $externalid->{'password'} },
637 return { error => "no_email" } unless $externalid->{'emailaddr'};
638 my $email = Koha::Email->new();
639 my %mail = $email->create_message_headers(
641 to => $externalid->{'emailaddr'},
642 from => $library->{branchemail},
643 replyto => $library->{branchreplyto},
644 sender => $library->{branchreturnpath},
645 subject => Encode::encode( "UTF-8", "" . $letter->{'title'} ),
646 message => $letter->{'is_html'}
647 ? _wrap_html( Encode::encode( "UTF-8", $letter->{'content'} ),
648 Encode::encode( "UTF-8", "" . $letter->{'title'} ) )
649 : Encode::encode( "UTF-8", "" . $letter->{'content'} ),
650 contenttype => $letter->{'is_html'}
651 ? 'text/html; charset="utf-8"'
652 : 'text/plain; charset="utf-8"',
655 unless( Mail::Sendmail::sendmail(%mail) ) {
656 carp $Mail::Sendmail::error;
657 return { error => $Mail::Sendmail::error };
661 # If we come here, return an OK status
665 =head2 GetPreparedLetter( %params )
668 module => letter module, mandatory
669 letter_code => letter code, mandatory
670 branchcode => for letter selection, if missing default system letter taken
671 tables => a hashref with table names as keys. Values are either:
672 - a scalar - primary key value
673 - an arrayref - primary key values
674 - a hashref - full record
675 substitute => custom substitution key/value pairs
676 repeat => records to be substituted on consecutive lines:
677 - an arrayref - tries to guess what needs substituting by
678 taking remaining << >> tokensr; not recommended
679 - a hashref token => @tables - replaces <token> << >> << >> </token>
680 subtemplate for each @tables row; table is a hashref as above
681 want_librarian => boolean, if set to true triggers librarian details
682 substitution from the userenv
684 letter fields hashref (title & content useful)
688 sub GetPreparedLetter {
691 my $letter = $params{letter};
694 my $module = $params{module} or croak "No module";
695 my $letter_code = $params{letter_code} or croak "No letter_code";
696 my $branchcode = $params{branchcode} || '';
697 my $mtt = $params{message_transport_type} || 'email';
698 my $lang = $params{lang} || 'default';
700 $letter = getletter( $module, $letter_code, $branchcode, $mtt, $lang );
703 $letter = getletter( $module, $letter_code, $branchcode, $mtt, 'default' )
704 or warn( "No $module $letter_code letter transported by " . $mtt ),
709 my $tables = $params{tables} || {};
710 my $substitute = $params{substitute} || {};
711 my $loops = $params{loops} || {}; # loops is not supported for historical notices syntax
712 my $repeat = $params{repeat};
713 %$tables || %$substitute || $repeat || %$loops
714 or carp( "ERROR: nothing to substitute - both 'tables', 'loops' and 'substitute' are empty" ),
716 my $want_librarian = $params{want_librarian};
719 while ( my ($token, $val) = each %$substitute ) {
720 if ( $token eq 'items.content' ) {
721 $val =~ s|\n|<br/>|g if $letter->{is_html};
724 $letter->{title} =~ s/<<$token>>/$val/g;
725 $letter->{content} =~ s/<<$token>>/$val/g;
729 my $OPACBaseURL = C4::Context->preference('OPACBaseURL');
730 $letter->{content} =~ s/<<OPACBaseURL>>/$OPACBaseURL/go;
732 if ($want_librarian) {
733 # parsing librarian name
734 my $userenv = C4::Context->userenv;
735 $letter->{content} =~ s/<<LibrarianFirstname>>/$userenv->{firstname}/go;
736 $letter->{content} =~ s/<<LibrarianSurname>>/$userenv->{surname}/go;
737 $letter->{content} =~ s/<<LibrarianEmailaddress>>/$userenv->{emailaddress}/go;
740 my ($repeat_no_enclosing_tags, $repeat_enclosing_tags);
743 if (ref ($repeat) eq 'ARRAY' ) {
744 $repeat_no_enclosing_tags = $repeat;
746 $repeat_enclosing_tags = $repeat;
750 if ($repeat_enclosing_tags) {
751 while ( my ($tag, $tag_tables) = each %$repeat_enclosing_tags ) {
752 if ( $letter->{content} =~ m!<$tag>(.*)</$tag>!s ) {
755 my %subletter = ( title => '', content => $subcontent );
756 _substitute_tables( \%subletter, $_ );
759 $letter->{content} =~ s!<$tag>.*</$tag>!join( "\n", @lines )!se;
765 _substitute_tables( $letter, $tables );
768 if ($repeat_no_enclosing_tags) {
769 if ( $letter->{content} =~ m/[^\n]*<<.*>>[^\n]*/so ) {
774 $c =~ s/<<count>>/$i/go;
775 foreach my $field ( keys %{$_} ) {
776 $c =~ s/(<<[^\.]+.$field>>)/$_->{$field}/;
780 } @$repeat_no_enclosing_tags;
782 my $replaceby = join( "\n", @lines );
783 $letter->{content} =~ s/\Q$line\E/$replaceby/s;
787 $letter->{content} = _process_tt(
789 content => $letter->{content},
792 substitute => $substitute,
796 $letter->{content} =~ s/<<\S*>>//go; #remove any stragglers
801 sub _substitute_tables {
802 my ( $letter, $tables ) = @_;
803 while ( my ($table, $param) = each %$tables ) {
806 my $ref = ref $param;
809 if ($ref && $ref eq 'HASH') {
813 my $sth = _parseletter_sth($table);
815 warn "_parseletter_sth('$table') failed to return a valid sth. No substitution will be done for that table.";
818 $sth->execute( $ref ? @$param : $param );
820 $values = $sth->fetchrow_hashref;
824 _parseletter ( $letter, $table, $values );
828 sub _parseletter_sth {
832 carp "ERROR: _parseletter_sth() called without argument (table)";
835 # NOTE: we used to check whether we had a statement handle cached in
836 # a %handles module-level variable. This was a dumb move and
837 # broke things for the rest of us. prepare_cached is a better
838 # way to cache statement handles anyway.
840 ($table eq 'biblio' ) ? "SELECT * FROM $table WHERE biblionumber = ?" :
841 ($table eq 'biblioitems' ) ? "SELECT * FROM $table WHERE biblionumber = ?" :
842 ($table eq 'items' ) ? "SELECT * FROM $table WHERE itemnumber = ?" :
843 ($table eq 'issues' ) ? "SELECT * FROM $table WHERE itemnumber = ?" :
844 ($table eq 'old_issues' ) ? "SELECT * FROM $table WHERE itemnumber = ? ORDER BY timestamp DESC LIMIT 1" :
845 ($table eq 'reserves' ) ? "SELECT * FROM $table WHERE borrowernumber = ? and biblionumber = ?" :
846 ($table eq 'borrowers' ) ? "SELECT * FROM $table WHERE borrowernumber = ?" :
847 ($table eq 'branches' ) ? "SELECT * FROM $table WHERE branchcode = ?" :
848 ($table eq 'suggestions' ) ? "SELECT * FROM $table WHERE suggestionid = ?" :
849 ($table eq 'aqbooksellers') ? "SELECT * FROM $table WHERE id = ?" :
850 ($table eq 'aqorders' ) ? "SELECT * FROM $table WHERE ordernumber = ?" :
851 ($table eq 'opac_news' ) ? "SELECT * FROM $table WHERE idnew = ?" :
852 ($table eq 'article_requests') ? "SELECT * FROM $table WHERE id = ?" :
853 ($table eq 'borrower_modifications') ? "SELECT * FROM $table WHERE verification_token = ?" :
854 ($table eq 'subscription') ? "SELECT * FROM $table WHERE subscriptionid = ?" :
855 ($table eq 'serial') ? "SELECT * FROM $table WHERE serialid = ?" :
858 warn "ERROR: No _parseletter_sth query for table '$table'";
859 return; # nothing to get
861 unless ($sth = C4::Context->dbh->prepare_cached($query)) {
862 warn "ERROR: Failed to prepare query: '$query'";
865 return $sth; # now cache is populated for that $table
868 =head2 _parseletter($letter, $table, $values)
871 - $letter : a hash to letter fields (title & content useful)
872 - $table : the Koha table to parse.
873 - $values_in : table record hashref
874 parse all fields from a table, and replace values in title & content with the appropriate value
875 (not exported sub, used only internally)
880 my ( $letter, $table, $values_in ) = @_;
882 # Work on a local copy of $values_in (passed by reference) to avoid side effects
883 # in callers ( by changing / formatting values )
884 my $values = $values_in ? { %$values_in } : {};
886 if ( $table eq 'borrowers' && $values->{'dateexpiry'} ){
887 $values->{'dateexpiry'} = format_sqldatetime( $values->{'dateexpiry'} );
890 if ( $table eq 'reserves' && $values->{'waitingdate'} ) {
891 $values->{'waitingdate'} = output_pref({ dt => dt_from_string( $values->{'waitingdate'} ), dateonly => 1 });
894 if ($letter->{content} && $letter->{content} =~ /<<today>>/) {
895 my $todaysdate = output_pref( DateTime->now() );
896 $letter->{content} =~ s/<<today>>/$todaysdate/go;
899 while ( my ($field, $val) = each %$values ) {
900 $val =~ s/\p{P}$// if $val && $table=~/biblio/;
901 #BZ 9886: Assuming that we want to eliminate ISBD punctuation here
902 #Therefore adding the test on biblio. This includes biblioitems,
903 #but excludes items. Removed unneeded global and lookahead.
905 if ( $table=~/^borrowers$/ && $field=~/^streettype$/ ) {
906 my $av = Koha::AuthorisedValues->search({ category => 'ROADTYPE', authorised_value => $val });
907 $val = $av->count ? $av->next->lib : '';
911 my $replacedby = defined ($val) ? $val : '';
913 and not $replacedby =~ m|0000-00-00|
914 and not $replacedby =~ m|9999-12-31|
915 and $replacedby =~ m|^\d{4}-\d{2}-\d{2}( \d{2}:\d{2}:\d{2})?$| )
917 # If the value is XXXX-YY-ZZ[ AA:BB:CC] we assume it is a date
918 my $dateonly = defined $1 ? 0 : 1; #$1 refers to the capture group wrapped in parentheses. In this case, that's the hours, minutes, seconds.
919 my $re_dateonly_filter = qr{ $field( \s* \| \s* dateonly\s*)?>> }xms;
921 for my $letter_field ( qw( title content ) ) {
922 my $filter_string_used = q{};
923 if ( $letter->{ $letter_field } =~ $re_dateonly_filter ) {
924 # We overwrite $dateonly if the filter exists and we have a time in the datetime
925 $filter_string_used = $1 || q{};
926 $dateonly = $1 unless $dateonly;
928 my $replacedby_date = eval {
929 output_pref({ dt => dt_from_string( $replacedby ), dateonly => $dateonly });
932 if ( $letter->{ $letter_field } ) {
933 $letter->{ $letter_field } =~ s/\Q<<$table.$field$filter_string_used>>\E/$replacedby_date/g;
934 $letter->{ $letter_field } =~ s/\Q<<$field$filter_string_used>>\E/$replacedby_date/g;
938 # Other fields replacement
940 for my $letter_field ( qw( title content ) ) {
941 if ( $letter->{ $letter_field } ) {
942 $letter->{ $letter_field } =~ s/<<$table.$field>>/$replacedby/g;
943 $letter->{ $letter_field } =~ s/<<$field>>/$replacedby/g;
949 if ($table eq 'borrowers' && $letter->{content}) {
950 if ( my $attributes = GetBorrowerAttributes($values->{borrowernumber}) ) {
952 foreach (@$attributes) {
953 my $code = $_->{code};
954 my $val = $_->{value_description} || $_->{value};
955 $val =~ s/\p{P}(?=$)//g if $val;
956 next unless $val gt '';
958 push @{ $attr{$code} }, $val;
960 while ( my ($code, $val_ar) = each %attr ) {
961 my $replacefield = "<<borrower-attribute:$code>>";
962 my $replacedby = join ',', @$val_ar;
963 $letter->{content} =~ s/$replacefield/$replacedby/g;
972 my $success = EnqueueLetter( { letter => $letter,
973 borrowernumber => '12', message_transport_type => 'email' } )
975 places a letter in the message_queue database table, which will
976 eventually get processed (sent) by the process_message_queue.pl
977 cronjob when it calls SendQueuedMessages.
979 return message_id on success
984 my $params = shift or return;
986 return unless exists $params->{'letter'};
987 # return unless exists $params->{'borrowernumber'};
988 return unless exists $params->{'message_transport_type'};
990 my $content = $params->{letter}->{content};
991 $content =~ s/\s+//g if(defined $content);
992 if ( not defined $content or $content eq '' ) {
993 warn "Trying to add an empty message to the message queue" if $debug;
997 # If we have any attachments we should encode then into the body.
998 if ( $params->{'attachments'} ) {
999 $params->{'letter'} = _add_attachments(
1000 { letter => $params->{'letter'},
1001 attachments => $params->{'attachments'},
1002 message => MIME::Lite->new( Type => 'multipart/mixed' ),
1007 my $dbh = C4::Context->dbh();
1008 my $statement = << 'ENDSQL';
1009 INSERT INTO message_queue
1010 ( borrowernumber, subject, content, metadata, letter_code, message_transport_type, status, time_queued, to_address, from_address, content_type )
1012 ( ?, ?, ?, ?, ?, ?, ?, NOW(), ?, ?, ? )
1015 my $sth = $dbh->prepare($statement);
1016 my $result = $sth->execute(
1017 $params->{'borrowernumber'}, # borrowernumber
1018 $params->{'letter'}->{'title'}, # subject
1019 $params->{'letter'}->{'content'}, # content
1020 $params->{'letter'}->{'metadata'} || '', # metadata
1021 $params->{'letter'}->{'code'} || '', # letter_code
1022 $params->{'message_transport_type'}, # message_transport_type
1024 $params->{'to_address'}, # to_address
1025 $params->{'from_address'}, # from_address
1026 $params->{'letter'}->{'content-type'}, # content_type
1028 return $dbh->last_insert_id(undef,undef,'message_queue', undef);
1031 =head2 SendQueuedMessages ([$hashref])
1033 my $sent = SendQueuedMessages({
1034 letter_code => $letter_code,
1035 borrowernumber => $who_letter_is_for,
1041 Sends all of the 'pending' items in the message queue, unless
1042 parameters are passed.
1044 The letter_code, borrowernumber and limit parameters are used
1045 to build a parameter set for _get_unsent_messages, thus limiting
1046 which pending messages will be processed. They are all optional.
1048 The verbose parameter can be used to generate debugging output.
1049 It is also optional.
1051 Returns number of messages sent.
1055 sub SendQueuedMessages {
1058 my $which_unsent_messages = {
1059 'limit' => $params->{'limit'} // 0,
1060 'borrowernumber' => $params->{'borrowernumber'} // q{},
1061 'letter_code' => $params->{'letter_code'} // q{},
1062 'type' => $params->{'type'} // q{},
1064 my $unsent_messages = _get_unsent_messages( $which_unsent_messages );
1065 MESSAGE: foreach my $message ( @$unsent_messages ) {
1066 # warn Data::Dumper->Dump( [ $message ], [ 'message' ] );
1067 warn sprintf( 'sending %s message to patron: %s',
1068 $message->{'message_transport_type'},
1069 $message->{'borrowernumber'} || 'Admin' )
1070 if $params->{'verbose'} or $debug;
1071 # This is just begging for subclassing
1072 next MESSAGE if ( lc($message->{'message_transport_type'}) eq 'rss' );
1073 if ( lc( $message->{'message_transport_type'} ) eq 'email' ) {
1074 _send_message_by_email( $message, $params->{'username'}, $params->{'password'}, $params->{'method'} );
1076 elsif ( lc( $message->{'message_transport_type'} ) eq 'sms' ) {
1077 if ( C4::Context->preference('SMSSendDriver') eq 'Email' ) {
1078 my $patron = Koha::Patrons->find( $message->{borrowernumber} );
1079 my $sms_provider = Koha::SMS::Providers->find( $patron->sms_provider_id );
1080 unless ( $sms_provider ) {
1081 warn sprintf( "Patron %s has no sms provider id set!", $message->{'borrowernumber'} ) if $params->{'verbose'} or $debug;
1082 _set_message_status( { message_id => $message->{'message_id'}, status => 'failed' } );
1085 unless ( $patron->smsalertnumber ) {
1086 _set_message_status( { message_id => $message->{'message_id'}, status => 'failed' } );
1087 warn sprintf( "No smsalertnumber found for patron %s!", $message->{'borrowernumber'} ) if $params->{'verbose'} or $debug;
1090 $message->{to_address} = $patron->smsalertnumber; #Sometime this is set to email - sms should always use smsalertnumber
1091 $message->{to_address} .= '@' . $sms_provider->domain();
1092 _update_message_to_address($message->{'message_id'},$message->{to_address});
1093 _send_message_by_email( $message, $params->{'username'}, $params->{'password'}, $params->{'method'} );
1095 _send_message_by_sms( $message );
1099 return scalar( @$unsent_messages );
1102 =head2 GetRSSMessages
1104 my $message_list = GetRSSMessages( { limit => 10, borrowernumber => '14' } )
1106 returns a listref of all queued RSS messages for a particular person.
1110 sub GetRSSMessages {
1113 return unless $params;
1114 return unless ref $params;
1115 return unless $params->{'borrowernumber'};
1117 return _get_unsent_messages( { message_transport_type => 'rss',
1118 limit => $params->{'limit'},
1119 borrowernumber => $params->{'borrowernumber'}, } );
1122 =head2 GetPrintMessages
1124 my $message_list = GetPrintMessages( { borrowernumber => $borrowernumber } )
1126 Returns a arrayref of all queued print messages (optionally, for a particular
1131 sub GetPrintMessages {
1132 my $params = shift || {};
1134 return _get_unsent_messages( { message_transport_type => 'print',
1135 borrowernumber => $params->{'borrowernumber'},
1139 =head2 GetQueuedMessages ([$hashref])
1141 my $messages = GetQueuedMessage( { borrowernumber => '123', limit => 20 } );
1143 fetches messages out of the message queue.
1146 list of hashes, each has represents a message in the message queue.
1150 sub GetQueuedMessages {
1153 my $dbh = C4::Context->dbh();
1154 my $statement = << 'ENDSQL';
1155 SELECT message_id, borrowernumber, subject, content, message_transport_type, status, time_queued
1161 if ( exists $params->{'borrowernumber'} ) {
1162 push @whereclauses, ' borrowernumber = ? ';
1163 push @query_params, $params->{'borrowernumber'};
1166 if ( @whereclauses ) {
1167 $statement .= ' WHERE ' . join( 'AND', @whereclauses );
1170 if ( defined $params->{'limit'} ) {
1171 $statement .= ' LIMIT ? ';
1172 push @query_params, $params->{'limit'};
1175 my $sth = $dbh->prepare( $statement );
1176 my $result = $sth->execute( @query_params );
1177 return $sth->fetchall_arrayref({});
1180 =head2 GetMessageTransportTypes
1182 my @mtt = GetMessageTransportTypes();
1184 returns an arrayref of transport types
1188 sub GetMessageTransportTypes {
1189 my $dbh = C4::Context->dbh();
1190 my $mtts = $dbh->selectcol_arrayref("
1191 SELECT message_transport_type
1192 FROM message_transport_types
1193 ORDER BY message_transport_type
1200 my $message = C4::Letters::Message($message_id);
1205 my ( $message_id ) = @_;
1206 return unless $message_id;
1207 my $dbh = C4::Context->dbh;
1208 return $dbh->selectrow_hashref(q|
1209 SELECT message_id, borrowernumber, subject, content, metadata, letter_code, message_transport_type, status, time_queued, to_address, from_address, content_type
1211 WHERE message_id = ?
1212 |, {}, $message_id );
1215 =head2 ResendMessage
1217 Attempt to resend a message which has failed previously.
1219 my $has_been_resent = C4::Letters::ResendMessage($message_id);
1221 Updates the message to 'pending' status so that
1222 it will be resent later on.
1224 returns 1 on success, 0 on failure, undef if no message was found
1229 my $message_id = shift;
1230 return unless $message_id;
1232 my $message = GetMessage( $message_id );
1233 return unless $message;
1235 if ( $message->{status} ne 'pending' ) {
1236 $rv = C4::Letters::_set_message_status({
1237 message_id => $message_id,
1238 status => 'pending',
1240 $rv = $rv > 0? 1: 0;
1241 # Clear destination email address to force address update
1242 _update_message_to_address( $message_id, undef ) if $rv &&
1243 $message->{message_transport_type} eq 'email';
1248 =head2 _add_attachements
1251 letter - the standard letter hashref
1252 attachments - listref of attachments. each attachment is a hashref of:
1253 type - the mime type, like 'text/plain'
1254 content - the actual attachment
1255 filename - the name of the attachment.
1256 message - a MIME::Lite object to attach these to.
1258 returns your letter object, with the content updated.
1262 sub _add_attachments {
1265 my $letter = $params->{'letter'};
1266 my $attachments = $params->{'attachments'};
1267 return $letter unless @$attachments;
1268 my $message = $params->{'message'};
1270 # First, we have to put the body in as the first attachment
1272 Type => $letter->{'content-type'} || 'TEXT',
1273 Data => $letter->{'is_html'}
1274 ? _wrap_html($letter->{'content'}, $letter->{'title'})
1275 : $letter->{'content'},
1278 foreach my $attachment ( @$attachments ) {
1280 Type => $attachment->{'type'},
1281 Data => $attachment->{'content'},
1282 Filename => $attachment->{'filename'},
1285 # we're forcing list context here to get the header, not the count back from grep.
1286 ( $letter->{'content-type'} ) = grep( /^Content-Type:/, split( /\n/, $params->{'message'}->header_as_string ) );
1287 $letter->{'content-type'} =~ s/^Content-Type:\s+//;
1288 $letter->{'content'} = $message->body_as_string;
1294 =head2 _get_unsent_messages
1296 This function's parameter hash reference takes the following
1297 optional named parameters:
1298 message_transport_type: method of message sending (e.g. email, sms, etc.)
1299 borrowernumber : who the message is to be sent
1300 letter_code : type of message being sent (e.g. PASSWORD_RESET)
1301 limit : maximum number of messages to send
1303 This function returns an array of matching hash referenced rows from
1304 message_queue with some borrower information added.
1308 sub _get_unsent_messages {
1311 my $dbh = C4::Context->dbh();
1313 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
1314 FROM message_queue mq
1315 LEFT JOIN borrowers b ON b.borrowernumber = mq.borrowernumber
1319 my @query_params = ('pending');
1320 if ( ref $params ) {
1321 if ( $params->{'message_transport_type'} ) {
1322 $statement .= ' AND mq.message_transport_type = ? ';
1323 push @query_params, $params->{'message_transport_type'};
1325 if ( $params->{'borrowernumber'} ) {
1326 $statement .= ' AND mq.borrowernumber = ? ';
1327 push @query_params, $params->{'borrowernumber'};
1329 if ( $params->{'letter_code'} ) {
1330 $statement .= ' AND mq.letter_code = ? ';
1331 push @query_params, $params->{'letter_code'};
1333 if ( $params->{'type'} ) {
1334 $statement .= ' AND message_transport_type = ? ';
1335 push @query_params, $params->{'type'};
1337 if ( $params->{'limit'} ) {
1338 $statement .= ' limit ? ';
1339 push @query_params, $params->{'limit'};
1343 $debug and warn "_get_unsent_messages SQL: $statement";
1344 $debug and warn "_get_unsent_messages params: " . join(',',@query_params);
1345 my $sth = $dbh->prepare( $statement );
1346 my $result = $sth->execute( @query_params );
1347 return $sth->fetchall_arrayref({});
1350 sub _send_message_by_email {
1351 my $message = shift or return;
1352 my ($username, $password, $method) = @_;
1354 my $patron = Koha::Patrons->find( $message->{borrowernumber} );
1355 my $to_address = $message->{'to_address'};
1356 unless ($to_address) {
1358 warn "FAIL: No 'to_address' and INVALID borrowernumber ($message->{borrowernumber})";
1359 _set_message_status( { message_id => $message->{'message_id'},
1360 status => 'failed' } );
1363 $to_address = $patron->notice_email_address;
1364 unless ($to_address) {
1365 # warn "FAIL: No 'to_address' and no email for " . ($member->{surname} ||'') . ", borrowernumber ($message->{borrowernumber})";
1366 # warning too verbose for this more common case?
1367 _set_message_status( { message_id => $message->{'message_id'},
1368 status => 'failed' } );
1373 my $utf8 = decode('MIME-Header', $message->{'subject'} );
1374 $message->{subject}= encode('MIME-Header', $utf8);
1375 my $subject = encode('UTF-8', $message->{'subject'});
1376 my $content = encode('UTF-8', $message->{'content'});
1377 my $content_type = $message->{'content_type'} || 'text/plain; charset="UTF-8"';
1378 my $is_html = $content_type =~ m/html/io;
1379 my $branch_email = undef;
1380 my $branch_replyto = undef;
1381 my $branch_returnpath = undef;
1383 my $library = $patron->library;
1384 $branch_email = $library->branchemail;
1385 $branch_replyto = $library->branchreplyto;
1386 $branch_returnpath = $library->branchreturnpath;
1388 my $email = Koha::Email->new();
1389 my %sendmail_params = $email->create_message_headers(
1392 from => $message->{'from_address'} || $branch_email,
1393 replyto => $branch_replyto,
1394 sender => $branch_returnpath,
1395 subject => $subject,
1396 message => $is_html ? _wrap_html( $content, $subject ) : $content,
1397 contenttype => $content_type
1401 $sendmail_params{'Auth'} = {user => $username, pass => $password, method => $method} if $username;
1402 if ( my $bcc = C4::Context->preference('NoticeBcc') ) {
1403 $sendmail_params{ Bcc } = $bcc;
1406 _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
1408 if ( Mail::Sendmail::sendmail( %sendmail_params ) ) {
1409 _set_message_status( { message_id => $message->{'message_id'},
1410 status => 'sent' } );
1413 _set_message_status( { message_id => $message->{'message_id'},
1414 status => 'failed' } );
1415 carp $Mail::Sendmail::error;
1421 my ($content, $title) = @_;
1423 my $css = C4::Context->preference("NoticeCSS") || '';
1424 $css = qq{<link rel="stylesheet" type="text/css" href="$css">} if $css;
1426 <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
1427 "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
1428 <html lang="en" xml:lang="en" xmlns="http://www.w3.org/1999/xhtml">
1430 <title>$title</title>
1431 <meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
1442 my ( $message ) = @_;
1443 my $dbh = C4::Context->dbh;
1444 my $count = $dbh->selectrow_array(q|
1447 WHERE message_transport_type = ?
1448 AND borrowernumber = ?
1450 AND CAST(time_queued AS date) = CAST(NOW() AS date)
1453 |, {}, $message->{message_transport_type}, $message->{borrowernumber}, $message->{letter_code}, $message->{content} );
1457 sub _send_message_by_sms {
1458 my $message = shift or return;
1459 my $patron = Koha::Patrons->find( $message->{borrowernumber} );
1461 unless ( $patron and $patron->smsalertnumber ) {
1462 _set_message_status( { message_id => $message->{'message_id'},
1463 status => 'failed' } );
1467 if ( _is_duplicate( $message ) ) {
1468 _set_message_status( { message_id => $message->{'message_id'},
1469 status => 'failed' } );
1473 my $success = C4::SMS->send_sms( { destination => $patron->smsalertnumber,
1474 message => $message->{'content'},
1476 _set_message_status( { message_id => $message->{'message_id'},
1477 status => ($success ? 'sent' : 'failed') } );
1481 sub _update_message_to_address {
1483 my $dbh = C4::Context->dbh();
1484 $dbh->do('UPDATE message_queue SET to_address=? WHERE message_id=?',undef,($to,$id));
1487 sub _set_message_status {
1488 my $params = shift or return;
1490 foreach my $required_parameter ( qw( message_id status ) ) {
1491 return unless exists $params->{ $required_parameter };
1494 my $dbh = C4::Context->dbh();
1495 my $statement = 'UPDATE message_queue SET status= ? WHERE message_id = ?';
1496 my $sth = $dbh->prepare( $statement );
1497 my $result = $sth->execute( $params->{'status'},
1498 $params->{'message_id'} );
1503 my ( $params ) = @_;
1505 my $content = $params->{content};
1506 my $tables = $params->{tables};
1507 my $loops = $params->{loops};
1508 my $substitute = $params->{substitute} || {};
1510 my $use_template_cache = C4::Context->config('template_cache_dir') && defined $ENV{GATEWAY_INTERFACE};
1511 my $template = Template->new(
1515 PLUGIN_BASE => 'Koha::Template::Plugin',
1516 COMPILE_EXT => $use_template_cache ? '.ttc' : '',
1517 COMPILE_DIR => $use_template_cache ? C4::Context->config('template_cache_dir') : '',
1519 ENCODING => 'UTF-8',
1521 ) or die Template->error();
1523 my $tt_params = { %{ _get_tt_params( $tables ) }, %{ _get_tt_params( $loops, 'is_a_loop' ) }, %$substitute };
1525 $content = add_tt_filters( $content );
1526 $content = qq|[% USE KohaDates %][% USE Remove_MARC_punctuation %]$content|;
1529 $template->process( \$content, $tt_params, \$output ) || croak "ERROR PROCESSING TEMPLATE: " . $template->error();
1534 sub _get_tt_params {
1535 my ($tables, $is_a_loop) = @_;
1541 article_requests => {
1542 module => 'Koha::ArticleRequests',
1543 singular => 'article_request',
1544 plural => 'article_requests',
1548 module => 'Koha::Biblios',
1549 singular => 'biblio',
1550 plural => 'biblios',
1551 pk => 'biblionumber',
1554 module => 'Koha::Biblioitems',
1555 singular => 'biblioitem',
1556 plural => 'biblioitems',
1557 pk => 'biblioitemnumber',
1560 module => 'Koha::Patrons',
1561 singular => 'borrower',
1562 plural => 'borrowers',
1563 pk => 'borrowernumber',
1566 module => 'Koha::Libraries',
1567 singular => 'branch',
1568 plural => 'branches',
1572 module => 'Koha::Items',
1578 module => 'Koha::News',
1584 module => 'Koha::Acquisition::Orders',
1585 singular => 'order',
1587 pk => 'ordernumber',
1590 module => 'Koha::Holds',
1593 fk => [ 'borrowernumber', 'biblionumber' ],
1596 module => 'Koha::Serials',
1597 singular => 'serial',
1598 plural => 'serials',
1602 module => 'Koha::Subscriptions',
1603 singular => 'subscription',
1604 plural => 'subscriptions',
1605 pk => 'subscriptionid',
1608 module => 'Koha::Suggestions',
1609 singular => 'suggestion',
1610 plural => 'suggestions',
1611 pk => 'suggestionid',
1614 module => 'Koha::Checkouts',
1615 singular => 'checkout',
1616 plural => 'checkouts',
1620 module => 'Koha::Old::Checkouts',
1621 singular => 'old_checkout',
1622 plural => 'old_checkouts',
1626 module => 'Koha::Checkouts',
1627 singular => 'overdue',
1628 plural => 'overdues',
1631 borrower_modifications => {
1632 module => 'Koha::Patron::Modifications',
1633 singular => 'patron_modification',
1634 plural => 'patron_modifications',
1635 fk => 'verification_token',
1639 foreach my $table ( keys %$tables ) {
1640 next unless $config->{$table};
1642 my $ref = ref( $tables->{$table} ) || q{};
1643 my $module = $config->{$table}->{module};
1645 if ( can_load( modules => { $module => undef } ) ) {
1646 my $pk = $config->{$table}->{pk};
1647 my $fk = $config->{$table}->{fk};
1650 my $values = $tables->{$table} || [];
1651 unless ( ref( $values ) eq 'ARRAY' ) {
1652 croak "ERROR processing table $table. Wrong API call.";
1654 my $key = $pk ? $pk : $fk;
1655 # $key does not come from user input
1656 my $objects = $module->search(
1657 { $key => $values },
1659 # We want to retrieve the data in the same order
1661 # field is a MySQLism, but they are no other way to do it
1662 # To be generic we could do it in perl, but we will need to fetch
1663 # all the data then order them
1664 @$values ? ( order_by => \[ "field($key, " . join( ', ', @$values ) . ")" ] ) : ()
1667 $params->{ $config->{$table}->{plural} } = $objects;
1669 elsif ( $ref eq q{} || $ref eq 'HASH' ) {
1670 my $id = ref $ref eq 'HASH' ? $tables->{$table}->{$pk} : $tables->{$table};
1672 if ( $fk ) { # Using a foreign key for lookup
1673 if ( ref( $fk ) eq 'ARRAY' ) { # Foreign key is multi-column
1675 foreach my $key ( @$fk ) {
1676 $search->{$key} = $id->{$key};
1678 $object = $module->search( $search )->last();
1679 } else { # Foreign key is single column
1680 $object = $module->search( { $fk => $id } )->last();
1682 } else { # using the table's primary key for lookup
1683 $object = $module->find($id);
1685 $params->{ $config->{$table}->{singular} } = $object;
1687 else { # $ref eq 'ARRAY'
1689 if ( @{ $tables->{$table} } == 1 ) { # Param is a single key
1690 $object = $module->search( { $pk => $tables->{$table} } )->last();
1692 else { # Params are mutliple foreign keys
1693 croak "Multiple foreign keys (table $table) should be passed using an hashref";
1695 $params->{ $config->{$table}->{singular} } = $object;
1699 croak "ERROR LOADING MODULE $module: $Module::Load::Conditional::ERROR";
1703 $params->{today} = output_pref({ dt => dt_from_string, dateformat => 'iso' });
1708 =head3 add_tt_filters
1710 $content = add_tt_filters( $content );
1712 Add TT filters to some specific fields if needed.
1714 For now we only add the Remove_MARC_punctuation TT filter to biblio and biblioitem fields
1718 sub add_tt_filters {
1719 my ( $content ) = @_;
1720 $content =~ s|\[%\s*biblio\.(.*?)\s*%\]|[% biblio.$1 \| \$Remove_MARC_punctuation %]|gxms;
1721 $content =~ s|\[%\s*biblioitem\.(.*?)\s*%\]|[% biblioitem.$1 \| \$Remove_MARC_punctuation %]|gxms;
1725 =head2 get_item_content
1727 my $item = Koha::Items->find(...)->unblessed;
1728 my @item_content_fields = qw( date_due title barcode author itemnumber );
1729 my $item_content = C4::Letters::get_item_content({
1731 item_content_fields => \@item_content_fields
1734 This function generates a tab-separated list of values for the passed item. Dates
1735 are formatted following the current setup.
1739 sub get_item_content {
1740 my ( $params ) = @_;
1741 my $item = $params->{item};
1742 my $dateonly = $params->{dateonly} || 0;
1743 my $item_content_fields = $params->{item_content_fields} || [];
1745 return unless $item;
1747 my @item_info = map {
1751 { dt => dt_from_string( $item->{$_} ), dateonly => $dateonly } );
1755 } @$item_content_fields;
1756 return join( "\t", @item_info ) . "\n";