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 &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
74 DEPRECATED - You must use Koha::Notice::Templates instead
75 The group by clause is confusing and can lead to issues
81 my $module = $filters->{module};
82 my $code = $filters->{code};
83 my $branchcode = $filters->{branchcode};
84 my $dbh = C4::Context->dbh;
85 my $letters = $dbh->selectall_arrayref(
87 SELECT code, module, name
91 . ( $module ? q| AND module = ?| : q|| )
92 . ( $code ? q| AND code = ?| : q|| )
93 . ( defined $branchcode ? q| AND branchcode = ?| : q|| )
94 . q| GROUP BY code, module, name ORDER BY name|, { Slice => {} }
95 , ( $module ? $module : () )
96 , ( $code ? $code : () )
97 , ( defined $branchcode ? $branchcode : () )
103 =head2 GetLetterTemplates
105 my $letter_templates = GetLetterTemplates(
107 module => 'circulation',
109 branchcode => 'CPL', # '' for default,
113 Return a hashref of letter templates.
117 sub GetLetterTemplates {
120 my $module = $params->{module};
121 my $code = $params->{code};
122 my $branchcode = $params->{branchcode} // '';
123 my $dbh = C4::Context->dbh;
124 my $letters = $dbh->selectall_arrayref(
126 SELECT module, code, branchcode, name, is_html, title, content, message_transport_type, lang
133 , $module, $code, $branchcode
139 =head2 GetLettersAvailableForALibrary
141 my $letters = GetLettersAvailableForALibrary(
143 branchcode => 'CPL', # '' for default
144 module => 'circulation',
148 Return an arrayref of letters, sorted by name.
149 If a specific letter exist for the given branchcode, it will be retrieve.
150 Otherwise the default letter will be.
154 sub GetLettersAvailableForALibrary {
156 my $branchcode = $filters->{branchcode};
157 my $module = $filters->{module};
159 croak "module should be provided" unless $module;
161 my $dbh = C4::Context->dbh;
162 my $default_letters = $dbh->selectall_arrayref(
164 SELECT module, code, branchcode, name
168 . q| AND branchcode = ''|
169 . ( $module ? q| AND module = ?| : q|| )
170 . q| ORDER BY name|, { Slice => {} }
171 , ( $module ? $module : () )
174 my $specific_letters;
176 $specific_letters = $dbh->selectall_arrayref(
178 SELECT module, code, branchcode, name
182 . q| AND branchcode = ?|
183 . ( $module ? q| AND module = ?| : q|| )
184 . q| ORDER BY name|, { Slice => {} }
186 , ( $module ? $module : () )
191 for my $l (@$default_letters) {
192 $letters{ $l->{code} } = $l;
194 for my $l (@$specific_letters) {
195 # Overwrite the default letter with the specific one.
196 $letters{ $l->{code} } = $l;
199 return [ map { $letters{$_} }
200 sort { $letters{$a}->{name} cmp $letters{$b}->{name} }
206 my ( $module, $code, $branchcode, $message_transport_type, $lang) = @_;
207 $message_transport_type //= '%';
208 $lang = 'default' unless( $lang && C4::Context->preference('TranslateNotices') );
211 my $only_my_library = C4::Context->only_my_library;
212 if ( $only_my_library and $branchcode ) {
213 $branchcode = C4::Context::mybranch();
217 my $dbh = C4::Context->dbh;
218 my $sth = $dbh->prepare(q{
221 WHERE module=? AND code=? AND (branchcode = ? OR branchcode = '')
222 AND message_transport_type LIKE ?
224 ORDER BY branchcode DESC LIMIT 1
226 $sth->execute( $module, $code, $branchcode, $message_transport_type, $lang );
227 my $line = $sth->fetchrow_hashref
229 $line->{'content-type'} = 'text/html; charset="UTF-8"' if $line->{is_html};
239 module => 'circulation',
245 Delete the letter. The mtt parameter is facultative.
246 If not given, all templates mathing the other parameters will be removed.
252 my $branchcode = $params->{branchcode};
253 my $module = $params->{module};
254 my $code = $params->{code};
255 my $mtt = $params->{mtt};
256 my $lang = $params->{lang};
257 my $dbh = C4::Context->dbh;
264 . ( $mtt ? q| AND message_transport_type = ?| : q|| )
265 . ( $lang? q| AND lang = ?| : q|| )
266 , undef, $branchcode, $module, $code, ( $mtt ? $mtt : () ), ( $lang ? $lang : () ) );
269 =head2 addalert ($borrowernumber, $subscriptionid)
272 - $borrowernumber : the number of the borrower subscribing to the alert
275 create an alert and return the alertid (primary key)
280 my ( $borrowernumber, $subscriptionid) = @_;
281 my $dbh = C4::Context->dbh;
284 "insert into alert (borrowernumber, externalid) values (?,?)");
285 $sth->execute( $borrowernumber, $subscriptionid );
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], [$subscriptionid])
310 - $borrowernumber : the number of the borrower subscribing to the alert
312 all parameters NON mandatory. If a parameter is omitted, the query is done without the corresponding parameter. For example, without $subscriptionid, returns all alerts for a borrower on a topic.
317 my ( $borrowernumber, $subscriptionid ) = @_;
318 my $dbh = C4::Context->dbh;
319 my $query = "SELECT a.*, b.branchcode FROM alert a JOIN borrowers b USING(borrowernumber) WHERE 1";
321 if ($borrowernumber and $borrowernumber =~ /^\d+$/) {
322 $query .= " AND borrowernumber=?";
323 push @bind, $borrowernumber;
325 if ($subscriptionid) {
326 $query .= " AND externalid=?";
327 push @bind, $subscriptionid;
329 my $sth = $dbh->prepare($query);
330 $sth->execute(@bind);
331 return $sth->fetchall_arrayref({});
336 my $err = &SendAlerts($type, $externalid, $letter_code);
339 - $type : the type of alert
340 - $externalid : the id of the "object" to query
341 - $letter_code : the notice template to use
343 C<&SendAlerts> sends an email notice directly to a patron or a vendor.
345 Currently it supports ($type):
346 - claim serial issues (claimissues)
347 - claim acquisition orders (claimacquisition)
348 - send acquisition orders to the vendor (orderacquisition)
349 - notify patrons about newly received serial issues (issue)
350 - notify patrons when their account is created (members)
352 Returns undef or { error => 'message } on failure.
353 Returns true on success.
358 my ( $type, $externalid, $letter_code ) = @_;
359 my $dbh = C4::Context->dbh;
360 if ( $type eq 'issue' ) {
362 # prepare the letter...
363 # search the subscriptionid
366 "SELECT subscriptionid FROM serial WHERE serialid=?");
367 $sth->execute($externalid);
368 my ($subscriptionid) = $sth->fetchrow
369 or warn( "No subscription for '$externalid'" ),
372 # search the biblionumber
375 "SELECT biblionumber FROM subscription WHERE subscriptionid=?");
376 $sth->execute($subscriptionid);
377 my ($biblionumber) = $sth->fetchrow
378 or warn( "No biblionumber for '$subscriptionid'" ),
382 # find the list of borrowers to alert
383 my $alerts = getalert( '', $subscriptionid );
385 my $patron = Koha::Patrons->find( $_->{borrowernumber} );
386 next unless $patron; # Just in case
387 my $email = $patron->email or next;
389 # warn "sending issues...";
390 my $userenv = C4::Context->userenv;
391 my $library = Koha::Libraries->find( $_->{branchcode} );
392 my $letter = GetPreparedLetter (
394 letter_code => $letter_code,
395 branchcode => $userenv->{branch},
397 'branches' => $_->{branchcode},
398 'biblio' => $biblionumber,
399 'biblioitems' => $biblionumber,
400 'borrowers' => $patron->unblessed,
401 'subscription' => $subscriptionid,
402 'serial' => $externalid,
408 my $message = Koha::Email->new();
409 my %mail = $message->create_message_headers(
412 from => $library->branchemail,
413 replyto => $library->branchreplyto,
414 sender => $library->branchreturnpath,
415 subject => Encode::encode( "UTF-8", "" . $letter->{title} ),
416 message => $letter->{'is_html'}
417 ? _wrap_html( Encode::encode( "UTF-8", $letter->{'content'} ),
418 Encode::encode( "UTF-8", "" . $letter->{'title'} ))
419 : Encode::encode( "UTF-8", "" . $letter->{'content'} ),
420 contenttype => $letter->{'is_html'}
421 ? 'text/html; charset="utf-8"'
422 : 'text/plain; charset="utf-8"',
425 unless( Mail::Sendmail::sendmail(%mail) ) {
426 carp $Mail::Sendmail::error;
427 return { error => $Mail::Sendmail::error };
431 elsif ( $type eq 'claimacquisition' or $type eq 'claimissues' or $type eq 'orderacquisition' ) {
433 # prepare the letter...
438 if ( $type eq 'claimacquisition') {
440 SELECT aqorders.*,aqbasket.*,biblio.*,biblioitems.*
442 LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno
443 LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
444 LEFT JOIN biblioitems ON aqorders.biblionumber=biblioitems.biblionumber
445 WHERE aqorders.ordernumber IN (
449 carp "No order selected";
450 return { error => "no_order_selected" };
452 $strsth .= join( ",", ('?') x @$externalid ) . ")";
453 $action = "ACQUISITION CLAIM";
454 $sthorders = $dbh->prepare($strsth);
455 $sthorders->execute( @$externalid );
456 $dataorders = $sthorders->fetchall_arrayref( {} );
459 if ($type eq 'claimissues') {
461 SELECT serial.*,subscription.*, biblio.*, aqbooksellers.*,
462 aqbooksellers.id AS booksellerid
464 LEFT JOIN subscription ON serial.subscriptionid=subscription.subscriptionid
465 LEFT JOIN biblio ON serial.biblionumber=biblio.biblionumber
466 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id
467 WHERE serial.serialid IN (
471 carp "No Order selected";
472 return { error => "no_order_selected" };
475 $strsth .= join( ",", ('?') x @$externalid ) . ")";
476 $action = "CLAIM ISSUE";
477 $sthorders = $dbh->prepare($strsth);
478 $sthorders->execute( @$externalid );
479 $dataorders = $sthorders->fetchall_arrayref( {} );
482 if ( $type eq 'orderacquisition') {
484 SELECT aqorders.*,aqbasket.*,biblio.*,biblioitems.*
486 LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno
487 LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
488 LEFT JOIN biblioitems ON aqorders.biblionumber=biblioitems.biblionumber
489 WHERE aqbasket.basketno = ?
490 AND orderstatus IN ('new','ordered')
494 carp "No basketnumber given";
495 return { error => "no_basketno" };
497 $action = "ACQUISITION ORDER";
498 $sthorders = $dbh->prepare($strsth);
499 $sthorders->execute($externalid);
500 $dataorders = $sthorders->fetchall_arrayref( {} );
504 $dbh->prepare("select * from aqbooksellers where id=?");
505 $sthbookseller->execute( $dataorders->[0]->{booksellerid} );
506 my $databookseller = $sthbookseller->fetchrow_hashref;
508 my $addressee = $type eq 'claimacquisition' || $type eq 'orderacquisition' ? 'acqprimary' : 'serialsprimary';
511 $dbh->prepare("SELECT * FROM aqcontacts WHERE booksellerid=? AND $type=1 ORDER BY $addressee DESC");
512 $sthcontact->execute( $dataorders->[0]->{booksellerid} );
513 my $datacontact = $sthcontact->fetchrow_hashref;
517 push @email, $databookseller->{bookselleremail} if $databookseller->{bookselleremail};
518 push @email, $datacontact->{email} if ( $datacontact && $datacontact->{email} );
520 warn "Bookseller $dataorders->[0]->{booksellerid} without emails";
521 return { error => "no_email" };
524 while ($addlcontact = $sthcontact->fetchrow_hashref) {
525 push @cc, $addlcontact->{email} if ( $addlcontact && $addlcontact->{email} );
528 my $userenv = C4::Context->userenv;
529 my $letter = GetPreparedLetter (
531 letter_code => $letter_code,
532 branchcode => $userenv->{branch},
534 'branches' => $userenv->{branch},
535 'aqbooksellers' => $databookseller,
536 'aqcontacts' => $datacontact,
538 repeat => $dataorders,
540 ) or return { error => "no_letter" };
542 # Remove the order tag
543 $letter->{content} =~ s/<order>(.*?)<\/order>/$1/gxms;
546 my $library = Koha::Libraries->find( $userenv->{branch} );
548 To => join( ',', @email),
549 Cc => join( ',', @cc),
550 From => $library->branchemail || C4::Context->preference('KohaAdminEmailAddress'),
551 Subject => Encode::encode( "UTF-8", "" . $letter->{title} ),
552 Message => $letter->{'is_html'}
553 ? _wrap_html( Encode::encode( "UTF-8", $letter->{'content'} ),
554 Encode::encode( "UTF-8", "" . $letter->{'title'} ))
555 : Encode::encode( "UTF-8", "" . $letter->{'content'} ),
556 'Content-Type' => $letter->{'is_html'}
557 ? 'text/html; charset="utf-8"'
558 : 'text/plain; charset="utf-8"',
561 if ($type eq 'claimacquisition' || $type eq 'claimissues' ) {
562 $mail{'Reply-to'} = C4::Context->preference('ReplytoDefault')
563 if C4::Context->preference('ReplytoDefault');
564 $mail{'Sender'} = C4::Context->preference('ReturnpathDefault')
565 if C4::Context->preference('ReturnpathDefault');
566 $mail{'Bcc'} = $userenv->{emailaddress}
567 if C4::Context->preference("ClaimsBccCopy");
570 unless ( Mail::Sendmail::sendmail(%mail) ) {
571 carp $Mail::Sendmail::error;
572 return { error => $Mail::Sendmail::error };
580 . join( ',', @email )
585 ) if C4::Context->preference("LetterLog");
587 # send an "account details" notice to a newly created user
588 elsif ( $type eq 'members' ) {
589 my $library = Koha::Libraries->find( $externalid->{branchcode} )->unblessed;
590 my $letter = GetPreparedLetter (
592 letter_code => $letter_code,
593 branchcode => $externalid->{'branchcode'},
595 'branches' => $library,
596 'borrowers' => $externalid->{'borrowernumber'},
598 substitute => { 'borrowers.password' => $externalid->{'password'} },
601 return { error => "no_email" } unless $externalid->{'emailaddr'};
602 my $email = Koha::Email->new();
603 my %mail = $email->create_message_headers(
605 to => $externalid->{'emailaddr'},
606 from => $library->{branchemail},
607 replyto => $library->{branchreplyto},
608 sender => $library->{branchreturnpath},
609 subject => Encode::encode( "UTF-8", "" . $letter->{'title'} ),
610 message => $letter->{'is_html'}
611 ? _wrap_html( Encode::encode( "UTF-8", $letter->{'content'} ),
612 Encode::encode( "UTF-8", "" . $letter->{'title'} ) )
613 : Encode::encode( "UTF-8", "" . $letter->{'content'} ),
614 contenttype => $letter->{'is_html'}
615 ? 'text/html; charset="utf-8"'
616 : 'text/plain; charset="utf-8"',
619 unless( Mail::Sendmail::sendmail(%mail) ) {
620 carp $Mail::Sendmail::error;
621 return { error => $Mail::Sendmail::error };
625 # If we come here, return an OK status
629 =head2 GetPreparedLetter( %params )
632 module => letter module, mandatory
633 letter_code => letter code, mandatory
634 branchcode => for letter selection, if missing default system letter taken
635 tables => a hashref with table names as keys. Values are either:
636 - a scalar - primary key value
637 - an arrayref - primary key values
638 - a hashref - full record
639 substitute => custom substitution key/value pairs
640 repeat => records to be substituted on consecutive lines:
641 - an arrayref - tries to guess what needs substituting by
642 taking remaining << >> tokensr; not recommended
643 - a hashref token => @tables - replaces <token> << >> << >> </token>
644 subtemplate for each @tables row; table is a hashref as above
645 want_librarian => boolean, if set to true triggers librarian details
646 substitution from the userenv
648 letter fields hashref (title & content useful)
652 sub GetPreparedLetter {
655 my $letter = $params{letter};
658 my $module = $params{module} or croak "No module";
659 my $letter_code = $params{letter_code} or croak "No letter_code";
660 my $branchcode = $params{branchcode} || '';
661 my $mtt = $params{message_transport_type} || 'email';
662 my $lang = $params{lang} || 'default';
664 $letter = getletter( $module, $letter_code, $branchcode, $mtt, $lang );
667 $letter = getletter( $module, $letter_code, $branchcode, $mtt, 'default' )
668 or warn( "No $module $letter_code letter transported by " . $mtt ),
673 my $tables = $params{tables} || {};
674 my $substitute = $params{substitute} || {};
675 my $loops = $params{loops} || {}; # loops is not supported for historical notices syntax
676 my $repeat = $params{repeat};
677 %$tables || %$substitute || $repeat || %$loops
678 or carp( "ERROR: nothing to substitute - both 'tables', 'loops' and 'substitute' are empty" ),
680 my $want_librarian = $params{want_librarian};
683 while ( my ($token, $val) = each %$substitute ) {
684 if ( $token eq 'items.content' ) {
685 $val =~ s|\n|<br/>|g if $letter->{is_html};
688 $letter->{title} =~ s/<<$token>>/$val/g;
689 $letter->{content} =~ s/<<$token>>/$val/g;
693 my $OPACBaseURL = C4::Context->preference('OPACBaseURL');
694 $letter->{content} =~ s/<<OPACBaseURL>>/$OPACBaseURL/go;
696 if ($want_librarian) {
697 # parsing librarian name
698 my $userenv = C4::Context->userenv;
699 $letter->{content} =~ s/<<LibrarianFirstname>>/$userenv->{firstname}/go;
700 $letter->{content} =~ s/<<LibrarianSurname>>/$userenv->{surname}/go;
701 $letter->{content} =~ s/<<LibrarianEmailaddress>>/$userenv->{emailaddress}/go;
704 my ($repeat_no_enclosing_tags, $repeat_enclosing_tags);
707 if (ref ($repeat) eq 'ARRAY' ) {
708 $repeat_no_enclosing_tags = $repeat;
710 $repeat_enclosing_tags = $repeat;
714 if ($repeat_enclosing_tags) {
715 while ( my ($tag, $tag_tables) = each %$repeat_enclosing_tags ) {
716 if ( $letter->{content} =~ m!<$tag>(.*)</$tag>!s ) {
719 my %subletter = ( title => '', content => $subcontent );
720 _substitute_tables( \%subletter, $_ );
723 $letter->{content} =~ s!<$tag>.*</$tag>!join( "\n", @lines )!se;
729 _substitute_tables( $letter, $tables );
732 if ($repeat_no_enclosing_tags) {
733 if ( $letter->{content} =~ m/[^\n]*<<.*>>[^\n]*/so ) {
738 $c =~ s/<<count>>/$i/go;
739 foreach my $field ( keys %{$_} ) {
740 $c =~ s/(<<[^\.]+.$field>>)/$_->{$field}/;
744 } @$repeat_no_enclosing_tags;
746 my $replaceby = join( "\n", @lines );
747 $letter->{content} =~ s/\Q$line\E/$replaceby/s;
751 $letter->{content} = _process_tt(
753 content => $letter->{content},
756 substitute => $substitute,
760 $letter->{content} =~ s/<<\S*>>//go; #remove any stragglers
765 sub _substitute_tables {
766 my ( $letter, $tables ) = @_;
767 while ( my ($table, $param) = each %$tables ) {
770 my $ref = ref $param;
773 if ($ref && $ref eq 'HASH') {
777 my $sth = _parseletter_sth($table);
779 warn "_parseletter_sth('$table') failed to return a valid sth. No substitution will be done for that table.";
782 $sth->execute( $ref ? @$param : $param );
784 $values = $sth->fetchrow_hashref;
788 _parseletter ( $letter, $table, $values );
792 sub _parseletter_sth {
796 carp "ERROR: _parseletter_sth() called without argument (table)";
799 # NOTE: we used to check whether we had a statement handle cached in
800 # a %handles module-level variable. This was a dumb move and
801 # broke things for the rest of us. prepare_cached is a better
802 # way to cache statement handles anyway.
804 ($table eq 'biblio' ) ? "SELECT * FROM $table WHERE biblionumber = ?" :
805 ($table eq 'biblioitems' ) ? "SELECT * FROM $table WHERE biblionumber = ?" :
806 ($table eq 'items' ) ? "SELECT * FROM $table WHERE itemnumber = ?" :
807 ($table eq 'issues' ) ? "SELECT * FROM $table WHERE itemnumber = ?" :
808 ($table eq 'old_issues' ) ? "SELECT * FROM $table WHERE itemnumber = ? ORDER BY timestamp DESC LIMIT 1" :
809 ($table eq 'reserves' ) ? "SELECT * FROM $table WHERE borrowernumber = ? and biblionumber = ?" :
810 ($table eq 'borrowers' ) ? "SELECT * FROM $table WHERE borrowernumber = ?" :
811 ($table eq 'branches' ) ? "SELECT * FROM $table WHERE branchcode = ?" :
812 ($table eq 'suggestions' ) ? "SELECT * FROM $table WHERE suggestionid = ?" :
813 ($table eq 'aqbooksellers') ? "SELECT * FROM $table WHERE id = ?" :
814 ($table eq 'aqorders' ) ? "SELECT * FROM $table WHERE ordernumber = ?" :
815 ($table eq 'opac_news' ) ? "SELECT * FROM $table WHERE idnew = ?" :
816 ($table eq 'article_requests') ? "SELECT * FROM $table WHERE id = ?" :
817 ($table eq 'borrower_modifications') ? "SELECT * FROM $table WHERE verification_token = ?" :
818 ($table eq 'subscription') ? "SELECT * FROM $table WHERE subscriptionid = ?" :
819 ($table eq 'serial') ? "SELECT * FROM $table WHERE serialid = ?" :
822 warn "ERROR: No _parseletter_sth query for table '$table'";
823 return; # nothing to get
825 unless ($sth = C4::Context->dbh->prepare_cached($query)) {
826 warn "ERROR: Failed to prepare query: '$query'";
829 return $sth; # now cache is populated for that $table
832 =head2 _parseletter($letter, $table, $values)
835 - $letter : a hash to letter fields (title & content useful)
836 - $table : the Koha table to parse.
837 - $values_in : table record hashref
838 parse all fields from a table, and replace values in title & content with the appropriate value
839 (not exported sub, used only internally)
844 my ( $letter, $table, $values_in ) = @_;
846 # Work on a local copy of $values_in (passed by reference) to avoid side effects
847 # in callers ( by changing / formatting values )
848 my $values = $values_in ? { %$values_in } : {};
850 if ( $table eq 'borrowers' && $values->{'dateexpiry'} ){
851 $values->{'dateexpiry'} = output_pref({ str => $values->{dateexpiry}, dateonly => 1 });
854 if ( $table eq 'reserves' && $values->{'waitingdate'} ) {
855 $values->{'waitingdate'} = output_pref({ dt => dt_from_string( $values->{'waitingdate'} ), dateonly => 1 });
858 if ($letter->{content} && $letter->{content} =~ /<<today>>/) {
859 my $todaysdate = output_pref( DateTime->now() );
860 $letter->{content} =~ s/<<today>>/$todaysdate/go;
863 while ( my ($field, $val) = each %$values ) {
864 $val =~ s/\p{P}$// if $val && $table=~/biblio/;
865 #BZ 9886: Assuming that we want to eliminate ISBD punctuation here
866 #Therefore adding the test on biblio. This includes biblioitems,
867 #but excludes items. Removed unneeded global and lookahead.
869 if ( $table=~/^borrowers$/ && $field=~/^streettype$/ ) {
870 my $av = Koha::AuthorisedValues->search({ category => 'ROADTYPE', authorised_value => $val });
871 $val = $av->count ? $av->next->lib : '';
875 my $replacedby = defined ($val) ? $val : '';
877 and not $replacedby =~ m|0000-00-00|
878 and not $replacedby =~ m|9999-12-31|
879 and $replacedby =~ m|^\d{4}-\d{2}-\d{2}( \d{2}:\d{2}:\d{2})?$| )
881 # If the value is XXXX-YY-ZZ[ AA:BB:CC] we assume it is a date
882 my $dateonly = defined $1 ? 0 : 1; #$1 refers to the capture group wrapped in parentheses. In this case, that's the hours, minutes, seconds.
883 my $re_dateonly_filter = qr{ $field( \s* \| \s* dateonly\s*)?>> }xms;
885 for my $letter_field ( qw( title content ) ) {
886 my $filter_string_used = q{};
887 if ( $letter->{ $letter_field } =~ $re_dateonly_filter ) {
888 # We overwrite $dateonly if the filter exists and we have a time in the datetime
889 $filter_string_used = $1 || q{};
890 $dateonly = $1 unless $dateonly;
892 my $replacedby_date = eval {
893 output_pref({ dt => dt_from_string( $replacedby ), dateonly => $dateonly });
896 if ( $letter->{ $letter_field } ) {
897 $letter->{ $letter_field } =~ s/\Q<<$table.$field$filter_string_used>>\E/$replacedby_date/g;
898 $letter->{ $letter_field } =~ s/\Q<<$field$filter_string_used>>\E/$replacedby_date/g;
902 # Other fields replacement
904 for my $letter_field ( qw( title content ) ) {
905 if ( $letter->{ $letter_field } ) {
906 $letter->{ $letter_field } =~ s/<<$table.$field>>/$replacedby/g;
907 $letter->{ $letter_field } =~ s/<<$field>>/$replacedby/g;
913 if ($table eq 'borrowers' && $letter->{content}) {
914 if ( my $attributes = GetBorrowerAttributes($values->{borrowernumber}) ) {
916 foreach (@$attributes) {
917 my $code = $_->{code};
918 my $val = $_->{value_description} || $_->{value};
919 $val =~ s/\p{P}(?=$)//g if $val;
920 next unless $val gt '';
922 push @{ $attr{$code} }, $val;
924 while ( my ($code, $val_ar) = each %attr ) {
925 my $replacefield = "<<borrower-attribute:$code>>";
926 my $replacedby = join ',', @$val_ar;
927 $letter->{content} =~ s/$replacefield/$replacedby/g;
936 my $success = EnqueueLetter( { letter => $letter,
937 borrowernumber => '12', message_transport_type => 'email' } )
939 places a letter in the message_queue database table, which will
940 eventually get processed (sent) by the process_message_queue.pl
941 cronjob when it calls SendQueuedMessages.
943 return message_id on success
948 my $params = shift or return;
950 return unless exists $params->{'letter'};
951 # return unless exists $params->{'borrowernumber'};
952 return unless exists $params->{'message_transport_type'};
954 my $content = $params->{letter}->{content};
955 $content =~ s/\s+//g if(defined $content);
956 if ( not defined $content or $content eq '' ) {
957 warn "Trying to add an empty message to the message queue" if $debug;
961 # If we have any attachments we should encode then into the body.
962 if ( $params->{'attachments'} ) {
963 $params->{'letter'} = _add_attachments(
964 { letter => $params->{'letter'},
965 attachments => $params->{'attachments'},
966 message => MIME::Lite->new( Type => 'multipart/mixed' ),
971 my $dbh = C4::Context->dbh();
972 my $statement = << 'ENDSQL';
973 INSERT INTO message_queue
974 ( borrowernumber, subject, content, metadata, letter_code, message_transport_type, status, time_queued, to_address, from_address, content_type )
976 ( ?, ?, ?, ?, ?, ?, ?, NOW(), ?, ?, ? )
979 my $sth = $dbh->prepare($statement);
980 my $result = $sth->execute(
981 $params->{'borrowernumber'}, # borrowernumber
982 $params->{'letter'}->{'title'}, # subject
983 $params->{'letter'}->{'content'}, # content
984 $params->{'letter'}->{'metadata'} || '', # metadata
985 $params->{'letter'}->{'code'} || '', # letter_code
986 $params->{'message_transport_type'}, # message_transport_type
988 $params->{'to_address'}, # to_address
989 $params->{'from_address'}, # from_address
990 $params->{'letter'}->{'content-type'}, # content_type
992 return $dbh->last_insert_id(undef,undef,'message_queue', undef);
995 =head2 SendQueuedMessages ([$hashref])
997 my $sent = SendQueuedMessages({
998 letter_code => $letter_code,
999 borrowernumber => $who_letter_is_for,
1005 Sends all of the 'pending' items in the message queue, unless
1006 parameters are passed.
1008 The letter_code, borrowernumber and limit parameters are used
1009 to build a parameter set for _get_unsent_messages, thus limiting
1010 which pending messages will be processed. They are all optional.
1012 The verbose parameter can be used to generate debugging output.
1013 It is also optional.
1015 Returns number of messages sent.
1019 sub SendQueuedMessages {
1022 my $which_unsent_messages = {
1023 'limit' => $params->{'limit'} // 0,
1024 'borrowernumber' => $params->{'borrowernumber'} // q{},
1025 'letter_code' => $params->{'letter_code'} // q{},
1026 'type' => $params->{'type'} // q{},
1028 my $unsent_messages = _get_unsent_messages( $which_unsent_messages );
1029 MESSAGE: foreach my $message ( @$unsent_messages ) {
1030 my $message_object = Koha::Notice::Messages->find( $message->{message_id} );
1031 # If this fails the database is unwritable and we won't manage to send a message that continues to be marked 'pending'
1032 $message_object->make_column_dirty('status');
1033 return unless $message_object->store;
1035 # warn Data::Dumper->Dump( [ $message ], [ 'message' ] );
1036 warn sprintf( 'sending %s message to patron: %s',
1037 $message->{'message_transport_type'},
1038 $message->{'borrowernumber'} || 'Admin' )
1039 if $params->{'verbose'} or $debug;
1040 # This is just begging for subclassing
1041 next MESSAGE if ( lc($message->{'message_transport_type'}) eq 'rss' );
1042 if ( lc( $message->{'message_transport_type'} ) eq 'email' ) {
1043 _send_message_by_email( $message, $params->{'username'}, $params->{'password'}, $params->{'method'} );
1045 elsif ( lc( $message->{'message_transport_type'} ) eq 'sms' ) {
1046 if ( C4::Context->preference('SMSSendDriver') eq 'Email' ) {
1047 my $patron = Koha::Patrons->find( $message->{borrowernumber} );
1048 my $sms_provider = Koha::SMS::Providers->find( $patron->sms_provider_id );
1049 unless ( $sms_provider ) {
1050 warn sprintf( "Patron %s has no sms provider id set!", $message->{'borrowernumber'} ) if $params->{'verbose'} or $debug;
1051 _set_message_status( { message_id => $message->{'message_id'}, status => 'failed' } );
1054 unless ( $patron->smsalertnumber ) {
1055 _set_message_status( { message_id => $message->{'message_id'}, status => 'failed' } );
1056 warn sprintf( "No smsalertnumber found for patron %s!", $message->{'borrowernumber'} ) if $params->{'verbose'} or $debug;
1059 $message->{to_address} = $patron->smsalertnumber; #Sometime this is set to email - sms should always use smsalertnumber
1060 $message->{to_address} .= '@' . $sms_provider->domain();
1061 _update_message_to_address($message->{'message_id'},$message->{to_address});
1062 _send_message_by_email( $message, $params->{'username'}, $params->{'password'}, $params->{'method'} );
1064 _send_message_by_sms( $message );
1068 return scalar( @$unsent_messages );
1071 =head2 GetRSSMessages
1073 my $message_list = GetRSSMessages( { limit => 10, borrowernumber => '14' } )
1075 returns a listref of all queued RSS messages for a particular person.
1079 sub GetRSSMessages {
1082 return unless $params;
1083 return unless ref $params;
1084 return unless $params->{'borrowernumber'};
1086 return _get_unsent_messages( { message_transport_type => 'rss',
1087 limit => $params->{'limit'},
1088 borrowernumber => $params->{'borrowernumber'}, } );
1091 =head2 GetPrintMessages
1093 my $message_list = GetPrintMessages( { borrowernumber => $borrowernumber } )
1095 Returns a arrayref of all queued print messages (optionally, for a particular
1100 sub GetPrintMessages {
1101 my $params = shift || {};
1103 return _get_unsent_messages( { message_transport_type => 'print',
1104 borrowernumber => $params->{'borrowernumber'},
1108 =head2 GetQueuedMessages ([$hashref])
1110 my $messages = GetQueuedMessage( { borrowernumber => '123', limit => 20 } );
1112 fetches messages out of the message queue.
1115 list of hashes, each has represents a message in the message queue.
1119 sub GetQueuedMessages {
1122 my $dbh = C4::Context->dbh();
1123 my $statement = << 'ENDSQL';
1124 SELECT message_id, borrowernumber, subject, content, message_transport_type, status, time_queued
1130 if ( exists $params->{'borrowernumber'} ) {
1131 push @whereclauses, ' borrowernumber = ? ';
1132 push @query_params, $params->{'borrowernumber'};
1135 if ( @whereclauses ) {
1136 $statement .= ' WHERE ' . join( 'AND', @whereclauses );
1139 if ( defined $params->{'limit'} ) {
1140 $statement .= ' LIMIT ? ';
1141 push @query_params, $params->{'limit'};
1144 my $sth = $dbh->prepare( $statement );
1145 my $result = $sth->execute( @query_params );
1146 return $sth->fetchall_arrayref({});
1149 =head2 GetMessageTransportTypes
1151 my @mtt = GetMessageTransportTypes();
1153 returns an arrayref of transport types
1157 sub GetMessageTransportTypes {
1158 my $dbh = C4::Context->dbh();
1159 my $mtts = $dbh->selectcol_arrayref("
1160 SELECT message_transport_type
1161 FROM message_transport_types
1162 ORDER BY message_transport_type
1169 my $message = C4::Letters::Message($message_id);
1174 my ( $message_id ) = @_;
1175 return unless $message_id;
1176 my $dbh = C4::Context->dbh;
1177 return $dbh->selectrow_hashref(q|
1178 SELECT message_id, borrowernumber, subject, content, metadata, letter_code, message_transport_type, status, time_queued, to_address, from_address, content_type
1180 WHERE message_id = ?
1181 |, {}, $message_id );
1184 =head2 ResendMessage
1186 Attempt to resend a message which has failed previously.
1188 my $has_been_resent = C4::Letters::ResendMessage($message_id);
1190 Updates the message to 'pending' status so that
1191 it will be resent later on.
1193 returns 1 on success, 0 on failure, undef if no message was found
1198 my $message_id = shift;
1199 return unless $message_id;
1201 my $message = GetMessage( $message_id );
1202 return unless $message;
1204 if ( $message->{status} ne 'pending' ) {
1205 $rv = C4::Letters::_set_message_status({
1206 message_id => $message_id,
1207 status => 'pending',
1209 $rv = $rv > 0? 1: 0;
1210 # Clear destination email address to force address update
1211 _update_message_to_address( $message_id, undef ) if $rv &&
1212 $message->{message_transport_type} eq 'email';
1217 =head2 _add_attachements
1220 letter - the standard letter hashref
1221 attachments - listref of attachments. each attachment is a hashref of:
1222 type - the mime type, like 'text/plain'
1223 content - the actual attachment
1224 filename - the name of the attachment.
1225 message - a MIME::Lite object to attach these to.
1227 returns your letter object, with the content updated.
1231 sub _add_attachments {
1234 my $letter = $params->{'letter'};
1235 my $attachments = $params->{'attachments'};
1236 return $letter unless @$attachments;
1237 my $message = $params->{'message'};
1239 # First, we have to put the body in as the first attachment
1241 Type => $letter->{'content-type'} || 'TEXT',
1242 Data => $letter->{'is_html'}
1243 ? _wrap_html($letter->{'content'}, $letter->{'title'})
1244 : $letter->{'content'},
1247 foreach my $attachment ( @$attachments ) {
1249 Type => $attachment->{'type'},
1250 Data => $attachment->{'content'},
1251 Filename => $attachment->{'filename'},
1254 # we're forcing list context here to get the header, not the count back from grep.
1255 ( $letter->{'content-type'} ) = grep( /^Content-Type:/, split( /\n/, $params->{'message'}->header_as_string ) );
1256 $letter->{'content-type'} =~ s/^Content-Type:\s+//;
1257 $letter->{'content'} = $message->body_as_string;
1263 =head2 _get_unsent_messages
1265 This function's parameter hash reference takes the following
1266 optional named parameters:
1267 message_transport_type: method of message sending (e.g. email, sms, etc.)
1268 borrowernumber : who the message is to be sent
1269 letter_code : type of message being sent (e.g. PASSWORD_RESET)
1270 limit : maximum number of messages to send
1272 This function returns an array of matching hash referenced rows from
1273 message_queue with some borrower information added.
1277 sub _get_unsent_messages {
1280 my $dbh = C4::Context->dbh();
1282 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
1283 FROM message_queue mq
1284 LEFT JOIN borrowers b ON b.borrowernumber = mq.borrowernumber
1288 my @query_params = ('pending');
1289 if ( ref $params ) {
1290 if ( $params->{'message_transport_type'} ) {
1291 $statement .= ' AND mq.message_transport_type = ? ';
1292 push @query_params, $params->{'message_transport_type'};
1294 if ( $params->{'borrowernumber'} ) {
1295 $statement .= ' AND mq.borrowernumber = ? ';
1296 push @query_params, $params->{'borrowernumber'};
1298 if ( $params->{'letter_code'} ) {
1299 $statement .= ' AND mq.letter_code = ? ';
1300 push @query_params, $params->{'letter_code'};
1302 if ( $params->{'type'} ) {
1303 $statement .= ' AND message_transport_type = ? ';
1304 push @query_params, $params->{'type'};
1306 if ( $params->{'limit'} ) {
1307 $statement .= ' limit ? ';
1308 push @query_params, $params->{'limit'};
1312 $debug and warn "_get_unsent_messages SQL: $statement";
1313 $debug and warn "_get_unsent_messages params: " . join(',',@query_params);
1314 my $sth = $dbh->prepare( $statement );
1315 my $result = $sth->execute( @query_params );
1316 return $sth->fetchall_arrayref({});
1319 sub _send_message_by_email {
1320 my $message = shift or return;
1321 my ($username, $password, $method) = @_;
1323 my $patron = Koha::Patrons->find( $message->{borrowernumber} );
1324 my $to_address = $message->{'to_address'};
1325 unless ($to_address) {
1327 warn "FAIL: No 'to_address' and INVALID borrowernumber ($message->{borrowernumber})";
1328 _set_message_status( { message_id => $message->{'message_id'},
1329 status => 'failed' } );
1332 $to_address = $patron->notice_email_address;
1333 unless ($to_address) {
1334 # warn "FAIL: No 'to_address' and no email for " . ($member->{surname} ||'') . ", borrowernumber ($message->{borrowernumber})";
1335 # warning too verbose for this more common case?
1336 _set_message_status( { message_id => $message->{'message_id'},
1337 status => 'failed' } );
1342 my $utf8 = decode('MIME-Header', $message->{'subject'} );
1343 $message->{subject}= encode('MIME-Header', $utf8);
1344 my $subject = encode('UTF-8', $message->{'subject'});
1345 my $content = encode('UTF-8', $message->{'content'});
1346 my $content_type = $message->{'content_type'} || 'text/plain; charset="UTF-8"';
1347 my $is_html = $content_type =~ m/html/io;
1348 my $branch_email = undef;
1349 my $branch_replyto = undef;
1350 my $branch_returnpath = undef;
1352 my $library = $patron->library;
1353 $branch_email = $library->branchemail;
1354 $branch_replyto = $library->branchreplyto;
1355 $branch_returnpath = $library->branchreturnpath;
1357 my $email = Koha::Email->new();
1358 my %sendmail_params = $email->create_message_headers(
1361 from => $message->{'from_address'} || $branch_email,
1362 replyto => $branch_replyto,
1363 sender => $branch_returnpath,
1364 subject => $subject,
1365 message => $is_html ? _wrap_html( $content, $subject ) : $content,
1366 contenttype => $content_type
1370 $sendmail_params{'Auth'} = {user => $username, pass => $password, method => $method} if $username;
1371 if ( my $bcc = C4::Context->preference('NoticeBcc') ) {
1372 $sendmail_params{ Bcc } = $bcc;
1375 _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
1377 if ( Mail::Sendmail::sendmail( %sendmail_params ) ) {
1378 _set_message_status( { message_id => $message->{'message_id'},
1379 status => 'sent' } );
1382 _set_message_status( { message_id => $message->{'message_id'},
1383 status => 'failed' } );
1384 carp $Mail::Sendmail::error;
1390 my ($content, $title) = @_;
1392 my $css = C4::Context->preference("NoticeCSS") || '';
1393 $css = qq{<link rel="stylesheet" type="text/css" href="$css">} if $css;
1395 <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
1396 "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
1397 <html lang="en" xml:lang="en" xmlns="http://www.w3.org/1999/xhtml">
1399 <title>$title</title>
1400 <meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
1411 my ( $message ) = @_;
1412 my $dbh = C4::Context->dbh;
1413 my $count = $dbh->selectrow_array(q|
1416 WHERE message_transport_type = ?
1417 AND borrowernumber = ?
1419 AND CAST(time_queued AS date) = CAST(NOW() AS date)
1422 |, {}, $message->{message_transport_type}, $message->{borrowernumber}, $message->{letter_code}, $message->{content} );
1426 sub _send_message_by_sms {
1427 my $message = shift or return;
1428 my $patron = Koha::Patrons->find( $message->{borrowernumber} );
1430 unless ( $patron and $patron->smsalertnumber ) {
1431 _set_message_status( { message_id => $message->{'message_id'},
1432 status => 'failed' } );
1436 if ( _is_duplicate( $message ) ) {
1437 _set_message_status( { message_id => $message->{'message_id'},
1438 status => 'failed' } );
1442 my $success = C4::SMS->send_sms( { destination => $patron->smsalertnumber,
1443 message => $message->{'content'},
1445 _set_message_status( { message_id => $message->{'message_id'},
1446 status => ($success ? 'sent' : 'failed') } );
1450 sub _update_message_to_address {
1452 my $dbh = C4::Context->dbh();
1453 $dbh->do('UPDATE message_queue SET to_address=? WHERE message_id=?',undef,($to,$id));
1456 sub _set_message_status {
1457 my $params = shift or return;
1459 foreach my $required_parameter ( qw( message_id status ) ) {
1460 return unless exists $params->{ $required_parameter };
1463 my $dbh = C4::Context->dbh();
1464 my $statement = 'UPDATE message_queue SET status= ? WHERE message_id = ?';
1465 my $sth = $dbh->prepare( $statement );
1466 my $result = $sth->execute( $params->{'status'},
1467 $params->{'message_id'} );
1472 my ( $params ) = @_;
1474 my $content = $params->{content};
1475 my $tables = $params->{tables};
1476 my $loops = $params->{loops};
1477 my $substitute = $params->{substitute} || {};
1479 my $use_template_cache = C4::Context->config('template_cache_dir') && defined $ENV{GATEWAY_INTERFACE};
1480 my $template = Template->new(
1484 PLUGIN_BASE => 'Koha::Template::Plugin',
1485 COMPILE_EXT => $use_template_cache ? '.ttc' : '',
1486 COMPILE_DIR => $use_template_cache ? C4::Context->config('template_cache_dir') : '',
1488 ENCODING => 'UTF-8',
1490 ) or die Template->error();
1492 my $tt_params = { %{ _get_tt_params( $tables ) }, %{ _get_tt_params( $loops, 'is_a_loop' ) }, %$substitute };
1494 $content = add_tt_filters( $content );
1495 $content = qq|[% USE KohaDates %][% USE Remove_MARC_punctuation %]$content|;
1498 $template->process( \$content, $tt_params, \$output ) || croak "ERROR PROCESSING TEMPLATE: " . $template->error();
1503 sub _get_tt_params {
1504 my ($tables, $is_a_loop) = @_;
1510 article_requests => {
1511 module => 'Koha::ArticleRequests',
1512 singular => 'article_request',
1513 plural => 'article_requests',
1517 module => 'Koha::Biblios',
1518 singular => 'biblio',
1519 plural => 'biblios',
1520 pk => 'biblionumber',
1523 module => 'Koha::Biblioitems',
1524 singular => 'biblioitem',
1525 plural => 'biblioitems',
1526 pk => 'biblioitemnumber',
1529 module => 'Koha::Patrons',
1530 singular => 'borrower',
1531 plural => 'borrowers',
1532 pk => 'borrowernumber',
1535 module => 'Koha::Libraries',
1536 singular => 'branch',
1537 plural => 'branches',
1541 module => 'Koha::Items',
1547 module => 'Koha::News',
1553 module => 'Koha::Acquisition::Orders',
1554 singular => 'order',
1556 pk => 'ordernumber',
1559 module => 'Koha::Holds',
1562 fk => [ 'borrowernumber', 'biblionumber' ],
1565 module => 'Koha::Serials',
1566 singular => 'serial',
1567 plural => 'serials',
1571 module => 'Koha::Subscriptions',
1572 singular => 'subscription',
1573 plural => 'subscriptions',
1574 pk => 'subscriptionid',
1577 module => 'Koha::Suggestions',
1578 singular => 'suggestion',
1579 plural => 'suggestions',
1580 pk => 'suggestionid',
1583 module => 'Koha::Checkouts',
1584 singular => 'checkout',
1585 plural => 'checkouts',
1589 module => 'Koha::Old::Checkouts',
1590 singular => 'old_checkout',
1591 plural => 'old_checkouts',
1595 module => 'Koha::Checkouts',
1596 singular => 'overdue',
1597 plural => 'overdues',
1600 borrower_modifications => {
1601 module => 'Koha::Patron::Modifications',
1602 singular => 'patron_modification',
1603 plural => 'patron_modifications',
1604 fk => 'verification_token',
1608 foreach my $table ( keys %$tables ) {
1609 next unless $config->{$table};
1611 my $ref = ref( $tables->{$table} ) || q{};
1612 my $module = $config->{$table}->{module};
1614 if ( can_load( modules => { $module => undef } ) ) {
1615 my $pk = $config->{$table}->{pk};
1616 my $fk = $config->{$table}->{fk};
1619 my $values = $tables->{$table} || [];
1620 unless ( ref( $values ) eq 'ARRAY' ) {
1621 croak "ERROR processing table $table. Wrong API call.";
1623 my $key = $pk ? $pk : $fk;
1624 # $key does not come from user input
1625 my $objects = $module->search(
1626 { $key => $values },
1628 # We want to retrieve the data in the same order
1630 # field is a MySQLism, but they are no other way to do it
1631 # To be generic we could do it in perl, but we will need to fetch
1632 # all the data then order them
1633 @$values ? ( order_by => \[ "field($key, " . join( ', ', @$values ) . ")" ] ) : ()
1636 $params->{ $config->{$table}->{plural} } = $objects;
1638 elsif ( $ref eq q{} || $ref eq 'HASH' ) {
1639 my $id = ref $ref eq 'HASH' ? $tables->{$table}->{$pk} : $tables->{$table};
1641 if ( $fk ) { # Using a foreign key for lookup
1642 if ( ref( $fk ) eq 'ARRAY' ) { # Foreign key is multi-column
1644 foreach my $key ( @$fk ) {
1645 $search->{$key} = $id->{$key};
1647 $object = $module->search( $search )->last();
1648 } else { # Foreign key is single column
1649 $object = $module->search( { $fk => $id } )->last();
1651 } else { # using the table's primary key for lookup
1652 $object = $module->find($id);
1654 $params->{ $config->{$table}->{singular} } = $object;
1656 else { # $ref eq 'ARRAY'
1658 if ( @{ $tables->{$table} } == 1 ) { # Param is a single key
1659 $object = $module->search( { $pk => $tables->{$table} } )->last();
1661 else { # Params are mutliple foreign keys
1662 croak "Multiple foreign keys (table $table) should be passed using an hashref";
1664 $params->{ $config->{$table}->{singular} } = $object;
1668 croak "ERROR LOADING MODULE $module: $Module::Load::Conditional::ERROR";
1672 $params->{today} = output_pref({ dt => dt_from_string, dateformat => 'iso' });
1677 =head3 add_tt_filters
1679 $content = add_tt_filters( $content );
1681 Add TT filters to some specific fields if needed.
1683 For now we only add the Remove_MARC_punctuation TT filter to biblio and biblioitem fields
1687 sub add_tt_filters {
1688 my ( $content ) = @_;
1689 $content =~ s|\[%\s*biblio\.(.*?)\s*%\]|[% biblio.$1 \| \$Remove_MARC_punctuation %]|gxms;
1690 $content =~ s|\[%\s*biblioitem\.(.*?)\s*%\]|[% biblioitem.$1 \| \$Remove_MARC_punctuation %]|gxms;
1694 =head2 get_item_content
1696 my $item = Koha::Items->find(...)->unblessed;
1697 my @item_content_fields = qw( date_due title barcode author itemnumber );
1698 my $item_content = C4::Letters::get_item_content({
1700 item_content_fields => \@item_content_fields
1703 This function generates a tab-separated list of values for the passed item. Dates
1704 are formatted following the current setup.
1708 sub get_item_content {
1709 my ( $params ) = @_;
1710 my $item = $params->{item};
1711 my $dateonly = $params->{dateonly} || 0;
1712 my $item_content_fields = $params->{item_content_fields} || [];
1714 return unless $item;
1716 my @item_info = map {
1720 { dt => dt_from_string( $item->{$_} ), dateonly => $dateonly } );
1724 } @$item_content_fields;
1725 return join( "\t", @item_info ) . "\n";