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 );
42 use Koha
::Subscriptions
;
44 use vars
qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
50 &GetLetters &GetLettersAvailableForALibrary &GetLetterTemplates &DelLetter &GetPreparedLetter &GetWrappedLetter &SendAlerts &GetPrintMessages &GetMessageTransportTypes
56 C4::Letters - Give functions for Letters management
64 "Letters" is the tool used in Koha to manage informations sent to the patrons and/or the library. This include some cron jobs like
65 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)
67 Letters are managed through "alerts" sent by Koha on some events. All "alert" related functions are in this module too.
69 =head2 GetLetters([$module])
71 $letters = &GetLetters($module);
72 returns informations about letters.
73 if needed, $module filters for letters given module
75 DEPRECATED - You must use Koha::Notice::Templates instead
76 The group by clause is confusing and can lead to issues
82 my $module = $filters->{module
};
83 my $code = $filters->{code
};
84 my $branchcode = $filters->{branchcode
};
85 my $dbh = C4
::Context
->dbh;
86 my $letters = $dbh->selectall_arrayref(
88 SELECT code
, module
, name
92 . ( $module ? q
| AND module
= ?
| : q
|| )
93 . ( $code ? q
| AND code
= ?
| : q
|| )
94 . ( defined $branchcode ? q
| AND branchcode
= ?
| : q
|| )
95 . q
| GROUP BY code
, module
, name ORDER BY name
|, { Slice
=> {} }
96 , ( $module ?
$module : () )
97 , ( $code ?
$code : () )
98 , ( defined $branchcode ?
$branchcode : () )
104 =head2 GetLetterTemplates
106 my $letter_templates = GetLetterTemplates(
108 module => 'circulation',
110 branchcode => 'CPL', # '' for default,
114 Return a hashref of letter templates.
118 sub GetLetterTemplates
{
121 my $module = $params->{module
};
122 my $code = $params->{code
};
123 my $branchcode = $params->{branchcode
} // '';
124 my $dbh = C4
::Context
->dbh;
125 my $letters = $dbh->selectall_arrayref(
127 SELECT module
, code
, branchcode
, name
, is_html
, title
, content
, message_transport_type
, lang
134 , $module, $code, $branchcode
140 =head2 GetLettersAvailableForALibrary
142 my $letters = GetLettersAvailableForALibrary(
144 branchcode => 'CPL', # '' for default
145 module => 'circulation',
149 Return an arrayref of letters, sorted by name.
150 If a specific letter exist for the given branchcode, it will be retrieve.
151 Otherwise the default letter will be.
155 sub GetLettersAvailableForALibrary
{
157 my $branchcode = $filters->{branchcode
};
158 my $module = $filters->{module
};
160 croak
"module should be provided" unless $module;
162 my $dbh = C4
::Context
->dbh;
163 my $default_letters = $dbh->selectall_arrayref(
165 SELECT module
, code
, branchcode
, name
169 . q
| AND branchcode
= ''|
170 . ( $module ? q
| AND module
= ?
| : q
|| )
171 . q
| ORDER BY name
|, { Slice
=> {} }
172 , ( $module ?
$module : () )
175 my $specific_letters;
177 $specific_letters = $dbh->selectall_arrayref(
179 SELECT module
, code
, branchcode
, name
183 . q
| AND branchcode
= ?
|
184 . ( $module ? q
| AND module
= ?
| : q
|| )
185 . q
| ORDER BY name
|, { Slice
=> {} }
187 , ( $module ?
$module : () )
192 for my $l (@
$default_letters) {
193 $letters{ $l->{code
} } = $l;
195 for my $l (@
$specific_letters) {
196 # Overwrite the default letter with the specific one.
197 $letters{ $l->{code
} } = $l;
200 return [ map { $letters{$_} }
201 sort { $letters{$a}->{name
} cmp $letters{$b}->{name
} }
207 my ( $module, $code, $branchcode, $message_transport_type, $lang) = @_;
208 $message_transport_type //= '%';
209 $lang = 'default' unless( $lang && C4
::Context
->preference('TranslateNotices') );
212 my $only_my_library = C4
::Context
->only_my_library;
213 if ( $only_my_library and $branchcode ) {
214 $branchcode = C4
::Context
::mybranch
();
218 my $dbh = C4
::Context
->dbh;
219 my $sth = $dbh->prepare(q{
222 WHERE module=? AND code=? AND (branchcode = ? OR branchcode = '')
223 AND message_transport_type LIKE ?
225 ORDER BY branchcode DESC LIMIT 1
227 $sth->execute( $module, $code, $branchcode, $message_transport_type, $lang );
228 my $line = $sth->fetchrow_hashref
230 $line->{'content-type'} = 'text/html; charset="UTF-8"' if $line->{is_html
};
240 module => 'circulation',
246 Delete the letter. The mtt parameter is facultative.
247 If not given, all templates mathing the other parameters will be removed.
253 my $branchcode = $params->{branchcode
};
254 my $module = $params->{module
};
255 my $code = $params->{code
};
256 my $mtt = $params->{mtt
};
257 my $lang = $params->{lang
};
258 my $dbh = C4
::Context
->dbh;
265 . ( $mtt ? q
| AND message_transport_type
= ?
| : q
|| )
266 . ( $lang? q
| AND lang
= ?
| : q
|| )
267 , undef, $branchcode, $module, $code, ( $mtt ?
$mtt : () ), ( $lang ?
$lang : () ) );
272 my $err = &SendAlerts($type, $externalid, $letter_code);
275 - $type : the type of alert
276 - $externalid : the id of the "object" to query
277 - $letter_code : the notice template to use
279 C<&SendAlerts> sends an email notice directly to a patron or a vendor.
281 Currently it supports ($type):
282 - claim serial issues (claimissues)
283 - claim acquisition orders (claimacquisition)
284 - send acquisition orders to the vendor (orderacquisition)
285 - notify patrons about newly received serial issues (issue)
286 - notify patrons when their account is created (members)
288 Returns undef or { error => 'message } on failure.
289 Returns true on success.
294 my ( $type, $externalid, $letter_code ) = @_;
295 my $dbh = C4
::Context
->dbh;
296 if ( $type eq 'issue' ) {
298 # prepare the letter...
299 # search the subscriptionid
302 "SELECT subscriptionid FROM serial WHERE serialid=?");
303 $sth->execute($externalid);
304 my ($subscriptionid) = $sth->fetchrow
305 or warn( "No subscription for '$externalid'" ),
308 # search the biblionumber
311 "SELECT biblionumber FROM subscription WHERE subscriptionid=?");
312 $sth->execute($subscriptionid);
313 my ($biblionumber) = $sth->fetchrow
314 or warn( "No biblionumber for '$subscriptionid'" ),
318 # find the list of subscribers to notify
319 my $subscription = Koha
::Subscriptions
->find( $subscriptionid );
320 my $subscribers = $subscription->subscribers;
321 while ( my $patron = $subscribers->next ) {
322 my $email = $patron->email or next;
324 # warn "sending issues...";
325 my $userenv = C4
::Context
->userenv;
326 my $library = $patron->library;
327 my $letter = GetPreparedLetter
(
329 letter_code
=> $letter_code,
330 branchcode
=> $userenv->{branch
},
332 'branches' => $library->branchcode,
333 'biblio' => $biblionumber,
334 'biblioitems' => $biblionumber,
335 'borrowers' => $patron->unblessed,
336 'subscription' => $subscriptionid,
337 'serial' => $externalid,
343 my $message = Koha
::Email
->new();
344 my %mail = $message->create_message_headers(
347 from
=> $library->branchemail,
348 replyto
=> $library->branchreplyto,
349 sender
=> $library->branchreturnpath,
350 subject
=> Encode
::encode
( "UTF-8", "" . $letter->{title
} ),
351 message
=> $letter->{'is_html'}
352 ? _wrap_html
( Encode
::encode
( "UTF-8", $letter->{'content'} ),
353 Encode
::encode
( "UTF-8", "" . $letter->{'title'} ))
354 : Encode
::encode
( "UTF-8", "" . $letter->{'content'} ),
355 contenttype
=> $letter->{'is_html'}
356 ?
'text/html; charset="utf-8"'
357 : 'text/plain; charset="utf-8"',
360 unless( Mail
::Sendmail
::sendmail
(%mail) ) {
361 carp
$Mail::Sendmail
::error
;
362 return { error
=> $Mail::Sendmail
::error
};
366 elsif ( $type eq 'claimacquisition' or $type eq 'claimissues' or $type eq 'orderacquisition' ) {
368 # prepare the letter...
373 if ( $type eq 'claimacquisition') {
375 SELECT aqorders
.*,aqbasket
.*,biblio
.*,biblioitems
.*
377 LEFT JOIN aqbasket ON aqbasket
.basketno
=aqorders
.basketno
378 LEFT JOIN biblio ON aqorders
.biblionumber
=biblio
.biblionumber
379 LEFT JOIN biblioitems ON aqorders
.biblionumber
=biblioitems
.biblionumber
380 WHERE aqorders
.ordernumber IN
(
384 carp
"No order selected";
385 return { error
=> "no_order_selected" };
387 $strsth .= join( ",", ('?') x @
$externalid ) . ")";
388 $action = "ACQUISITION CLAIM";
389 $sthorders = $dbh->prepare($strsth);
390 $sthorders->execute( @
$externalid );
391 $dataorders = $sthorders->fetchall_arrayref( {} );
394 if ($type eq 'claimissues') {
396 SELECT serial
.*,subscription
.*, biblio
.*, aqbooksellers
.*,
397 aqbooksellers
.id AS booksellerid
399 LEFT JOIN subscription ON serial
.subscriptionid
=subscription
.subscriptionid
400 LEFT JOIN biblio ON serial
.biblionumber
=biblio
.biblionumber
401 LEFT JOIN aqbooksellers ON subscription
.aqbooksellerid
=aqbooksellers
.id
402 WHERE serial
.serialid IN
(
406 carp
"No Order selected";
407 return { error
=> "no_order_selected" };
410 $strsth .= join( ",", ('?') x @
$externalid ) . ")";
411 $action = "CLAIM ISSUE";
412 $sthorders = $dbh->prepare($strsth);
413 $sthorders->execute( @
$externalid );
414 $dataorders = $sthorders->fetchall_arrayref( {} );
417 if ( $type eq 'orderacquisition') {
419 SELECT aqorders
.*,aqbasket
.*,biblio
.*,biblioitems
.*
421 LEFT JOIN aqbasket ON aqbasket
.basketno
=aqorders
.basketno
422 LEFT JOIN biblio ON aqorders
.biblionumber
=biblio
.biblionumber
423 LEFT JOIN biblioitems ON aqorders
.biblionumber
=biblioitems
.biblionumber
424 WHERE aqbasket
.basketno
= ?
425 AND orderstatus IN
('new','ordered')
429 carp
"No basketnumber given";
430 return { error
=> "no_basketno" };
432 $action = "ACQUISITION ORDER";
433 $sthorders = $dbh->prepare($strsth);
434 $sthorders->execute($externalid);
435 $dataorders = $sthorders->fetchall_arrayref( {} );
439 $dbh->prepare("select * from aqbooksellers where id=?");
440 $sthbookseller->execute( $dataorders->[0]->{booksellerid
} );
441 my $databookseller = $sthbookseller->fetchrow_hashref;
443 my $addressee = $type eq 'claimacquisition' || $type eq 'orderacquisition' ?
'acqprimary' : 'serialsprimary';
446 $dbh->prepare("SELECT * FROM aqcontacts WHERE booksellerid=? AND $type=1 ORDER BY $addressee DESC");
447 $sthcontact->execute( $dataorders->[0]->{booksellerid
} );
448 my $datacontact = $sthcontact->fetchrow_hashref;
452 push @email, $databookseller->{bookselleremail
} if $databookseller->{bookselleremail
};
453 push @email, $datacontact->{email
} if ( $datacontact && $datacontact->{email
} );
455 warn "Bookseller $dataorders->[0]->{booksellerid} without emails";
456 return { error
=> "no_email" };
459 while ($addlcontact = $sthcontact->fetchrow_hashref) {
460 push @cc, $addlcontact->{email
} if ( $addlcontact && $addlcontact->{email
} );
463 my $userenv = C4
::Context
->userenv;
464 my $letter = GetPreparedLetter
(
466 letter_code
=> $letter_code,
467 branchcode
=> $userenv->{branch
},
469 'branches' => $userenv->{branch
},
470 'aqbooksellers' => $databookseller,
471 'aqcontacts' => $datacontact,
473 repeat
=> $dataorders,
475 ) or return { error
=> "no_letter" };
477 # Remove the order tag
478 $letter->{content
} =~ s/<order>(.*?)<\/order>/$1/gxms
;
481 my $library = Koha
::Libraries
->find( $userenv->{branch
} );
483 To
=> join( ',', @email),
484 Cc
=> join( ',', @cc),
485 From
=> $library->branchemail || C4
::Context
->preference('KohaAdminEmailAddress'),
486 Subject
=> Encode
::encode
( "UTF-8", "" . $letter->{title
} ),
487 Message
=> $letter->{'is_html'}
488 ? _wrap_html
( Encode
::encode
( "UTF-8", $letter->{'content'} ),
489 Encode
::encode
( "UTF-8", "" . $letter->{'title'} ))
490 : Encode
::encode
( "UTF-8", "" . $letter->{'content'} ),
491 'Content-Type' => $letter->{'is_html'}
492 ?
'text/html; charset="utf-8"'
493 : 'text/plain; charset="utf-8"',
496 if ($type eq 'claimacquisition' || $type eq 'claimissues' ) {
497 $mail{'Reply-to'} = C4
::Context
->preference('ReplytoDefault')
498 if C4
::Context
->preference('ReplytoDefault');
499 $mail{'Sender'} = C4
::Context
->preference('ReturnpathDefault')
500 if C4
::Context
->preference('ReturnpathDefault');
501 $mail{'Bcc'} = $userenv->{emailaddress
}
502 if C4
::Context
->preference("ClaimsBccCopy");
505 unless ( Mail
::Sendmail
::sendmail
(%mail) ) {
506 carp
$Mail::Sendmail
::error
;
507 return { error
=> $Mail::Sendmail
::error
};
515 . join( ',', @email )
520 ) if C4
::Context
->preference("LetterLog");
522 # send an "account details" notice to a newly created user
523 elsif ( $type eq 'members' ) {
524 my $library = Koha
::Libraries
->find( $externalid->{branchcode
} )->unblessed;
525 my $letter = GetPreparedLetter
(
527 letter_code
=> $letter_code,
528 branchcode
=> $externalid->{'branchcode'},
530 'branches' => $library,
531 'borrowers' => $externalid->{'borrowernumber'},
533 substitute
=> { 'borrowers.password' => $externalid->{'password'} },
536 return { error
=> "no_email" } unless $externalid->{'emailaddr'};
537 my $email = Koha
::Email
->new();
538 my %mail = $email->create_message_headers(
540 to
=> $externalid->{'emailaddr'},
541 from
=> $library->{branchemail
},
542 replyto
=> $library->{branchreplyto
},
543 sender
=> $library->{branchreturnpath
},
544 subject
=> Encode
::encode
( "UTF-8", "" . $letter->{'title'} ),
545 message
=> $letter->{'is_html'}
546 ? _wrap_html
( Encode
::encode
( "UTF-8", $letter->{'content'} ),
547 Encode
::encode
( "UTF-8", "" . $letter->{'title'} ) )
548 : Encode
::encode
( "UTF-8", "" . $letter->{'content'} ),
549 contenttype
=> $letter->{'is_html'}
550 ?
'text/html; charset="utf-8"'
551 : 'text/plain; charset="utf-8"',
554 unless( Mail
::Sendmail
::sendmail
(%mail) ) {
555 carp
$Mail::Sendmail
::error
;
556 return { error
=> $Mail::Sendmail
::error
};
560 # If we come here, return an OK status
564 =head2 GetPreparedLetter( %params )
567 module => letter module, mandatory
568 letter_code => letter code, mandatory
569 branchcode => for letter selection, if missing default system letter taken
570 tables => a hashref with table names as keys. Values are either:
571 - a scalar - primary key value
572 - an arrayref - primary key values
573 - a hashref - full record
574 substitute => custom substitution key/value pairs
575 repeat => records to be substituted on consecutive lines:
576 - an arrayref - tries to guess what needs substituting by
577 taking remaining << >> tokensr; not recommended
578 - a hashref token => @tables - replaces <token> << >> << >> </token>
579 subtemplate for each @tables row; table is a hashref as above
580 want_librarian => boolean, if set to true triggers librarian details
581 substitution from the userenv
583 letter fields hashref (title & content useful)
587 sub GetPreparedLetter
{
590 my $letter = $params{letter
};
593 my $module = $params{module
} or croak
"No module";
594 my $letter_code = $params{letter_code
} or croak
"No letter_code";
595 my $branchcode = $params{branchcode
} || '';
596 my $mtt = $params{message_transport_type
} || 'email';
597 my $lang = $params{lang
} || 'default';
599 $letter = getletter
( $module, $letter_code, $branchcode, $mtt, $lang );
602 $letter = getletter
( $module, $letter_code, $branchcode, $mtt, 'default' )
603 or warn( "No $module $letter_code letter transported by " . $mtt ),
608 my $tables = $params{tables
} || {};
609 my $substitute = $params{substitute
} || {};
610 my $loops = $params{loops
} || {}; # loops is not supported for historical notices syntax
611 my $repeat = $params{repeat
};
612 %$tables || %$substitute || $repeat || %$loops
613 or carp
( "ERROR: nothing to substitute - both 'tables', 'loops' and 'substitute' are empty" ),
615 my $want_librarian = $params{want_librarian
};
618 while ( my ($token, $val) = each %$substitute ) {
619 if ( $token eq 'items.content' ) {
620 $val =~ s
|\n|<br
/>|g
if $letter->{is_html
};
623 $letter->{title
} =~ s/<<$token>>/$val/g;
624 $letter->{content
} =~ s/<<$token>>/$val/g;
628 my $OPACBaseURL = C4
::Context
->preference('OPACBaseURL');
629 $letter->{content
} =~ s/<<OPACBaseURL>>/$OPACBaseURL/go;
631 if ($want_librarian) {
632 # parsing librarian name
633 my $userenv = C4
::Context
->userenv;
634 $letter->{content
} =~ s/<<LibrarianFirstname>>/$userenv->{firstname}/go;
635 $letter->{content
} =~ s/<<LibrarianSurname>>/$userenv->{surname}/go;
636 $letter->{content
} =~ s/<<LibrarianEmailaddress>>/$userenv->{emailaddress}/go;
639 my ($repeat_no_enclosing_tags, $repeat_enclosing_tags);
642 if (ref ($repeat) eq 'ARRAY' ) {
643 $repeat_no_enclosing_tags = $repeat;
645 $repeat_enclosing_tags = $repeat;
649 if ($repeat_enclosing_tags) {
650 while ( my ($tag, $tag_tables) = each %$repeat_enclosing_tags ) {
651 if ( $letter->{content
} =~ m!<$tag>(.*)</$tag>!s ) {
654 my %subletter = ( title
=> '', content
=> $subcontent );
655 _substitute_tables
( \
%subletter, $_ );
658 $letter->{content
} =~ s!<$tag>.*</$tag>!join( "\n", @lines )!se;
664 _substitute_tables
( $letter, $tables );
667 if ($repeat_no_enclosing_tags) {
668 if ( $letter->{content
} =~ m/[^\n]*<<.*>>[^\n]*/so ) {
673 $c =~ s/<<count>>/$i/go;
674 foreach my $field ( keys %{$_} ) {
675 $c =~ s/(<<[^\.]+.$field>>)/$_->{$field}/;
679 } @
$repeat_no_enclosing_tags;
681 my $replaceby = join( "\n", @lines );
682 $letter->{content
} =~ s/\Q$line\E/$replaceby/s;
686 $letter->{content
} = _process_tt
(
688 content
=> $letter->{content
},
691 substitute
=> $substitute,
695 $letter->{content
} =~ s/<<\S*>>//go; #remove any stragglers
700 sub _substitute_tables
{
701 my ( $letter, $tables ) = @_;
702 while ( my ($table, $param) = each %$tables ) {
705 my $ref = ref $param;
708 if ($ref && $ref eq 'HASH') {
712 my $sth = _parseletter_sth
($table);
714 warn "_parseletter_sth('$table') failed to return a valid sth. No substitution will be done for that table.";
717 $sth->execute( $ref ? @
$param : $param );
719 $values = $sth->fetchrow_hashref;
723 _parseletter
( $letter, $table, $values );
727 sub _parseletter_sth
{
731 carp
"ERROR: _parseletter_sth() called without argument (table)";
734 # NOTE: we used to check whether we had a statement handle cached in
735 # a %handles module-level variable. This was a dumb move and
736 # broke things for the rest of us. prepare_cached is a better
737 # way to cache statement handles anyway.
739 ($table eq 'biblio' ) ?
"SELECT * FROM $table WHERE biblionumber = ?" :
740 ($table eq 'biblioitems' ) ?
"SELECT * FROM $table WHERE biblionumber = ?" :
741 ($table eq 'items' ) ?
"SELECT * FROM $table WHERE itemnumber = ?" :
742 ($table eq 'issues' ) ?
"SELECT * FROM $table WHERE itemnumber = ?" :
743 ($table eq 'old_issues' ) ?
"SELECT * FROM $table WHERE itemnumber = ? ORDER BY timestamp DESC LIMIT 1" :
744 ($table eq 'reserves' ) ?
"SELECT * FROM $table WHERE borrowernumber = ? and biblionumber = ?" :
745 ($table eq 'borrowers' ) ?
"SELECT * FROM $table WHERE borrowernumber = ?" :
746 ($table eq 'branches' ) ?
"SELECT * FROM $table WHERE branchcode = ?" :
747 ($table eq 'suggestions' ) ?
"SELECT * FROM $table WHERE suggestionid = ?" :
748 ($table eq 'aqbooksellers') ?
"SELECT * FROM $table WHERE id = ?" :
749 ($table eq 'aqorders' ) ?
"SELECT * FROM $table WHERE ordernumber = ?" :
750 ($table eq 'opac_news' ) ?
"SELECT * FROM $table WHERE idnew = ?" :
751 ($table eq 'article_requests') ?
"SELECT * FROM $table WHERE id = ?" :
752 ($table eq 'borrower_modifications') ?
"SELECT * FROM $table WHERE verification_token = ?" :
753 ($table eq 'subscription') ?
"SELECT * FROM $table WHERE subscriptionid = ?" :
754 ($table eq 'serial') ?
"SELECT * FROM $table WHERE serialid = ?" :
757 warn "ERROR: No _parseletter_sth query for table '$table'";
758 return; # nothing to get
760 unless ($sth = C4
::Context
->dbh->prepare_cached($query)) {
761 warn "ERROR: Failed to prepare query: '$query'";
764 return $sth; # now cache is populated for that $table
767 =head2 _parseletter($letter, $table, $values)
770 - $letter : a hash to letter fields (title & content useful)
771 - $table : the Koha table to parse.
772 - $values_in : table record hashref
773 parse all fields from a table, and replace values in title & content with the appropriate value
774 (not exported sub, used only internally)
779 my ( $letter, $table, $values_in ) = @_;
781 # Work on a local copy of $values_in (passed by reference) to avoid side effects
782 # in callers ( by changing / formatting values )
783 my $values = $values_in ?
{ %$values_in } : {};
785 if ( $table eq 'borrowers' && $values->{'dateexpiry'} ){
786 $values->{'dateexpiry'} = output_pref
({ str
=> $values->{dateexpiry
}, dateonly
=> 1 });
789 if ( $table eq 'reserves' && $values->{'waitingdate'} ) {
790 $values->{'waitingdate'} = output_pref
({ dt
=> dt_from_string
( $values->{'waitingdate'} ), dateonly
=> 1 });
793 if ($letter->{content
} && $letter->{content
} =~ /<<today>>/) {
794 my $todaysdate = output_pref
( DateTime
->now() );
795 $letter->{content
} =~ s/<<today>>/$todaysdate/go;
798 while ( my ($field, $val) = each %$values ) {
799 $val =~ s/\p{P}$// if $val && $table=~/biblio/;
800 #BZ 9886: Assuming that we want to eliminate ISBD punctuation here
801 #Therefore adding the test on biblio. This includes biblioitems,
802 #but excludes items. Removed unneeded global and lookahead.
804 if ( $table=~/^borrowers$/ && $field=~/^streettype$/ ) {
805 my $av = Koha
::AuthorisedValues
->search({ category
=> 'ROADTYPE', authorised_value
=> $val });
806 $val = $av->count ?
$av->next->lib : '';
810 my $replacedby = defined ($val) ?
$val : '';
812 and not $replacedby =~ m
|0000-00-00|
813 and not $replacedby =~ m
|9999-12-31|
814 and $replacedby =~ m
|^\d
{4}-\d
{2}-\d
{2}( \d
{2}:\d
{2}:\d
{2})?
$| )
816 # If the value is XXXX-YY-ZZ[ AA:BB:CC] we assume it is a date
817 my $dateonly = defined $1 ?
0 : 1; #$1 refers to the capture group wrapped in parentheses. In this case, that's the hours, minutes, seconds.
818 my $re_dateonly_filter = qr{ $field( \s* \| \s* dateonly\s*)?>> }xms;
820 for my $letter_field ( qw( title content ) ) {
821 my $filter_string_used = q{};
822 if ( $letter->{ $letter_field } =~ $re_dateonly_filter ) {
823 # We overwrite $dateonly if the filter exists and we have a time in the datetime
824 $filter_string_used = $1 || q{};
825 $dateonly = $1 unless $dateonly;
827 my $replacedby_date = eval {
828 output_pref
({ dt
=> dt_from_string
( $replacedby ), dateonly
=> $dateonly });
831 if ( $letter->{ $letter_field } ) {
832 $letter->{ $letter_field } =~ s/\Q<<$table.$field$filter_string_used>>\E/$replacedby_date/g;
833 $letter->{ $letter_field } =~ s/\Q<<$field$filter_string_used>>\E/$replacedby_date/g;
837 # Other fields replacement
839 for my $letter_field ( qw( title content ) ) {
840 if ( $letter->{ $letter_field } ) {
841 $letter->{ $letter_field } =~ s/<<$table.$field>>/$replacedby/g;
842 $letter->{ $letter_field } =~ s/<<$field>>/$replacedby/g;
848 if ($table eq 'borrowers' && $letter->{content
}) {
849 if ( my $attributes = GetBorrowerAttributes
($values->{borrowernumber
}) ) {
851 foreach (@
$attributes) {
852 my $code = $_->{code
};
853 my $val = $_->{value_description
} || $_->{value
};
854 $val =~ s/\p{P}(?=$)//g if $val;
855 next unless $val gt '';
857 push @
{ $attr{$code} }, $val;
859 while ( my ($code, $val_ar) = each %attr ) {
860 my $replacefield = "<<borrower-attribute:$code>>";
861 my $replacedby = join ',', @
$val_ar;
862 $letter->{content
} =~ s/$replacefield/$replacedby/g;
871 my $success = EnqueueLetter( { letter => $letter,
872 borrowernumber => '12', message_transport_type => 'email' } )
874 places a letter in the message_queue database table, which will
875 eventually get processed (sent) by the process_message_queue.pl
876 cronjob when it calls SendQueuedMessages.
878 return message_id on success
883 my $params = shift or return;
885 return unless exists $params->{'letter'};
886 # return unless exists $params->{'borrowernumber'};
887 return unless exists $params->{'message_transport_type'};
889 my $content = $params->{letter
}->{content
};
890 $content =~ s/\s+//g if(defined $content);
891 if ( not defined $content or $content eq '' ) {
892 warn "Trying to add an empty message to the message queue" if $debug;
896 # If we have any attachments we should encode then into the body.
897 if ( $params->{'attachments'} ) {
898 $params->{'letter'} = _add_attachments
(
899 { letter
=> $params->{'letter'},
900 attachments
=> $params->{'attachments'},
901 message
=> MIME
::Lite
->new( Type
=> 'multipart/mixed' ),
906 my $dbh = C4
::Context
->dbh();
907 my $statement = << 'ENDSQL';
908 INSERT INTO message_queue
909 ( borrowernumber
, subject
, content
, metadata
, letter_code
, message_transport_type
, status
, time_queued
, to_address
, from_address
, content_type
)
911 ( ?
, ?
, ?
, ?
, ?
, ?
, ?
, NOW
(), ?
, ?
, ?
)
914 my $sth = $dbh->prepare($statement);
915 my $result = $sth->execute(
916 $params->{'borrowernumber'}, # borrowernumber
917 $params->{'letter'}->{'title'}, # subject
918 $params->{'letter'}->{'content'}, # content
919 $params->{'letter'}->{'metadata'} || '', # metadata
920 $params->{'letter'}->{'code'} || '', # letter_code
921 $params->{'message_transport_type'}, # message_transport_type
923 $params->{'to_address'}, # to_address
924 $params->{'from_address'}, # from_address
925 $params->{'letter'}->{'content-type'}, # content_type
927 return $dbh->last_insert_id(undef,undef,'message_queue', undef);
930 =head2 SendQueuedMessages ([$hashref])
932 my $sent = SendQueuedMessages({
933 letter_code => $letter_code,
934 borrowernumber => $who_letter_is_for,
940 Sends all of the 'pending' items in the message queue, unless
941 parameters are passed.
943 The letter_code, borrowernumber and limit parameters are used
944 to build a parameter set for _get_unsent_messages, thus limiting
945 which pending messages will be processed. They are all optional.
947 The verbose parameter can be used to generate debugging output.
950 Returns number of messages sent.
954 sub SendQueuedMessages
{
957 my $which_unsent_messages = {
958 'limit' => $params->{'limit'} // 0,
959 'borrowernumber' => $params->{'borrowernumber'} // q{},
960 'letter_code' => $params->{'letter_code'} // q{},
961 'type' => $params->{'type'} // q{},
963 my $unsent_messages = _get_unsent_messages
( $which_unsent_messages );
964 MESSAGE
: foreach my $message ( @
$unsent_messages ) {
965 my $message_object = Koha
::Notice
::Messages
->find( $message->{message_id
} );
966 # If this fails the database is unwritable and we won't manage to send a message that continues to be marked 'pending'
967 $message_object->make_column_dirty('status');
968 return unless $message_object->store;
970 # warn Data::Dumper->Dump( [ $message ], [ 'message' ] );
971 warn sprintf( 'sending %s message to patron: %s',
972 $message->{'message_transport_type'},
973 $message->{'borrowernumber'} || 'Admin' )
974 if $params->{'verbose'} or $debug;
975 # This is just begging for subclassing
976 next MESSAGE
if ( lc($message->{'message_transport_type'}) eq 'rss' );
977 if ( lc( $message->{'message_transport_type'} ) eq 'email' ) {
978 _send_message_by_email
( $message, $params->{'username'}, $params->{'password'}, $params->{'method'} );
980 elsif ( lc( $message->{'message_transport_type'} ) eq 'sms' ) {
981 if ( C4
::Context
->preference('SMSSendDriver') eq 'Email' ) {
982 my $patron = Koha
::Patrons
->find( $message->{borrowernumber
} );
983 my $sms_provider = Koha
::SMS
::Providers
->find( $patron->sms_provider_id );
984 unless ( $sms_provider ) {
985 warn sprintf( "Patron %s has no sms provider id set!", $message->{'borrowernumber'} ) if $params->{'verbose'} or $debug;
986 _set_message_status
( { message_id
=> $message->{'message_id'}, status
=> 'failed' } );
989 unless ( $patron->smsalertnumber ) {
990 _set_message_status
( { message_id
=> $message->{'message_id'}, status
=> 'failed' } );
991 warn sprintf( "No smsalertnumber found for patron %s!", $message->{'borrowernumber'} ) if $params->{'verbose'} or $debug;
994 $message->{to_address
} = $patron->smsalertnumber; #Sometime this is set to email - sms should always use smsalertnumber
995 $message->{to_address
} .= '@' . $sms_provider->domain();
996 _update_message_to_address
($message->{'message_id'},$message->{to_address
});
997 _send_message_by_email
( $message, $params->{'username'}, $params->{'password'}, $params->{'method'} );
999 _send_message_by_sms
( $message );
1003 return scalar( @
$unsent_messages );
1006 =head2 GetRSSMessages
1008 my $message_list = GetRSSMessages( { limit => 10, borrowernumber => '14' } )
1010 returns a listref of all queued RSS messages for a particular person.
1014 sub GetRSSMessages
{
1017 return unless $params;
1018 return unless ref $params;
1019 return unless $params->{'borrowernumber'};
1021 return _get_unsent_messages
( { message_transport_type
=> 'rss',
1022 limit
=> $params->{'limit'},
1023 borrowernumber
=> $params->{'borrowernumber'}, } );
1026 =head2 GetPrintMessages
1028 my $message_list = GetPrintMessages( { borrowernumber => $borrowernumber } )
1030 Returns a arrayref of all queued print messages (optionally, for a particular
1035 sub GetPrintMessages
{
1036 my $params = shift || {};
1038 return _get_unsent_messages
( { message_transport_type
=> 'print',
1039 borrowernumber
=> $params->{'borrowernumber'},
1043 =head2 GetQueuedMessages ([$hashref])
1045 my $messages = GetQueuedMessage( { borrowernumber => '123', limit => 20 } );
1047 fetches messages out of the message queue.
1050 list of hashes, each has represents a message in the message queue.
1054 sub GetQueuedMessages
{
1057 my $dbh = C4
::Context
->dbh();
1058 my $statement = << 'ENDSQL';
1059 SELECT message_id
, borrowernumber
, subject
, content
, message_transport_type
, status
, time_queued
1065 if ( exists $params->{'borrowernumber'} ) {
1066 push @whereclauses, ' borrowernumber = ? ';
1067 push @query_params, $params->{'borrowernumber'};
1070 if ( @whereclauses ) {
1071 $statement .= ' WHERE ' . join( 'AND', @whereclauses );
1074 if ( defined $params->{'limit'} ) {
1075 $statement .= ' LIMIT ? ';
1076 push @query_params, $params->{'limit'};
1079 my $sth = $dbh->prepare( $statement );
1080 my $result = $sth->execute( @query_params );
1081 return $sth->fetchall_arrayref({});
1084 =head2 GetMessageTransportTypes
1086 my @mtt = GetMessageTransportTypes();
1088 returns an arrayref of transport types
1092 sub GetMessageTransportTypes
{
1093 my $dbh = C4
::Context
->dbh();
1094 my $mtts = $dbh->selectcol_arrayref("
1095 SELECT message_transport_type
1096 FROM message_transport_types
1097 ORDER BY message_transport_type
1104 my $message = C4::Letters::Message($message_id);
1109 my ( $message_id ) = @_;
1110 return unless $message_id;
1111 my $dbh = C4
::Context
->dbh;
1112 return $dbh->selectrow_hashref(q
|
1113 SELECT message_id
, borrowernumber
, subject
, content
, metadata
, letter_code
, message_transport_type
, status
, time_queued
, to_address
, from_address
, content_type
1115 WHERE message_id
= ?
1116 |, {}, $message_id );
1119 =head2 ResendMessage
1121 Attempt to resend a message which has failed previously.
1123 my $has_been_resent = C4::Letters::ResendMessage($message_id);
1125 Updates the message to 'pending' status so that
1126 it will be resent later on.
1128 returns 1 on success, 0 on failure, undef if no message was found
1133 my $message_id = shift;
1134 return unless $message_id;
1136 my $message = GetMessage
( $message_id );
1137 return unless $message;
1139 if ( $message->{status
} ne 'pending' ) {
1140 $rv = C4
::Letters
::_set_message_status
({
1141 message_id
=> $message_id,
1142 status
=> 'pending',
1144 $rv = $rv > 0?
1: 0;
1145 # Clear destination email address to force address update
1146 _update_message_to_address
( $message_id, undef ) if $rv &&
1147 $message->{message_transport_type
} eq 'email';
1152 =head2 _add_attachements
1155 letter - the standard letter hashref
1156 attachments - listref of attachments. each attachment is a hashref of:
1157 type - the mime type, like 'text/plain'
1158 content - the actual attachment
1159 filename - the name of the attachment.
1160 message - a MIME::Lite object to attach these to.
1162 returns your letter object, with the content updated.
1166 sub _add_attachments
{
1169 my $letter = $params->{'letter'};
1170 my $attachments = $params->{'attachments'};
1171 return $letter unless @
$attachments;
1172 my $message = $params->{'message'};
1174 # First, we have to put the body in as the first attachment
1176 Type
=> $letter->{'content-type'} || 'TEXT',
1177 Data
=> $letter->{'is_html'}
1178 ? _wrap_html
($letter->{'content'}, $letter->{'title'})
1179 : $letter->{'content'},
1182 foreach my $attachment ( @
$attachments ) {
1184 Type
=> $attachment->{'type'},
1185 Data
=> $attachment->{'content'},
1186 Filename
=> $attachment->{'filename'},
1189 # we're forcing list context here to get the header, not the count back from grep.
1190 ( $letter->{'content-type'} ) = grep( /^Content-Type:/, split( /\n/, $params->{'message'}->header_as_string ) );
1191 $letter->{'content-type'} =~ s/^Content-Type:\s+//;
1192 $letter->{'content'} = $message->body_as_string;
1198 =head2 _get_unsent_messages
1200 This function's parameter hash reference takes the following
1201 optional named parameters:
1202 message_transport_type: method of message sending (e.g. email, sms, etc.)
1203 borrowernumber : who the message is to be sent
1204 letter_code : type of message being sent (e.g. PASSWORD_RESET)
1205 limit : maximum number of messages to send
1207 This function returns an array of matching hash referenced rows from
1208 message_queue with some borrower information added.
1212 sub _get_unsent_messages
{
1215 my $dbh = C4
::Context
->dbh();
1217 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
1218 FROM message_queue mq
1219 LEFT JOIN borrowers b ON b
.borrowernumber
= mq
.borrowernumber
1223 my @query_params = ('pending');
1224 if ( ref $params ) {
1225 if ( $params->{'message_transport_type'} ) {
1226 $statement .= ' AND mq.message_transport_type = ? ';
1227 push @query_params, $params->{'message_transport_type'};
1229 if ( $params->{'borrowernumber'} ) {
1230 $statement .= ' AND mq.borrowernumber = ? ';
1231 push @query_params, $params->{'borrowernumber'};
1233 if ( $params->{'letter_code'} ) {
1234 $statement .= ' AND mq.letter_code = ? ';
1235 push @query_params, $params->{'letter_code'};
1237 if ( $params->{'type'} ) {
1238 $statement .= ' AND message_transport_type = ? ';
1239 push @query_params, $params->{'type'};
1241 if ( $params->{'limit'} ) {
1242 $statement .= ' limit ? ';
1243 push @query_params, $params->{'limit'};
1247 $debug and warn "_get_unsent_messages SQL: $statement";
1248 $debug and warn "_get_unsent_messages params: " . join(',',@query_params);
1249 my $sth = $dbh->prepare( $statement );
1250 my $result = $sth->execute( @query_params );
1251 return $sth->fetchall_arrayref({});
1254 sub _send_message_by_email
{
1255 my $message = shift or return;
1256 my ($username, $password, $method) = @_;
1258 my $patron = Koha
::Patrons
->find( $message->{borrowernumber
} );
1259 my $to_address = $message->{'to_address'};
1260 unless ($to_address) {
1262 warn "FAIL: No 'to_address' and INVALID borrowernumber ($message->{borrowernumber})";
1263 _set_message_status
( { message_id
=> $message->{'message_id'},
1264 status
=> 'failed' } );
1267 $to_address = $patron->notice_email_address;
1268 unless ($to_address) {
1269 # warn "FAIL: No 'to_address' and no email for " . ($member->{surname} ||'') . ", borrowernumber ($message->{borrowernumber})";
1270 # warning too verbose for this more common case?
1271 _set_message_status
( { message_id
=> $message->{'message_id'},
1272 status
=> 'failed' } );
1277 my $utf8 = decode
('MIME-Header', $message->{'subject'} );
1278 $message->{subject
}= encode
('MIME-Header', $utf8);
1279 my $subject = encode
('UTF-8', $message->{'subject'});
1280 my $content = encode
('UTF-8', $message->{'content'});
1281 my $content_type = $message->{'content_type'} || 'text/plain; charset="UTF-8"';
1282 my $is_html = $content_type =~ m/html/io;
1283 my $branch_email = undef;
1284 my $branch_replyto = undef;
1285 my $branch_returnpath = undef;
1287 my $library = $patron->library;
1288 $branch_email = $library->branchemail;
1289 $branch_replyto = $library->branchreplyto;
1290 $branch_returnpath = $library->branchreturnpath;
1292 my $email = Koha
::Email
->new();
1293 my %sendmail_params = $email->create_message_headers(
1296 from
=> $message->{'from_address'} || $branch_email,
1297 replyto
=> $branch_replyto,
1298 sender
=> $branch_returnpath,
1299 subject
=> $subject,
1300 message
=> $is_html ? _wrap_html
( $content, $subject ) : $content,
1301 contenttype
=> $content_type
1305 $sendmail_params{'Auth'} = {user
=> $username, pass
=> $password, method
=> $method} if $username;
1306 if ( my $bcc = C4
::Context
->preference('NoticeBcc') ) {
1307 $sendmail_params{ Bcc
} = $bcc;
1310 _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
1312 if ( Mail
::Sendmail
::sendmail
( %sendmail_params ) ) {
1313 _set_message_status
( { message_id
=> $message->{'message_id'},
1314 status
=> 'sent' } );
1317 _set_message_status
( { message_id
=> $message->{'message_id'},
1318 status
=> 'failed' } );
1319 carp
$Mail::Sendmail
::error
;
1325 my ($content, $title) = @_;
1327 my $css = C4
::Context
->preference("NoticeCSS") || '';
1328 $css = qq{<link rel
="stylesheet" type
="text/css" href
="$css">} if $css;
1330 <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
1331 "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
1332 <html lang="en" xml:lang="en" xmlns="http://www.w3.org/1999/xhtml">
1334 <title>$title</title>
1335 <meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
1346 my ( $message ) = @_;
1347 my $dbh = C4
::Context
->dbh;
1348 my $count = $dbh->selectrow_array(q
|
1351 WHERE message_transport_type
= ?
1352 AND borrowernumber
= ?
1354 AND CAST
(time_queued AS date
) = CAST
(NOW
() AS date
)
1357 |, {}, $message->{message_transport_type
}, $message->{borrowernumber
}, $message->{letter_code
}, $message->{content
} );
1361 sub _send_message_by_sms
{
1362 my $message = shift or return;
1363 my $patron = Koha
::Patrons
->find( $message->{borrowernumber
} );
1365 unless ( $patron and $patron->smsalertnumber ) {
1366 _set_message_status
( { message_id
=> $message->{'message_id'},
1367 status
=> 'failed' } );
1371 if ( _is_duplicate
( $message ) ) {
1372 _set_message_status
( { message_id
=> $message->{'message_id'},
1373 status
=> 'failed' } );
1377 my $success = C4
::SMS
->send_sms( { destination
=> $patron->smsalertnumber,
1378 message
=> $message->{'content'},
1380 _set_message_status
( { message_id
=> $message->{'message_id'},
1381 status
=> ($success ?
'sent' : 'failed') } );
1385 sub _update_message_to_address
{
1387 my $dbh = C4
::Context
->dbh();
1388 $dbh->do('UPDATE message_queue SET to_address=? WHERE message_id=?',undef,($to,$id));
1391 sub _set_message_status
{
1392 my $params = shift or return;
1394 foreach my $required_parameter ( qw( message_id status ) ) {
1395 return unless exists $params->{ $required_parameter };
1398 my $dbh = C4
::Context
->dbh();
1399 my $statement = 'UPDATE message_queue SET status= ? WHERE message_id = ?';
1400 my $sth = $dbh->prepare( $statement );
1401 my $result = $sth->execute( $params->{'status'},
1402 $params->{'message_id'} );
1407 my ( $params ) = @_;
1409 my $content = $params->{content
};
1410 my $tables = $params->{tables
};
1411 my $loops = $params->{loops
};
1412 my $substitute = $params->{substitute
} || {};
1414 my $use_template_cache = C4
::Context
->config('template_cache_dir') && defined $ENV{GATEWAY_INTERFACE
};
1415 my $template = Template
->new(
1419 PLUGIN_BASE
=> 'Koha::Template::Plugin',
1420 COMPILE_EXT
=> $use_template_cache ?
'.ttc' : '',
1421 COMPILE_DIR
=> $use_template_cache ? C4
::Context
->config('template_cache_dir') : '',
1423 ENCODING
=> 'UTF-8',
1425 ) or die Template
->error();
1427 my $tt_params = { %{ _get_tt_params
( $tables ) }, %{ _get_tt_params
( $loops, 'is_a_loop' ) }, %$substitute };
1429 $content = add_tt_filters
( $content );
1430 $content = qq|[% USE KohaDates
%][% USE Remove_MARC_punctuation
%]$content|;
1433 $template->process( \
$content, $tt_params, \
$output ) || croak
"ERROR PROCESSING TEMPLATE: " . $template->error();
1438 sub _get_tt_params
{
1439 my ($tables, $is_a_loop) = @_;
1445 article_requests
=> {
1446 module
=> 'Koha::ArticleRequests',
1447 singular
=> 'article_request',
1448 plural
=> 'article_requests',
1452 module
=> 'Koha::Biblios',
1453 singular
=> 'biblio',
1454 plural
=> 'biblios',
1455 pk
=> 'biblionumber',
1458 module
=> 'Koha::Biblioitems',
1459 singular
=> 'biblioitem',
1460 plural
=> 'biblioitems',
1461 pk
=> 'biblioitemnumber',
1464 module
=> 'Koha::Patrons',
1465 singular
=> 'borrower',
1466 plural
=> 'borrowers',
1467 pk
=> 'borrowernumber',
1470 module
=> 'Koha::Libraries',
1471 singular
=> 'branch',
1472 plural
=> 'branches',
1476 module
=> 'Koha::Items',
1482 module
=> 'Koha::News',
1488 module
=> 'Koha::Acquisition::Orders',
1489 singular
=> 'order',
1491 pk
=> 'ordernumber',
1494 module
=> 'Koha::Holds',
1497 fk
=> [ 'borrowernumber', 'biblionumber' ],
1500 module
=> 'Koha::Serials',
1501 singular
=> 'serial',
1502 plural
=> 'serials',
1506 module
=> 'Koha::Subscriptions',
1507 singular
=> 'subscription',
1508 plural
=> 'subscriptions',
1509 pk
=> 'subscriptionid',
1512 module
=> 'Koha::Suggestions',
1513 singular
=> 'suggestion',
1514 plural
=> 'suggestions',
1515 pk
=> 'suggestionid',
1518 module
=> 'Koha::Checkouts',
1519 singular
=> 'checkout',
1520 plural
=> 'checkouts',
1524 module
=> 'Koha::Old::Checkouts',
1525 singular
=> 'old_checkout',
1526 plural
=> 'old_checkouts',
1530 module
=> 'Koha::Checkouts',
1531 singular
=> 'overdue',
1532 plural
=> 'overdues',
1535 borrower_modifications
=> {
1536 module
=> 'Koha::Patron::Modifications',
1537 singular
=> 'patron_modification',
1538 plural
=> 'patron_modifications',
1539 fk
=> 'verification_token',
1543 foreach my $table ( keys %$tables ) {
1544 next unless $config->{$table};
1546 my $ref = ref( $tables->{$table} ) || q{};
1547 my $module = $config->{$table}->{module
};
1549 if ( can_load
( modules
=> { $module => undef } ) ) {
1550 my $pk = $config->{$table}->{pk
};
1551 my $fk = $config->{$table}->{fk
};
1554 my $values = $tables->{$table} || [];
1555 unless ( ref( $values ) eq 'ARRAY' ) {
1556 croak
"ERROR processing table $table. Wrong API call.";
1558 my $key = $pk ?
$pk : $fk;
1559 # $key does not come from user input
1560 my $objects = $module->search(
1561 { $key => $values },
1563 # We want to retrieve the data in the same order
1565 # field is a MySQLism, but they are no other way to do it
1566 # To be generic we could do it in perl, but we will need to fetch
1567 # all the data then order them
1568 @
$values ?
( order_by
=> \
[ "field($key, " . join( ', ', @
$values ) . ")" ] ) : ()
1571 $params->{ $config->{$table}->{plural
} } = $objects;
1573 elsif ( $ref eq q{} || $ref eq 'HASH' ) {
1574 my $id = ref $ref eq 'HASH' ?
$tables->{$table}->{$pk} : $tables->{$table};
1576 if ( $fk ) { # Using a foreign key for lookup
1577 if ( ref( $fk ) eq 'ARRAY' ) { # Foreign key is multi-column
1579 foreach my $key ( @
$fk ) {
1580 $search->{$key} = $id->{$key};
1582 $object = $module->search( $search )->last();
1583 } else { # Foreign key is single column
1584 $object = $module->search( { $fk => $id } )->last();
1586 } else { # using the table's primary key for lookup
1587 $object = $module->find($id);
1589 $params->{ $config->{$table}->{singular
} } = $object;
1591 else { # $ref eq 'ARRAY'
1593 if ( @
{ $tables->{$table} } == 1 ) { # Param is a single key
1594 $object = $module->search( { $pk => $tables->{$table} } )->last();
1596 else { # Params are mutliple foreign keys
1597 croak
"Multiple foreign keys (table $table) should be passed using an hashref";
1599 $params->{ $config->{$table}->{singular
} } = $object;
1603 croak
"ERROR LOADING MODULE $module: $Module::Load::Conditional::ERROR";
1607 $params->{today
} = output_pref
({ dt
=> dt_from_string
, dateformat
=> 'iso' });
1612 =head3 add_tt_filters
1614 $content = add_tt_filters( $content );
1616 Add TT filters to some specific fields if needed.
1618 For now we only add the Remove_MARC_punctuation TT filter to biblio and biblioitem fields
1622 sub add_tt_filters
{
1623 my ( $content ) = @_;
1624 $content =~ s
|\
[%\s
*biblio\
.(.*?
)\s
*%\
]|[% biblio
.$1 \
| \
$Remove_MARC_punctuation %]|gxms
;
1625 $content =~ s
|\
[%\s
*biblioitem\
.(.*?
)\s
*%\
]|[% biblioitem
.$1 \
| \
$Remove_MARC_punctuation %]|gxms
;
1629 =head2 get_item_content
1631 my $item = Koha::Items->find(...)->unblessed;
1632 my @item_content_fields = qw( date_due title barcode author itemnumber );
1633 my $item_content = C4::Letters::get_item_content({
1635 item_content_fields => \@item_content_fields
1638 This function generates a tab-separated list of values for the passed item. Dates
1639 are formatted following the current setup.
1643 sub get_item_content
{
1644 my ( $params ) = @_;
1645 my $item = $params->{item
};
1646 my $dateonly = $params->{dateonly
} || 0;
1647 my $item_content_fields = $params->{item_content_fields
} || [];
1649 return unless $item;
1651 my @item_info = map {
1655 { dt
=> dt_from_string
( $item->{$_} ), dateonly
=> $dateonly } );
1659 } @
$item_content_fields;
1660 return join( "\t", @item_info ) . "\n";