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( 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 ( 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( 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 $module = $params{module} or croak "No module";
692 my $letter_code = $params{letter_code} or croak "No letter_code";
693 my $branchcode = $params{branchcode} || '';
694 my $mtt = $params{message_transport_type} || 'email';
695 my $lang = $params{lang} || 'default';
697 my $letter = getletter( $module, $letter_code, $branchcode, $mtt, $lang );
700 $letter = getletter( $module, $letter_code, $branchcode, $mtt, 'default' )
701 or warn( "No $module $letter_code letter transported by " . $mtt ),
705 my $tables = $params{tables} || {};
706 my $substitute = $params{substitute} || {};
707 my $loops = $params{loops} || {}; # loops is not supported for historical notices syntax
708 my $repeat = $params{repeat};
709 %$tables || %$substitute || $repeat || %$loops
710 or carp( "ERROR: nothing to substitute - both 'tables', 'loops' and 'substitute' are empty" ),
712 my $want_librarian = $params{want_librarian};
715 while ( my ($token, $val) = each %$substitute ) {
716 if ( $token eq 'items.content' ) {
717 $val =~ s|\n|<br/>|g if $letter->{is_html};
720 $letter->{title} =~ s/<<$token>>/$val/g;
721 $letter->{content} =~ s/<<$token>>/$val/g;
725 my $OPACBaseURL = C4::Context->preference('OPACBaseURL');
726 $letter->{content} =~ s/<<OPACBaseURL>>/$OPACBaseURL/go;
728 if ($want_librarian) {
729 # parsing librarian name
730 my $userenv = C4::Context->userenv;
731 $letter->{content} =~ s/<<LibrarianFirstname>>/$userenv->{firstname}/go;
732 $letter->{content} =~ s/<<LibrarianSurname>>/$userenv->{surname}/go;
733 $letter->{content} =~ s/<<LibrarianEmailaddress>>/$userenv->{emailaddress}/go;
736 my ($repeat_no_enclosing_tags, $repeat_enclosing_tags);
739 if (ref ($repeat) eq 'ARRAY' ) {
740 $repeat_no_enclosing_tags = $repeat;
742 $repeat_enclosing_tags = $repeat;
746 if ($repeat_enclosing_tags) {
747 while ( my ($tag, $tag_tables) = each %$repeat_enclosing_tags ) {
748 if ( $letter->{content} =~ m!<$tag>(.*)</$tag>!s ) {
751 my %subletter = ( title => '', content => $subcontent );
752 _substitute_tables( \%subletter, $_ );
755 $letter->{content} =~ s!<$tag>.*</$tag>!join( "\n", @lines )!se;
761 _substitute_tables( $letter, $tables );
764 if ($repeat_no_enclosing_tags) {
765 if ( $letter->{content} =~ m/[^\n]*<<.*>>[^\n]*/so ) {
770 $c =~ s/<<count>>/$i/go;
771 foreach my $field ( keys %{$_} ) {
772 $c =~ s/(<<[^\.]+.$field>>)/$_->{$field}/;
776 } @$repeat_no_enclosing_tags;
778 my $replaceby = join( "\n", @lines );
779 $letter->{content} =~ s/\Q$line\E/$replaceby/s;
783 $letter->{content} = _process_tt(
785 content => $letter->{content},
788 substitute => $substitute,
792 $letter->{content} =~ s/<<\S*>>//go; #remove any stragglers
797 sub _substitute_tables {
798 my ( $letter, $tables ) = @_;
799 while ( my ($table, $param) = each %$tables ) {
802 my $ref = ref $param;
805 if ($ref && $ref eq 'HASH') {
809 my $sth = _parseletter_sth($table);
811 warn "_parseletter_sth('$table') failed to return a valid sth. No substitution will be done for that table.";
814 $sth->execute( $ref ? @$param : $param );
816 $values = $sth->fetchrow_hashref;
820 _parseletter ( $letter, $table, $values );
824 sub _parseletter_sth {
828 carp "ERROR: _parseletter_sth() called without argument (table)";
831 # NOTE: we used to check whether we had a statement handle cached in
832 # a %handles module-level variable. This was a dumb move and
833 # broke things for the rest of us. prepare_cached is a better
834 # way to cache statement handles anyway.
836 ($table eq 'biblio' ) ? "SELECT * FROM $table WHERE biblionumber = ?" :
837 ($table eq 'biblioitems' ) ? "SELECT * FROM $table WHERE biblionumber = ?" :
838 ($table eq 'items' ) ? "SELECT * FROM $table WHERE itemnumber = ?" :
839 ($table eq 'issues' ) ? "SELECT * FROM $table WHERE itemnumber = ?" :
840 ($table eq 'old_issues' ) ? "SELECT * FROM $table WHERE itemnumber = ? ORDER BY timestamp DESC LIMIT 1" :
841 ($table eq 'reserves' ) ? "SELECT * FROM $table WHERE borrowernumber = ? and biblionumber = ?" :
842 ($table eq 'borrowers' ) ? "SELECT * FROM $table WHERE borrowernumber = ?" :
843 ($table eq 'branches' ) ? "SELECT * FROM $table WHERE branchcode = ?" :
844 ($table eq 'suggestions' ) ? "SELECT * FROM $table WHERE suggestionid = ?" :
845 ($table eq 'aqbooksellers') ? "SELECT * FROM $table WHERE id = ?" :
846 ($table eq 'aqorders' ) ? "SELECT * FROM $table WHERE ordernumber = ?" :
847 ($table eq 'opac_news' ) ? "SELECT * FROM $table WHERE idnew = ?" :
848 ($table eq 'article_requests') ? "SELECT * FROM $table WHERE id = ?" :
849 ($table eq 'borrower_modifications') ? "SELECT * FROM $table WHERE verification_token = ?" :
850 ($table eq 'subscription') ? "SELECT * FROM $table WHERE subscriptionid = ?" :
851 ($table eq 'serial') ? "SELECT * FROM $table WHERE serialid = ?" :
854 warn "ERROR: No _parseletter_sth query for table '$table'";
855 return; # nothing to get
857 unless ($sth = C4::Context->dbh->prepare_cached($query)) {
858 warn "ERROR: Failed to prepare query: '$query'";
861 return $sth; # now cache is populated for that $table
864 =head2 _parseletter($letter, $table, $values)
867 - $letter : a hash to letter fields (title & content useful)
868 - $table : the Koha table to parse.
869 - $values_in : table record hashref
870 parse all fields from a table, and replace values in title & content with the appropriate value
871 (not exported sub, used only internally)
876 my ( $letter, $table, $values_in ) = @_;
878 # Work on a local copy of $values_in (passed by reference) to avoid side effects
879 # in callers ( by changing / formatting values )
880 my $values = $values_in ? { %$values_in } : {};
882 if ( $table eq 'borrowers' && $values->{'dateexpiry'} ){
883 $values->{'dateexpiry'} = format_sqldatetime( $values->{'dateexpiry'} );
886 if ( $table eq 'reserves' && $values->{'waitingdate'} ) {
887 $values->{'waitingdate'} = output_pref({ dt => dt_from_string( $values->{'waitingdate'} ), dateonly => 1 });
890 if ($letter->{content} && $letter->{content} =~ /<<today>>/) {
891 my $todaysdate = output_pref( DateTime->now() );
892 $letter->{content} =~ s/<<today>>/$todaysdate/go;
895 while ( my ($field, $val) = each %$values ) {
896 $val =~ s/\p{P}$// if $val && $table=~/biblio/;
897 #BZ 9886: Assuming that we want to eliminate ISBD punctuation here
898 #Therefore adding the test on biblio. This includes biblioitems,
899 #but excludes items. Removed unneeded global and lookahead.
901 if ( $table=~/^borrowers$/ && $field=~/^streettype$/ ) {
902 my $av = Koha::AuthorisedValues->search({ category => 'ROADTYPE', authorised_value => $val });
903 $val = $av->count ? $av->next->lib : '';
907 my $replacedby = defined ($val) ? $val : '';
909 and not $replacedby =~ m|0000-00-00|
910 and not $replacedby =~ m|9999-12-31|
911 and $replacedby =~ m|^\d{4}-\d{2}-\d{2}( \d{2}:\d{2}:\d{2})?$| )
913 # If the value is XXXX-YY-ZZ[ AA:BB:CC] we assume it is a date
914 my $dateonly = defined $1 ? 0 : 1; #$1 refers to the capture group wrapped in parentheses. In this case, that's the hours, minutes, seconds.
915 my $re_dateonly_filter = qr{ $field( \s* \| \s* dateonly\s*)?>> }xms;
917 for my $letter_field ( qw( title content ) ) {
918 my $filter_string_used = q{};
919 if ( $letter->{ $letter_field } =~ $re_dateonly_filter ) {
920 # We overwrite $dateonly if the filter exists and we have a time in the datetime
921 $filter_string_used = $1 || q{};
922 $dateonly = $1 unless $dateonly;
924 my $replacedby_date = eval {
925 output_pref({ dt => dt_from_string( $replacedby ), dateonly => $dateonly });
928 if ( $letter->{ $letter_field } ) {
929 $letter->{ $letter_field } =~ s/\Q<<$table.$field$filter_string_used>>\E/$replacedby_date/g;
930 $letter->{ $letter_field } =~ s/\Q<<$field$filter_string_used>>\E/$replacedby_date/g;
934 # Other fields replacement
936 for my $letter_field ( qw( title content ) ) {
937 if ( $letter->{ $letter_field } ) {
938 $letter->{ $letter_field } =~ s/<<$table.$field>>/$replacedby/g;
939 $letter->{ $letter_field } =~ s/<<$field>>/$replacedby/g;
945 if ($table eq 'borrowers' && $letter->{content}) {
946 if ( my $attributes = GetBorrowerAttributes($values->{borrowernumber}) ) {
948 foreach (@$attributes) {
949 my $code = $_->{code};
950 my $val = $_->{value_description} || $_->{value};
951 $val =~ s/\p{P}(?=$)//g if $val;
952 next unless $val gt '';
954 push @{ $attr{$code} }, $val;
956 while ( my ($code, $val_ar) = each %attr ) {
957 my $replacefield = "<<borrower-attribute:$code>>";
958 my $replacedby = join ',', @$val_ar;
959 $letter->{content} =~ s/$replacefield/$replacedby/g;
968 my $success = EnqueueLetter( { letter => $letter,
969 borrowernumber => '12', message_transport_type => 'email' } )
971 places a letter in the message_queue database table, which will
972 eventually get processed (sent) by the process_message_queue.pl
973 cronjob when it calls SendQueuedMessages.
975 return message_id on success
980 my $params = shift or return;
982 return unless exists $params->{'letter'};
983 # return unless exists $params->{'borrowernumber'};
984 return unless exists $params->{'message_transport_type'};
986 my $content = $params->{letter}->{content};
987 $content =~ s/\s+//g if(defined $content);
988 if ( not defined $content or $content eq '' ) {
989 warn "Trying to add an empty message to the message queue" if $debug;
993 # If we have any attachments we should encode then into the body.
994 if ( $params->{'attachments'} ) {
995 $params->{'letter'} = _add_attachments(
996 { letter => $params->{'letter'},
997 attachments => $params->{'attachments'},
998 message => MIME::Lite->new( Type => 'multipart/mixed' ),
1003 my $dbh = C4::Context->dbh();
1004 my $statement = << 'ENDSQL';
1005 INSERT INTO message_queue
1006 ( borrowernumber, subject, content, metadata, letter_code, message_transport_type, status, time_queued, to_address, from_address, content_type )
1008 ( ?, ?, ?, ?, ?, ?, ?, NOW(), ?, ?, ? )
1011 my $sth = $dbh->prepare($statement);
1012 my $result = $sth->execute(
1013 $params->{'borrowernumber'}, # borrowernumber
1014 $params->{'letter'}->{'title'}, # subject
1015 $params->{'letter'}->{'content'}, # content
1016 $params->{'letter'}->{'metadata'} || '', # metadata
1017 $params->{'letter'}->{'code'} || '', # letter_code
1018 $params->{'message_transport_type'}, # message_transport_type
1020 $params->{'to_address'}, # to_address
1021 $params->{'from_address'}, # from_address
1022 $params->{'letter'}->{'content-type'}, # content_type
1024 return $dbh->last_insert_id(undef,undef,'message_queue', undef);
1027 =head2 SendQueuedMessages ([$hashref])
1029 my $sent = SendQueuedMessages({ verbose => 1, limit => 50 });
1031 Sends all of the 'pending' items in the message queue, unless the optional
1032 limit parameter is passed too. The verbose parameter is also optional.
1034 Returns number of messages sent.
1038 sub SendQueuedMessages {
1041 my $unsent_messages = _get_unsent_messages( { limit => $params->{limit} } );
1042 MESSAGE: foreach my $message ( @$unsent_messages ) {
1043 # warn Data::Dumper->Dump( [ $message ], [ 'message' ] );
1044 warn sprintf( 'sending %s message to patron: %s',
1045 $message->{'message_transport_type'},
1046 $message->{'borrowernumber'} || 'Admin' )
1047 if $params->{'verbose'} or $debug;
1048 # This is just begging for subclassing
1049 next MESSAGE if ( lc($message->{'message_transport_type'}) eq 'rss' );
1050 if ( lc( $message->{'message_transport_type'} ) eq 'email' ) {
1051 _send_message_by_email( $message, $params->{'username'}, $params->{'password'}, $params->{'method'} );
1053 elsif ( lc( $message->{'message_transport_type'} ) eq 'sms' ) {
1054 if ( C4::Context->preference('SMSSendDriver') eq 'Email' ) {
1055 my $patron = Koha::Patrons->find( $message->{borrowernumber} );
1056 my $sms_provider = Koha::SMS::Providers->find( $patron->sms_provider_id );
1057 unless ( $sms_provider ) {
1058 warn sprintf( "Patron %s has no sms provider id set!", $message->{'borrowernumber'} ) if $params->{'verbose'} or $debug;
1059 _set_message_status( { message_id => $message->{'message_id'}, status => 'failed' } );
1062 unless ( $patron->smsalertnumber ) {
1063 _set_message_status( { message_id => $message->{'message_id'}, status => 'failed' } );
1064 warn sprintf( "No smsalertnumber found for patron %s!", $message->{'borrowernumber'} ) if $params->{'verbose'} or $debug;
1067 $message->{to_address} = $patron->smsalertnumber; #Sometime this is set to email - sms should always use smsalertnumber
1068 $message->{to_address} .= '@' . $sms_provider->domain();
1069 _update_message_to_address($message->{'message_id'},$message->{to_address});
1070 _send_message_by_email( $message, $params->{'username'}, $params->{'password'}, $params->{'method'} );
1072 _send_message_by_sms( $message );
1076 return scalar( @$unsent_messages );
1079 =head2 GetRSSMessages
1081 my $message_list = GetRSSMessages( { limit => 10, borrowernumber => '14' } )
1083 returns a listref of all queued RSS messages for a particular person.
1087 sub GetRSSMessages {
1090 return unless $params;
1091 return unless ref $params;
1092 return unless $params->{'borrowernumber'};
1094 return _get_unsent_messages( { message_transport_type => 'rss',
1095 limit => $params->{'limit'},
1096 borrowernumber => $params->{'borrowernumber'}, } );
1099 =head2 GetPrintMessages
1101 my $message_list = GetPrintMessages( { borrowernumber => $borrowernumber } )
1103 Returns a arrayref of all queued print messages (optionally, for a particular
1108 sub GetPrintMessages {
1109 my $params = shift || {};
1111 return _get_unsent_messages( { message_transport_type => 'print',
1112 borrowernumber => $params->{'borrowernumber'},
1116 =head2 GetQueuedMessages ([$hashref])
1118 my $messages = GetQueuedMessage( { borrowernumber => '123', limit => 20 } );
1120 fetches messages out of the message queue.
1123 list of hashes, each has represents a message in the message queue.
1127 sub GetQueuedMessages {
1130 my $dbh = C4::Context->dbh();
1131 my $statement = << 'ENDSQL';
1132 SELECT message_id, borrowernumber, subject, content, message_transport_type, status, time_queued
1138 if ( exists $params->{'borrowernumber'} ) {
1139 push @whereclauses, ' borrowernumber = ? ';
1140 push @query_params, $params->{'borrowernumber'};
1143 if ( @whereclauses ) {
1144 $statement .= ' WHERE ' . join( 'AND', @whereclauses );
1147 if ( defined $params->{'limit'} ) {
1148 $statement .= ' LIMIT ? ';
1149 push @query_params, $params->{'limit'};
1152 my $sth = $dbh->prepare( $statement );
1153 my $result = $sth->execute( @query_params );
1154 return $sth->fetchall_arrayref({});
1157 =head2 GetMessageTransportTypes
1159 my @mtt = GetMessageTransportTypes();
1161 returns an arrayref of transport types
1165 sub GetMessageTransportTypes {
1166 my $dbh = C4::Context->dbh();
1167 my $mtts = $dbh->selectcol_arrayref("
1168 SELECT message_transport_type
1169 FROM message_transport_types
1170 ORDER BY message_transport_type
1177 my $message = C4::Letters::Message($message_id);
1182 my ( $message_id ) = @_;
1183 return unless $message_id;
1184 my $dbh = C4::Context->dbh;
1185 return $dbh->selectrow_hashref(q|
1186 SELECT message_id, borrowernumber, subject, content, metadata, letter_code, message_transport_type, status, time_queued, to_address, from_address, content_type
1188 WHERE message_id = ?
1189 |, {}, $message_id );
1192 =head2 ResendMessage
1194 Attempt to resend a message which has failed previously.
1196 my $has_been_resent = C4::Letters::ResendMessage($message_id);
1198 Updates the message to 'pending' status so that
1199 it will be resent later on.
1201 returns 1 on success, 0 on failure, undef if no message was found
1206 my $message_id = shift;
1207 return unless $message_id;
1209 my $message = GetMessage( $message_id );
1210 return unless $message;
1212 if ( $message->{status} ne 'pending' ) {
1213 $rv = C4::Letters::_set_message_status({
1214 message_id => $message_id,
1215 status => 'pending',
1217 $rv = $rv > 0? 1: 0;
1218 # Clear destination email address to force address update
1219 _update_message_to_address( $message_id, undef ) if $rv &&
1220 $message->{message_transport_type} eq 'email';
1225 =head2 _add_attachements
1228 letter - the standard letter hashref
1229 attachments - listref of attachments. each attachment is a hashref of:
1230 type - the mime type, like 'text/plain'
1231 content - the actual attachment
1232 filename - the name of the attachment.
1233 message - a MIME::Lite object to attach these to.
1235 returns your letter object, with the content updated.
1239 sub _add_attachments {
1242 my $letter = $params->{'letter'};
1243 my $attachments = $params->{'attachments'};
1244 return $letter unless @$attachments;
1245 my $message = $params->{'message'};
1247 # First, we have to put the body in as the first attachment
1249 Type => $letter->{'content-type'} || 'TEXT',
1250 Data => $letter->{'is_html'}
1251 ? _wrap_html($letter->{'content'}, $letter->{'title'})
1252 : $letter->{'content'},
1255 foreach my $attachment ( @$attachments ) {
1257 Type => $attachment->{'type'},
1258 Data => $attachment->{'content'},
1259 Filename => $attachment->{'filename'},
1262 # we're forcing list context here to get the header, not the count back from grep.
1263 ( $letter->{'content-type'} ) = grep( /^Content-Type:/, split( /\n/, $params->{'message'}->header_as_string ) );
1264 $letter->{'content-type'} =~ s/^Content-Type:\s+//;
1265 $letter->{'content'} = $message->body_as_string;
1271 sub _get_unsent_messages {
1274 my $dbh = C4::Context->dbh();
1276 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
1277 FROM message_queue mq
1278 LEFT JOIN borrowers b ON b.borrowernumber = mq.borrowernumber
1282 my @query_params = ('pending');
1283 if ( ref $params ) {
1284 if ( $params->{'message_transport_type'} ) {
1285 $statement .= ' AND message_transport_type = ? ';
1286 push @query_params, $params->{'message_transport_type'};
1288 if ( $params->{'borrowernumber'} ) {
1289 $statement .= ' AND borrowernumber = ? ';
1290 push @query_params, $params->{'borrowernumber'};
1292 if ( $params->{'limit'} ) {
1293 $statement .= ' limit ? ';
1294 push @query_params, $params->{'limit'};
1298 $debug and warn "_get_unsent_messages SQL: $statement";
1299 $debug and warn "_get_unsent_messages params: " . join(',',@query_params);
1300 my $sth = $dbh->prepare( $statement );
1301 my $result = $sth->execute( @query_params );
1302 return $sth->fetchall_arrayref({});
1305 sub _send_message_by_email {
1306 my $message = shift or return;
1307 my ($username, $password, $method) = @_;
1309 my $patron = Koha::Patrons->find( $message->{borrowernumber} );
1310 my $to_address = $message->{'to_address'};
1311 unless ($to_address) {
1313 warn "FAIL: No 'to_address' and INVALID borrowernumber ($message->{borrowernumber})";
1314 _set_message_status( { message_id => $message->{'message_id'},
1315 status => 'failed' } );
1318 $to_address = $patron->notice_email_address;
1319 unless ($to_address) {
1320 # warn "FAIL: No 'to_address' and no email for " . ($member->{surname} ||'') . ", borrowernumber ($message->{borrowernumber})";
1321 # warning too verbose for this more common case?
1322 _set_message_status( { message_id => $message->{'message_id'},
1323 status => 'failed' } );
1328 my $utf8 = decode('MIME-Header', $message->{'subject'} );
1329 $message->{subject}= encode('MIME-Header', $utf8);
1330 my $subject = encode('UTF-8', $message->{'subject'});
1331 my $content = encode('UTF-8', $message->{'content'});
1332 my $content_type = $message->{'content_type'} || 'text/plain; charset="UTF-8"';
1333 my $is_html = $content_type =~ m/html/io;
1334 my $branch_email = undef;
1335 my $branch_replyto = undef;
1336 my $branch_returnpath = undef;
1338 my $library = $patron->library;
1339 $branch_email = $library->branchemail;
1340 $branch_replyto = $library->branchreplyto;
1341 $branch_returnpath = $library->branchreturnpath;
1343 my $email = Koha::Email->new();
1344 my %sendmail_params = $email->create_message_headers(
1347 from => $message->{'from_address'} || $branch_email,
1348 replyto => $branch_replyto,
1349 sender => $branch_returnpath,
1350 subject => $subject,
1351 message => $is_html ? _wrap_html( $content, $subject ) : $content,
1352 contenttype => $content_type
1356 $sendmail_params{'Auth'} = {user => $username, pass => $password, method => $method} if $username;
1357 if ( my $bcc = C4::Context->preference('NoticeBcc') ) {
1358 $sendmail_params{ Bcc } = $bcc;
1361 _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
1363 if ( sendmail( %sendmail_params ) ) {
1364 _set_message_status( { message_id => $message->{'message_id'},
1365 status => 'sent' } );
1368 _set_message_status( { message_id => $message->{'message_id'},
1369 status => 'failed' } );
1370 carp $Mail::Sendmail::error;
1376 my ($content, $title) = @_;
1378 my $css = C4::Context->preference("NoticeCSS") || '';
1379 $css = qq{<link rel="stylesheet" type="text/css" href="$css">} if $css;
1381 <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
1382 "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
1383 <html lang="en" xml:lang="en" xmlns="http://www.w3.org/1999/xhtml">
1385 <title>$title</title>
1386 <meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
1397 my ( $message ) = @_;
1398 my $dbh = C4::Context->dbh;
1399 my $count = $dbh->selectrow_array(q|
1402 WHERE message_transport_type = ?
1403 AND borrowernumber = ?
1405 AND CAST(time_queued AS date) = CAST(NOW() AS date)
1408 |, {}, $message->{message_transport_type}, $message->{borrowernumber}, $message->{letter_code}, $message->{content} );
1412 sub _send_message_by_sms {
1413 my $message = shift or return;
1414 my $patron = Koha::Patrons->find( $message->{borrowernumber} );
1416 unless ( $patron and $patron->smsalertnumber ) {
1417 _set_message_status( { message_id => $message->{'message_id'},
1418 status => 'failed' } );
1422 if ( _is_duplicate( $message ) ) {
1423 _set_message_status( { message_id => $message->{'message_id'},
1424 status => 'failed' } );
1428 my $success = C4::SMS->send_sms( { destination => $patron->smsalertnumber,
1429 message => $message->{'content'},
1431 _set_message_status( { message_id => $message->{'message_id'},
1432 status => ($success ? 'sent' : 'failed') } );
1436 sub _update_message_to_address {
1438 my $dbh = C4::Context->dbh();
1439 $dbh->do('UPDATE message_queue SET to_address=? WHERE message_id=?',undef,($to,$id));
1442 sub _set_message_status {
1443 my $params = shift or return;
1445 foreach my $required_parameter ( qw( message_id status ) ) {
1446 return unless exists $params->{ $required_parameter };
1449 my $dbh = C4::Context->dbh();
1450 my $statement = 'UPDATE message_queue SET status= ? WHERE message_id = ?';
1451 my $sth = $dbh->prepare( $statement );
1452 my $result = $sth->execute( $params->{'status'},
1453 $params->{'message_id'} );
1458 my ( $params ) = @_;
1460 my $content = $params->{content};
1461 my $tables = $params->{tables};
1462 my $loops = $params->{loops};
1463 my $substitute = $params->{substitute} || {};
1465 my $use_template_cache = C4::Context->config('template_cache_dir') && defined $ENV{GATEWAY_INTERFACE};
1466 my $template = Template->new(
1470 PLUGIN_BASE => 'Koha::Template::Plugin',
1471 COMPILE_EXT => $use_template_cache ? '.ttc' : '',
1472 COMPILE_DIR => $use_template_cache ? C4::Context->config('template_cache_dir') : '',
1474 ENCODING => 'UTF-8',
1476 ) or die Template->error();
1478 my $tt_params = { %{ _get_tt_params( $tables ) }, %{ _get_tt_params( $loops, 'is_a_loop' ) }, %$substitute };
1480 $content = qq|[% USE KohaDates %]$content|;
1483 $template->process( \$content, $tt_params, \$output ) || croak "ERROR PROCESSING TEMPLATE: " . $template->error();
1488 sub _get_tt_params {
1489 my ($tables, $is_a_loop) = @_;
1495 article_requests => {
1496 module => 'Koha::ArticleRequests',
1497 singular => 'article_request',
1498 plural => 'article_requests',
1502 module => 'Koha::Biblios',
1503 singular => 'biblio',
1504 plural => 'biblios',
1505 pk => 'biblionumber',
1508 module => 'Koha::Patrons',
1509 singular => 'borrower',
1510 plural => 'borrowers',
1511 pk => 'borrowernumber',
1514 module => 'Koha::Libraries',
1515 singular => 'branch',
1516 plural => 'branches',
1520 module => 'Koha::Items',
1526 module => 'Koha::News',
1532 module => 'Koha::Acquisition::Orders',
1533 singular => 'order',
1535 pk => 'ordernumber',
1538 module => 'Koha::Holds',
1541 fk => [ 'borrowernumber', 'biblionumber' ],
1544 module => 'Koha::Serials',
1545 singular => 'serial',
1546 plural => 'serials',
1550 module => 'Koha::Subscriptions',
1551 singular => 'subscription',
1552 plural => 'subscriptions',
1553 pk => 'subscriptionid',
1556 module => 'Koha::Suggestions',
1557 singular => 'suggestion',
1558 plural => 'suggestions',
1559 pk => 'suggestionid',
1562 module => 'Koha::Checkouts',
1563 singular => 'checkout',
1564 plural => 'checkouts',
1568 module => 'Koha::Old::Checkouts',
1569 singular => 'old_checkout',
1570 plural => 'old_checkouts',
1574 module => 'Koha::Checkouts',
1575 singular => 'overdue',
1576 plural => 'overdues',
1579 borrower_modifications => {
1580 module => 'Koha::Patron::Modifications',
1581 singular => 'patron_modification',
1582 plural => 'patron_modifications',
1583 fk => 'verification_token',
1587 foreach my $table ( keys %$tables ) {
1588 next unless $config->{$table};
1590 my $ref = ref( $tables->{$table} ) || q{};
1591 my $module = $config->{$table}->{module};
1593 if ( can_load( modules => { $module => undef } ) ) {
1594 my $pk = $config->{$table}->{pk};
1595 my $fk = $config->{$table}->{fk};
1598 my $values = $tables->{$table} || [];
1599 unless ( ref( $values ) eq 'ARRAY' ) {
1600 croak "ERROR processing table $table. Wrong API call.";
1602 my $key = $pk ? $pk : $fk;
1603 # $key does not come from user input
1604 my $objects = $module->search(
1605 { $key => $values },
1607 # We want to retrieve the data in the same order
1609 # field is a MySQLism, but they are no other way to do it
1610 # To be generic we could do it in perl, but we will need to fetch
1611 # all the data then order them
1612 @$values ? ( order_by => \[ "field($key, " . join( ', ', @$values ) . ")" ] ) : ()
1615 $params->{ $config->{$table}->{plural} } = $objects;
1617 elsif ( $ref eq q{} || $ref eq 'HASH' ) {
1618 my $id = ref $ref eq 'HASH' ? $tables->{$table}->{$pk} : $tables->{$table};
1620 if ( $fk ) { # Using a foreign key for lookup
1621 if ( ref( $fk ) eq 'ARRAY' ) { # Foreign key is multi-column
1623 foreach my $key ( @$fk ) {
1624 $search->{$key} = $id->{$key};
1626 $object = $module->search( $search )->last();
1627 } else { # Foreign key is single column
1628 $object = $module->search( { $fk => $id } )->last();
1630 } else { # using the table's primary key for lookup
1631 $object = $module->find($id);
1633 $params->{ $config->{$table}->{singular} } = $object;
1635 else { # $ref eq 'ARRAY'
1637 if ( @{ $tables->{$table} } == 1 ) { # Param is a single key
1638 $object = $module->search( { $pk => $tables->{$table} } )->last();
1640 else { # Params are mutliple foreign keys
1641 croak "Multiple foreign keys (table $table) should be passed using an hashref";
1643 $params->{ $config->{$table}->{singular} } = $object;
1647 croak "ERROR LOADING MODULE $module: $Module::Load::Conditional::ERROR";
1651 $params->{today} = output_pref({ dt => dt_from_string, dateformat => 'iso' });
1656 =head2 get_item_content
1658 my $item = Koha::Items->find(...)->unblessed;
1659 my @item_content_fields = qw( date_due title barcode author itemnumber );
1660 my $item_content = C4::Letters::get_item_content({
1662 item_content_fields => \@item_content_fields
1665 This function generates a tab-separated list of values for the passed item. Dates
1666 are formatted following the current setup.
1670 sub get_item_content {
1671 my ( $params ) = @_;
1672 my $item = $params->{item};
1673 my $dateonly = $params->{dateonly} || 0;
1674 my $item_content_fields = $params->{item_content_fields} || [];
1676 return unless $item;
1678 my @item_info = map {
1682 { dt => dt_from_string( $item->{$_} ), dateonly => $dateonly } );
1686 } @$item_content_fields;
1687 return join( "\t", @item_info ) . "\n";