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 );
43 use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
49 &GetLetters &GetLettersAvailableForALibrary &GetLetterTemplates &DelLetter &GetPreparedLetter &GetWrappedLetter &addalert &getalert &delalert &findrelatedto &SendAlerts &GetPrintMessages &GetMessageTransportTypes
55 C4::Letters - Give functions for Letters management
63 "Letters" is the tool used in Koha to manage informations sent to the patrons and/or the library. This include some cron jobs like
64 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)
66 Letters are managed through "alerts" sent by Koha on some events. All "alert" related functions are in this module too.
68 =head2 GetLetters([$module])
70 $letters = &GetLetters($module);
71 returns informations about letters.
72 if needed, $module filters for letters given module
78 my $module = $filters->{module};
79 my $code = $filters->{code};
80 my $branchcode = $filters->{branchcode};
81 my $dbh = C4::Context->dbh;
82 my $letters = $dbh->selectall_arrayref(
84 SELECT module, code, branchcode, name
88 . ( $module ? q| AND module = ?| : q|| )
89 . ( $code ? q| AND code = ?| : q|| )
90 . ( defined $branchcode ? q| AND branchcode = ?| : q|| )
91 . q| GROUP BY code ORDER BY name|, { Slice => {} }
92 , ( $module ? $module : () )
93 , ( $code ? $code : () )
94 , ( defined $branchcode ? $branchcode : () )
100 =head2 GetLetterTemplates
102 my $letter_templates = GetLetterTemplates(
104 module => 'circulation',
106 branchcode => 'CPL', # '' for default,
110 Return a hashref of letter templates.
114 sub GetLetterTemplates {
117 my $module = $params->{module};
118 my $code = $params->{code};
119 my $branchcode = $params->{branchcode} // '';
120 my $dbh = C4::Context->dbh;
121 my $letters = $dbh->selectall_arrayref(
123 SELECT module, code, branchcode, name, is_html, title, content, message_transport_type, lang
130 , $module, $code, $branchcode
136 =head2 GetLettersAvailableForALibrary
138 my $letters = GetLettersAvailableForALibrary(
140 branchcode => 'CPL', # '' for default
141 module => 'circulation',
145 Return an arrayref of letters, sorted by name.
146 If a specific letter exist for the given branchcode, it will be retrieve.
147 Otherwise the default letter will be.
151 sub GetLettersAvailableForALibrary {
153 my $branchcode = $filters->{branchcode};
154 my $module = $filters->{module};
156 croak "module should be provided" unless $module;
158 my $dbh = C4::Context->dbh;
159 my $default_letters = $dbh->selectall_arrayref(
161 SELECT module, code, branchcode, name
165 . q| AND branchcode = ''|
166 . ( $module ? q| AND module = ?| : q|| )
167 . q| ORDER BY name|, { Slice => {} }
168 , ( $module ? $module : () )
171 my $specific_letters;
173 $specific_letters = $dbh->selectall_arrayref(
175 SELECT module, code, branchcode, name
179 . q| AND branchcode = ?|
180 . ( $module ? q| AND module = ?| : q|| )
181 . q| ORDER BY name|, { Slice => {} }
183 , ( $module ? $module : () )
188 for my $l (@$default_letters) {
189 $letters{ $l->{code} } = $l;
191 for my $l (@$specific_letters) {
192 # Overwrite the default letter with the specific one.
193 $letters{ $l->{code} } = $l;
196 return [ map { $letters{$_} }
197 sort { $letters{$a}->{name} cmp $letters{$b}->{name} }
203 my ( $module, $code, $branchcode, $message_transport_type, $lang) = @_;
204 $message_transport_type //= '%';
205 $lang = 'default' unless( $lang && C4::Context->preference('TranslateNotices') );
208 my $only_my_library = C4::Context->only_my_library;
209 if ( $only_my_library and $branchcode ) {
210 $branchcode = C4::Context::mybranch();
214 my $dbh = C4::Context->dbh;
215 my $sth = $dbh->prepare(q{
218 WHERE module=? AND code=? AND (branchcode = ? OR branchcode = '')
219 AND message_transport_type LIKE ?
221 ORDER BY branchcode DESC LIMIT 1
223 $sth->execute( $module, $code, $branchcode, $message_transport_type, $lang );
224 my $line = $sth->fetchrow_hashref
226 $line->{'content-type'} = 'text/html; charset="UTF-8"' if $line->{is_html};
236 module => 'circulation',
242 Delete the letter. The mtt parameter is facultative.
243 If not given, all templates mathing the other parameters will be removed.
249 my $branchcode = $params->{branchcode};
250 my $module = $params->{module};
251 my $code = $params->{code};
252 my $mtt = $params->{mtt};
253 my $lang = $params->{lang};
254 my $dbh = C4::Context->dbh;
261 . ( $mtt ? q| AND message_transport_type = ?| : q|| )
262 . ( $lang? q| AND lang = ?| : q|| )
263 , undef, $branchcode, $module, $code, ( $mtt ? $mtt : () ), ( $lang ? $lang : () ) );
266 =head2 addalert ($borrowernumber, $type, $externalid)
269 - $borrowernumber : the number of the borrower subscribing to the alert
270 - $type : the type of alert.
271 - $externalid : the primary key of the object to put alert on. For issues, the alert is made on subscriptionid.
273 create an alert and return the alertid (primary key)
278 my ( $borrowernumber, $type, $externalid ) = @_;
279 my $dbh = C4::Context->dbh;
282 "insert into alert (borrowernumber, type, externalid) values (?,?,?)");
283 $sth->execute( $borrowernumber, $type, $externalid );
285 # get the alert number newly created and return it
286 my $alertid = $dbh->{'mysql_insertid'};
290 =head2 delalert ($alertid)
293 - alertid : the alert id
299 my $alertid = shift or die "delalert() called without valid argument (alertid)"; # it's gonna die anyway.
300 $debug and warn "delalert: deleting alertid $alertid";
301 my $sth = C4::Context->dbh->prepare("delete from alert where alertid=?");
302 $sth->execute($alertid);
305 =head2 getalert ([$borrowernumber], [$type], [$externalid])
308 - $borrowernumber : the number of the borrower subscribing to the alert
309 - $type : the type of alert.
310 - $externalid : the primary key of the object to put alert on. For issues, the alert is made on subscriptionid.
311 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.
316 my ( $borrowernumber, $type, $externalid ) = @_;
317 my $dbh = C4::Context->dbh;
318 my $query = "SELECT a.*, b.branchcode FROM alert a JOIN borrowers b USING(borrowernumber) WHERE 1";
320 if ($borrowernumber and $borrowernumber =~ /^\d+$/) {
321 $query .= " AND borrowernumber=?";
322 push @bind, $borrowernumber;
325 $query .= " AND type=?";
329 $query .= " AND externalid=?";
330 push @bind, $externalid;
332 my $sth = $dbh->prepare($query);
333 $sth->execute(@bind);
334 return $sth->fetchall_arrayref({});
337 =head2 findrelatedto($type, $externalid)
340 - $type : the type of alert
341 - $externalid : the id of the "object" to query
343 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.
344 When type=issue, the id is related to a subscriptionid and this sub returns the name of the biblio.
349 # When type=virtual, the id is related to a virtual shelf and this sub returns the name of the sub
352 my $type = shift or return;
353 my $externalid = shift or return;
354 my $q = ($type eq 'issue' ) ?
355 "select title as result from subscription left join biblio on subscription.biblionumber=biblio.biblionumber where subscriptionid=?" :
356 ($type eq 'borrower') ?
357 "select concat(firstname,' ',surname) from borrowers where borrowernumber=?" : undef;
359 warn "findrelatedto(): Illegal type '$type'";
362 my $sth = C4::Context->dbh->prepare($q);
363 $sth->execute($externalid);
364 my ($result) = $sth->fetchrow;
370 my $err = &SendAlerts($type, $externalid, $letter_code);
373 - $type : the type of alert
374 - $externalid : the id of the "object" to query
375 - $letter_code : the notice template to use
377 C<&SendAlerts> sends an email notice directly to a patron or a vendor.
379 Currently it supports ($type):
380 - claim serial issues (claimissues)
381 - claim acquisition orders (claimacquisition)
382 - send acquisition orders to the vendor (orderacquisition)
383 - notify patrons about newly received serial issues (issue)
384 - notify patrons when their account is created (members)
386 Returns undef or { error => 'message } on failure.
387 Returns true on success.
392 my ( $type, $externalid, $letter_code ) = @_;
393 my $dbh = C4::Context->dbh;
394 if ( $type eq 'issue' ) {
396 # prepare the letter...
397 # search the subscriptionid
400 "SELECT subscriptionid FROM serial WHERE serialid=?");
401 $sth->execute($externalid);
402 my ($subscriptionid) = $sth->fetchrow
403 or warn( "No subscription for '$externalid'" ),
406 # search the biblionumber
409 "SELECT biblionumber FROM subscription WHERE subscriptionid=?");
410 $sth->execute($subscriptionid);
411 my ($biblionumber) = $sth->fetchrow
412 or warn( "No biblionumber for '$subscriptionid'" ),
416 # find the list of borrowers to alert
417 my $alerts = getalert( '', 'issue', $subscriptionid );
419 my $patron = Koha::Patrons->find( $_->{borrowernumber} );
420 next unless $patron; # Just in case
421 my $email = $patron->email or next;
423 # warn "sending issues...";
424 my $userenv = C4::Context->userenv;
425 my $library = Koha::Libraries->find( $_->{branchcode} );
426 my $letter = GetPreparedLetter (
428 letter_code => $letter_code,
429 branchcode => $userenv->{branch},
431 'branches' => $_->{branchcode},
432 'biblio' => $biblionumber,
433 'biblioitems' => $biblionumber,
434 'borrowers' => $patron->unblessed,
435 'subscription' => $subscriptionid,
436 'serial' => $externalid,
442 my $message = Koha::Email->new();
443 my %mail = $message->create_message_headers(
446 from => $library->branchemail,
447 replyto => $library->branchreplyto,
448 sender => $library->branchreturnpath,
449 subject => Encode::encode( "UTF-8", "" . $letter->{title} ),
450 message => $letter->{'is_html'}
451 ? _wrap_html( Encode::encode( "UTF-8", $letter->{'content'} ),
452 Encode::encode( "UTF-8", "" . $letter->{'title'} ))
453 : Encode::encode( "UTF-8", "" . $letter->{'content'} ),
454 contenttype => $letter->{'is_html'}
455 ? 'text/html; charset="utf-8"'
456 : 'text/plain; charset="utf-8"',
459 unless( Mail::Sendmail::sendmail(%mail) ) {
460 carp $Mail::Sendmail::error;
461 return { error => $Mail::Sendmail::error };
465 elsif ( $type eq 'claimacquisition' or $type eq 'claimissues' or $type eq 'orderacquisition' ) {
467 # prepare the letter...
472 if ( $type eq 'claimacquisition') {
474 SELECT aqorders.*,aqbasket.*,biblio.*,biblioitems.*
476 LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno
477 LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
478 LEFT JOIN biblioitems ON aqorders.biblionumber=biblioitems.biblionumber
479 WHERE aqorders.ordernumber IN (
483 carp "No order selected";
484 return { error => "no_order_selected" };
486 $strsth .= join( ",", ('?') x @$externalid ) . ")";
487 $action = "ACQUISITION CLAIM";
488 $sthorders = $dbh->prepare($strsth);
489 $sthorders->execute( @$externalid );
490 $dataorders = $sthorders->fetchall_arrayref( {} );
493 if ($type eq 'claimissues') {
495 SELECT serial.*,subscription.*, biblio.*, biblioitems.*, aqbooksellers.*,
496 aqbooksellers.id AS booksellerid
498 LEFT JOIN subscription ON serial.subscriptionid=subscription.subscriptionid
499 LEFT JOIN biblio ON serial.biblionumber=biblio.biblionumber
500 LEFT JOIN biblioitems ON serial.biblionumber = biblioitems.biblionumber
501 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id
502 WHERE serial.serialid IN (
506 carp "No issues selected";
507 return { error => "no_issues_selected" };
510 $strsth .= join( ",", ('?') x @$externalid ) . ")";
511 $action = "SERIAL CLAIM";
512 $sthorders = $dbh->prepare($strsth);
513 $sthorders->execute( @$externalid );
514 $dataorders = $sthorders->fetchall_arrayref( {} );
517 if ( $type eq 'orderacquisition') {
519 SELECT aqorders.*,aqbasket.*,biblio.*,biblioitems.*
521 LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno
522 LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
523 LEFT JOIN biblioitems ON aqorders.biblionumber=biblioitems.biblionumber
524 WHERE aqbasket.basketno = ?
525 AND orderstatus IN ('new','ordered')
529 carp "No basketnumber given";
530 return { error => "no_basketno" };
532 $action = "ACQUISITION ORDER";
533 $sthorders = $dbh->prepare($strsth);
534 $sthorders->execute($externalid);
535 $dataorders = $sthorders->fetchall_arrayref( {} );
539 $dbh->prepare("select * from aqbooksellers where id=?");
540 $sthbookseller->execute( $dataorders->[0]->{booksellerid} );
541 my $databookseller = $sthbookseller->fetchrow_hashref;
543 my $addressee = $type eq 'claimacquisition' || $type eq 'orderacquisition' ? 'acqprimary' : 'serialsprimary';
546 $dbh->prepare("SELECT * FROM aqcontacts WHERE booksellerid=? AND $type=1 ORDER BY $addressee DESC");
547 $sthcontact->execute( $dataorders->[0]->{booksellerid} );
548 my $datacontact = $sthcontact->fetchrow_hashref;
552 push @email, $databookseller->{bookselleremail} if $databookseller->{bookselleremail};
553 push @email, $datacontact->{email} if ( $datacontact && $datacontact->{email} );
555 warn "Bookseller $dataorders->[0]->{booksellerid} without emails";
556 return { error => "no_email" };
559 while ($addlcontact = $sthcontact->fetchrow_hashref) {
560 push @cc, $addlcontact->{email} if ( $addlcontact && $addlcontact->{email} );
563 my $userenv = C4::Context->userenv;
564 my $letter = GetPreparedLetter (
566 letter_code => $letter_code,
567 branchcode => $userenv->{branch},
569 'branches' => $userenv->{branch},
570 'aqbooksellers' => $databookseller,
571 'aqcontacts' => $datacontact,
573 repeat => $dataorders,
575 ) or return { error => "no_letter" };
577 # Remove the order tag
578 $letter->{content} =~ s/<order>(.*?)<\/order>/$1/gxms;
581 my $library = Koha::Libraries->find( $userenv->{branch} );
583 To => join( ',', @email),
584 Cc => join( ',', @cc),
585 From => $library->branchemail || C4::Context->preference('KohaAdminEmailAddress'),
586 Subject => Encode::encode( "UTF-8", "" . $letter->{title} ),
587 Message => $letter->{'is_html'}
588 ? _wrap_html( Encode::encode( "UTF-8", $letter->{'content'} ),
589 Encode::encode( "UTF-8", "" . $letter->{'title'} ))
590 : Encode::encode( "UTF-8", "" . $letter->{'content'} ),
591 'Content-Type' => $letter->{'is_html'}
592 ? 'text/html; charset="utf-8"'
593 : 'text/plain; charset="utf-8"',
596 if ($type eq 'claimacquisition' || $type eq 'claimissues' ) {
597 $mail{'Reply-to'} = C4::Context->preference('ReplytoDefault')
598 if C4::Context->preference('ReplytoDefault');
599 $mail{'Sender'} = C4::Context->preference('ReturnpathDefault')
600 if C4::Context->preference('ReturnpathDefault');
601 $mail{'Bcc'} = $userenv->{emailaddress}
602 if C4::Context->preference("ClaimsBccCopy");
605 unless ( Mail::Sendmail::sendmail(%mail) ) {
606 carp $Mail::Sendmail::error;
607 return { error => $Mail::Sendmail::error };
615 . join( ',', @email )
620 ) if C4::Context->preference("LetterLog");
622 # send an "account details" notice to a newly created user
623 elsif ( $type eq 'members' ) {
624 my $library = Koha::Libraries->find( $externalid->{branchcode} )->unblessed;
625 my $letter = GetPreparedLetter (
627 letter_code => $letter_code,
628 branchcode => $externalid->{'branchcode'},
630 'branches' => $library,
631 'borrowers' => $externalid->{'borrowernumber'},
633 substitute => { 'borrowers.password' => $externalid->{'password'} },
636 return { error => "no_email" } unless $externalid->{'emailaddr'};
637 my $email = Koha::Email->new();
638 my %mail = $email->create_message_headers(
640 to => $externalid->{'emailaddr'},
641 from => $library->{branchemail},
642 replyto => $library->{branchreplyto},
643 sender => $library->{branchreturnpath},
644 subject => Encode::encode( "UTF-8", "" . $letter->{'title'} ),
645 message => $letter->{'is_html'}
646 ? _wrap_html( Encode::encode( "UTF-8", $letter->{'content'} ),
647 Encode::encode( "UTF-8", "" . $letter->{'title'} ) )
648 : Encode::encode( "UTF-8", "" . $letter->{'content'} ),
649 contenttype => $letter->{'is_html'}
650 ? 'text/html; charset="utf-8"'
651 : 'text/plain; charset="utf-8"',
654 unless( Mail::Sendmail::sendmail(%mail) ) {
655 carp $Mail::Sendmail::error;
656 return { error => $Mail::Sendmail::error };
660 # If we come here, return an OK status
664 =head2 GetPreparedLetter( %params )
667 module => letter module, mandatory
668 letter_code => letter code, mandatory
669 branchcode => for letter selection, if missing default system letter taken
670 tables => a hashref with table names as keys. Values are either:
671 - a scalar - primary key value
672 - an arrayref - primary key values
673 - a hashref - full record
674 substitute => custom substitution key/value pairs
675 repeat => records to be substituted on consecutive lines:
676 - an arrayref - tries to guess what needs substituting by
677 taking remaining << >> tokensr; not recommended
678 - a hashref token => @tables - replaces <token> << >> << >> </token>
679 subtemplate for each @tables row; table is a hashref as above
680 want_librarian => boolean, if set to true triggers librarian details
681 substitution from the userenv
683 letter fields hashref (title & content useful)
687 sub GetPreparedLetter {
690 my $module = $params{module} or croak "No module";
691 my $letter_code = $params{letter_code} or croak "No letter_code";
692 my $branchcode = $params{branchcode} || '';
693 my $mtt = $params{message_transport_type} || 'email';
694 my $lang = $params{lang} || 'default';
696 my $letter = getletter( $module, $letter_code, $branchcode, $mtt, $lang );
699 $letter = getletter( $module, $letter_code, $branchcode, $mtt, 'default' )
700 or warn( "No $module $letter_code letter transported by " . $mtt ),
704 my $tables = $params{tables} || {};
705 my $substitute = $params{substitute} || {};
706 my $loops = $params{loops} || {}; # loops is not supported for historical notices syntax
707 my $repeat = $params{repeat};
708 %$tables || %$substitute || $repeat || %$loops
709 or carp( "ERROR: nothing to substitute - both 'tables', 'loops' and 'substitute' are empty" ),
711 my $want_librarian = $params{want_librarian};
714 while ( my ($token, $val) = each %$substitute ) {
715 if ( $token eq 'items.content' ) {
716 $val =~ s|\n|<br/>|g if $letter->{is_html};
719 $letter->{title} =~ s/<<$token>>/$val/g;
720 $letter->{content} =~ s/<<$token>>/$val/g;
724 my $OPACBaseURL = C4::Context->preference('OPACBaseURL');
725 $letter->{content} =~ s/<<OPACBaseURL>>/$OPACBaseURL/go;
727 if ($want_librarian) {
728 # parsing librarian name
729 my $userenv = C4::Context->userenv;
730 $letter->{content} =~ s/<<LibrarianFirstname>>/$userenv->{firstname}/go;
731 $letter->{content} =~ s/<<LibrarianSurname>>/$userenv->{surname}/go;
732 $letter->{content} =~ s/<<LibrarianEmailaddress>>/$userenv->{emailaddress}/go;
735 my ($repeat_no_enclosing_tags, $repeat_enclosing_tags);
738 if (ref ($repeat) eq 'ARRAY' ) {
739 $repeat_no_enclosing_tags = $repeat;
741 $repeat_enclosing_tags = $repeat;
745 if ($repeat_enclosing_tags) {
746 while ( my ($tag, $tag_tables) = each %$repeat_enclosing_tags ) {
747 if ( $letter->{content} =~ m!<$tag>(.*)</$tag>!s ) {
750 my %subletter = ( title => '', content => $subcontent );
751 _substitute_tables( \%subletter, $_ );
754 $letter->{content} =~ s!<$tag>.*</$tag>!join( "\n", @lines )!se;
760 _substitute_tables( $letter, $tables );
763 if ($repeat_no_enclosing_tags) {
764 if ( $letter->{content} =~ m/[^\n]*<<.*>>[^\n]*/so ) {
769 $c =~ s/<<count>>/$i/go;
770 foreach my $field ( keys %{$_} ) {
771 $c =~ s/(<<[^\.]+.$field>>)/$_->{$field}/;
775 } @$repeat_no_enclosing_tags;
777 my $replaceby = join( "\n", @lines );
778 $letter->{content} =~ s/\Q$line\E/$replaceby/s;
782 $letter->{content} = _process_tt(
784 content => $letter->{content},
787 substitute => $substitute,
791 $letter->{content} =~ s/<<\S*>>//go; #remove any stragglers
796 sub _substitute_tables {
797 my ( $letter, $tables ) = @_;
798 while ( my ($table, $param) = each %$tables ) {
801 my $ref = ref $param;
804 if ($ref && $ref eq 'HASH') {
808 my $sth = _parseletter_sth($table);
810 warn "_parseletter_sth('$table') failed to return a valid sth. No substitution will be done for that table.";
813 $sth->execute( $ref ? @$param : $param );
815 $values = $sth->fetchrow_hashref;
819 _parseletter ( $letter, $table, $values );
823 sub _parseletter_sth {
827 carp "ERROR: _parseletter_sth() called without argument (table)";
830 # NOTE: we used to check whether we had a statement handle cached in
831 # a %handles module-level variable. This was a dumb move and
832 # broke things for the rest of us. prepare_cached is a better
833 # way to cache statement handles anyway.
835 ($table eq 'biblio' ) ? "SELECT * FROM $table WHERE biblionumber = ?" :
836 ($table eq 'biblioitems' ) ? "SELECT * FROM $table WHERE biblionumber = ?" :
837 ($table eq 'items' ) ? "SELECT * FROM $table WHERE itemnumber = ?" :
838 ($table eq 'issues' ) ? "SELECT * FROM $table WHERE itemnumber = ?" :
839 ($table eq 'old_issues' ) ? "SELECT * FROM $table WHERE itemnumber = ? ORDER BY timestamp DESC LIMIT 1" :
840 ($table eq 'reserves' ) ? "SELECT * FROM $table WHERE borrowernumber = ? and biblionumber = ?" :
841 ($table eq 'borrowers' ) ? "SELECT * FROM $table WHERE borrowernumber = ?" :
842 ($table eq 'branches' ) ? "SELECT * FROM $table WHERE branchcode = ?" :
843 ($table eq 'suggestions' ) ? "SELECT * FROM $table WHERE suggestionid = ?" :
844 ($table eq 'aqbooksellers') ? "SELECT * FROM $table WHERE id = ?" :
845 ($table eq 'aqorders' ) ? "SELECT * FROM $table WHERE ordernumber = ?" :
846 ($table eq 'opac_news' ) ? "SELECT * FROM $table WHERE idnew = ?" :
847 ($table eq 'article_requests') ? "SELECT * FROM $table WHERE id = ?" :
848 ($table eq 'borrower_modifications') ? "SELECT * FROM $table WHERE verification_token = ?" :
849 ($table eq 'subscription') ? "SELECT * FROM $table WHERE subscriptionid = ?" :
850 ($table eq 'serial') ? "SELECT * FROM $table WHERE serialid = ?" :
853 warn "ERROR: No _parseletter_sth query for table '$table'";
854 return; # nothing to get
856 unless ($sth = C4::Context->dbh->prepare_cached($query)) {
857 warn "ERROR: Failed to prepare query: '$query'";
860 return $sth; # now cache is populated for that $table
863 =head2 _parseletter($letter, $table, $values)
866 - $letter : a hash to letter fields (title & content useful)
867 - $table : the Koha table to parse.
868 - $values_in : table record hashref
869 parse all fields from a table, and replace values in title & content with the appropriate value
870 (not exported sub, used only internally)
875 my ( $letter, $table, $values_in ) = @_;
877 # Work on a local copy of $values_in (passed by reference) to avoid side effects
878 # in callers ( by changing / formatting values )
879 my $values = $values_in ? { %$values_in } : {};
881 if ( $table eq 'borrowers' && $values->{'dateexpiry'} ){
882 $values->{'dateexpiry'} = format_sqldatetime( $values->{'dateexpiry'} );
885 if ( $table eq 'reserves' && $values->{'waitingdate'} ) {
886 $values->{'waitingdate'} = output_pref({ dt => dt_from_string( $values->{'waitingdate'} ), dateonly => 1 });
889 if ($letter->{content} && $letter->{content} =~ /<<today>>/) {
890 my $todaysdate = output_pref( DateTime->now() );
891 $letter->{content} =~ s/<<today>>/$todaysdate/go;
894 while ( my ($field, $val) = each %$values ) {
895 $val =~ s/\p{P}$// if $val && $table=~/biblio/;
896 #BZ 9886: Assuming that we want to eliminate ISBD punctuation here
897 #Therefore adding the test on biblio. This includes biblioitems,
898 #but excludes items. Removed unneeded global and lookahead.
900 if ( $table=~/^borrowers$/ && $field=~/^streettype$/ ) {
901 my $av = Koha::AuthorisedValues->search({ category => 'ROADTYPE', authorised_value => $val });
902 $val = $av->count ? $av->next->lib : '';
906 my $replacedby = defined ($val) ? $val : '';
908 and not $replacedby =~ m|0000-00-00|
909 and not $replacedby =~ m|9999-12-31|
910 and $replacedby =~ m|^\d{4}-\d{2}-\d{2}( \d{2}:\d{2}:\d{2})?$| )
912 # If the value is XXXX-YY-ZZ[ AA:BB:CC] we assume it is a date
913 my $dateonly = defined $1 ? 0 : 1; #$1 refers to the capture group wrapped in parentheses. In this case, that's the hours, minutes, seconds.
914 my $re_dateonly_filter = qr{ $field( \s* \| \s* dateonly\s*)?>> }xms;
916 for my $letter_field ( qw( title content ) ) {
917 my $filter_string_used = q{};
918 if ( $letter->{ $letter_field } =~ $re_dateonly_filter ) {
919 # We overwrite $dateonly if the filter exists and we have a time in the datetime
920 $filter_string_used = $1 || q{};
921 $dateonly = $1 unless $dateonly;
923 my $replacedby_date = eval {
924 output_pref({ dt => dt_from_string( $replacedby ), dateonly => $dateonly });
927 if ( $letter->{ $letter_field } ) {
928 $letter->{ $letter_field } =~ s/\Q<<$table.$field$filter_string_used>>\E/$replacedby_date/g;
929 $letter->{ $letter_field } =~ s/\Q<<$field$filter_string_used>>\E/$replacedby_date/g;
933 # Other fields replacement
935 for my $letter_field ( qw( title content ) ) {
936 if ( $letter->{ $letter_field } ) {
937 $letter->{ $letter_field } =~ s/<<$table.$field>>/$replacedby/g;
938 $letter->{ $letter_field } =~ s/<<$field>>/$replacedby/g;
944 if ($table eq 'borrowers' && $letter->{content}) {
945 if ( my $attributes = GetBorrowerAttributes($values->{borrowernumber}) ) {
947 foreach (@$attributes) {
948 my $code = $_->{code};
949 my $val = $_->{value_description} || $_->{value};
950 $val =~ s/\p{P}(?=$)//g if $val;
951 next unless $val gt '';
953 push @{ $attr{$code} }, $val;
955 while ( my ($code, $val_ar) = each %attr ) {
956 my $replacefield = "<<borrower-attribute:$code>>";
957 my $replacedby = join ',', @$val_ar;
958 $letter->{content} =~ s/$replacefield/$replacedby/g;
967 my $success = EnqueueLetter( { letter => $letter,
968 borrowernumber => '12', message_transport_type => 'email' } )
970 places a letter in the message_queue database table, which will
971 eventually get processed (sent) by the process_message_queue.pl
972 cronjob when it calls SendQueuedMessages.
974 return message_id on success
979 my $params = shift or return;
981 return unless exists $params->{'letter'};
982 # return unless exists $params->{'borrowernumber'};
983 return unless exists $params->{'message_transport_type'};
985 my $content = $params->{letter}->{content};
986 $content =~ s/\s+//g if(defined $content);
987 if ( not defined $content or $content eq '' ) {
988 warn "Trying to add an empty message to the message queue" if $debug;
992 # If we have any attachments we should encode then into the body.
993 if ( $params->{'attachments'} ) {
994 $params->{'letter'} = _add_attachments(
995 { letter => $params->{'letter'},
996 attachments => $params->{'attachments'},
997 message => MIME::Lite->new( Type => 'multipart/mixed' ),
1002 my $dbh = C4::Context->dbh();
1003 my $statement = << 'ENDSQL';
1004 INSERT INTO message_queue
1005 ( borrowernumber, subject, content, metadata, letter_code, message_transport_type, status, time_queued, to_address, from_address, content_type )
1007 ( ?, ?, ?, ?, ?, ?, ?, NOW(), ?, ?, ? )
1010 my $sth = $dbh->prepare($statement);
1011 my $result = $sth->execute(
1012 $params->{'borrowernumber'}, # borrowernumber
1013 $params->{'letter'}->{'title'}, # subject
1014 $params->{'letter'}->{'content'}, # content
1015 $params->{'letter'}->{'metadata'} || '', # metadata
1016 $params->{'letter'}->{'code'} || '', # letter_code
1017 $params->{'message_transport_type'}, # message_transport_type
1019 $params->{'to_address'}, # to_address
1020 $params->{'from_address'}, # from_address
1021 $params->{'letter'}->{'content-type'}, # content_type
1023 return $dbh->last_insert_id(undef,undef,'message_queue', undef);
1026 =head2 SendQueuedMessages ([$hashref])
1028 my $sent = SendQueuedMessages({
1029 letter_code => $letter_code,
1030 borrowernumber => $who_letter_is_for,
1036 Sends all of the 'pending' items in the message queue, unless
1037 parameters are passed.
1039 The letter_code, borrowernumber and limit parameters are used
1040 to build a parameter set for _get_unsent_messages, thus limiting
1041 which pending messages will be processed. They are all optional.
1043 The verbose parameter can be used to generate debugging output.
1044 It is also optional.
1046 Returns number of messages sent.
1050 sub SendQueuedMessages {
1053 my $which_unsent_messages = {
1054 'limit' => $params->{'limit'} // 0,
1055 'borrowernumber' => $params->{'borrowernumber'} // q{},
1056 'letter_code' => $params->{'letter_code'} // q{},
1057 'type' => $params->{'type'} // q{},
1059 my $unsent_messages = _get_unsent_messages( $which_unsent_messages );
1060 MESSAGE: foreach my $message ( @$unsent_messages ) {
1061 my $message_object = Koha::Notice::Messages->find( $message->{message_id} );
1062 # If this fails the database is unwritable and we won't manage to send a message that continues to be marked 'pending'
1063 $message_object->make_column_dirty('status');
1064 return unless $message_object->store;
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 = C4::Members::GetNoticeEmailAddress( $message->{'borrowernumber'} );
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";