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
.*, biblioitems
.*, 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 biblioitems ON serial
.biblionumber
= biblioitems
.biblionumber
402 LEFT JOIN aqbooksellers ON subscription
.aqbooksellerid
=aqbooksellers
.id
403 WHERE serial
.serialid IN
(
407 carp
"No issues selected";
408 return { error
=> "no_issues_selected" };
411 $strsth .= join( ",", ('?') x @
$externalid ) . ")";
412 $action = "SERIAL CLAIM";
413 $sthorders = $dbh->prepare($strsth);
414 $sthorders->execute( @
$externalid );
415 $dataorders = $sthorders->fetchall_arrayref( {} );
418 if ( $type eq 'orderacquisition') {
420 SELECT aqorders
.*,aqbasket
.*,biblio
.*,biblioitems
.*
422 LEFT JOIN aqbasket ON aqbasket
.basketno
=aqorders
.basketno
423 LEFT JOIN biblio ON aqorders
.biblionumber
=biblio
.biblionumber
424 LEFT JOIN biblioitems ON aqorders
.biblionumber
=biblioitems
.biblionumber
425 WHERE aqbasket
.basketno
= ?
426 AND orderstatus IN
('new','ordered')
430 carp
"No basketnumber given";
431 return { error
=> "no_basketno" };
433 $action = "ACQUISITION ORDER";
434 $sthorders = $dbh->prepare($strsth);
435 $sthorders->execute($externalid);
436 $dataorders = $sthorders->fetchall_arrayref( {} );
440 $dbh->prepare("select * from aqbooksellers where id=?");
441 $sthbookseller->execute( $dataorders->[0]->{booksellerid
} );
442 my $databookseller = $sthbookseller->fetchrow_hashref;
444 my $addressee = $type eq 'claimacquisition' || $type eq 'orderacquisition' ?
'acqprimary' : 'serialsprimary';
447 $dbh->prepare("SELECT * FROM aqcontacts WHERE booksellerid=? AND $type=1 ORDER BY $addressee DESC");
448 $sthcontact->execute( $dataorders->[0]->{booksellerid
} );
449 my $datacontact = $sthcontact->fetchrow_hashref;
453 push @email, $databookseller->{bookselleremail
} if $databookseller->{bookselleremail
};
454 push @email, $datacontact->{email
} if ( $datacontact && $datacontact->{email
} );
456 warn "Bookseller $dataorders->[0]->{booksellerid} without emails";
457 return { error
=> "no_email" };
460 while ($addlcontact = $sthcontact->fetchrow_hashref) {
461 push @cc, $addlcontact->{email
} if ( $addlcontact && $addlcontact->{email
} );
464 my $userenv = C4
::Context
->userenv;
465 my $letter = GetPreparedLetter
(
467 letter_code
=> $letter_code,
468 branchcode
=> $userenv->{branch
},
470 'branches' => $userenv->{branch
},
471 'aqbooksellers' => $databookseller,
472 'aqcontacts' => $datacontact,
474 repeat
=> $dataorders,
476 ) or return { error
=> "no_letter" };
478 # Remove the order tag
479 $letter->{content
} =~ s/<order>(.*?)<\/order>/$1/gxms
;
482 my $library = Koha
::Libraries
->find( $userenv->{branch
} );
484 To
=> join( ',', @email),
485 Cc
=> join( ',', @cc),
486 From
=> $library->branchemail || C4
::Context
->preference('KohaAdminEmailAddress'),
487 Subject
=> Encode
::encode
( "UTF-8", "" . $letter->{title
} ),
488 Message
=> $letter->{'is_html'}
489 ? _wrap_html
( Encode
::encode
( "UTF-8", $letter->{'content'} ),
490 Encode
::encode
( "UTF-8", "" . $letter->{'title'} ))
491 : Encode
::encode
( "UTF-8", "" . $letter->{'content'} ),
492 'Content-Type' => $letter->{'is_html'}
493 ?
'text/html; charset="utf-8"'
494 : 'text/plain; charset="utf-8"',
497 if ($type eq 'claimacquisition' || $type eq 'claimissues' ) {
498 $mail{'Reply-to'} = C4
::Context
->preference('ReplytoDefault')
499 if C4
::Context
->preference('ReplytoDefault');
500 $mail{'Sender'} = C4
::Context
->preference('ReturnpathDefault')
501 if C4
::Context
->preference('ReturnpathDefault');
502 $mail{'Bcc'} = $userenv->{emailaddress
}
503 if C4
::Context
->preference("ClaimsBccCopy");
506 unless ( Mail
::Sendmail
::sendmail
(%mail) ) {
507 carp
$Mail::Sendmail
::error
;
508 return { error
=> $Mail::Sendmail
::error
};
516 . join( ',', @email )
521 ) if C4
::Context
->preference("LetterLog");
523 # send an "account details" notice to a newly created user
524 elsif ( $type eq 'members' ) {
525 my $library = Koha
::Libraries
->find( $externalid->{branchcode
} )->unblessed;
526 my $letter = GetPreparedLetter
(
528 letter_code
=> $letter_code,
529 branchcode
=> $externalid->{'branchcode'},
531 'branches' => $library,
532 'borrowers' => $externalid->{'borrowernumber'},
534 substitute
=> { 'borrowers.password' => $externalid->{'password'} },
537 return { error
=> "no_email" } unless $externalid->{'emailaddr'};
538 my $email = Koha
::Email
->new();
539 my %mail = $email->create_message_headers(
541 to
=> $externalid->{'emailaddr'},
542 from
=> $library->{branchemail
},
543 replyto
=> $library->{branchreplyto
},
544 sender
=> $library->{branchreturnpath
},
545 subject
=> Encode
::encode
( "UTF-8", "" . $letter->{'title'} ),
546 message
=> $letter->{'is_html'}
547 ? _wrap_html
( Encode
::encode
( "UTF-8", $letter->{'content'} ),
548 Encode
::encode
( "UTF-8", "" . $letter->{'title'} ) )
549 : Encode
::encode
( "UTF-8", "" . $letter->{'content'} ),
550 contenttype
=> $letter->{'is_html'}
551 ?
'text/html; charset="utf-8"'
552 : 'text/plain; charset="utf-8"',
555 unless( Mail
::Sendmail
::sendmail
(%mail) ) {
556 carp
$Mail::Sendmail
::error
;
557 return { error
=> $Mail::Sendmail
::error
};
561 # If we come here, return an OK status
565 =head2 GetPreparedLetter( %params )
568 module => letter module, mandatory
569 letter_code => letter code, mandatory
570 branchcode => for letter selection, if missing default system letter taken
571 tables => a hashref with table names as keys. Values are either:
572 - a scalar - primary key value
573 - an arrayref - primary key values
574 - a hashref - full record
575 substitute => custom substitution key/value pairs
576 repeat => records to be substituted on consecutive lines:
577 - an arrayref - tries to guess what needs substituting by
578 taking remaining << >> tokensr; not recommended
579 - a hashref token => @tables - replaces <token> << >> << >> </token>
580 subtemplate for each @tables row; table is a hashref as above
581 want_librarian => boolean, if set to true triggers librarian details
582 substitution from the userenv
584 letter fields hashref (title & content useful)
588 sub GetPreparedLetter
{
591 my $letter = $params{letter
};
594 my $module = $params{module
} or croak
"No module";
595 my $letter_code = $params{letter_code
} or croak
"No letter_code";
596 my $branchcode = $params{branchcode
} || '';
597 my $mtt = $params{message_transport_type
} || 'email';
598 my $lang = $params{lang
} || 'default';
600 $letter = getletter
( $module, $letter_code, $branchcode, $mtt, $lang );
603 $letter = getletter
( $module, $letter_code, $branchcode, $mtt, 'default' )
604 or warn( "No $module $letter_code letter transported by " . $mtt ),
609 my $tables = $params{tables
} || {};
610 my $substitute = $params{substitute
} || {};
611 my $loops = $params{loops
} || {}; # loops is not supported for historical notices syntax
612 my $repeat = $params{repeat
};
613 %$tables || %$substitute || $repeat || %$loops
614 or carp
( "ERROR: nothing to substitute - both 'tables', 'loops' and 'substitute' are empty" ),
616 my $want_librarian = $params{want_librarian
};
619 while ( my ($token, $val) = each %$substitute ) {
620 if ( $token eq 'items.content' ) {
621 $val =~ s
|\n|<br
/>|g
if $letter->{is_html
};
624 $letter->{title
} =~ s/<<$token>>/$val/g;
625 $letter->{content
} =~ s/<<$token>>/$val/g;
629 my $OPACBaseURL = C4
::Context
->preference('OPACBaseURL');
630 $letter->{content
} =~ s/<<OPACBaseURL>>/$OPACBaseURL/go;
632 if ($want_librarian) {
633 # parsing librarian name
634 my $userenv = C4
::Context
->userenv;
635 $letter->{content
} =~ s/<<LibrarianFirstname>>/$userenv->{firstname}/go;
636 $letter->{content
} =~ s/<<LibrarianSurname>>/$userenv->{surname}/go;
637 $letter->{content
} =~ s/<<LibrarianEmailaddress>>/$userenv->{emailaddress}/go;
640 my ($repeat_no_enclosing_tags, $repeat_enclosing_tags);
643 if (ref ($repeat) eq 'ARRAY' ) {
644 $repeat_no_enclosing_tags = $repeat;
646 $repeat_enclosing_tags = $repeat;
650 if ($repeat_enclosing_tags) {
651 while ( my ($tag, $tag_tables) = each %$repeat_enclosing_tags ) {
652 if ( $letter->{content
} =~ m!<$tag>(.*)</$tag>!s ) {
655 my %subletter = ( title
=> '', content
=> $subcontent );
656 _substitute_tables
( \
%subletter, $_ );
659 $letter->{content
} =~ s!<$tag>.*</$tag>!join( "\n", @lines )!se;
665 _substitute_tables
( $letter, $tables );
668 if ($repeat_no_enclosing_tags) {
669 if ( $letter->{content
} =~ m/[^\n]*<<.*>>[^\n]*/so ) {
674 $c =~ s/<<count>>/$i/go;
675 foreach my $field ( keys %{$_} ) {
676 $c =~ s/(<<[^\.]+.$field>>)/$_->{$field}/;
680 } @
$repeat_no_enclosing_tags;
682 my $replaceby = join( "\n", @lines );
683 $letter->{content
} =~ s/\Q$line\E/$replaceby/s;
687 $letter->{content
} = _process_tt
(
689 content
=> $letter->{content
},
692 substitute
=> $substitute,
696 $letter->{content
} =~ s/<<\S*>>//go; #remove any stragglers
701 sub _substitute_tables
{
702 my ( $letter, $tables ) = @_;
703 while ( my ($table, $param) = each %$tables ) {
706 my $ref = ref $param;
709 if ($ref && $ref eq 'HASH') {
713 my $sth = _parseletter_sth
($table);
715 warn "_parseletter_sth('$table') failed to return a valid sth. No substitution will be done for that table.";
718 $sth->execute( $ref ? @
$param : $param );
720 $values = $sth->fetchrow_hashref;
724 _parseletter
( $letter, $table, $values );
728 sub _parseletter_sth
{
732 carp
"ERROR: _parseletter_sth() called without argument (table)";
735 # NOTE: we used to check whether we had a statement handle cached in
736 # a %handles module-level variable. This was a dumb move and
737 # broke things for the rest of us. prepare_cached is a better
738 # way to cache statement handles anyway.
740 ($table eq 'biblio' ) ?
"SELECT * FROM $table WHERE biblionumber = ?" :
741 ($table eq 'biblioitems' ) ?
"SELECT * FROM $table WHERE biblionumber = ?" :
742 ($table eq 'items' ) ?
"SELECT * FROM $table WHERE itemnumber = ?" :
743 ($table eq 'issues' ) ?
"SELECT * FROM $table WHERE itemnumber = ?" :
744 ($table eq 'old_issues' ) ?
"SELECT * FROM $table WHERE itemnumber = ? ORDER BY timestamp DESC LIMIT 1" :
745 ($table eq 'reserves' ) ?
"SELECT * FROM $table WHERE borrowernumber = ? and biblionumber = ?" :
746 ($table eq 'borrowers' ) ?
"SELECT * FROM $table WHERE borrowernumber = ?" :
747 ($table eq 'branches' ) ?
"SELECT * FROM $table WHERE branchcode = ?" :
748 ($table eq 'suggestions' ) ?
"SELECT * FROM $table WHERE suggestionid = ?" :
749 ($table eq 'aqbooksellers') ?
"SELECT * FROM $table WHERE id = ?" :
750 ($table eq 'aqorders' ) ?
"SELECT * FROM $table WHERE ordernumber = ?" :
751 ($table eq 'opac_news' ) ?
"SELECT * FROM $table WHERE idnew = ?" :
752 ($table eq 'article_requests') ?
"SELECT * FROM $table WHERE id = ?" :
753 ($table eq 'borrower_modifications') ?
"SELECT * FROM $table WHERE verification_token = ?" :
754 ($table eq 'subscription') ?
"SELECT * FROM $table WHERE subscriptionid = ?" :
755 ($table eq 'serial') ?
"SELECT * FROM $table WHERE serialid = ?" :
758 warn "ERROR: No _parseletter_sth query for table '$table'";
759 return; # nothing to get
761 unless ($sth = C4
::Context
->dbh->prepare_cached($query)) {
762 warn "ERROR: Failed to prepare query: '$query'";
765 return $sth; # now cache is populated for that $table
768 =head2 _parseletter($letter, $table, $values)
771 - $letter : a hash to letter fields (title & content useful)
772 - $table : the Koha table to parse.
773 - $values_in : table record hashref
774 parse all fields from a table, and replace values in title & content with the appropriate value
775 (not exported sub, used only internally)
780 my ( $letter, $table, $values_in ) = @_;
782 # Work on a local copy of $values_in (passed by reference) to avoid side effects
783 # in callers ( by changing / formatting values )
784 my $values = $values_in ?
{ %$values_in } : {};
786 if ( $table eq 'borrowers' && $values->{'dateexpiry'} ){
787 $values->{'dateexpiry'} = output_pref
({ str
=> $values->{dateexpiry
}, dateonly
=> 1 });
790 if ( $table eq 'reserves' && $values->{'waitingdate'} ) {
791 $values->{'waitingdate'} = output_pref
({ dt
=> dt_from_string
( $values->{'waitingdate'} ), dateonly
=> 1 });
794 if ($letter->{content
} && $letter->{content
} =~ /<<today>>/) {
795 my $todaysdate = output_pref
( DateTime
->now() );
796 $letter->{content
} =~ s/<<today>>/$todaysdate/go;
799 while ( my ($field, $val) = each %$values ) {
800 $val =~ s/\p{P}$// if $val && $table=~/biblio/;
801 #BZ 9886: Assuming that we want to eliminate ISBD punctuation here
802 #Therefore adding the test on biblio. This includes biblioitems,
803 #but excludes items. Removed unneeded global and lookahead.
805 if ( $table=~/^borrowers$/ && $field=~/^streettype$/ ) {
806 my $av = Koha
::AuthorisedValues
->search({ category
=> 'ROADTYPE', authorised_value
=> $val });
807 $val = $av->count ?
$av->next->lib : '';
811 my $replacedby = defined ($val) ?
$val : '';
813 and not $replacedby =~ m
|0000-00-00|
814 and not $replacedby =~ m
|9999-12-31|
815 and $replacedby =~ m
|^\d
{4}-\d
{2}-\d
{2}( \d
{2}:\d
{2}:\d
{2})?
$| )
817 # If the value is XXXX-YY-ZZ[ AA:BB:CC] we assume it is a date
818 my $dateonly = defined $1 ?
0 : 1; #$1 refers to the capture group wrapped in parentheses. In this case, that's the hours, minutes, seconds.
819 my $re_dateonly_filter = qr{ $field( \s* \| \s* dateonly\s*)?>> }xms;
821 for my $letter_field ( qw( title content ) ) {
822 my $filter_string_used = q{};
823 if ( $letter->{ $letter_field } =~ $re_dateonly_filter ) {
824 # We overwrite $dateonly if the filter exists and we have a time in the datetime
825 $filter_string_used = $1 || q{};
826 $dateonly = $1 unless $dateonly;
828 my $replacedby_date = eval {
829 output_pref
({ dt
=> dt_from_string
( $replacedby ), dateonly
=> $dateonly });
832 if ( $letter->{ $letter_field } ) {
833 $letter->{ $letter_field } =~ s/\Q<<$table.$field$filter_string_used>>\E/$replacedby_date/g;
834 $letter->{ $letter_field } =~ s/\Q<<$field$filter_string_used>>\E/$replacedby_date/g;
838 # Other fields replacement
840 for my $letter_field ( qw( title content ) ) {
841 if ( $letter->{ $letter_field } ) {
842 $letter->{ $letter_field } =~ s/<<$table.$field>>/$replacedby/g;
843 $letter->{ $letter_field } =~ s/<<$field>>/$replacedby/g;
849 if ($table eq 'borrowers' && $letter->{content
}) {
850 if ( my $attributes = GetBorrowerAttributes
($values->{borrowernumber
}) ) {
852 foreach (@
$attributes) {
853 my $code = $_->{code
};
854 my $val = $_->{value_description
} || $_->{value
};
855 $val =~ s/\p{P}(?=$)//g if $val;
856 next unless $val gt '';
858 push @
{ $attr{$code} }, $val;
860 while ( my ($code, $val_ar) = each %attr ) {
861 my $replacefield = "<<borrower-attribute:$code>>";
862 my $replacedby = join ',', @
$val_ar;
863 $letter->{content
} =~ s/$replacefield/$replacedby/g;
872 my $success = EnqueueLetter( { letter => $letter,
873 borrowernumber => '12', message_transport_type => 'email' } )
875 places a letter in the message_queue database table, which will
876 eventually get processed (sent) by the process_message_queue.pl
877 cronjob when it calls SendQueuedMessages.
879 return message_id on success
884 my $params = shift or return;
886 return unless exists $params->{'letter'};
887 # return unless exists $params->{'borrowernumber'};
888 return unless exists $params->{'message_transport_type'};
890 my $content = $params->{letter
}->{content
};
891 $content =~ s/\s+//g if(defined $content);
892 if ( not defined $content or $content eq '' ) {
893 warn "Trying to add an empty message to the message queue" if $debug;
897 # If we have any attachments we should encode then into the body.
898 if ( $params->{'attachments'} ) {
899 $params->{'letter'} = _add_attachments
(
900 { letter
=> $params->{'letter'},
901 attachments
=> $params->{'attachments'},
902 message
=> MIME
::Lite
->new( Type
=> 'multipart/mixed' ),
907 my $dbh = C4
::Context
->dbh();
908 my $statement = << 'ENDSQL';
909 INSERT INTO message_queue
910 ( borrowernumber
, subject
, content
, metadata
, letter_code
, message_transport_type
, status
, time_queued
, to_address
, from_address
, content_type
)
912 ( ?
, ?
, ?
, ?
, ?
, ?
, ?
, NOW
(), ?
, ?
, ?
)
915 my $sth = $dbh->prepare($statement);
916 my $result = $sth->execute(
917 $params->{'borrowernumber'}, # borrowernumber
918 $params->{'letter'}->{'title'}, # subject
919 $params->{'letter'}->{'content'}, # content
920 $params->{'letter'}->{'metadata'} || '', # metadata
921 $params->{'letter'}->{'code'} || '', # letter_code
922 $params->{'message_transport_type'}, # message_transport_type
924 $params->{'to_address'}, # to_address
925 $params->{'from_address'}, # from_address
926 $params->{'letter'}->{'content-type'}, # content_type
928 return $dbh->last_insert_id(undef,undef,'message_queue', undef);
931 =head2 SendQueuedMessages ([$hashref])
933 my $sent = SendQueuedMessages({
934 letter_code => $letter_code,
935 borrowernumber => $who_letter_is_for,
941 Sends all of the 'pending' items in the message queue, unless
942 parameters are passed.
944 The letter_code, borrowernumber and limit parameters are used
945 to build a parameter set for _get_unsent_messages, thus limiting
946 which pending messages will be processed. They are all optional.
948 The verbose parameter can be used to generate debugging output.
951 Returns number of messages sent.
955 sub SendQueuedMessages
{
958 my $which_unsent_messages = {
959 'limit' => $params->{'limit'} // 0,
960 'borrowernumber' => $params->{'borrowernumber'} // q{},
961 'letter_code' => $params->{'letter_code'} // q{},
962 'type' => $params->{'type'} // q{},
964 my $unsent_messages = _get_unsent_messages
( $which_unsent_messages );
965 MESSAGE
: foreach my $message ( @
$unsent_messages ) {
966 my $message_object = Koha
::Notice
::Messages
->find( $message->{message_id
} );
967 # If this fails the database is unwritable and we won't manage to send a message that continues to be marked 'pending'
968 $message_object->make_column_dirty('status');
969 return unless $message_object->store;
971 # warn Data::Dumper->Dump( [ $message ], [ 'message' ] );
972 warn sprintf( 'sending %s message to patron: %s',
973 $message->{'message_transport_type'},
974 $message->{'borrowernumber'} || 'Admin' )
975 if $params->{'verbose'} or $debug;
976 # This is just begging for subclassing
977 next MESSAGE
if ( lc($message->{'message_transport_type'}) eq 'rss' );
978 if ( lc( $message->{'message_transport_type'} ) eq 'email' ) {
979 _send_message_by_email
( $message, $params->{'username'}, $params->{'password'}, $params->{'method'} );
981 elsif ( lc( $message->{'message_transport_type'} ) eq 'sms' ) {
982 if ( C4
::Context
->preference('SMSSendDriver') eq 'Email' ) {
983 my $patron = Koha
::Patrons
->find( $message->{borrowernumber
} );
984 my $sms_provider = Koha
::SMS
::Providers
->find( $patron->sms_provider_id );
985 unless ( $sms_provider ) {
986 warn sprintf( "Patron %s has no sms provider id set!", $message->{'borrowernumber'} ) if $params->{'verbose'} or $debug;
987 _set_message_status
( { message_id
=> $message->{'message_id'}, status
=> 'failed' } );
990 unless ( $patron->smsalertnumber ) {
991 _set_message_status
( { message_id
=> $message->{'message_id'}, status
=> 'failed' } );
992 warn sprintf( "No smsalertnumber found for patron %s!", $message->{'borrowernumber'} ) if $params->{'verbose'} or $debug;
995 $message->{to_address
} = $patron->smsalertnumber; #Sometime this is set to email - sms should always use smsalertnumber
996 $message->{to_address
} .= '@' . $sms_provider->domain();
997 _update_message_to_address
($message->{'message_id'},$message->{to_address
});
998 _send_message_by_email
( $message, $params->{'username'}, $params->{'password'}, $params->{'method'} );
1000 _send_message_by_sms
( $message );
1004 return scalar( @
$unsent_messages );
1007 =head2 GetRSSMessages
1009 my $message_list = GetRSSMessages( { limit => 10, borrowernumber => '14' } )
1011 returns a listref of all queued RSS messages for a particular person.
1015 sub GetRSSMessages
{
1018 return unless $params;
1019 return unless ref $params;
1020 return unless $params->{'borrowernumber'};
1022 return _get_unsent_messages
( { message_transport_type
=> 'rss',
1023 limit
=> $params->{'limit'},
1024 borrowernumber
=> $params->{'borrowernumber'}, } );
1027 =head2 GetPrintMessages
1029 my $message_list = GetPrintMessages( { borrowernumber => $borrowernumber } )
1031 Returns a arrayref of all queued print messages (optionally, for a particular
1036 sub GetPrintMessages
{
1037 my $params = shift || {};
1039 return _get_unsent_messages
( { message_transport_type
=> 'print',
1040 borrowernumber
=> $params->{'borrowernumber'},
1044 =head2 GetQueuedMessages ([$hashref])
1046 my $messages = GetQueuedMessage( { borrowernumber => '123', limit => 20 } );
1048 fetches messages out of the message queue.
1051 list of hashes, each has represents a message in the message queue.
1055 sub GetQueuedMessages
{
1058 my $dbh = C4
::Context
->dbh();
1059 my $statement = << 'ENDSQL';
1060 SELECT message_id
, borrowernumber
, subject
, content
, message_transport_type
, status
, time_queued
1066 if ( exists $params->{'borrowernumber'} ) {
1067 push @whereclauses, ' borrowernumber = ? ';
1068 push @query_params, $params->{'borrowernumber'};
1071 if ( @whereclauses ) {
1072 $statement .= ' WHERE ' . join( 'AND', @whereclauses );
1075 if ( defined $params->{'limit'} ) {
1076 $statement .= ' LIMIT ? ';
1077 push @query_params, $params->{'limit'};
1080 my $sth = $dbh->prepare( $statement );
1081 my $result = $sth->execute( @query_params );
1082 return $sth->fetchall_arrayref({});
1085 =head2 GetMessageTransportTypes
1087 my @mtt = GetMessageTransportTypes();
1089 returns an arrayref of transport types
1093 sub GetMessageTransportTypes
{
1094 my $dbh = C4
::Context
->dbh();
1095 my $mtts = $dbh->selectcol_arrayref("
1096 SELECT message_transport_type
1097 FROM message_transport_types
1098 ORDER BY message_transport_type
1105 my $message = C4::Letters::Message($message_id);
1110 my ( $message_id ) = @_;
1111 return unless $message_id;
1112 my $dbh = C4
::Context
->dbh;
1113 return $dbh->selectrow_hashref(q
|
1114 SELECT message_id
, borrowernumber
, subject
, content
, metadata
, letter_code
, message_transport_type
, status
, time_queued
, to_address
, from_address
, content_type
1116 WHERE message_id
= ?
1117 |, {}, $message_id );
1120 =head2 ResendMessage
1122 Attempt to resend a message which has failed previously.
1124 my $has_been_resent = C4::Letters::ResendMessage($message_id);
1126 Updates the message to 'pending' status so that
1127 it will be resent later on.
1129 returns 1 on success, 0 on failure, undef if no message was found
1134 my $message_id = shift;
1135 return unless $message_id;
1137 my $message = GetMessage
( $message_id );
1138 return unless $message;
1140 if ( $message->{status
} ne 'pending' ) {
1141 $rv = C4
::Letters
::_set_message_status
({
1142 message_id
=> $message_id,
1143 status
=> 'pending',
1145 $rv = $rv > 0?
1: 0;
1146 # Clear destination email address to force address update
1147 _update_message_to_address
( $message_id, undef ) if $rv &&
1148 $message->{message_transport_type
} eq 'email';
1153 =head2 _add_attachements
1156 letter - the standard letter hashref
1157 attachments - listref of attachments. each attachment is a hashref of:
1158 type - the mime type, like 'text/plain'
1159 content - the actual attachment
1160 filename - the name of the attachment.
1161 message - a MIME::Lite object to attach these to.
1163 returns your letter object, with the content updated.
1167 sub _add_attachments
{
1170 my $letter = $params->{'letter'};
1171 my $attachments = $params->{'attachments'};
1172 return $letter unless @
$attachments;
1173 my $message = $params->{'message'};
1175 # First, we have to put the body in as the first attachment
1177 Type
=> $letter->{'content-type'} || 'TEXT',
1178 Data
=> $letter->{'is_html'}
1179 ? _wrap_html
($letter->{'content'}, $letter->{'title'})
1180 : $letter->{'content'},
1183 foreach my $attachment ( @
$attachments ) {
1185 Type
=> $attachment->{'type'},
1186 Data
=> $attachment->{'content'},
1187 Filename
=> $attachment->{'filename'},
1190 # we're forcing list context here to get the header, not the count back from grep.
1191 ( $letter->{'content-type'} ) = grep( /^Content-Type:/, split( /\n/, $params->{'message'}->header_as_string ) );
1192 $letter->{'content-type'} =~ s/^Content-Type:\s+//;
1193 $letter->{'content'} = $message->body_as_string;
1199 =head2 _get_unsent_messages
1201 This function's parameter hash reference takes the following
1202 optional named parameters:
1203 message_transport_type: method of message sending (e.g. email, sms, etc.)
1204 borrowernumber : who the message is to be sent
1205 letter_code : type of message being sent (e.g. PASSWORD_RESET)
1206 limit : maximum number of messages to send
1208 This function returns an array of matching hash referenced rows from
1209 message_queue with some borrower information added.
1213 sub _get_unsent_messages
{
1216 my $dbh = C4
::Context
->dbh();
1218 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
1219 FROM message_queue mq
1220 LEFT JOIN borrowers b ON b
.borrowernumber
= mq
.borrowernumber
1224 my @query_params = ('pending');
1225 if ( ref $params ) {
1226 if ( $params->{'message_transport_type'} ) {
1227 $statement .= ' AND mq.message_transport_type = ? ';
1228 push @query_params, $params->{'message_transport_type'};
1230 if ( $params->{'borrowernumber'} ) {
1231 $statement .= ' AND mq.borrowernumber = ? ';
1232 push @query_params, $params->{'borrowernumber'};
1234 if ( $params->{'letter_code'} ) {
1235 $statement .= ' AND mq.letter_code = ? ';
1236 push @query_params, $params->{'letter_code'};
1238 if ( $params->{'type'} ) {
1239 $statement .= ' AND message_transport_type = ? ';
1240 push @query_params, $params->{'type'};
1242 if ( $params->{'limit'} ) {
1243 $statement .= ' limit ? ';
1244 push @query_params, $params->{'limit'};
1248 $debug and warn "_get_unsent_messages SQL: $statement";
1249 $debug and warn "_get_unsent_messages params: " . join(',',@query_params);
1250 my $sth = $dbh->prepare( $statement );
1251 my $result = $sth->execute( @query_params );
1252 return $sth->fetchall_arrayref({});
1255 sub _send_message_by_email
{
1256 my $message = shift or return;
1257 my ($username, $password, $method) = @_;
1259 my $patron = Koha
::Patrons
->find( $message->{borrowernumber
} );
1260 my $to_address = $message->{'to_address'};
1261 unless ($to_address) {
1263 warn "FAIL: No 'to_address' and INVALID borrowernumber ($message->{borrowernumber})";
1264 _set_message_status
( { message_id
=> $message->{'message_id'},
1265 status
=> 'failed' } );
1268 $to_address = $patron->notice_email_address;
1269 unless ($to_address) {
1270 # warn "FAIL: No 'to_address' and no email for " . ($member->{surname} ||'') . ", borrowernumber ($message->{borrowernumber})";
1271 # warning too verbose for this more common case?
1272 _set_message_status
( { message_id
=> $message->{'message_id'},
1273 status
=> 'failed' } );
1278 my $utf8 = decode
('MIME-Header', $message->{'subject'} );
1279 $message->{subject
}= encode
('MIME-Header', $utf8);
1280 my $subject = encode
('UTF-8', $message->{'subject'});
1281 my $content = encode
('UTF-8', $message->{'content'});
1282 my $content_type = $message->{'content_type'} || 'text/plain; charset="UTF-8"';
1283 my $is_html = $content_type =~ m/html/io;
1284 my $branch_email = undef;
1285 my $branch_replyto = undef;
1286 my $branch_returnpath = undef;
1288 my $library = $patron->library;
1289 $branch_email = $library->branchemail;
1290 $branch_replyto = $library->branchreplyto;
1291 $branch_returnpath = $library->branchreturnpath;
1293 my $email = Koha
::Email
->new();
1294 my %sendmail_params = $email->create_message_headers(
1297 from
=> $message->{'from_address'} || $branch_email,
1298 replyto
=> $branch_replyto,
1299 sender
=> $branch_returnpath,
1300 subject
=> $subject,
1301 message
=> $is_html ? _wrap_html
( $content, $subject ) : $content,
1302 contenttype
=> $content_type
1306 $sendmail_params{'Auth'} = {user
=> $username, pass
=> $password, method
=> $method} if $username;
1307 if ( my $bcc = C4
::Context
->preference('NoticeBcc') ) {
1308 $sendmail_params{ Bcc
} = $bcc;
1311 _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
1313 if ( Mail
::Sendmail
::sendmail
( %sendmail_params ) ) {
1314 _set_message_status
( { message_id
=> $message->{'message_id'},
1315 status
=> 'sent' } );
1318 _set_message_status
( { message_id
=> $message->{'message_id'},
1319 status
=> 'failed' } );
1320 carp
$Mail::Sendmail
::error
;
1326 my ($content, $title) = @_;
1328 my $css = C4
::Context
->preference("NoticeCSS") || '';
1329 $css = qq{<link rel
="stylesheet" type
="text/css" href
="$css">} if $css;
1331 <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
1332 "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
1333 <html lang="en" xml:lang="en" xmlns="http://www.w3.org/1999/xhtml">
1335 <title>$title</title>
1336 <meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
1347 my ( $message ) = @_;
1348 my $dbh = C4
::Context
->dbh;
1349 my $count = $dbh->selectrow_array(q
|
1352 WHERE message_transport_type
= ?
1353 AND borrowernumber
= ?
1355 AND CAST
(time_queued AS date
) = CAST
(NOW
() AS date
)
1358 |, {}, $message->{message_transport_type
}, $message->{borrowernumber
}, $message->{letter_code
}, $message->{content
} );
1362 sub _send_message_by_sms
{
1363 my $message = shift or return;
1364 my $patron = Koha
::Patrons
->find( $message->{borrowernumber
} );
1366 unless ( $patron and $patron->smsalertnumber ) {
1367 _set_message_status
( { message_id
=> $message->{'message_id'},
1368 status
=> 'failed' } );
1372 if ( _is_duplicate
( $message ) ) {
1373 _set_message_status
( { message_id
=> $message->{'message_id'},
1374 status
=> 'failed' } );
1378 my $success = C4
::SMS
->send_sms( { destination
=> $patron->smsalertnumber,
1379 message
=> $message->{'content'},
1381 _set_message_status
( { message_id
=> $message->{'message_id'},
1382 status
=> ($success ?
'sent' : 'failed') } );
1386 sub _update_message_to_address
{
1388 my $dbh = C4
::Context
->dbh();
1389 $dbh->do('UPDATE message_queue SET to_address=? WHERE message_id=?',undef,($to,$id));
1392 sub _set_message_status
{
1393 my $params = shift or return;
1395 foreach my $required_parameter ( qw( message_id status ) ) {
1396 return unless exists $params->{ $required_parameter };
1399 my $dbh = C4
::Context
->dbh();
1400 my $statement = 'UPDATE message_queue SET status= ? WHERE message_id = ?';
1401 my $sth = $dbh->prepare( $statement );
1402 my $result = $sth->execute( $params->{'status'},
1403 $params->{'message_id'} );
1408 my ( $params ) = @_;
1410 my $content = $params->{content
};
1411 my $tables = $params->{tables
};
1412 my $loops = $params->{loops
};
1413 my $substitute = $params->{substitute
} || {};
1415 my $use_template_cache = C4
::Context
->config('template_cache_dir') && defined $ENV{GATEWAY_INTERFACE
};
1416 my $template = Template
->new(
1420 PLUGIN_BASE
=> 'Koha::Template::Plugin',
1421 COMPILE_EXT
=> $use_template_cache ?
'.ttc' : '',
1422 COMPILE_DIR
=> $use_template_cache ? C4
::Context
->config('template_cache_dir') : '',
1424 ENCODING
=> 'UTF-8',
1426 ) or die Template
->error();
1428 my $tt_params = { %{ _get_tt_params
( $tables ) }, %{ _get_tt_params
( $loops, 'is_a_loop' ) }, %$substitute };
1430 $content = add_tt_filters
( $content );
1431 $content = qq|[% USE KohaDates
%][% USE Remove_MARC_punctuation
%]$content|;
1434 $template->process( \
$content, $tt_params, \
$output ) || croak
"ERROR PROCESSING TEMPLATE: " . $template->error();
1439 sub _get_tt_params
{
1440 my ($tables, $is_a_loop) = @_;
1446 article_requests
=> {
1447 module
=> 'Koha::ArticleRequests',
1448 singular
=> 'article_request',
1449 plural
=> 'article_requests',
1453 module
=> 'Koha::Biblios',
1454 singular
=> 'biblio',
1455 plural
=> 'biblios',
1456 pk
=> 'biblionumber',
1459 module
=> 'Koha::Biblioitems',
1460 singular
=> 'biblioitem',
1461 plural
=> 'biblioitems',
1462 pk
=> 'biblioitemnumber',
1465 module
=> 'Koha::Patrons',
1466 singular
=> 'borrower',
1467 plural
=> 'borrowers',
1468 pk
=> 'borrowernumber',
1471 module
=> 'Koha::Libraries',
1472 singular
=> 'branch',
1473 plural
=> 'branches',
1477 module
=> 'Koha::Items',
1483 module
=> 'Koha::News',
1489 module
=> 'Koha::Acquisition::Orders',
1490 singular
=> 'order',
1492 pk
=> 'ordernumber',
1495 module
=> 'Koha::Holds',
1498 fk
=> [ 'borrowernumber', 'biblionumber' ],
1501 module
=> 'Koha::Serials',
1502 singular
=> 'serial',
1503 plural
=> 'serials',
1507 module
=> 'Koha::Subscriptions',
1508 singular
=> 'subscription',
1509 plural
=> 'subscriptions',
1510 pk
=> 'subscriptionid',
1513 module
=> 'Koha::Suggestions',
1514 singular
=> 'suggestion',
1515 plural
=> 'suggestions',
1516 pk
=> 'suggestionid',
1519 module
=> 'Koha::Checkouts',
1520 singular
=> 'checkout',
1521 plural
=> 'checkouts',
1525 module
=> 'Koha::Old::Checkouts',
1526 singular
=> 'old_checkout',
1527 plural
=> 'old_checkouts',
1531 module
=> 'Koha::Checkouts',
1532 singular
=> 'overdue',
1533 plural
=> 'overdues',
1536 borrower_modifications
=> {
1537 module
=> 'Koha::Patron::Modifications',
1538 singular
=> 'patron_modification',
1539 plural
=> 'patron_modifications',
1540 fk
=> 'verification_token',
1544 foreach my $table ( keys %$tables ) {
1545 next unless $config->{$table};
1547 my $ref = ref( $tables->{$table} ) || q{};
1548 my $module = $config->{$table}->{module
};
1550 if ( can_load
( modules
=> { $module => undef } ) ) {
1551 my $pk = $config->{$table}->{pk
};
1552 my $fk = $config->{$table}->{fk
};
1555 my $values = $tables->{$table} || [];
1556 unless ( ref( $values ) eq 'ARRAY' ) {
1557 croak
"ERROR processing table $table. Wrong API call.";
1559 my $key = $pk ?
$pk : $fk;
1560 # $key does not come from user input
1561 my $objects = $module->search(
1562 { $key => $values },
1564 # We want to retrieve the data in the same order
1566 # field is a MySQLism, but they are no other way to do it
1567 # To be generic we could do it in perl, but we will need to fetch
1568 # all the data then order them
1569 @
$values ?
( order_by
=> \
[ "field($key, " . join( ', ', @
$values ) . ")" ] ) : ()
1572 $params->{ $config->{$table}->{plural
} } = $objects;
1574 elsif ( $ref eq q{} || $ref eq 'HASH' ) {
1575 my $id = ref $ref eq 'HASH' ?
$tables->{$table}->{$pk} : $tables->{$table};
1577 if ( $fk ) { # Using a foreign key for lookup
1578 if ( ref( $fk ) eq 'ARRAY' ) { # Foreign key is multi-column
1580 foreach my $key ( @
$fk ) {
1581 $search->{$key} = $id->{$key};
1583 $object = $module->search( $search )->last();
1584 } else { # Foreign key is single column
1585 $object = $module->search( { $fk => $id } )->last();
1587 } else { # using the table's primary key for lookup
1588 $object = $module->find($id);
1590 $params->{ $config->{$table}->{singular
} } = $object;
1592 else { # $ref eq 'ARRAY'
1594 if ( @
{ $tables->{$table} } == 1 ) { # Param is a single key
1595 $object = $module->search( { $pk => $tables->{$table} } )->last();
1597 else { # Params are mutliple foreign keys
1598 croak
"Multiple foreign keys (table $table) should be passed using an hashref";
1600 $params->{ $config->{$table}->{singular
} } = $object;
1604 croak
"ERROR LOADING MODULE $module: $Module::Load::Conditional::ERROR";
1608 $params->{today
} = output_pref
({ dt
=> dt_from_string
, dateformat
=> 'iso' });
1613 =head3 add_tt_filters
1615 $content = add_tt_filters( $content );
1617 Add TT filters to some specific fields if needed.
1619 For now we only add the Remove_MARC_punctuation TT filter to biblio and biblioitem fields
1623 sub add_tt_filters
{
1624 my ( $content ) = @_;
1625 $content =~ s
|\
[%\s
*biblio\
.(.*?
)\s
*%\
]|[% biblio
.$1 \
| \
$Remove_MARC_punctuation %]|gxms
;
1626 $content =~ s
|\
[%\s
*biblioitem\
.(.*?
)\s
*%\
]|[% biblioitem
.$1 \
| \
$Remove_MARC_punctuation %]|gxms
;
1630 =head2 get_item_content
1632 my $item = Koha::Items->find(...)->unblessed;
1633 my @item_content_fields = qw( date_due title barcode author itemnumber );
1634 my $item_content = C4::Letters::get_item_content({
1636 item_content_fields => \@item_content_fields
1639 This function generates a tab-separated list of values for the passed item. Dates
1640 are formatted following the current setup.
1644 sub get_item_content
{
1645 my ( $params ) = @_;
1646 my $item = $params->{item
};
1647 my $dateonly = $params->{dateonly
} || 0;
1648 my $item_content_fields = $params->{item_content_fields
} || [];
1650 return unless $item;
1652 my @item_info = map {
1656 { dt
=> dt_from_string
( $item->{$_} ), dateonly
=> $dateonly } );
1660 } @
$item_content_fields;
1661 return join( "\t", @item_info ) . "\n";