X-Git-Url: http://koha-dev.rot13.org:8081/gitweb/?a=blobdiff_plain;f=C4%2FLetters.pm;h=177a4f51f674b210fe3d6cccabfa61391431c592;hb=9d6d641d1f8b77271800f43bc027b651f9aea52b;hp=6ff7713c5a760984a2b44e7572c398bcee15780f;hpb=9af64aa7d5739c0160fe484958921f1294955fb5;p=srvgit diff --git a/C4/Letters.pm b/C4/Letters.pm index 6ff7713c5a..177a4f51f6 100644 --- a/C4/Letters.pm +++ b/C4/Letters.pm @@ -20,31 +20,47 @@ package C4::Letters; use Modern::Perl; use MIME::Lite; -use Mail::Sendmail; -use Date::Calc qw( Add_Delta_Days ); -use Encode; -use Carp; +use Carp qw( carp croak ); use Template; -use Module::Load::Conditional qw(can_load); +use Module::Load::Conditional qw( can_load ); + +use Try::Tiny qw( catch try ); use C4::Members; -use C4::Members::Attributes qw(GetBorrowerAttributes); -use C4::Log; +use C4::Log qw( logaction ); use C4::SMS; -use C4::Debug; -use Koha::DateUtils; +use C4::Templates; +use Koha::DateUtils qw( dt_from_string output_pref ); use Koha::SMS::Providers; use Koha::Email; -use Koha::DateUtils qw( format_sqldatetime dt_from_string ); - -use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); - +use Koha::Notice::Messages; +use Koha::Notice::Templates; +use Koha::DateUtils qw( dt_from_string output_pref ); +use Koha::Patrons; +use Koha::SMTP::Servers; +use Koha::Subscriptions; + +our (@ISA, @EXPORT_OK); BEGIN { require Exporter; @ISA = qw(Exporter); - @EXPORT = qw( - &GetLetters &GetLettersAvailableForALibrary &GetLetterTemplates &DelLetter &GetPreparedLetter &GetWrappedLetter &addalert &getalert &delalert &findrelatedto &SendAlerts &GetPrintMessages &GetMessageTransportTypes + @EXPORT_OK = qw( + GetLetters + GetLettersAvailableForALibrary + GetLetterTemplates + DelLetter + GetPreparedLetter + GetWrappedLetter + SendAlerts + GetPrintMessages + GetQueuedMessages + GetMessage + GetMessageTransportTypes + + EnqueueLetter + SendQueuedMessages + ResendMessage ); } @@ -69,6 +85,9 @@ C4::Letters - Give functions for Letters management returns informations about letters. if needed, $module filters for letters given module + DEPRECATED - You must use Koha::Notice::Templates instead + The group by clause is confusing and can lead to issues + =cut sub GetLetters { @@ -79,14 +98,14 @@ sub GetLetters { my $dbh = C4::Context->dbh; my $letters = $dbh->selectall_arrayref( q| - SELECT module, code, branchcode, name + SELECT code, module, name FROM letter WHERE 1 | . ( $module ? q| AND module = ?| : q|| ) . ( $code ? q| AND code = ?| : q|| ) . ( defined $branchcode ? q| AND branchcode = ?| : q|| ) - . q| GROUP BY code ORDER BY name|, { Slice => {} } + . q| GROUP BY code, module, name ORDER BY name|, { Slice => {} } , ( $module ? $module : () ) , ( $code ? $code : () ) , ( defined $branchcode ? $branchcode : () ) @@ -106,7 +125,6 @@ sub GetLetters { ); Return a hashref of letter templates. - The key will be the message transport type. =cut @@ -117,20 +135,18 @@ sub GetLetterTemplates { my $code = $params->{code}; my $branchcode = $params->{branchcode} // ''; my $dbh = C4::Context->dbh; - my $letters = $dbh->selectall_hashref( - q| - SELECT module, code, branchcode, name, is_html, title, content, message_transport_type - FROM letter - WHERE module = ? - AND code = ? - and branchcode = ? - | - , 'message_transport_type' - , undef - , $module, $code, $branchcode - ); - - return $letters; + return Koha::Notice::Templates->search( + { + module => $module, + code => $code, + branchcode => $branchcode, + ( + C4::Context->preference('TranslateNotices') + ? () + : ( lang => 'default' ) + ) + } + )->unblessed; } =head2 GetLettersAvailableForALibrary @@ -199,34 +215,6 @@ sub GetLettersAvailableForALibrary { } -sub getletter { - my ( $module, $code, $branchcode, $message_transport_type ) = @_; - $message_transport_type //= '%'; - - if ( C4::Context->preference('IndependentBranches') - and $branchcode - and C4::Context->userenv ) { - - $branchcode = C4::Context->userenv->{'branch'}; - } - $branchcode //= ''; - - my $dbh = C4::Context->dbh; - my $sth = $dbh->prepare(q{ - SELECT * - FROM letter - WHERE module=? AND code=? AND (branchcode = ? OR branchcode = '') - AND message_transport_type LIKE ? - ORDER BY branchcode DESC LIMIT 1 - }); - $sth->execute( $module, $code, $branchcode, $message_transport_type ); - my $line = $sth->fetchrow_hashref - or return; - $line->{'content-type'} = 'text/html; charset="UTF-8"' if $line->{is_html}; - return { %$line }; -} - - =head2 DelLetter DelLetter( @@ -249,134 +237,36 @@ sub DelLetter { my $module = $params->{module}; my $code = $params->{code}; my $mtt = $params->{mtt}; + my $lang = $params->{lang}; my $dbh = C4::Context->dbh; $dbh->do(q| DELETE FROM letter WHERE branchcode = ? AND module = ? AND code = ? - | . ( $mtt ? q| AND message_transport_type = ?| : q|| ) - , undef, $branchcode, $module, $code, ( $mtt ? $mtt : () ) ); -} - -=head2 addalert ($borrowernumber, $type, $externalid) - - parameters : - - $borrowernumber : the number of the borrower subscribing to the alert - - $type : the type of alert. - - $externalid : the primary key of the object to put alert on. For issues, the alert is made on subscriptionid. - - create an alert and return the alertid (primary key) - -=cut - -sub addalert { - my ( $borrowernumber, $type, $externalid ) = @_; - my $dbh = C4::Context->dbh; - my $sth = - $dbh->prepare( - "insert into alert (borrowernumber, type, externalid) values (?,?,?)"); - $sth->execute( $borrowernumber, $type, $externalid ); - - # get the alert number newly created and return it - my $alertid = $dbh->{'mysql_insertid'}; - return $alertid; -} - -=head2 delalert ($alertid) - - parameters : - - alertid : the alert id - deletes the alert - -=cut - -sub delalert { - my $alertid = shift or die "delalert() called without valid argument (alertid)"; # it's gonna die anyway. - $debug and warn "delalert: deleting alertid $alertid"; - my $sth = C4::Context->dbh->prepare("delete from alert where alertid=?"); - $sth->execute($alertid); -} - -=head2 getalert ([$borrowernumber], [$type], [$externalid]) - - parameters : - - $borrowernumber : the number of the borrower subscribing to the alert - - $type : the type of alert. - - $externalid : the primary key of the object to put alert on. For issues, the alert is made on subscriptionid. - all parameters NON mandatory. If a parameter is omitted, the query is done without the corresponding parameter. For example, without $externalid, returns all alerts for a borrower on a topic. - -=cut - -sub getalert { - my ( $borrowernumber, $type, $externalid ) = @_; - my $dbh = C4::Context->dbh; - my $query = "SELECT a.*, b.branchcode FROM alert a JOIN borrowers b USING(borrowernumber) WHERE 1"; - my @bind; - if ($borrowernumber and $borrowernumber =~ /^\d+$/) { - $query .= " AND borrowernumber=?"; - push @bind, $borrowernumber; - } - if ($type) { - $query .= " AND type=?"; - push @bind, $type; - } - if ($externalid) { - $query .= " AND externalid=?"; - push @bind, $externalid; - } - my $sth = $dbh->prepare($query); - $sth->execute(@bind); - return $sth->fetchall_arrayref({}); -} - -=head2 findrelatedto($type, $externalid) - - parameters : - - $type : the type of alert - - $externalid : the id of the "object" to query - - In the table alert, a "id" is stored in the externalid field. This "id" is related to another table, depending on the type of the alert. - When type=issue, the id is related to a subscriptionid and this sub returns the name of the biblio. - -=cut - -# outmoded POD: -# When type=virtual, the id is related to a virtual shelf and this sub returns the name of the sub - -sub findrelatedto { - my $type = shift or return; - my $externalid = shift or return; - my $q = ($type eq 'issue' ) ? -"select title as result from subscription left join biblio on subscription.biblionumber=biblio.biblionumber where subscriptionid=?" : - ($type eq 'borrower') ? -"select concat(firstname,' ',surname) from borrowers where borrowernumber=?" : undef; - unless ($q) { - warn "findrelatedto(): Illegal type '$type'"; - return; - } - my $sth = C4::Context->dbh->prepare($q); - $sth->execute($externalid); - my ($result) = $sth->fetchrow; - return $result; + | + . ( $mtt ? q| AND message_transport_type = ?| : q|| ) + . ( $lang? q| AND lang = ?| : q|| ) + , undef, $branchcode, $module, $code, ( $mtt ? $mtt : () ), ( $lang ? $lang : () ) ); } =head2 SendAlerts my $err = &SendAlerts($type, $externalid, $letter_code); -Parameters: - - $type : the type of alert - - $externalid : the id of the "object" to query - - $letter_code : the notice template to use + Parameters: + - $type : the type of alert + - $externalid : the id of the "object" to query + - $letter_code : the notice template to use + + C<&SendAlerts> sends an email notice directly to a patron or a vendor. -C<&SendAlerts> sends an email notice directly to a patron or a vendor. -Currently it supports ($type): -- claim serial issues (claimissues) -- claim acquisition orders (claimacquisition) -- send acquisition orders to the vendor (orderacquisition) -- notify patrons about newly received serial issues (issue) -- notify patrons when their account is created (members) + Currently it supports ($type): + - claim serial issues (claimissues) + - claim acquisition orders (claimacquisition) + - send acquisition orders to the vendor (orderacquisition) + - notify patrons about newly received serial issues (issue) + - notify patrons when their account is created (members) Returns undef or { error => 'message } on failure. Returns true on success. @@ -386,6 +276,8 @@ Currently it supports ($type): sub SendAlerts { my ( $type, $externalid, $letter_code ) = @_; my $dbh = C4::Context->dbh; + my $error; + if ( $type eq 'issue' ) { # prepare the letter... @@ -407,53 +299,61 @@ sub SendAlerts { or warn( "No biblionumber for '$subscriptionid'" ), return; - my %letter; - # find the list of borrowers to alert - my $alerts = getalert( '', 'issue', $subscriptionid ); - foreach (@$alerts) { - my $borinfo = C4::Members::GetMember('borrowernumber' => $_->{'borrowernumber'}); - my $email = $borinfo->{email} or next; + # find the list of subscribers to notify + my $subscription = Koha::Subscriptions->find( $subscriptionid ); + my $subscribers = $subscription->subscribers; + while ( my $patron = $subscribers->next ) { + my $email = $patron->email or next; # warn "sending issues..."; my $userenv = C4::Context->userenv; - my $library = Koha::Libraries->find( $_->{branchcode} ); + my $library = $patron->library; my $letter = GetPreparedLetter ( module => 'serial', letter_code => $letter_code, branchcode => $userenv->{branch}, tables => { - 'branches' => $_->{branchcode}, + 'branches' => $library->branchcode, 'biblio' => $biblionumber, 'biblioitems' => $biblionumber, - 'borrowers' => $borinfo, + 'borrowers' => $patron->unblessed, 'subscription' => $subscriptionid, 'serial' => $externalid, }, want_librarian => 1, ) or return; - # ... then send mail - my $message = Koha::Email->new(); - my %mail = $message->create_message_headers( + # FIXME: This 'default' behaviour should be moved to Koha::Email + my $mail = Koha::Email->create( { - to => $email, - from => $library->branchemail, - replyto => $library->branchreplyto, - sender => $library->branchreturnpath, - subject => Encode::encode( "UTF-8", "" . $letter->{title} ), - message => $letter->{'is_html'} - ? _wrap_html( Encode::encode( "UTF-8", $letter->{'content'} ), - Encode::encode( "UTF-8", "" . $letter->{'title'} )) - : Encode::encode( "UTF-8", "" . $letter->{'content'} ), - contenttype => $letter->{'is_html'} - ? 'text/html; charset="utf-8"' - : 'text/plain; charset="utf-8"', + to => $email, + from => $library->branchemail, + reply_to => $library->branchreplyto, + sender => $library->branchreturnpath, + subject => "" . $letter->{title}, } ); - unless( sendmail(%mail) ) { - carp $Mail::Sendmail::error; - return { error => $Mail::Sendmail::error }; + + if ( $letter->{is_html} ) { + $mail->html_body( _wrap_html( $letter->{content}, "" . $letter->{title} ) ); + } + else { + $mail->text_body( $letter->{content} ); } + + my $success = try { + $mail->send_or_die({ transport => $library->smtp_server->transport }); + } + catch { + # We expect ref($_) eq 'Email::Sender::Failure' + $error = $_->message; + + carp "$_"; + return; + }; + + return { error => $error } + unless $success; } } elsif ( $type eq 'claimacquisition' or $type eq 'claimissues' or $type eq 'orderacquisition' ) { @@ -463,6 +363,7 @@ sub SendAlerts { my $sthorders; my $dataorders; my $action; + my $basketno; if ( $type eq 'claimacquisition') { $strsth = qq{ SELECT aqorders.*,aqbasket.*,biblio.*,biblioitems.* @@ -477,37 +378,39 @@ sub SendAlerts { carp "No order selected"; return { error => "no_order_selected" }; } - $strsth .= join( ",", @$externalid ) . ")"; + $strsth .= join( ",", ('?') x @$externalid ) . ")"; $action = "ACQUISITION CLAIM"; $sthorders = $dbh->prepare($strsth); - $sthorders->execute; + $sthorders->execute( @$externalid ); $dataorders = $sthorders->fetchall_arrayref( {} ); } if ($type eq 'claimissues') { $strsth = qq{ - SELECT serial.*,subscription.*, biblio.*, aqbooksellers.*, + SELECT serial.*,subscription.*, biblio.*, biblioitems.*, aqbooksellers.*, aqbooksellers.id AS booksellerid FROM serial LEFT JOIN subscription ON serial.subscriptionid=subscription.subscriptionid LEFT JOIN biblio ON serial.biblionumber=biblio.biblionumber + LEFT JOIN biblioitems ON serial.biblionumber = biblioitems.biblionumber LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id WHERE serial.serialid IN ( }; if (!@$externalid){ - carp "No Order selected"; - return { error => "no_order_selected" }; + carp "No issues selected"; + return { error => "no_issues_selected" }; } - $strsth .= join( ",", @$externalid ) . ")"; - $action = "CLAIM ISSUE"; + $strsth .= join( ",", ('?') x @$externalid ) . ")"; + $action = "SERIAL CLAIM"; $sthorders = $dbh->prepare($strsth); - $sthorders->execute; + $sthorders->execute( @$externalid ); $dataorders = $sthorders->fetchall_arrayref( {} ); } if ( $type eq 'orderacquisition') { + my $basketno = $externalid; $strsth = qq{ SELECT aqorders.*,aqbasket.*,biblio.*,biblioitems.* FROM aqorders @@ -518,13 +421,13 @@ sub SendAlerts { AND orderstatus IN ('new','ordered') }; - if (!$externalid){ + unless ( $basketno ) { carp "No basketnumber given"; return { error => "no_basketno" }; } $action = "ACQUISITION ORDER"; $sthorders = $dbh->prepare($strsth); - $sthorders->execute($externalid); + $sthorders->execute($basketno); $dataorders = $sthorders->fetchall_arrayref( {} ); } @@ -542,7 +445,6 @@ sub SendAlerts { my @email; my @cc; - push @email, $databookseller->{bookselleremail} if $databookseller->{bookselleremail}; push @email, $datacontact->{email} if ( $datacontact && $datacontact->{email} ); unless (@email) { warn "Bookseller $dataorders->[0]->{booksellerid} without emails"; @@ -559,48 +461,63 @@ sub SendAlerts { letter_code => $letter_code, branchcode => $userenv->{branch}, tables => { - 'branches' => $userenv->{branch}, + 'branches' => $userenv->{branch}, 'aqbooksellers' => $databookseller, 'aqcontacts' => $datacontact, + 'aqbasket' => $basketno, }, repeat => $dataorders, want_librarian => 1, - ) or return; + ) or return { error => "no_letter" }; # Remove the order tag $letter->{content} =~ s/(.*?)<\/order>/$1/gxms; # ... then send mail - my %mail = ( - To => join( ',', @email), - Cc => join( ',', @cc), - From => $userenv->{emailaddress}, - Subject => Encode::encode( "UTF-8", "" . $letter->{title} ), - Message => $letter->{'is_html'} - ? _wrap_html( Encode::encode( "UTF-8", $letter->{'content'} ), - Encode::encode( "UTF-8", "" . $letter->{'title'} )) - : Encode::encode( "UTF-8", "" . $letter->{'content'} ), - 'Content-Type' => $letter->{'is_html'} - ? 'text/html; charset="utf-8"' - : 'text/plain; charset="utf-8"', + my $library = Koha::Libraries->find( $userenv->{branch} ); + my $mail = Koha::Email->create( + { + to => join( ',', @email ), + cc => join( ',', @cc ), + ( + ( + C4::Context->preference("ClaimsBccCopy") + && ( $type eq 'claimacquisition' + || $type eq 'claimissues' ) + ) + ? ( bcc => $userenv->{emailaddress} ) + : () + ), + from => $library->branchemail + || C4::Context->preference('KohaAdminEmailAddress'), + subject => "" . $letter->{title}, + } ); - if ($type eq 'claimacquisition' || $type eq 'claimissues' ) { - $mail{'Reply-to'} = C4::Context->preference('ReplytoDefault') - if C4::Context->preference('ReplytoDefault'); - $mail{'Sender'} = C4::Context->preference('ReturnpathDefault') - if C4::Context->preference('ReturnpathDefault'); - $mail{'Bcc'} = $userenv->{emailaddress} - if C4::Context->preference("ClaimsBccCopy"); + if ( $letter->{is_html} ) { + $mail->html_body( _wrap_html( $letter->{content}, "" . $letter->{title} ) ); + } + else { + $mail->text_body( "" . $letter->{content} ); } - unless ( sendmail(%mail) ) { - carp $Mail::Sendmail::error; - return { error => $Mail::Sendmail::error }; + my $success = try { + $mail->send_or_die({ transport => $library->smtp_server->transport }); } + catch { + # We expect ref($_) eq 'Email::Sender::Failure' + $error = $_->message; + carp "$_"; + return; + }; + + return { error => $error } + unless $success; + + my $module = $action eq 'ACQUISITION ORDER' ? 'ACQUISITIONS' : 'CLAIMS'; logaction( - "ACQUISITION", + $module, $action, undef, "To=" @@ -609,44 +526,57 @@ sub SendAlerts { . $letter->{title} . " Content=" . $letter->{content} - ) if C4::Context->preference("LetterLog"); + ) if C4::Context->preference("ClaimsLog"); } # send an "account details" notice to a newly created user elsif ( $type eq 'members' ) { - my $library = Koha::Libraries->find( $externalid->{branchcode} )->unblessed; + my $library = Koha::Libraries->find( $externalid->{branchcode} ); my $letter = GetPreparedLetter ( module => 'members', letter_code => $letter_code, branchcode => $externalid->{'branchcode'}, + lang => $externalid->{lang} || 'default', tables => { - 'branches' => $library, + 'branches' => $library->unblessed, 'borrowers' => $externalid->{'borrowernumber'}, }, substitute => { 'borrowers.password' => $externalid->{'password'} }, want_librarian => 1, ) or return; return { error => "no_email" } unless $externalid->{'emailaddr'}; - my $email = Koha::Email->new(); - my %mail = $email->create_message_headers( - { - to => $externalid->{'emailaddr'}, - from => $library->{branchemail}, - replyto => $library->{branchreplyto}, - sender => $library->{branchreturnpath}, - subject => Encode::encode( "UTF-8", "" . $letter->{'title'} ), - message => $letter->{'is_html'} - ? _wrap_html( Encode::encode( "UTF-8", $letter->{'content'} ), - Encode::encode( "UTF-8", "" . $letter->{'title'} ) ) - : Encode::encode( "UTF-8", "" . $letter->{'content'} ), - contenttype => $letter->{'is_html'} - ? 'text/html; charset="utf-8"' - : 'text/plain; charset="utf-8"', + + my $success = try { + + # FIXME: This 'default' behaviour should be moved to Koha::Email + my $mail = Koha::Email->create( + { + to => $externalid->{'emailaddr'}, + from => $library->branchemail, + reply_to => $library->branchreplyto, + sender => $library->branchreturnpath, + subject => "" . $letter->{'title'}, + } + ); + + if ( $letter->{is_html} ) { + $mail->html_body( _wrap_html( $letter->{content}, "" . $letter->{title} ) ); } - ); - unless( sendmail(%mail) ) { - carp $Mail::Sendmail::error; - return { error => $Mail::Sendmail::error }; + else { + $mail->text_body( $letter->{content} ); + } + + $mail->send_or_die({ transport => $library->smtp_server->transport }); } + catch { + # We expect ref($_) eq 'Email::Sender::Failure' + $error = $_->message; + + carp "$_"; + return; + }; + + return { error => $error } + unless $success; } # If we come here, return an OK status @@ -679,24 +609,44 @@ sub SendAlerts { sub GetPreparedLetter { my %params = @_; - my $module = $params{module} or croak "No module"; - my $letter_code = $params{letter_code} or croak "No letter_code"; - my $branchcode = $params{branchcode} || ''; - my $mtt = $params{message_transport_type} || 'email'; + my $letter = $params{letter}; + my $lang = $params{lang} || 'default'; + + unless ( $letter ) { + my $module = $params{module} or croak "No module"; + my $letter_code = $params{letter_code} or croak "No letter_code"; + my $branchcode = $params{branchcode} || ''; + my $mtt = $params{message_transport_type} || 'email'; + + my $template = Koha::Notice::Templates->find_effective_template( + { + module => $module, + code => $letter_code, + branchcode => $branchcode, + message_transport_type => $mtt, + lang => $lang + } + ); - my $letter = getletter( $module, $letter_code, $branchcode, $mtt ) - or warn( "No $module $letter_code letter transported by " . $mtt ), + unless ( $template ) { + warn( "No $module $letter_code letter transported by " . $mtt ); return; + } + + $letter = $template->unblessed; + $letter->{'content-type'} = 'text/html; charset="UTF-8"' if $letter->{is_html}; + } - my $tables = $params{tables}; - my $substitute = $params{substitute}; + my $tables = $params{tables} || {}; + my $substitute = $params{substitute} || {}; + my $loops = $params{loops} || {}; # loops is not supported for historical notices syntax my $repeat = $params{repeat}; - $tables || $substitute || $repeat - or carp( "ERROR: nothing to substitute - both 'tables' and 'substitute' are empty" ), + %$tables || %$substitute || $repeat || %$loops + or carp( "ERROR: nothing to substitute - both 'tables', 'loops' and 'substitute' are empty" ), return; my $want_librarian = $params{want_librarian}; - if ($substitute) { + if (%$substitute) { while ( my ($token, $val) = each %$substitute ) { if ( $token eq 'items.content' ) { $val =~ s|\n|
|g if $letter->{is_html}; @@ -742,7 +692,7 @@ sub GetPreparedLetter { } } - if ($tables) { + if (%$tables) { _substitute_tables( $letter, $tables ); } @@ -769,6 +719,18 @@ sub GetPreparedLetter { { content => $letter->{content}, tables => $tables, + loops => $loops, + substitute => $substitute, + lang => $lang + } + ); + + $letter->{title} = _process_tt( + { + content => $letter->{title}, + tables => $tables, + loops => $loops, + substitute => $substitute, } ); @@ -816,8 +778,11 @@ sub _parseletter_sth { # broke things for the rest of us. prepare_cached is a better # way to cache statement handles anyway. my $query = + ($table eq 'accountlines' ) ? "SELECT * FROM $table WHERE accountlines_id = ?" : ($table eq 'biblio' ) ? "SELECT * FROM $table WHERE biblionumber = ?" : ($table eq 'biblioitems' ) ? "SELECT * FROM $table WHERE biblionumber = ?" : + ($table eq 'credits' ) ? "SELECT * FROM accountlines WHERE accountlines_id = ?" : + ($table eq 'debits' ) ? "SELECT * FROM accountlines WHERE accountlines_id = ?" : ($table eq 'items' ) ? "SELECT * FROM $table WHERE itemnumber = ?" : ($table eq 'issues' ) ? "SELECT * FROM $table WHERE itemnumber = ?" : ($table eq 'old_issues' ) ? "SELECT * FROM $table WHERE itemnumber = ? ORDER BY timestamp DESC LIMIT 1" : @@ -827,11 +792,14 @@ sub _parseletter_sth { ($table eq 'suggestions' ) ? "SELECT * FROM $table WHERE suggestionid = ?" : ($table eq 'aqbooksellers') ? "SELECT * FROM $table WHERE id = ?" : ($table eq 'aqorders' ) ? "SELECT * FROM $table WHERE ordernumber = ?" : + ($table eq 'aqbasket' ) ? "SELECT * FROM $table WHERE basketno = ?" : + ($table eq 'illrequests' ) ? "SELECT * FROM $table WHERE illrequest_id = ?" : ($table eq 'opac_news' ) ? "SELECT * FROM $table WHERE idnew = ?" : ($table eq 'article_requests') ? "SELECT * FROM $table WHERE id = ?" : ($table eq 'borrower_modifications') ? "SELECT * FROM $table WHERE verification_token = ?" : ($table eq 'subscription') ? "SELECT * FROM $table WHERE subscriptionid = ?" : ($table eq 'serial') ? "SELECT * FROM $table WHERE serialid = ?" : + ($table eq 'problem_reports') ? "SELECT * FROM $table WHERE reportid = ?" : undef ; unless ($query) { warn "ERROR: No _parseletter_sth query for table '$table'"; @@ -863,25 +831,15 @@ sub _parseletter { my $values = $values_in ? { %$values_in } : {}; if ( $table eq 'borrowers' && $values->{'dateexpiry'} ){ - $values->{'dateexpiry'} = format_sqldatetime( $values->{'dateexpiry'} ); + $values->{'dateexpiry'} = output_pref({ dt => dt_from_string( $values->{'dateexpiry'} ), dateonly => 1 }); } if ( $table eq 'reserves' && $values->{'waitingdate'} ) { - my @waitingdate = split /-/, $values->{'waitingdate'}; - - $values->{'expirationdate'} = ''; - if ( C4::Context->preference('ReservesMaxPickUpDelay') ) { - my $dt = dt_from_string(); - $dt->add( days => C4::Context->preference('ReservesMaxPickUpDelay') ); - $values->{'expirationdate'} = output_pref( { dt => $dt, dateonly => 1 } ); - } - $values->{'waitingdate'} = output_pref({ dt => dt_from_string( $values->{'waitingdate'} ), dateonly => 1 }); - } if ($letter->{content} && $letter->{content} =~ /<>/) { - my $todaysdate = output_pref( DateTime->now() ); + my $todaysdate = output_pref( dt_from_string() ); $letter->{content} =~ s/<>/$todaysdate/go; } @@ -899,7 +857,6 @@ sub _parseletter { # Dates replacement my $replacedby = defined ($val) ? $val : ''; if ( $replacedby - and not $replacedby =~ m|0000-00-00| and not $replacedby =~ m|9999-12-31| and $replacedby =~ m|^\d{4}-\d{2}-\d{2}( \d{2}:\d{2}:\d{2})?$| ) { @@ -936,11 +893,13 @@ sub _parseletter { } if ($table eq 'borrowers' && $letter->{content}) { - if ( my $attributes = GetBorrowerAttributes($values->{borrowernumber}) ) { + my $patron = Koha::Patrons->find( $values->{borrowernumber} ); + if ( $patron ) { + my $attributes = $patron->extended_attributes; my %attr; - foreach (@$attributes) { - my $code = $_->{code}; - my $val = $_->{value_description} || $_->{value}; + while ( my $attribute = $attributes->next ) { + my $code = $attribute->code; + my $val = $attribute->description; # FIXME - we always display intranet description here! $val =~ s/\p{P}(?=$)//g if $val; next unless $val gt ''; $attr{$code} ||= []; @@ -961,11 +920,19 @@ sub _parseletter { my $success = EnqueueLetter( { letter => $letter, borrowernumber => '12', message_transport_type => 'email' } ) -places a letter in the message_queue database table, which will +Places a letter in the message_queue database table, which will eventually get processed (sent) by the process_message_queue.pl cronjob when it calls SendQueuedMessages. -return message_id on success +Return message_id on success + +Parameters +* letter - required; A letter hashref as returned from GetPreparedLetter +* message_transport_type - required; One of the available mtts +* borrowernumber - optional if 'to_address' is passed; The borrowernumber of the patron we enqueuing the notice for +* to_address - optional if 'borrowernumber' is passed; The destination email address for the notice (defaults to patron->notice_email_address) +* from_address - optional; The from address for the notice, defaults to patron->library->from_email_address +* reply_address - optional; The reply address for the notice, defaults to patron->library->reply_to =cut @@ -979,7 +946,7 @@ sub EnqueueLetter { my $content = $params->{letter}->{content}; $content =~ s/\s+//g if(defined $content); if ( not defined $content or $content eq '' ) { - warn "Trying to add an empty message to the message queue" if $debug; + Koha::Logger->get->info("Trying to add an empty message to the message queue"); return; } @@ -996,9 +963,9 @@ sub EnqueueLetter { my $dbh = C4::Context->dbh(); my $statement = << 'ENDSQL'; INSERT INTO message_queue -( borrowernumber, subject, content, metadata, letter_code, message_transport_type, status, time_queued, to_address, from_address, content_type ) +( borrowernumber, subject, content, metadata, letter_code, message_transport_type, status, time_queued, to_address, from_address, reply_address, content_type, delivery_note ) VALUES -( ?, ?, ?, ?, ?, ?, ?, NOW(), ?, ?, ? ) +( ?, ?, ?, ?, ?, ?, ?, CAST(NOW() AS DATETIME), ?, ?, ?, ?, ? ) ENDSQL my $sth = $dbh->prepare($statement); @@ -1012,31 +979,59 @@ ENDSQL 'pending', # status $params->{'to_address'}, # to_address $params->{'from_address'}, # from_address + $params->{'reply_address'}, # reply_address $params->{'letter'}->{'content-type'}, # content_type + $params->{'delivery_note'} || '', # delivery_note ); return $dbh->last_insert_id(undef,undef,'message_queue', undef); } =head2 SendQueuedMessages ([$hashref]) - my $sent = SendQueuedMessages( { verbose => 1 } ); + my $sent = SendQueuedMessages({ + letter_code => $letter_code, + borrowernumber => $who_letter_is_for, + limit => 50, + verbose => 1, + type => 'sms', + }); + +Sends all of the 'pending' items in the message queue, unless +parameters are passed. + +The letter_code, borrowernumber and limit parameters are used +to build a parameter set for _get_unsent_messages, thus limiting +which pending messages will be processed. They are all optional. -sends all of the 'pending' items in the message queue. +The verbose parameter can be used to generate debugging output. +It is also optional. -returns number of messages sent. +Returns number of messages sent. =cut sub SendQueuedMessages { my $params = shift; - my $unsent_messages = _get_unsent_messages(); + my $which_unsent_messages = { + 'message_id' => $params->{'message_id'}, + 'limit' => $params->{'limit'} // 0, + 'borrowernumber' => $params->{'borrowernumber'} // q{}, + 'letter_code' => $params->{'letter_code'} // q{}, + 'type' => $params->{'type'} // q{}, + }; + my $unsent_messages = _get_unsent_messages( $which_unsent_messages ); MESSAGE: foreach my $message ( @$unsent_messages ) { + my $message_object = Koha::Notice::Messages->find( $message->{message_id} ); + # If this fails the database is unwritable and we won't manage to send a message that continues to be marked 'pending' + $message_object->make_column_dirty('status'); + return unless $message_object->store; + # warn Data::Dumper->Dump( [ $message ], [ 'message' ] ); warn sprintf( 'sending %s message to patron: %s', $message->{'message_transport_type'}, $message->{'borrowernumber'} || 'Admin' ) - if $params->{'verbose'} or $debug; + if $params->{'verbose'}; # This is just begging for subclassing next MESSAGE if ( lc($message->{'message_transport_type'}) eq 'rss' ); if ( lc( $message->{'message_transport_type'} ) eq 'email' ) { @@ -1044,9 +1039,29 @@ sub SendQueuedMessages { } elsif ( lc( $message->{'message_transport_type'} ) eq 'sms' ) { if ( C4::Context->preference('SMSSendDriver') eq 'Email' ) { - my $member = C4::Members::GetMember( 'borrowernumber' => $message->{'borrowernumber'} ); - my $sms_provider = Koha::SMS::Providers->find( $member->{'sms_provider_id'} ); + my $patron = Koha::Patrons->find( $message->{borrowernumber} ); + my $sms_provider = Koha::SMS::Providers->find( $patron->sms_provider_id ); + unless ( $sms_provider ) { + warn sprintf( "Patron %s has no sms provider id set!", $message->{'borrowernumber'} ) if $params->{'verbose'}; + _set_message_status( { message_id => $message->{'message_id'}, status => 'failed' } ); + next MESSAGE; + } + unless ( $patron->smsalertnumber ) { + _set_message_status( { message_id => $message->{'message_id'}, status => 'failed' } ); + warn sprintf( "No smsalertnumber found for patron %s!", $message->{'borrowernumber'} ) if $params->{'verbose'}; + next MESSAGE; + } + $message->{to_address} = $patron->smsalertnumber; #Sometime this is set to email - sms should always use smsalertnumber $message->{to_address} .= '@' . $sms_provider->domain(); + + # Check for possible from_address override + my $from_address = C4::Context->preference('EmailSMSSendDriverFromAddress'); + if ($from_address && $message->{from_address} ne $from_address) { + $message->{from_address} = $from_address; + _update_message_from_address($message->{'message_id'}, $message->{from_address}); + } + + _update_message_to_address($message->{'message_id'}, $message->{to_address}); _send_message_by_email( $message, $params->{'username'}, $params->{'password'}, $params->{'method'} ); } else { _send_message_by_sms( $message ); @@ -1097,10 +1112,10 @@ sub GetPrintMessages { my $messages = GetQueuedMessage( { borrowernumber => '123', limit => 20 } ); -fetches messages out of the message queue. +Fetches a list of messages from the message queue optionally filtered by borrowernumber +and limited to specified limit. -returns: -list of hashes, each has represents a message in the message queue. +Return is an arrayref of hashes, each has represents a message in the message queue. =cut @@ -1109,7 +1124,7 @@ sub GetQueuedMessages { my $dbh = C4::Context->dbh(); my $statement = << 'ENDSQL'; -SELECT message_id, borrowernumber, subject, content, message_transport_type, status, time_queued +SELECT message_id, borrowernumber, subject, content, message_transport_type, status, time_queued, updated_on, delivery_note FROM message_queue ENDSQL @@ -1163,7 +1178,7 @@ sub GetMessage { return unless $message_id; my $dbh = C4::Context->dbh; return $dbh->selectrow_hashref(q| - SELECT message_id, borrowernumber, subject, content, metadata, letter_code, message_transport_type, status, time_queued, to_address, from_address, content_type + SELECT message_id, borrowernumber, subject, content, metadata, letter_code, message_transport_type, status, time_queued, updated_on, to_address, from_address, reply_address, content_type, delivery_note FROM message_queue WHERE message_id = ? |, {}, $message_id ); @@ -1204,15 +1219,15 @@ sub ResendMessage { =head2 _add_attachements -named parameters: -letter - the standard letter hashref -attachments - listref of attachments. each attachment is a hashref of: - type - the mime type, like 'text/plain' - content - the actual attachment - filename - the name of the attachment. -message - a MIME::Lite object to attach these to. + named parameters: + letter - the standard letter hashref + attachments - listref of attachments. each attachment is a hashref of: + type - the mime type, like 'text/plain' + content - the actual attachment + filename - the name of the attachment. + message - a MIME::Lite object to attach these to. -returns your letter object, with the content updated. + returns your letter object, with the content updated. =cut @@ -1248,35 +1263,60 @@ sub _add_attachments { } +=head2 _get_unsent_messages + + This function's parameter hash reference takes the following + optional named parameters: + message_transport_type: method of message sending (e.g. email, sms, etc.) + borrowernumber : who the message is to be sent + letter_code : type of message being sent (e.g. PASSWORD_RESET) + message_id : the message_id of the message. In that case the sub will return only 1 result + limit : maximum number of messages to send + + This function returns an array of matching hash referenced rows from + message_queue with some borrower information added. + +=cut + sub _get_unsent_messages { my $params = shift; my $dbh = C4::Context->dbh(); - my $statement = << 'ENDSQL'; -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 - FROM message_queue mq - LEFT JOIN borrowers b ON b.borrowernumber = mq.borrowernumber - WHERE status = ? -ENDSQL + my $statement = qq{ + SELECT mq.message_id, mq.borrowernumber, mq.subject, mq.content, mq.message_transport_type, mq.status, mq.time_queued, mq.from_address, mq.reply_address, mq.to_address, mq.content_type, b.branchcode, mq.letter_code, mq.delivery_note + FROM message_queue mq + LEFT JOIN borrowers b ON b.borrowernumber = mq.borrowernumber + WHERE status = ? + }; my @query_params = ('pending'); if ( ref $params ) { if ( $params->{'message_transport_type'} ) { - $statement .= ' AND message_transport_type = ? '; + $statement .= ' AND mq.message_transport_type = ? '; push @query_params, $params->{'message_transport_type'}; } if ( $params->{'borrowernumber'} ) { - $statement .= ' AND borrowernumber = ? '; + $statement .= ' AND mq.borrowernumber = ? '; push @query_params, $params->{'borrowernumber'}; } + if ( $params->{'letter_code'} ) { + $statement .= ' AND mq.letter_code = ? '; + push @query_params, $params->{'letter_code'}; + } + if ( $params->{'type'} ) { + $statement .= ' AND message_transport_type = ? '; + push @query_params, $params->{'type'}; + } + if ( $params->{message_id} ) { + $statement .= ' AND message_id = ?'; + push @query_params, $params->{message_id}; + } if ( $params->{'limit'} ) { $statement .= ' limit ? '; push @query_params, $params->{'limit'}; } } - $debug and warn "_get_unsent_messages SQL: $statement"; - $debug and warn "_get_unsent_messages params: " . join(',',@query_params); my $sth = $dbh->prepare( $statement ); my $result = $sth->execute( @query_params ); return $sth->fetchall_arrayref({}); @@ -1286,70 +1326,131 @@ sub _send_message_by_email { my $message = shift or return; my ($username, $password, $method) = @_; - my $member = C4::Members::GetMember( 'borrowernumber' => $message->{'borrowernumber'} ); + my $patron = Koha::Patrons->find( $message->{borrowernumber} ); my $to_address = $message->{'to_address'}; unless ($to_address) { - unless ($member) { + unless ($patron) { warn "FAIL: No 'to_address' and INVALID borrowernumber ($message->{borrowernumber})"; _set_message_status( { message_id => $message->{'message_id'}, - status => 'failed' } ); + status => 'failed', + delivery_note => 'Invalid borrowernumber '.$message->{borrowernumber}, + error_code => 'INVALID_BORNUMBER' } ); return; } - $to_address = C4::Members::GetNoticeEmailAddress( $message->{'borrowernumber'} ); + $to_address = $patron->notice_email_address; unless ($to_address) { # warn "FAIL: No 'to_address' and no email for " . ($member->{surname} ||'') . ", borrowernumber ($message->{borrowernumber})"; # warning too verbose for this more common case? _set_message_status( { message_id => $message->{'message_id'}, - status => 'failed' } ); + status => 'failed', + delivery_note => 'Unable to find an email address for this borrower', + error_code => 'NO_EMAIL' } ); return; } } - my $utf8 = decode('MIME-Header', $message->{'subject'} ); - $message->{subject}= encode('MIME-Header', $utf8); - my $subject = encode('UTF-8', $message->{'subject'}); - my $content = encode('UTF-8', $message->{'content'}); + my $subject = $message->{'subject'}; + + my $content = $message->{'content'}; my $content_type = $message->{'content_type'} || 'text/plain; charset="UTF-8"'; my $is_html = $content_type =~ m/html/io; + my $branch_email = undef; my $branch_replyto = undef; my $branch_returnpath = undef; - if ($member) { - my $library = Koha::Libraries->find( $member->{branchcode} ); - $branch_email = $library->branchemail; + my $library; + + if ($patron) { + $library = $patron->library; + $branch_email = $library->from_email_address; $branch_replyto = $library->branchreplyto; $branch_returnpath = $library->branchreturnpath; } - my $email = Koha::Email->new(); - my %sendmail_params = $email->create_message_headers( + + # NOTE: Patron may not be defined above so branch_email may be undefined still + # so we need to fallback to KohaAdminEmailAddress as a last resort. + my $from_address = + $message->{'from_address'} + || $branch_email + || C4::Context->preference('KohaAdminEmailAddress'); + if( !$from_address ) { + _set_message_status({ + message_id => $message->{'message_id'}, + status => 'failed', + delivery_note => 'No from address', + }); + return; + }; + my $email = Koha::Email->create( { - to => $to_address, - from => $message->{'from_address'} || $branch_email, - replyto => $branch_replyto, - sender => $branch_returnpath, - subject => $subject, - message => $is_html ? _wrap_html( $content, $subject ) : $content, - contenttype => $content_type + to => $to_address, + ( + C4::Context->preference('NoticeBcc') + ? ( bcc => C4::Context->preference('NoticeBcc') ) + : () + ), + from => $from_address, + reply_to => $message->{'reply_address'} || $branch_replyto, + sender => $branch_returnpath, + subject => "" . $message->{subject} } ); - $sendmail_params{'Auth'} = {user => $username, pass => $password, method => $method} if $username; - if ( my $bcc = C4::Context->preference('OverdueNoticeBcc') ) { - $sendmail_params{ Bcc } = $bcc; + if ( $is_html ) { + $email->html_body( + _wrap_html( $content, $subject ) + ); + } + else { + $email->text_body( $content ); } - _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 + my $smtp_server; + if ( $library ) { + $smtp_server = $library->smtp_server; + } + else { + $smtp_server = Koha::SMTP::Servers->get_default; + } - if ( sendmail( %sendmail_params ) ) { - _set_message_status( { message_id => $message->{'message_id'}, - status => 'sent' } ); + if ( $username ) { + $smtp_server->set( + { + sasl_username => $username, + sasl_password => $password, + } + ); + } + +# if initial message address was empty, coming here means that a to address was found and +# queue should be updated; same if to address was overriden by Koha::Email->create + _update_message_to_address( $message->{'message_id'}, $email->email->header('To') ) + if !$message->{to_address} + || $message->{to_address} ne $email->email->header('To'); + + try { + $email->send_or_die({ transport => $smtp_server->transport }); + + _set_message_status( + { + message_id => $message->{'message_id'}, + status => 'sent', + delivery_note => '' + } + ); return 1; - } else { - _set_message_status( { message_id => $message->{'message_id'}, - status => 'failed' } ); - carp $Mail::Sendmail::error; - return; } + catch { + _set_message_status( + { + message_id => $message->{'message_id'}, + status => 'failed', + delivery_note => $Mail::Sendmail::error + } + ); + carp "$_"; + return; + }; } sub _wrap_html { @@ -1382,7 +1483,7 @@ sub _is_duplicate { WHERE message_transport_type = ? AND borrowernumber = ? AND letter_code = ? - AND CAST(time_queued AS date) = CAST(NOW() AS date) + AND CAST(updated_on AS date) = CAST(NOW() AS date) AND status="sent" AND content = ? |, {}, $message->{message_transport_type}, $message->{borrowernumber}, $message->{letter_code}, $message->{content} ); @@ -1391,25 +1492,32 @@ sub _is_duplicate { sub _send_message_by_sms { my $message = shift or return; - my $member = C4::Members::GetMember( 'borrowernumber' => $message->{'borrowernumber'} ); + my $patron = Koha::Patrons->find( $message->{borrowernumber} ); - unless ( $member->{smsalertnumber} ) { + unless ( $patron and $patron->smsalertnumber ) { _set_message_status( { message_id => $message->{'message_id'}, - status => 'failed' } ); + status => 'failed', + delivery_note => 'Missing SMS number', + error_code => 'MISSING_SMS' } ); return; } if ( _is_duplicate( $message ) ) { _set_message_status( { message_id => $message->{'message_id'}, - status => 'failed' } ); + status => 'failed', + delivery_note => 'Message is duplicate', + error_code => 'DUPLICATE_MESSAGE' } ); return; } - my $success = C4::SMS->send_sms( { destination => $member->{'smsalertnumber'}, + my $success = C4::SMS->send_sms( { destination => $patron->smsalertnumber, message => $message->{'content'}, } ); _set_message_status( { message_id => $message->{'message_id'}, - status => ($success ? 'sent' : 'failed') } ); + status => ($success ? 'sent' : 'failed'), + delivery_note => ($success ? '' : 'No notes from SMS driver'), + error_code => 'NO_NOTES' } ); + return $success; } @@ -1419,6 +1527,12 @@ sub _update_message_to_address { $dbh->do('UPDATE message_queue SET to_address=? WHERE message_id=?',undef,($to,$id)); } +sub _update_message_from_address { + my ($message_id, $from_address) = @_; + my $dbh = C4::Context->dbh(); + $dbh->do('UPDATE message_queue SET from_address = ? WHERE message_id = ?', undef, ($from_address, $message_id)); +} + sub _set_message_status { my $params = shift or return; @@ -1427,9 +1541,10 @@ sub _set_message_status { } my $dbh = C4::Context->dbh(); - my $statement = 'UPDATE message_queue SET status= ? WHERE message_id = ?'; + my $statement = 'UPDATE message_queue SET status= ?, delivery_note= ? WHERE message_id = ?'; my $sth = $dbh->prepare( $statement ); my $result = $sth->execute( $params->{'status'}, + $params->{'delivery_note'} || '', $params->{'message_id'} ); return $result; } @@ -1439,6 +1554,18 @@ sub _process_tt { my $content = $params->{content}; my $tables = $params->{tables}; + my $loops = $params->{loops}; + my $substitute = $params->{substitute} || {}; + my $lang = defined($params->{lang}) && $params->{lang} ne 'default' ? $params->{lang} : 'en'; + my ($theme, $availablethemes); + + my $htdocs = C4::Context->config('intrahtdocs'); + ($theme, $lang, $availablethemes)= C4::Templates::availablethemes( $htdocs, 'about.tt', 'intranet', $lang); + my @includes; + foreach (@$availablethemes) { + push @includes, "$htdocs/$_/$lang/includes"; + push @includes, "$htdocs/$_/en/includes" unless $lang eq 'en'; + } my $use_template_cache = C4::Context->config('template_cache_dir') && defined $ENV{GATEWAY_INTERFACE}; my $template = Template->new( @@ -1448,12 +1575,16 @@ sub _process_tt { PLUGIN_BASE => 'Koha::Template::Plugin', COMPILE_EXT => $use_template_cache ? '.ttc' : '', COMPILE_DIR => $use_template_cache ? C4::Context->config('template_cache_dir') : '', + INCLUDE_PATH => \@includes, FILTERS => {}, ENCODING => 'UTF-8', } ) or die Template->error(); - my $tt_params = _get_tt_params( $tables ); + my $tt_params = { %{ _get_tt_params( $tables ) }, %{ _get_tt_params( $loops, 'is_a_loop' ) }, %$substitute }; + + $content = add_tt_filters( $content ); + $content = qq|[% USE KohaDates %][% USE Remove_MARC_punctuation %]$content|; my $output; $template->process( \$content, $tt_params, \$output ) || croak "ERROR PROCESSING TEMPLATE: " . $template->error(); @@ -1462,17 +1593,36 @@ sub _process_tt { } sub _get_tt_params { - my ($tables) = @_; + my ($tables, $is_a_loop) = @_; my $params; + $is_a_loop ||= 0; my $config = { + article_requests => { + module => 'Koha::ArticleRequests', + singular => 'article_request', + plural => 'article_requests', + pk => 'id', + }, + aqbasket => { + module => 'Koha::Acquisition::Baskets', + singular => 'basket', + plural => 'baskets', + pk => 'basketno', + }, biblio => { module => 'Koha::Biblios', singular => 'biblio', plural => 'biblios', pk => 'biblionumber', }, + biblioitems => { + module => 'Koha::Biblioitems', + singular => 'biblioitem', + plural => 'biblioitems', + pk => 'biblioitemnumber', + }, borrowers => { module => 'Koha::Patrons', singular => 'borrower', @@ -1485,6 +1635,18 @@ sub _get_tt_params { plural => 'branches', pk => 'branchcode', }, + credits => { + module => 'Koha::Account::Lines', + singular => 'credit', + plural => 'credits', + pk => 'accountlines_id', + }, + debits => { + module => 'Koha::Account::Lines', + singular => 'debit', + plural => 'debits', + pk => 'accountlines_id', + }, items => { module => 'Koha::Items', singular => 'item', @@ -1497,11 +1659,17 @@ sub _get_tt_params { plural => 'news', pk => 'idnew', }, + aqorders => { + module => 'Koha::Acquisition::Orders', + singular => 'order', + plural => 'orders', + pk => 'ordernumber', + }, reserves => { module => 'Koha::Holds', singular => 'hold', plural => 'holds', - fk => [ 'borrowernumber', 'biblionumber' ], + pk => 'reserve_id', }, serial => { module => 'Koha::Serials', @@ -1527,12 +1695,30 @@ sub _get_tt_params { plural => 'checkouts', fk => 'itemnumber', }, + old_issues => { + module => 'Koha::Old::Checkouts', + singular => 'old_checkout', + plural => 'old_checkouts', + fk => 'itemnumber', + }, + overdues => { + module => 'Koha::Checkouts', + singular => 'overdue', + plural => 'overdues', + fk => 'itemnumber', + }, borrower_modifications => { module => 'Koha::Patron::Modifications', singular => 'patron_modification', plural => 'patron_modifications', fk => 'verification_token', }, + illrequests => { + module => 'Koha::Illrequests', + singular => 'illrequest', + plural => 'illrequests', + pk => 'illrequest_id' + } }; foreach my $table ( keys %$tables ) { @@ -1545,7 +1731,27 @@ sub _get_tt_params { my $pk = $config->{$table}->{pk}; my $fk = $config->{$table}->{fk}; - if ( $ref eq q{} || $ref eq 'HASH' ) { + if ( $is_a_loop ) { + my $values = $tables->{$table} || []; + unless ( ref( $values ) eq 'ARRAY' ) { + croak "ERROR processing table $table. Wrong API call."; + } + my $key = $pk ? $pk : $fk; + # $key does not come from user input + my $objects = $module->search( + { $key => $values }, + { + # We want to retrieve the data in the same order + # FIXME MySQLism + # field is a MySQLism, but they are no other way to do it + # To be generic we could do it in perl, but we will need to fetch + # all the data then order them + @$values ? ( order_by => \[ "field($key, " . join( ', ', @$values ) . ")" ] ) : () + } + ); + $params->{ $config->{$table}->{plural} } = $objects; + } + elsif ( $ref eq q{} || $ref eq 'HASH' ) { my $id = ref $ref eq 'HASH' ? $tables->{$table}->{$pk} : $tables->{$table}; my $object; if ( $fk ) { # Using a foreign key for lookup @@ -1554,9 +1760,9 @@ sub _get_tt_params { foreach my $key ( @$fk ) { $search->{$key} = $id->{$key}; } - $object = $module->search( $search )->next(); + $object = $module->search( $search )->last(); } else { # Foreign key is single column - $object = $module->search( { $fk => $id } )->next(); + $object = $module->search( { $fk => $id } )->last(); } } else { # using the table's primary key for lookup $object = $module->find($id); @@ -1566,13 +1772,10 @@ sub _get_tt_params { else { # $ref eq 'ARRAY' my $object; if ( @{ $tables->{$table} } == 1 ) { # Param is a single key - $object = $module->search( { $pk => $tables->{$table} } )->next(); + $object = $module->search( { $pk => $tables->{$table} } )->last(); } else { # Params are mutliple foreign keys - my @values = @{ $tables->{$table} }; - my @keys = @{ $config->{$table}->{fk} }; - my %params = map { $_ => shift(@values) } @keys; - $object = $module->search( \%params )->next(); + croak "Multiple foreign keys (table $table) should be passed using an hashref"; } $params->{ $config->{$table}->{singular} } = $object; } @@ -1582,11 +1785,61 @@ sub _get_tt_params { } } - $params->{today} = dt_from_string(); + $params->{today} = output_pref({ dt => dt_from_string, dateformat => 'iso' }); return $params; } +=head3 add_tt_filters + +$content = add_tt_filters( $content ); + +Add TT filters to some specific fields if needed. + +For now we only add the Remove_MARC_punctuation TT filter to biblio and biblioitem fields + +=cut + +sub add_tt_filters { + my ( $content ) = @_; + $content =~ s|\[%\s*biblio\.(.*?)\s*%\]|[% biblio.$1 \| \$Remove_MARC_punctuation %]|gxms; + $content =~ s|\[%\s*biblioitem\.(.*?)\s*%\]|[% biblioitem.$1 \| \$Remove_MARC_punctuation %]|gxms; + return $content; +} + +=head2 get_item_content + + my $item = Koha::Items->find(...)->unblessed; + my @item_content_fields = qw( date_due title barcode author itemnumber ); + my $item_content = C4::Letters::get_item_content({ + item => $item, + item_content_fields => \@item_content_fields + }); + +This function generates a tab-separated list of values for the passed item. Dates +are formatted following the current setup. + +=cut + +sub get_item_content { + my ( $params ) = @_; + my $item = $params->{item}; + my $dateonly = $params->{dateonly} || 0; + my $item_content_fields = $params->{item_content_fields} || []; + + return unless $item; + + my @item_info = map { + $_ =~ /^date|date$/ + ? eval { + output_pref( + { dt => dt_from_string( $item->{$_} ), dateonly => $dateonly } ); + } + : $item->{$_} + || '' + } @$item_content_fields; + return join( "\t", @item_info ) . "\n"; +} 1; __END__