3 # Copyright 2000-2002 Katipo Communications
5 # This file is part of Koha.
7 # Koha is free software; you can redistribute it and/or modify it
8 # under the terms of the GNU General Public License as published by
9 # the Free Software Foundation; either version 3 of the License, or
10 # (at your option) any later version.
12 # Koha is distributed in the hope that it will be useful, but
13 # WITHOUT ANY WARRANTY; without even the implied warranty of
14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 # GNU General Public License for more details.
17 # You should have received a copy of the GNU General Public License
18 # along with Koha; if not, see <http://www.gnu.org/licenses>.
24 use Date
::Calc
qw( Add_Delta_Days );
28 use Module
::Load
::Conditional
qw(can_load);
31 use C4
::Members
::Attributes
qw(GetBorrowerAttributes);
36 use Koha
::SMS
::Providers
;
39 use Koha
::Notice
::Messages
;
40 use Koha
::DateUtils
qw( format_sqldatetime dt_from_string );
43 use vars
qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
49 &GetLetters &GetLettersAvailableForALibrary &GetLetterTemplates &DelLetter &GetPreparedLetter &GetWrappedLetter &addalert &getalert &delalert &findrelatedto &SendAlerts &GetPrintMessages &GetMessageTransportTypes
55 C4::Letters - Give functions for Letters management
63 "Letters" is the tool used in Koha to manage informations sent to the patrons and/or the library. This include some cron jobs like
64 late issues, as well as other tasks like sending a mail to users that have subscribed to a "serial issue alert" (= being warned every time a new issue has arrived at the library)
66 Letters are managed through "alerts" sent by Koha on some events. All "alert" related functions are in this module too.
68 =head2 GetLetters([$module])
70 $letters = &GetLetters($module);
71 returns informations about letters.
72 if needed, $module filters for letters given module
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, $type, $externalid)
272 - $borrowernumber : the number of the borrower subscribing to the alert
273 - $type : the type of alert.
274 - $externalid : the primary key of the object to put alert on. For issues, the alert is made on subscriptionid.
276 create an alert and return the alertid (primary key)
281 my ( $borrowernumber, $type, $externalid ) = @_;
282 my $dbh = C4
::Context
->dbh;
285 "insert into alert (borrowernumber, type, externalid) values (?,?,?)");
286 $sth->execute( $borrowernumber, $type, $externalid );
288 # get the alert number newly created and return it
289 my $alertid = $dbh->{'mysql_insertid'};
293 =head2 delalert ($alertid)
296 - alertid : the alert id
302 my $alertid = shift or die "delalert() called without valid argument (alertid)"; # it's gonna die anyway.
303 $debug and warn "delalert: deleting alertid $alertid";
304 my $sth = C4
::Context
->dbh->prepare("delete from alert where alertid=?");
305 $sth->execute($alertid);
308 =head2 getalert ([$borrowernumber], [$type], [$externalid])
311 - $borrowernumber : the number of the borrower subscribing to the alert
312 - $type : the type of alert.
313 - $externalid : the primary key of the object to put alert on. For issues, the alert is made on subscriptionid.
314 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.
319 my ( $borrowernumber, $type, $externalid ) = @_;
320 my $dbh = C4
::Context
->dbh;
321 my $query = "SELECT a.*, b.branchcode FROM alert a JOIN borrowers b USING(borrowernumber) WHERE 1";
323 if ($borrowernumber and $borrowernumber =~ /^\d+$/) {
324 $query .= " AND borrowernumber=?";
325 push @bind, $borrowernumber;
328 $query .= " AND type=?";
332 $query .= " AND externalid=?";
333 push @bind, $externalid;
335 my $sth = $dbh->prepare($query);
336 $sth->execute(@bind);
337 return $sth->fetchall_arrayref({});
340 =head2 findrelatedto($type, $externalid)
343 - $type : the type of alert
344 - $externalid : the id of the "object" to query
346 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.
347 When type=issue, the id is related to a subscriptionid and this sub returns the name of the biblio.
352 # When type=virtual, the id is related to a virtual shelf and this sub returns the name of the sub
355 my $type = shift or return;
356 my $externalid = shift or return;
357 my $q = ($type eq 'issue' ) ?
358 "select title as result from subscription left join biblio on subscription.biblionumber=biblio.biblionumber where subscriptionid=?" :
359 ($type eq 'borrower') ?
360 "select concat(firstname,' ',surname) from borrowers where borrowernumber=?" : undef;
362 warn "findrelatedto(): Illegal type '$type'";
365 my $sth = C4
::Context
->dbh->prepare($q);
366 $sth->execute($externalid);
367 my ($result) = $sth->fetchrow;
373 my $err = &SendAlerts($type, $externalid, $letter_code);
376 - $type : the type of alert
377 - $externalid : the id of the "object" to query
378 - $letter_code : the notice template to use
380 C<&SendAlerts> sends an email notice directly to a patron or a vendor.
382 Currently it supports ($type):
383 - claim serial issues (claimissues)
384 - claim acquisition orders (claimacquisition)
385 - send acquisition orders to the vendor (orderacquisition)
386 - notify patrons about newly received serial issues (issue)
387 - notify patrons when their account is created (members)
389 Returns undef or { error => 'message } on failure.
390 Returns true on success.
395 my ( $type, $externalid, $letter_code ) = @_;
396 my $dbh = C4
::Context
->dbh;
397 if ( $type eq 'issue' ) {
399 # prepare the letter...
400 # search the subscriptionid
403 "SELECT subscriptionid FROM serial WHERE serialid=?");
404 $sth->execute($externalid);
405 my ($subscriptionid) = $sth->fetchrow
406 or warn( "No subscription for '$externalid'" ),
409 # search the biblionumber
412 "SELECT biblionumber FROM subscription WHERE subscriptionid=?");
413 $sth->execute($subscriptionid);
414 my ($biblionumber) = $sth->fetchrow
415 or warn( "No biblionumber for '$subscriptionid'" ),
419 # find the list of borrowers to alert
420 my $alerts = getalert
( '', 'issue', $subscriptionid );
422 my $patron = Koha
::Patrons
->find( $_->{borrowernumber
} );
423 next unless $patron; # Just in case
424 my $email = $patron->email or next;
426 # warn "sending issues...";
427 my $userenv = C4
::Context
->userenv;
428 my $library = Koha
::Libraries
->find( $_->{branchcode
} );
429 my $letter = GetPreparedLetter
(
431 letter_code
=> $letter_code,
432 branchcode
=> $userenv->{branch
},
434 'branches' => $_->{branchcode
},
435 'biblio' => $biblionumber,
436 'biblioitems' => $biblionumber,
437 'borrowers' => $patron->unblessed,
438 'subscription' => $subscriptionid,
439 'serial' => $externalid,
445 my $message = Koha
::Email
->new();
446 my %mail = $message->create_message_headers(
449 from
=> $library->branchemail,
450 replyto
=> $library->branchreplyto,
451 sender
=> $library->branchreturnpath,
452 subject
=> Encode
::encode
( "UTF-8", "" . $letter->{title
} ),
453 message
=> $letter->{'is_html'}
454 ? _wrap_html
( Encode
::encode
( "UTF-8", $letter->{'content'} ),
455 Encode
::encode
( "UTF-8", "" . $letter->{'title'} ))
456 : Encode
::encode
( "UTF-8", "" . $letter->{'content'} ),
457 contenttype
=> $letter->{'is_html'}
458 ?
'text/html; charset="utf-8"'
459 : 'text/plain; charset="utf-8"',
462 unless( Mail
::Sendmail
::sendmail
(%mail) ) {
463 carp
$Mail::Sendmail
::error
;
464 return { error
=> $Mail::Sendmail
::error
};
468 elsif ( $type eq 'claimacquisition' or $type eq 'claimissues' or $type eq 'orderacquisition' ) {
470 # prepare the letter...
475 if ( $type eq 'claimacquisition') {
477 SELECT aqorders
.*,aqbasket
.*,biblio
.*,biblioitems
.*
479 LEFT JOIN aqbasket ON aqbasket
.basketno
=aqorders
.basketno
480 LEFT JOIN biblio ON aqorders
.biblionumber
=biblio
.biblionumber
481 LEFT JOIN biblioitems ON aqorders
.biblionumber
=biblioitems
.biblionumber
482 WHERE aqorders
.ordernumber IN
(
486 carp
"No order selected";
487 return { error
=> "no_order_selected" };
489 $strsth .= join( ",", ('?') x @
$externalid ) . ")";
490 $action = "ACQUISITION CLAIM";
491 $sthorders = $dbh->prepare($strsth);
492 $sthorders->execute( @
$externalid );
493 $dataorders = $sthorders->fetchall_arrayref( {} );
496 if ($type eq 'claimissues') {
498 SELECT serial
.*,subscription
.*, biblio
.*, aqbooksellers
.*,
499 aqbooksellers
.id AS booksellerid
501 LEFT JOIN subscription ON serial
.subscriptionid
=subscription
.subscriptionid
502 LEFT JOIN biblio ON serial
.biblionumber
=biblio
.biblionumber
503 LEFT JOIN aqbooksellers ON subscription
.aqbooksellerid
=aqbooksellers
.id
504 WHERE serial
.serialid IN
(
508 carp
"No Order selected";
509 return { error
=> "no_order_selected" };
512 $strsth .= join( ",", ('?') x @
$externalid ) . ")";
513 $action = "CLAIM ISSUE";
514 $sthorders = $dbh->prepare($strsth);
515 $sthorders->execute( @
$externalid );
516 $dataorders = $sthorders->fetchall_arrayref( {} );
519 if ( $type eq 'orderacquisition') {
521 SELECT aqorders
.*,aqbasket
.*,biblio
.*,biblioitems
.*
523 LEFT JOIN aqbasket ON aqbasket
.basketno
=aqorders
.basketno
524 LEFT JOIN biblio ON aqorders
.biblionumber
=biblio
.biblionumber
525 LEFT JOIN biblioitems ON aqorders
.biblionumber
=biblioitems
.biblionumber
526 WHERE aqbasket
.basketno
= ?
527 AND orderstatus IN
('new','ordered')
531 carp
"No basketnumber given";
532 return { error
=> "no_basketno" };
534 $action = "ACQUISITION ORDER";
535 $sthorders = $dbh->prepare($strsth);
536 $sthorders->execute($externalid);
537 $dataorders = $sthorders->fetchall_arrayref( {} );
541 $dbh->prepare("select * from aqbooksellers where id=?");
542 $sthbookseller->execute( $dataorders->[0]->{booksellerid
} );
543 my $databookseller = $sthbookseller->fetchrow_hashref;
545 my $addressee = $type eq 'claimacquisition' || $type eq 'orderacquisition' ?
'acqprimary' : 'serialsprimary';
548 $dbh->prepare("SELECT * FROM aqcontacts WHERE booksellerid=? AND $type=1 ORDER BY $addressee DESC");
549 $sthcontact->execute( $dataorders->[0]->{booksellerid
} );
550 my $datacontact = $sthcontact->fetchrow_hashref;
554 push @email, $databookseller->{bookselleremail
} if $databookseller->{bookselleremail
};
555 push @email, $datacontact->{email
} if ( $datacontact && $datacontact->{email
} );
557 warn "Bookseller $dataorders->[0]->{booksellerid} without emails";
558 return { error
=> "no_email" };
561 while ($addlcontact = $sthcontact->fetchrow_hashref) {
562 push @cc, $addlcontact->{email
} if ( $addlcontact && $addlcontact->{email
} );
565 my $userenv = C4
::Context
->userenv;
566 my $letter = GetPreparedLetter
(
568 letter_code
=> $letter_code,
569 branchcode
=> $userenv->{branch
},
571 'branches' => $userenv->{branch
},
572 'aqbooksellers' => $databookseller,
573 'aqcontacts' => $datacontact,
575 repeat
=> $dataorders,
577 ) or return { error
=> "no_letter" };
579 # Remove the order tag
580 $letter->{content
} =~ s/<order>(.*?)<\/order>/$1/gxms
;
583 my $library = Koha
::Libraries
->find( $userenv->{branch
} );
585 To
=> join( ',', @email),
586 Cc
=> join( ',', @cc),
587 From
=> $library->branchemail || C4
::Context
->preference('KohaAdminEmailAddress'),
588 Subject
=> Encode
::encode
( "UTF-8", "" . $letter->{title
} ),
589 Message
=> $letter->{'is_html'}
590 ? _wrap_html
( Encode
::encode
( "UTF-8", $letter->{'content'} ),
591 Encode
::encode
( "UTF-8", "" . $letter->{'title'} ))
592 : Encode
::encode
( "UTF-8", "" . $letter->{'content'} ),
593 'Content-Type' => $letter->{'is_html'}
594 ?
'text/html; charset="utf-8"'
595 : 'text/plain; charset="utf-8"',
598 if ($type eq 'claimacquisition' || $type eq 'claimissues' ) {
599 $mail{'Reply-to'} = C4
::Context
->preference('ReplytoDefault')
600 if C4
::Context
->preference('ReplytoDefault');
601 $mail{'Sender'} = C4
::Context
->preference('ReturnpathDefault')
602 if C4
::Context
->preference('ReturnpathDefault');
603 $mail{'Bcc'} = $userenv->{emailaddress
}
604 if C4
::Context
->preference("ClaimsBccCopy");
607 unless ( Mail
::Sendmail
::sendmail
(%mail) ) {
608 carp
$Mail::Sendmail
::error
;
609 return { error
=> $Mail::Sendmail
::error
};
617 . join( ',', @email )
622 ) if C4
::Context
->preference("LetterLog");
624 # send an "account details" notice to a newly created user
625 elsif ( $type eq 'members' ) {
626 my $library = Koha
::Libraries
->find( $externalid->{branchcode
} )->unblessed;
627 my $letter = GetPreparedLetter
(
629 letter_code
=> $letter_code,
630 branchcode
=> $externalid->{'branchcode'},
632 'branches' => $library,
633 'borrowers' => $externalid->{'borrowernumber'},
635 substitute
=> { 'borrowers.password' => $externalid->{'password'} },
638 return { error
=> "no_email" } unless $externalid->{'emailaddr'};
639 my $email = Koha
::Email
->new();
640 my %mail = $email->create_message_headers(
642 to
=> $externalid->{'emailaddr'},
643 from
=> $library->{branchemail
},
644 replyto
=> $library->{branchreplyto
},
645 sender
=> $library->{branchreturnpath
},
646 subject
=> Encode
::encode
( "UTF-8", "" . $letter->{'title'} ),
647 message
=> $letter->{'is_html'}
648 ? _wrap_html
( Encode
::encode
( "UTF-8", $letter->{'content'} ),
649 Encode
::encode
( "UTF-8", "" . $letter->{'title'} ) )
650 : Encode
::encode
( "UTF-8", "" . $letter->{'content'} ),
651 contenttype
=> $letter->{'is_html'}
652 ?
'text/html; charset="utf-8"'
653 : 'text/plain; charset="utf-8"',
656 unless( Mail
::Sendmail
::sendmail
(%mail) ) {
657 carp
$Mail::Sendmail
::error
;
658 return { error
=> $Mail::Sendmail
::error
};
662 # If we come here, return an OK status
666 =head2 GetPreparedLetter( %params )
669 module => letter module, mandatory
670 letter_code => letter code, mandatory
671 branchcode => for letter selection, if missing default system letter taken
672 tables => a hashref with table names as keys. Values are either:
673 - a scalar - primary key value
674 - an arrayref - primary key values
675 - a hashref - full record
676 substitute => custom substitution key/value pairs
677 repeat => records to be substituted on consecutive lines:
678 - an arrayref - tries to guess what needs substituting by
679 taking remaining << >> tokensr; not recommended
680 - a hashref token => @tables - replaces <token> << >> << >> </token>
681 subtemplate for each @tables row; table is a hashref as above
682 want_librarian => boolean, if set to true triggers librarian details
683 substitution from the userenv
685 letter fields hashref (title & content useful)
689 sub GetPreparedLetter
{
692 my $letter = $params{letter
};
695 my $module = $params{module
} or croak
"No module";
696 my $letter_code = $params{letter_code
} or croak
"No letter_code";
697 my $branchcode = $params{branchcode
} || '';
698 my $mtt = $params{message_transport_type
} || 'email';
699 my $lang = $params{lang
} || 'default';
701 $letter = getletter
( $module, $letter_code, $branchcode, $mtt, $lang );
704 $letter = getletter
( $module, $letter_code, $branchcode, $mtt, 'default' )
705 or warn( "No $module $letter_code letter transported by " . $mtt ),
710 my $tables = $params{tables
} || {};
711 my $substitute = $params{substitute
} || {};
712 my $loops = $params{loops
} || {}; # loops is not supported for historical notices syntax
713 my $repeat = $params{repeat
};
714 %$tables || %$substitute || $repeat || %$loops
715 or carp
( "ERROR: nothing to substitute - both 'tables', 'loops' and 'substitute' are empty" ),
717 my $want_librarian = $params{want_librarian
};
720 while ( my ($token, $val) = each %$substitute ) {
721 if ( $token eq 'items.content' ) {
722 $val =~ s
|\n|<br
/>|g
if $letter->{is_html
};
725 $letter->{title
} =~ s/<<$token>>/$val/g;
726 $letter->{content
} =~ s/<<$token>>/$val/g;
730 my $OPACBaseURL = C4
::Context
->preference('OPACBaseURL');
731 $letter->{content
} =~ s/<<OPACBaseURL>>/$OPACBaseURL/go;
733 if ($want_librarian) {
734 # parsing librarian name
735 my $userenv = C4
::Context
->userenv;
736 $letter->{content
} =~ s/<<LibrarianFirstname>>/$userenv->{firstname}/go;
737 $letter->{content
} =~ s/<<LibrarianSurname>>/$userenv->{surname}/go;
738 $letter->{content
} =~ s/<<LibrarianEmailaddress>>/$userenv->{emailaddress}/go;
741 my ($repeat_no_enclosing_tags, $repeat_enclosing_tags);
744 if (ref ($repeat) eq 'ARRAY' ) {
745 $repeat_no_enclosing_tags = $repeat;
747 $repeat_enclosing_tags = $repeat;
751 if ($repeat_enclosing_tags) {
752 while ( my ($tag, $tag_tables) = each %$repeat_enclosing_tags ) {
753 if ( $letter->{content
} =~ m!<$tag>(.*)</$tag>!s ) {
756 my %subletter = ( title
=> '', content
=> $subcontent );
757 _substitute_tables
( \
%subletter, $_ );
760 $letter->{content
} =~ s!<$tag>.*</$tag>!join( "\n", @lines )!se;
766 _substitute_tables
( $letter, $tables );
769 if ($repeat_no_enclosing_tags) {
770 if ( $letter->{content
} =~ m/[^\n]*<<.*>>[^\n]*/so ) {
775 $c =~ s/<<count>>/$i/go;
776 foreach my $field ( keys %{$_} ) {
777 $c =~ s/(<<[^\.]+.$field>>)/$_->{$field}/;
781 } @
$repeat_no_enclosing_tags;
783 my $replaceby = join( "\n", @lines );
784 $letter->{content
} =~ s/\Q$line\E/$replaceby/s;
788 $letter->{content
} = _process_tt
(
790 content
=> $letter->{content
},
793 substitute
=> $substitute,
797 $letter->{content
} =~ s/<<\S*>>//go; #remove any stragglers
802 sub _substitute_tables
{
803 my ( $letter, $tables ) = @_;
804 while ( my ($table, $param) = each %$tables ) {
807 my $ref = ref $param;
810 if ($ref && $ref eq 'HASH') {
814 my $sth = _parseletter_sth
($table);
816 warn "_parseletter_sth('$table') failed to return a valid sth. No substitution will be done for that table.";
819 $sth->execute( $ref ? @
$param : $param );
821 $values = $sth->fetchrow_hashref;
825 _parseletter
( $letter, $table, $values );
829 sub _parseletter_sth
{
833 carp
"ERROR: _parseletter_sth() called without argument (table)";
836 # NOTE: we used to check whether we had a statement handle cached in
837 # a %handles module-level variable. This was a dumb move and
838 # broke things for the rest of us. prepare_cached is a better
839 # way to cache statement handles anyway.
841 ($table eq 'biblio' ) ?
"SELECT * FROM $table WHERE biblionumber = ?" :
842 ($table eq 'biblioitems' ) ?
"SELECT * FROM $table WHERE biblionumber = ?" :
843 ($table eq 'items' ) ?
"SELECT * FROM $table WHERE itemnumber = ?" :
844 ($table eq 'issues' ) ?
"SELECT * FROM $table WHERE itemnumber = ?" :
845 ($table eq 'old_issues' ) ?
"SELECT * FROM $table WHERE itemnumber = ? ORDER BY timestamp DESC LIMIT 1" :
846 ($table eq 'reserves' ) ?
"SELECT * FROM $table WHERE borrowernumber = ? and biblionumber = ?" :
847 ($table eq 'borrowers' ) ?
"SELECT * FROM $table WHERE borrowernumber = ?" :
848 ($table eq 'branches' ) ?
"SELECT * FROM $table WHERE branchcode = ?" :
849 ($table eq 'suggestions' ) ?
"SELECT * FROM $table WHERE suggestionid = ?" :
850 ($table eq 'aqbooksellers') ?
"SELECT * FROM $table WHERE id = ?" :
851 ($table eq 'aqorders' ) ?
"SELECT * FROM $table WHERE ordernumber = ?" :
852 ($table eq 'opac_news' ) ?
"SELECT * FROM $table WHERE idnew = ?" :
853 ($table eq 'article_requests') ?
"SELECT * FROM $table WHERE id = ?" :
854 ($table eq 'borrower_modifications') ?
"SELECT * FROM $table WHERE verification_token = ?" :
855 ($table eq 'subscription') ?
"SELECT * FROM $table WHERE subscriptionid = ?" :
856 ($table eq 'serial') ?
"SELECT * FROM $table WHERE serialid = ?" :
859 warn "ERROR: No _parseletter_sth query for table '$table'";
860 return; # nothing to get
862 unless ($sth = C4
::Context
->dbh->prepare_cached($query)) {
863 warn "ERROR: Failed to prepare query: '$query'";
866 return $sth; # now cache is populated for that $table
869 =head2 _parseletter($letter, $table, $values)
872 - $letter : a hash to letter fields (title & content useful)
873 - $table : the Koha table to parse.
874 - $values_in : table record hashref
875 parse all fields from a table, and replace values in title & content with the appropriate value
876 (not exported sub, used only internally)
881 my ( $letter, $table, $values_in ) = @_;
883 # Work on a local copy of $values_in (passed by reference) to avoid side effects
884 # in callers ( by changing / formatting values )
885 my $values = $values_in ?
{ %$values_in } : {};
887 if ( $table eq 'borrowers' && $values->{'dateexpiry'} ){
888 $values->{'dateexpiry'} = output_pref
({ str
=> $values->{dateexpiry
}, dateonly
=> 1 });
891 if ( $table eq 'reserves' && $values->{'waitingdate'} ) {
892 $values->{'waitingdate'} = output_pref
({ dt
=> dt_from_string
( $values->{'waitingdate'} ), dateonly
=> 1 });
895 if ($letter->{content
} && $letter->{content
} =~ /<<today>>/) {
896 my $todaysdate = output_pref
( DateTime
->now() );
897 $letter->{content
} =~ s/<<today>>/$todaysdate/go;
900 while ( my ($field, $val) = each %$values ) {
901 $val =~ s/\p{P}$// if $val && $table=~/biblio/;
902 #BZ 9886: Assuming that we want to eliminate ISBD punctuation here
903 #Therefore adding the test on biblio. This includes biblioitems,
904 #but excludes items. Removed unneeded global and lookahead.
906 if ( $table=~/^borrowers$/ && $field=~/^streettype$/ ) {
907 my $av = Koha
::AuthorisedValues
->search({ category
=> 'ROADTYPE', authorised_value
=> $val });
908 $val = $av->count ?
$av->next->lib : '';
912 my $replacedby = defined ($val) ?
$val : '';
914 and not $replacedby =~ m
|0000-00-00|
915 and not $replacedby =~ m
|9999-12-31|
916 and $replacedby =~ m
|^\d
{4}-\d
{2}-\d
{2}( \d
{2}:\d
{2}:\d
{2})?
$| )
918 # If the value is XXXX-YY-ZZ[ AA:BB:CC] we assume it is a date
919 my $dateonly = defined $1 ?
0 : 1; #$1 refers to the capture group wrapped in parentheses. In this case, that's the hours, minutes, seconds.
920 my $re_dateonly_filter = qr{ $field( \s* \| \s* dateonly\s*)?>> }xms;
922 for my $letter_field ( qw( title content ) ) {
923 my $filter_string_used = q{};
924 if ( $letter->{ $letter_field } =~ $re_dateonly_filter ) {
925 # We overwrite $dateonly if the filter exists and we have a time in the datetime
926 $filter_string_used = $1 || q{};
927 $dateonly = $1 unless $dateonly;
929 my $replacedby_date = eval {
930 output_pref
({ dt
=> dt_from_string
( $replacedby ), dateonly
=> $dateonly });
933 if ( $letter->{ $letter_field } ) {
934 $letter->{ $letter_field } =~ s/\Q<<$table.$field$filter_string_used>>\E/$replacedby_date/g;
935 $letter->{ $letter_field } =~ s/\Q<<$field$filter_string_used>>\E/$replacedby_date/g;
939 # Other fields replacement
941 for my $letter_field ( qw( title content ) ) {
942 if ( $letter->{ $letter_field } ) {
943 $letter->{ $letter_field } =~ s/<<$table.$field>>/$replacedby/g;
944 $letter->{ $letter_field } =~ s/<<$field>>/$replacedby/g;
950 if ($table eq 'borrowers' && $letter->{content
}) {
951 if ( my $attributes = GetBorrowerAttributes
($values->{borrowernumber
}) ) {
953 foreach (@
$attributes) {
954 my $code = $_->{code
};
955 my $val = $_->{value_description
} || $_->{value
};
956 $val =~ s/\p{P}(?=$)//g if $val;
957 next unless $val gt '';
959 push @
{ $attr{$code} }, $val;
961 while ( my ($code, $val_ar) = each %attr ) {
962 my $replacefield = "<<borrower-attribute:$code>>";
963 my $replacedby = join ',', @
$val_ar;
964 $letter->{content
} =~ s/$replacefield/$replacedby/g;
973 my $success = EnqueueLetter( { letter => $letter,
974 borrowernumber => '12', message_transport_type => 'email' } )
976 places a letter in the message_queue database table, which will
977 eventually get processed (sent) by the process_message_queue.pl
978 cronjob when it calls SendQueuedMessages.
980 return message_id on success
985 my $params = shift or return;
987 return unless exists $params->{'letter'};
988 # return unless exists $params->{'borrowernumber'};
989 return unless exists $params->{'message_transport_type'};
991 my $content = $params->{letter
}->{content
};
992 $content =~ s/\s+//g if(defined $content);
993 if ( not defined $content or $content eq '' ) {
994 warn "Trying to add an empty message to the message queue" if $debug;
998 # If we have any attachments we should encode then into the body.
999 if ( $params->{'attachments'} ) {
1000 $params->{'letter'} = _add_attachments
(
1001 { letter
=> $params->{'letter'},
1002 attachments
=> $params->{'attachments'},
1003 message
=> MIME
::Lite
->new( Type
=> 'multipart/mixed' ),
1008 my $dbh = C4
::Context
->dbh();
1009 my $statement = << 'ENDSQL';
1010 INSERT INTO message_queue
1011 ( borrowernumber
, subject
, content
, metadata
, letter_code
, message_transport_type
, status
, time_queued
, to_address
, from_address
, content_type
)
1013 ( ?
, ?
, ?
, ?
, ?
, ?
, ?
, NOW
(), ?
, ?
, ?
)
1016 my $sth = $dbh->prepare($statement);
1017 my $result = $sth->execute(
1018 $params->{'borrowernumber'}, # borrowernumber
1019 $params->{'letter'}->{'title'}, # subject
1020 $params->{'letter'}->{'content'}, # content
1021 $params->{'letter'}->{'metadata'} || '', # metadata
1022 $params->{'letter'}->{'code'} || '', # letter_code
1023 $params->{'message_transport_type'}, # message_transport_type
1025 $params->{'to_address'}, # to_address
1026 $params->{'from_address'}, # from_address
1027 $params->{'letter'}->{'content-type'}, # content_type
1029 return $dbh->last_insert_id(undef,undef,'message_queue', undef);
1032 =head2 SendQueuedMessages ([$hashref])
1034 my $sent = SendQueuedMessages({
1035 letter_code => $letter_code,
1036 borrowernumber => $who_letter_is_for,
1042 Sends all of the 'pending' items in the message queue, unless
1043 parameters are passed.
1045 The letter_code, borrowernumber and limit parameters are used
1046 to build a parameter set for _get_unsent_messages, thus limiting
1047 which pending messages will be processed. They are all optional.
1049 The verbose parameter can be used to generate debugging output.
1050 It is also optional.
1052 Returns number of messages sent.
1056 sub SendQueuedMessages
{
1059 my $which_unsent_messages = {
1060 'limit' => $params->{'limit'} // 0,
1061 'borrowernumber' => $params->{'borrowernumber'} // q{},
1062 'letter_code' => $params->{'letter_code'} // q{},
1063 'type' => $params->{'type'} // q{},
1065 my $unsent_messages = _get_unsent_messages
( $which_unsent_messages );
1066 MESSAGE
: foreach my $message ( @
$unsent_messages ) {
1067 my $message_object = Koha
::Notice
::Messages
->find( $message->{message_id
} );
1068 # If this fails the database is unwritable and we won't manage to send a message that continues to be marked 'pending'
1069 $message_object->make_column_dirty('status');
1070 return unless $message_object->store;
1072 # warn Data::Dumper->Dump( [ $message ], [ 'message' ] );
1073 warn sprintf( 'sending %s message to patron: %s',
1074 $message->{'message_transport_type'},
1075 $message->{'borrowernumber'} || 'Admin' )
1076 if $params->{'verbose'} or $debug;
1077 # This is just begging for subclassing
1078 next MESSAGE
if ( lc($message->{'message_transport_type'}) eq 'rss' );
1079 if ( lc( $message->{'message_transport_type'} ) eq 'email' ) {
1080 _send_message_by_email
( $message, $params->{'username'}, $params->{'password'}, $params->{'method'} );
1082 elsif ( lc( $message->{'message_transport_type'} ) eq 'sms' ) {
1083 if ( C4
::Context
->preference('SMSSendDriver') eq 'Email' ) {
1084 my $patron = Koha
::Patrons
->find( $message->{borrowernumber
} );
1085 my $sms_provider = Koha
::SMS
::Providers
->find( $patron->sms_provider_id );
1086 unless ( $sms_provider ) {
1087 warn sprintf( "Patron %s has no sms provider id set!", $message->{'borrowernumber'} ) if $params->{'verbose'} or $debug;
1088 _set_message_status
( { message_id
=> $message->{'message_id'}, status
=> 'failed' } );
1091 unless ( $patron->smsalertnumber ) {
1092 _set_message_status
( { message_id
=> $message->{'message_id'}, status
=> 'failed' } );
1093 warn sprintf( "No smsalertnumber found for patron %s!", $message->{'borrowernumber'} ) if $params->{'verbose'} or $debug;
1096 $message->{to_address
} = $patron->smsalertnumber; #Sometime this is set to email - sms should always use smsalertnumber
1097 $message->{to_address
} .= '@' . $sms_provider->domain();
1098 _update_message_to_address
($message->{'message_id'},$message->{to_address
});
1099 _send_message_by_email
( $message, $params->{'username'}, $params->{'password'}, $params->{'method'} );
1101 _send_message_by_sms
( $message );
1105 return scalar( @
$unsent_messages );
1108 =head2 GetRSSMessages
1110 my $message_list = GetRSSMessages( { limit => 10, borrowernumber => '14' } )
1112 returns a listref of all queued RSS messages for a particular person.
1116 sub GetRSSMessages
{
1119 return unless $params;
1120 return unless ref $params;
1121 return unless $params->{'borrowernumber'};
1123 return _get_unsent_messages
( { message_transport_type
=> 'rss',
1124 limit
=> $params->{'limit'},
1125 borrowernumber
=> $params->{'borrowernumber'}, } );
1128 =head2 GetPrintMessages
1130 my $message_list = GetPrintMessages( { borrowernumber => $borrowernumber } )
1132 Returns a arrayref of all queued print messages (optionally, for a particular
1137 sub GetPrintMessages
{
1138 my $params = shift || {};
1140 return _get_unsent_messages
( { message_transport_type
=> 'print',
1141 borrowernumber
=> $params->{'borrowernumber'},
1145 =head2 GetQueuedMessages ([$hashref])
1147 my $messages = GetQueuedMessage( { borrowernumber => '123', limit => 20 } );
1149 fetches messages out of the message queue.
1152 list of hashes, each has represents a message in the message queue.
1156 sub GetQueuedMessages
{
1159 my $dbh = C4
::Context
->dbh();
1160 my $statement = << 'ENDSQL';
1161 SELECT message_id
, borrowernumber
, subject
, content
, message_transport_type
, status
, time_queued
1167 if ( exists $params->{'borrowernumber'} ) {
1168 push @whereclauses, ' borrowernumber = ? ';
1169 push @query_params, $params->{'borrowernumber'};
1172 if ( @whereclauses ) {
1173 $statement .= ' WHERE ' . join( 'AND', @whereclauses );
1176 if ( defined $params->{'limit'} ) {
1177 $statement .= ' LIMIT ? ';
1178 push @query_params, $params->{'limit'};
1181 my $sth = $dbh->prepare( $statement );
1182 my $result = $sth->execute( @query_params );
1183 return $sth->fetchall_arrayref({});
1186 =head2 GetMessageTransportTypes
1188 my @mtt = GetMessageTransportTypes();
1190 returns an arrayref of transport types
1194 sub GetMessageTransportTypes
{
1195 my $dbh = C4
::Context
->dbh();
1196 my $mtts = $dbh->selectcol_arrayref("
1197 SELECT message_transport_type
1198 FROM message_transport_types
1199 ORDER BY message_transport_type
1206 my $message = C4::Letters::Message($message_id);
1211 my ( $message_id ) = @_;
1212 return unless $message_id;
1213 my $dbh = C4
::Context
->dbh;
1214 return $dbh->selectrow_hashref(q
|
1215 SELECT message_id
, borrowernumber
, subject
, content
, metadata
, letter_code
, message_transport_type
, status
, time_queued
, to_address
, from_address
, content_type
1217 WHERE message_id
= ?
1218 |, {}, $message_id );
1221 =head2 ResendMessage
1223 Attempt to resend a message which has failed previously.
1225 my $has_been_resent = C4::Letters::ResendMessage($message_id);
1227 Updates the message to 'pending' status so that
1228 it will be resent later on.
1230 returns 1 on success, 0 on failure, undef if no message was found
1235 my $message_id = shift;
1236 return unless $message_id;
1238 my $message = GetMessage
( $message_id );
1239 return unless $message;
1241 if ( $message->{status
} ne 'pending' ) {
1242 $rv = C4
::Letters
::_set_message_status
({
1243 message_id
=> $message_id,
1244 status
=> 'pending',
1246 $rv = $rv > 0?
1: 0;
1247 # Clear destination email address to force address update
1248 _update_message_to_address
( $message_id, undef ) if $rv &&
1249 $message->{message_transport_type
} eq 'email';
1254 =head2 _add_attachements
1257 letter - the standard letter hashref
1258 attachments - listref of attachments. each attachment is a hashref of:
1259 type - the mime type, like 'text/plain'
1260 content - the actual attachment
1261 filename - the name of the attachment.
1262 message - a MIME::Lite object to attach these to.
1264 returns your letter object, with the content updated.
1268 sub _add_attachments
{
1271 my $letter = $params->{'letter'};
1272 my $attachments = $params->{'attachments'};
1273 return $letter unless @
$attachments;
1274 my $message = $params->{'message'};
1276 # First, we have to put the body in as the first attachment
1278 Type
=> $letter->{'content-type'} || 'TEXT',
1279 Data
=> $letter->{'is_html'}
1280 ? _wrap_html
($letter->{'content'}, $letter->{'title'})
1281 : $letter->{'content'},
1284 foreach my $attachment ( @
$attachments ) {
1286 Type
=> $attachment->{'type'},
1287 Data
=> $attachment->{'content'},
1288 Filename
=> $attachment->{'filename'},
1291 # we're forcing list context here to get the header, not the count back from grep.
1292 ( $letter->{'content-type'} ) = grep( /^Content-Type:/, split( /\n/, $params->{'message'}->header_as_string ) );
1293 $letter->{'content-type'} =~ s/^Content-Type:\s+//;
1294 $letter->{'content'} = $message->body_as_string;
1300 =head2 _get_unsent_messages
1302 This function's parameter hash reference takes the following
1303 optional named parameters:
1304 message_transport_type: method of message sending (e.g. email, sms, etc.)
1305 borrowernumber : who the message is to be sent
1306 letter_code : type of message being sent (e.g. PASSWORD_RESET)
1307 limit : maximum number of messages to send
1309 This function returns an array of matching hash referenced rows from
1310 message_queue with some borrower information added.
1314 sub _get_unsent_messages
{
1317 my $dbh = C4
::Context
->dbh();
1319 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
1320 FROM message_queue mq
1321 LEFT JOIN borrowers b ON b
.borrowernumber
= mq
.borrowernumber
1325 my @query_params = ('pending');
1326 if ( ref $params ) {
1327 if ( $params->{'message_transport_type'} ) {
1328 $statement .= ' AND mq.message_transport_type = ? ';
1329 push @query_params, $params->{'message_transport_type'};
1331 if ( $params->{'borrowernumber'} ) {
1332 $statement .= ' AND mq.borrowernumber = ? ';
1333 push @query_params, $params->{'borrowernumber'};
1335 if ( $params->{'letter_code'} ) {
1336 $statement .= ' AND mq.letter_code = ? ';
1337 push @query_params, $params->{'letter_code'};
1339 if ( $params->{'type'} ) {
1340 $statement .= ' AND message_transport_type = ? ';
1341 push @query_params, $params->{'type'};
1343 if ( $params->{'limit'} ) {
1344 $statement .= ' limit ? ';
1345 push @query_params, $params->{'limit'};
1349 $debug and warn "_get_unsent_messages SQL: $statement";
1350 $debug and warn "_get_unsent_messages params: " . join(',',@query_params);
1351 my $sth = $dbh->prepare( $statement );
1352 my $result = $sth->execute( @query_params );
1353 return $sth->fetchall_arrayref({});
1356 sub _send_message_by_email
{
1357 my $message = shift or return;
1358 my ($username, $password, $method) = @_;
1360 my $patron = Koha
::Patrons
->find( $message->{borrowernumber
} );
1361 my $to_address = $message->{'to_address'};
1362 unless ($to_address) {
1364 warn "FAIL: No 'to_address' and INVALID borrowernumber ($message->{borrowernumber})";
1365 _set_message_status
( { message_id
=> $message->{'message_id'},
1366 status
=> 'failed' } );
1369 $to_address = $patron->notice_email_address;
1370 unless ($to_address) {
1371 # warn "FAIL: No 'to_address' and no email for " . ($member->{surname} ||'') . ", borrowernumber ($message->{borrowernumber})";
1372 # warning too verbose for this more common case?
1373 _set_message_status
( { message_id
=> $message->{'message_id'},
1374 status
=> 'failed' } );
1379 my $utf8 = decode
('MIME-Header', $message->{'subject'} );
1380 $message->{subject
}= encode
('MIME-Header', $utf8);
1381 my $subject = encode
('UTF-8', $message->{'subject'});
1382 my $content = encode
('UTF-8', $message->{'content'});
1383 my $content_type = $message->{'content_type'} || 'text/plain; charset="UTF-8"';
1384 my $is_html = $content_type =~ m/html/io;
1385 my $branch_email = undef;
1386 my $branch_replyto = undef;
1387 my $branch_returnpath = undef;
1389 my $library = $patron->library;
1390 $branch_email = $library->branchemail;
1391 $branch_replyto = $library->branchreplyto;
1392 $branch_returnpath = $library->branchreturnpath;
1394 my $email = Koha
::Email
->new();
1395 my %sendmail_params = $email->create_message_headers(
1398 from
=> $message->{'from_address'} || $branch_email,
1399 replyto
=> $branch_replyto,
1400 sender
=> $branch_returnpath,
1401 subject
=> $subject,
1402 message
=> $is_html ? _wrap_html
( $content, $subject ) : $content,
1403 contenttype
=> $content_type
1407 $sendmail_params{'Auth'} = {user
=> $username, pass
=> $password, method
=> $method} if $username;
1408 if ( my $bcc = C4
::Context
->preference('NoticeBcc') ) {
1409 $sendmail_params{ Bcc
} = $bcc;
1412 _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
1414 if ( Mail
::Sendmail
::sendmail
( %sendmail_params ) ) {
1415 _set_message_status
( { message_id
=> $message->{'message_id'},
1416 status
=> 'sent' } );
1419 _set_message_status
( { message_id
=> $message->{'message_id'},
1420 status
=> 'failed' } );
1421 carp
$Mail::Sendmail
::error
;
1427 my ($content, $title) = @_;
1429 my $css = C4
::Context
->preference("NoticeCSS") || '';
1430 $css = qq{<link rel
="stylesheet" type
="text/css" href
="$css">} if $css;
1432 <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
1433 "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
1434 <html lang="en" xml:lang="en" xmlns="http://www.w3.org/1999/xhtml">
1436 <title>$title</title>
1437 <meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
1448 my ( $message ) = @_;
1449 my $dbh = C4
::Context
->dbh;
1450 my $count = $dbh->selectrow_array(q
|
1453 WHERE message_transport_type
= ?
1454 AND borrowernumber
= ?
1456 AND CAST
(time_queued AS date
) = CAST
(NOW
() AS date
)
1459 |, {}, $message->{message_transport_type
}, $message->{borrowernumber
}, $message->{letter_code
}, $message->{content
} );
1463 sub _send_message_by_sms
{
1464 my $message = shift or return;
1465 my $patron = Koha
::Patrons
->find( $message->{borrowernumber
} );
1467 unless ( $patron and $patron->smsalertnumber ) {
1468 _set_message_status
( { message_id
=> $message->{'message_id'},
1469 status
=> 'failed' } );
1473 if ( _is_duplicate
( $message ) ) {
1474 _set_message_status
( { message_id
=> $message->{'message_id'},
1475 status
=> 'failed' } );
1479 my $success = C4
::SMS
->send_sms( { destination
=> $patron->smsalertnumber,
1480 message
=> $message->{'content'},
1482 _set_message_status
( { message_id
=> $message->{'message_id'},
1483 status
=> ($success ?
'sent' : 'failed') } );
1487 sub _update_message_to_address
{
1489 my $dbh = C4
::Context
->dbh();
1490 $dbh->do('UPDATE message_queue SET to_address=? WHERE message_id=?',undef,($to,$id));
1493 sub _set_message_status
{
1494 my $params = shift or return;
1496 foreach my $required_parameter ( qw( message_id status ) ) {
1497 return unless exists $params->{ $required_parameter };
1500 my $dbh = C4
::Context
->dbh();
1501 my $statement = 'UPDATE message_queue SET status= ? WHERE message_id = ?';
1502 my $sth = $dbh->prepare( $statement );
1503 my $result = $sth->execute( $params->{'status'},
1504 $params->{'message_id'} );
1509 my ( $params ) = @_;
1511 my $content = $params->{content
};
1512 my $tables = $params->{tables
};
1513 my $loops = $params->{loops
};
1514 my $substitute = $params->{substitute
} || {};
1516 my $use_template_cache = C4
::Context
->config('template_cache_dir') && defined $ENV{GATEWAY_INTERFACE
};
1517 my $template = Template
->new(
1521 PLUGIN_BASE
=> 'Koha::Template::Plugin',
1522 COMPILE_EXT
=> $use_template_cache ?
'.ttc' : '',
1523 COMPILE_DIR
=> $use_template_cache ? C4
::Context
->config('template_cache_dir') : '',
1525 ENCODING
=> 'UTF-8',
1527 ) or die Template
->error();
1529 my $tt_params = { %{ _get_tt_params
( $tables ) }, %{ _get_tt_params
( $loops, 'is_a_loop' ) }, %$substitute };
1531 $content = add_tt_filters
( $content );
1532 $content = qq|[% USE KohaDates
%][% USE Remove_MARC_punctuation
%]$content|;
1535 $template->process( \
$content, $tt_params, \
$output ) || croak
"ERROR PROCESSING TEMPLATE: " . $template->error();
1540 sub _get_tt_params
{
1541 my ($tables, $is_a_loop) = @_;
1547 article_requests
=> {
1548 module
=> 'Koha::ArticleRequests',
1549 singular
=> 'article_request',
1550 plural
=> 'article_requests',
1554 module
=> 'Koha::Biblios',
1555 singular
=> 'biblio',
1556 plural
=> 'biblios',
1557 pk
=> 'biblionumber',
1560 module
=> 'Koha::Biblioitems',
1561 singular
=> 'biblioitem',
1562 plural
=> 'biblioitems',
1563 pk
=> 'biblioitemnumber',
1566 module
=> 'Koha::Patrons',
1567 singular
=> 'borrower',
1568 plural
=> 'borrowers',
1569 pk
=> 'borrowernumber',
1572 module
=> 'Koha::Libraries',
1573 singular
=> 'branch',
1574 plural
=> 'branches',
1578 module
=> 'Koha::Items',
1584 module
=> 'Koha::News',
1590 module
=> 'Koha::Acquisition::Orders',
1591 singular
=> 'order',
1593 pk
=> 'ordernumber',
1596 module
=> 'Koha::Holds',
1599 fk
=> [ 'borrowernumber', 'biblionumber' ],
1602 module
=> 'Koha::Serials',
1603 singular
=> 'serial',
1604 plural
=> 'serials',
1608 module
=> 'Koha::Subscriptions',
1609 singular
=> 'subscription',
1610 plural
=> 'subscriptions',
1611 pk
=> 'subscriptionid',
1614 module
=> 'Koha::Suggestions',
1615 singular
=> 'suggestion',
1616 plural
=> 'suggestions',
1617 pk
=> 'suggestionid',
1620 module
=> 'Koha::Checkouts',
1621 singular
=> 'checkout',
1622 plural
=> 'checkouts',
1626 module
=> 'Koha::Old::Checkouts',
1627 singular
=> 'old_checkout',
1628 plural
=> 'old_checkouts',
1632 module
=> 'Koha::Checkouts',
1633 singular
=> 'overdue',
1634 plural
=> 'overdues',
1637 borrower_modifications
=> {
1638 module
=> 'Koha::Patron::Modifications',
1639 singular
=> 'patron_modification',
1640 plural
=> 'patron_modifications',
1641 fk
=> 'verification_token',
1645 foreach my $table ( keys %$tables ) {
1646 next unless $config->{$table};
1648 my $ref = ref( $tables->{$table} ) || q{};
1649 my $module = $config->{$table}->{module
};
1651 if ( can_load
( modules
=> { $module => undef } ) ) {
1652 my $pk = $config->{$table}->{pk
};
1653 my $fk = $config->{$table}->{fk
};
1656 my $values = $tables->{$table} || [];
1657 unless ( ref( $values ) eq 'ARRAY' ) {
1658 croak
"ERROR processing table $table. Wrong API call.";
1660 my $key = $pk ?
$pk : $fk;
1661 # $key does not come from user input
1662 my $objects = $module->search(
1663 { $key => $values },
1665 # We want to retrieve the data in the same order
1667 # field is a MySQLism, but they are no other way to do it
1668 # To be generic we could do it in perl, but we will need to fetch
1669 # all the data then order them
1670 @
$values ?
( order_by
=> \
[ "field($key, " . join( ', ', @
$values ) . ")" ] ) : ()
1673 $params->{ $config->{$table}->{plural
} } = $objects;
1675 elsif ( $ref eq q{} || $ref eq 'HASH' ) {
1676 my $id = ref $ref eq 'HASH' ?
$tables->{$table}->{$pk} : $tables->{$table};
1678 if ( $fk ) { # Using a foreign key for lookup
1679 if ( ref( $fk ) eq 'ARRAY' ) { # Foreign key is multi-column
1681 foreach my $key ( @
$fk ) {
1682 $search->{$key} = $id->{$key};
1684 $object = $module->search( $search )->last();
1685 } else { # Foreign key is single column
1686 $object = $module->search( { $fk => $id } )->last();
1688 } else { # using the table's primary key for lookup
1689 $object = $module->find($id);
1691 $params->{ $config->{$table}->{singular
} } = $object;
1693 else { # $ref eq 'ARRAY'
1695 if ( @
{ $tables->{$table} } == 1 ) { # Param is a single key
1696 $object = $module->search( { $pk => $tables->{$table} } )->last();
1698 else { # Params are mutliple foreign keys
1699 croak
"Multiple foreign keys (table $table) should be passed using an hashref";
1701 $params->{ $config->{$table}->{singular
} } = $object;
1705 croak
"ERROR LOADING MODULE $module: $Module::Load::Conditional::ERROR";
1709 $params->{today
} = output_pref
({ dt
=> dt_from_string
, dateformat
=> 'iso' });
1714 =head3 add_tt_filters
1716 $content = add_tt_filters( $content );
1718 Add TT filters to some specific fields if needed.
1720 For now we only add the Remove_MARC_punctuation TT filter to biblio and biblioitem fields
1724 sub add_tt_filters
{
1725 my ( $content ) = @_;
1726 $content =~ s
|\
[%\s
*biblio\
.(.*?
)\s
*%\
]|[% biblio
.$1 \
| \
$Remove_MARC_punctuation %]|gxms
;
1727 $content =~ s
|\
[%\s
*biblioitem\
.(.*?
)\s
*%\
]|[% biblioitem
.$1 \
| \
$Remove_MARC_punctuation %]|gxms
;
1731 =head2 get_item_content
1733 my $item = Koha::Items->find(...)->unblessed;
1734 my @item_content_fields = qw( date_due title barcode author itemnumber );
1735 my $item_content = C4::Letters::get_item_content({
1737 item_content_fields => \@item_content_fields
1740 This function generates a tab-separated list of values for the passed item. Dates
1741 are formatted following the current setup.
1745 sub get_item_content
{
1746 my ( $params ) = @_;
1747 my $item = $params->{item
};
1748 my $dateonly = $params->{dateonly
} || 0;
1749 my $item_content_fields = $params->{item_content_fields
} || [];
1751 return unless $item;
1753 my @item_info = map {
1757 { dt
=> dt_from_string
( $item->{$_} ), dateonly
=> $dateonly } );
1761 } @
$item_content_fields;
1762 return join( "\t", @item_info ) . "\n";