X-Git-Url: http://git.rot13.org/?a=blobdiff_plain;f=C4%2FLetters.pm;h=cbe6559e8202e10ce48e74c68b9837159b9a29c5;hb=4ccbae8879a386a1846bb48c18b3722f936dc983;hp=8c9f5072f4c638fa0b47ae93a11feda317e9db69;hpb=57dff1e63f5778a427390215f82909a82f54eccd;p=koha.git diff --git a/C4/Letters.pm b/C4/Letters.pm index 8c9f5072f4..cbe6559e82 100644 --- a/C4/Letters.pm +++ b/C4/Letters.pm @@ -4,47 +4,50 @@ package C4::Letters; # # This file is part of Koha. # -# Koha is free software; you can redistribute it and/or modify it under the -# terms of the GNU General Public License as published by the Free Software -# Foundation; either version 2 of the License, or (at your option) any later -# version. +# Koha is free software; you can redistribute it and/or modify it +# under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 3 of the License, or +# (at your option) any later version. # -# Koha is distributed in the hope that it will be useful, but WITHOUT ANY -# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR -# A PARTICULAR PURPOSE. See the GNU General Public License for more details. +# Koha is distributed in the hope that it will be useful, but +# WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. # -# You should have received a copy of the GNU General Public License along -# with Koha; if not, write to the Free Software Foundation, Inc., -# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. +# You should have received a copy of the GNU General Public License +# along with Koha; if not, see . -use strict; -use warnings; +use Modern::Perl; use MIME::Lite; use Mail::Sendmail; +use Date::Calc qw( Add_Delta_Days ); +use Encode; +use Carp; +use Template; +use Module::Load::Conditional qw(can_load); -use C4::Koha qw(GetAuthorisedValueByCode); use C4::Members; use C4::Members::Attributes qw(GetBorrowerAttributes); -use C4::Branch; use C4::Log; use C4::SMS; use C4::Debug; use Koha::DateUtils; -use Date::Calc qw( Add_Delta_Days ); -use Encode; -use Carp; +use Koha::SMS::Providers; + use Koha::Email; +use Koha::Notice::Messages; +use Koha::DateUtils qw( format_sqldatetime dt_from_string ); +use Koha::Patrons; +use Koha::Subscriptions; -use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); +use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); BEGIN { require Exporter; - # set the version for version checking - $VERSION = 3.07.00.049; @ISA = qw(Exporter); @EXPORT = qw( - &GetLetters &GetPreparedLetter &GetWrappedLetter &addalert &getalert &delalert &findrelatedto &SendAlerts &GetPrintMessages &GetMessageTransportTypes + &GetLetters &GetLettersAvailableForALibrary &GetLetterTemplates &DelLetter &GetPreparedLetter &GetWrappedLetter &SendAlerts &GetPrintMessages &GetMessageTransportTypes ); } @@ -69,178 +72,221 @@ 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 { my ($filters) = @_; my $module = $filters->{module}; my $code = $filters->{code}; + my $branchcode = $filters->{branchcode}; 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|| ) - . q| GROUP BY code ORDER BY name|, { Slice => {} } + . ( defined $branchcode ? q| AND branchcode = ?| : q|| ) + . q| GROUP BY code, module, name ORDER BY name|, { Slice => {} } , ( $module ? $module : () ) , ( $code ? $code : () ) + , ( defined $branchcode ? $branchcode : () ) ); return $letters; } -# FIXME: using our here means that a Plack server will need to be -# restarted fairly regularly when working with this routine. -# A better option would be to use Koha::Cache and use a cache -# that actually works in a persistent environment, but as a -# short-term fix, our will work. -our %letter; -sub getletter { - my ( $module, $code, $branchcode, $message_transport_type ) = @_; - $message_transport_type ||= 'email'; +=head2 GetLetterTemplates + + my $letter_templates = GetLetterTemplates( + { + module => 'circulation', + code => 'my code', + branchcode => 'CPL', # '' for default, + } + ); + + Return a hashref of letter templates. + +=cut + +sub GetLetterTemplates { + my ( $params ) = @_; + + my $module = $params->{module}; + my $code = $params->{code}; + my $branchcode = $params->{branchcode} // ''; + my $dbh = C4::Context->dbh; + my $letters = $dbh->selectall_arrayref( + q| + SELECT module, code, branchcode, name, is_html, title, content, message_transport_type, lang + FROM letter + WHERE module = ? + AND code = ? + and branchcode = ? + | + , { Slice => {} } + , $module, $code, $branchcode + ); + + return $letters; +} + +=head2 GetLettersAvailableForALibrary + + my $letters = GetLettersAvailableForALibrary( + { + branchcode => 'CPL', # '' for default + module => 'circulation', + } + ); + + Return an arrayref of letters, sorted by name. + If a specific letter exist for the given branchcode, it will be retrieve. + Otherwise the default letter will be. + +=cut + +sub GetLettersAvailableForALibrary { + my ($filters) = @_; + my $branchcode = $filters->{branchcode}; + my $module = $filters->{module}; + + croak "module should be provided" unless $module; + my $dbh = C4::Context->dbh; + my $default_letters = $dbh->selectall_arrayref( + q| + SELECT module, code, branchcode, name + FROM letter + WHERE 1 + | + . q| AND branchcode = ''| + . ( $module ? q| AND module = ?| : q|| ) + . q| ORDER BY name|, { Slice => {} } + , ( $module ? $module : () ) + ); - if ( C4::Context->preference('IndependentBranches') - and $branchcode - and C4::Context->userenv ) { + my $specific_letters; + if ($branchcode) { + $specific_letters = $dbh->selectall_arrayref( + q| + SELECT module, code, branchcode, name + FROM letter + WHERE 1 + | + . q| AND branchcode = ?| + . ( $module ? q| AND module = ?| : q|| ) + . q| ORDER BY name|, { Slice => {} } + , $branchcode + , ( $module ? $module : () ) + ); + } - $branchcode = C4::Context->userenv->{'branch'}; + my %letters; + for my $l (@$default_letters) { + $letters{ $l->{code} } = $l; } - $branchcode //= ''; + for my $l (@$specific_letters) { + # Overwrite the default letter with the specific one. + $letters{ $l->{code} } = $l; + } + + return [ map { $letters{$_} } + sort { $letters{$a}->{name} cmp $letters{$b}->{name} } + keys %letters ]; + +} - if ( my $l = $letter{$module}{$code}{$branchcode}{$message_transport_type} ) { - return { %$l }; # deep copy +sub getletter { + my ( $module, $code, $branchcode, $message_transport_type, $lang) = @_; + $message_transport_type //= '%'; + $lang = 'default' unless( $lang && C4::Context->preference('TranslateNotices') ); + + + my $only_my_library = C4::Context->only_my_library; + if ( $only_my_library and $branchcode ) { + $branchcode = C4::Context::mybranch(); } + $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 = ? + WHERE module=? AND code=? AND (branchcode = ? OR branchcode = '') + AND message_transport_type LIKE ? + AND lang =? ORDER BY branchcode DESC LIMIT 1 }); - $sth->execute( $module, $code, $branchcode, $message_transport_type ); + $sth->execute( $module, $code, $branchcode, $message_transport_type, $lang ); my $line = $sth->fetchrow_hashref or return; $line->{'content-type'} = 'text/html; charset="UTF-8"' if $line->{is_html}; - $letter{$module}{$code}{$branchcode}{$message_transport_type} = $line; return { %$line }; } -=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 +=head2 DelLetter -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]) + DelLetter( + { + branchcode => 'CPL', + module => 'circulation', + code => 'my code', + [ mtt => 'email', ] + } + ); - 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. + Delete the letter. The mtt parameter is facultative. + If not given, all templates mathing the other parameters will be removed. =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"; - my @bind; - if ($borrowernumber and $borrowernumber =~ /^\d+$/) { - $query .= " borrowernumber=? AND "; - push @bind, $borrowernumber; - } - if ($type) { - $query .= " type=? AND "; - push @bind, $type; - } - if ($externalid) { - $query .= " externalid=? AND "; - push @bind, $externalid; - } - $query =~ s/ AND $//; - my $sth = $dbh->prepare($query); - $sth->execute(@bind); - return $sth->fetchall_arrayref({}); +sub DelLetter { + my ($params) = @_; + my $branchcode = $params->{branchcode}; + 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|| ) + . ( $lang? q| AND lang = ?| : q|| ) + , undef, $branchcode, $module, $code, ( $mtt ? $mtt : () ), ( $lang ? $lang : () ) ); } -=head2 findrelatedto($type, $externalid) +=head2 SendAlerts - parameters : - - $type : the type of alert - - $externalid : the id of the "object" to query + my $err = &SendAlerts($type, $externalid, $letter_code); - 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. + Parameters: + - $type : the type of alert + - $externalid : the id of the "object" to query + - $letter_code : the notice template to use -=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; -} + C<&SendAlerts> sends an email notice directly to a patron or a vendor. -=head2 SendAlerts + 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) - parameters : - - $type : the type of alert - - $externalid : the id of the "object" to query - - $letter_code : the letter to send. - - send an alert to all borrowers having put an alert on a given subject. + Returns undef or { error => 'message } on failure. + Returns true on success. =cut @@ -250,34 +296,45 @@ sub SendAlerts { if ( $type eq 'issue' ) { # prepare the letter... - # search the biblionumber + # search the subscriptionid my $sth = $dbh->prepare( - "SELECT biblionumber FROM subscription WHERE subscriptionid=?"); + "SELECT subscriptionid FROM serial WHERE serialid=?"); $sth->execute($externalid); - my ($biblionumber) = $sth->fetchrow + my ($subscriptionid) = $sth->fetchrow or warn( "No subscription for '$externalid'" ), return; + # search the biblionumber + $sth = + $dbh->prepare( + "SELECT biblionumber FROM subscription WHERE subscriptionid=?"); + $sth->execute($subscriptionid); + my ($biblionumber) = $sth->fetchrow + or warn( "No biblionumber for '$subscriptionid'" ), + return; + my %letter; - # find the list of borrowers to alert - my $alerts = getalert( '', 'issue', $externalid ); - 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 $branchdetails = GetBranchDetail($_->{'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; @@ -287,53 +344,105 @@ sub SendAlerts { my %mail = $message->create_message_headers( { to => $email, - from => $branchdetails->{'branchemail'}, - replyto => $branchdetails->{'branchreplyto'}, - sender => $branchdetails->{'branchreturnpath'}, - subject => Encode::encode( "utf8", "" . $letter->{title} ), - message => - Encode::encode( "utf8", "" . $letter->{content} ), - contenttype => 'text/plain; charset="utf8"', - + 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"', } ); - sendmail(%mail) or carp $Mail::Sendmail::error; + unless( Mail::Sendmail::sendmail(%mail) ) { + carp $Mail::Sendmail::error; + return { error => $Mail::Sendmail::error }; + } } } - elsif ( $type eq 'claimacquisition' or $type eq 'claimissues' ) { + elsif ( $type eq 'claimacquisition' or $type eq 'claimissues' or $type eq 'orderacquisition' ) { # prepare the letter... - # search the biblionumber - my $strsth = $type eq 'claimacquisition' - ? qq{ - SELECT aqorders.*,aqbasket.*,biblio.*,biblioitems.*,aqbooksellers.*, - aqbooksellers.id AS booksellerid + my $strsth; + my $sthorders; + my $dataorders; + my $action; + if ( $type eq 'claimacquisition') { + $strsth = qq{ + SELECT aqorders.*,aqbasket.*,biblio.*,biblioitems.* FROM aqorders LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber LEFT JOIN biblioitems ON aqorders.biblionumber=biblioitems.biblionumber - LEFT JOIN aqbooksellers ON aqbasket.booksellerid=aqbooksellers.id WHERE aqorders.ordernumber IN ( + }; + + if (!@$externalid){ + carp "No order selected"; + return { error => "no_order_selected" }; } - : qq{ - SELECT serial.*,subscription.*, biblio.*, aqbooksellers.*, + $strsth .= join( ",", ('?') x @$externalid ) . ")"; + $action = "ACQUISITION CLAIM"; + $sthorders = $dbh->prepare($strsth); + $sthorders->execute( @$externalid ); + $dataorders = $sthorders->fetchall_arrayref( {} ); + } + + if ($type eq 'claimissues') { + $strsth = qq{ + 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 ( }; - $strsth .= join( ",", @$externalid ) . ")"; - my $sthorders = $dbh->prepare($strsth); - $sthorders->execute; - my $dataorders = $sthorders->fetchall_arrayref( {} ); + + if (!@$externalid){ + carp "No issues selected"; + return { error => "no_issues_selected" }; + } + + $strsth .= join( ",", ('?') x @$externalid ) . ")"; + $action = "SERIAL CLAIM"; + $sthorders = $dbh->prepare($strsth); + $sthorders->execute( @$externalid ); + $dataorders = $sthorders->fetchall_arrayref( {} ); + } + + if ( $type eq 'orderacquisition') { + $strsth = qq{ + SELECT aqorders.*,aqbasket.*,biblio.*,biblioitems.* + FROM aqorders + LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno + LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber + LEFT JOIN biblioitems ON aqorders.biblionumber=biblioitems.biblionumber + WHERE aqbasket.basketno = ? + AND orderstatus IN ('new','ordered') + }; + + if (!$externalid){ + carp "No basketnumber given"; + return { error => "no_basketno" }; + } + $action = "ACQUISITION ORDER"; + $sthorders = $dbh->prepare($strsth); + $sthorders->execute($externalid); + $dataorders = $sthorders->fetchall_arrayref( {} ); + } my $sthbookseller = $dbh->prepare("select * from aqbooksellers where id=?"); $sthbookseller->execute( $dataorders->[0]->{booksellerid} ); my $databookseller = $sthbookseller->fetchrow_hashref; - my $addressee = $type eq 'claimacquisition' ? 'acqprimary' : 'serialsprimary'; + + my $addressee = $type eq 'claimacquisition' || $type eq 'orderacquisition' ? 'acqprimary' : 'serialsprimary'; + my $sthcontact = $dbh->prepare("SELECT * FROM aqcontacts WHERE booksellerid=? AND $type=1 ORDER BY $addressee DESC"); $sthcontact->execute( $dataorders->[0]->{booksellerid} ); @@ -364,31 +473,44 @@ sub SendAlerts { }, 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 $library = Koha::Libraries->find( $userenv->{branch} ); my %mail = ( To => join( ',', @email), Cc => join( ',', @cc), - From => $userenv->{emailaddress}, - Subject => Encode::encode( "utf8", "" . $letter->{title} ), - Message => Encode::encode( "utf8", "" . $letter->{content} ), - 'Content-Type' => 'text/plain; charset="utf8"', + From => $library->branchemail || C4::Context->preference('KohaAdminEmailAddress'), + 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"', ); - $mail{'Reply-to'} = C4::Context->preference('ReplytoDefault') - if C4::Context->preference('ReplytoDefault'); - $mail{'Sender'} = C4::Context->preference('ReturnpathDefault') - if C4::Context->preference('ReturnpathDefault'); + 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"); + } - unless ( sendmail(%mail) ) { + unless ( Mail::Sendmail::sendmail(%mail) ) { carp $Mail::Sendmail::error; return { error => $Mail::Sendmail::error }; } logaction( "ACQUISITION", - $type eq 'claimissues' ? "CLAIM ISSUE" : "ACQUISITION CLAIM", + $action, undef, "To=" . join( ',', @email ) @@ -400,13 +522,14 @@ sub SendAlerts { } # send an "account details" notice to a newly created user elsif ( $type eq 'members' ) { - my $branchdetails = GetBranchDetail($externalid->{'branchcode'}); + my $library = Koha::Libraries->find( $externalid->{branchcode} )->unblessed; my $letter = GetPreparedLetter ( module => 'members', letter_code => $letter_code, branchcode => $externalid->{'branchcode'}, + lang => $externalid->{lang} || 'default', tables => { - 'branches' => $branchdetails, + 'branches' => $library, 'borrowers' => $externalid->{'borrowernumber'}, }, substitute => { 'borrowers.password' => $externalid->{'password'} }, @@ -417,16 +540,27 @@ sub SendAlerts { my %mail = $email->create_message_headers( { to => $externalid->{'emailaddr'}, - from => $branchdetails->{'branchemail'}, - replyto => $branchdetails->{'branchreplyto'}, - sender => $branchdetails->{'branchreturnpath'}, - subject => Encode::encode( "utf8", "" . $letter->{'title'} ), - message => Encode::encode( "utf8", "" . $letter->{'content'} ), - contenttype => 'text/plain; charset="utf8"' + 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"', } ); - sendmail(%mail) or carp $Mail::Sendmail::error; + unless( Mail::Sendmail::sendmail(%mail) ) { + carp $Mail::Sendmail::error; + return { error => $Mail::Sendmail::error }; + } } + + # If we come here, return an OK status + return 1; } =head2 GetPreparedLetter( %params ) @@ -455,25 +589,39 @@ 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 $letter = getletter( $module, $letter_code, $branchcode, $mtt ) - or warn( "No $module $letter_code letter transported by " . $mtt ), - return; + 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 $lang = $params{lang} || 'default'; - my $tables = $params{tables}; - my $substitute = $params{substitute}; + $letter = getletter( $module, $letter_code, $branchcode, $mtt, $lang ); + + unless ( $letter ) { + $letter = getletter( $module, $letter_code, $branchcode, $mtt, 'default' ) + or warn( "No $module $letter_code letter transported by " . $mtt ), + return; + } + } + + 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}; + } + $letter->{title} =~ s/<<$token>>/$val/g; $letter->{content} =~ s/<<$token>>/$val/g; } @@ -514,7 +662,7 @@ sub GetPreparedLetter { } } - if ($tables) { + if (%$tables) { _substitute_tables( $letter, $tables ); } @@ -537,8 +685,16 @@ sub GetPreparedLetter { } } + $letter->{content} = _process_tt( + { + content => $letter->{content}, + tables => $tables, + loops => $loops, + substitute => $substitute, + } + ); + $letter->{content} =~ s/<<\S*>>//go; #remove any stragglers -# $letter->{content} =~ s/<<[^>]*>>//go; return $letter; } @@ -555,7 +711,6 @@ sub _substitute_tables { $values = $param; } else { - my @pk; my $sth = _parseletter_sth($table); unless ($sth) { warn "_parseletter_sth('$table') failed to return a valid sth. No substitution will be done for that table."; @@ -583,19 +738,22 @@ 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 'biblio' ) ? "SELECT * FROM $table WHERE biblionumber = ?" : - ($table eq 'biblioitems' ) ? "SELECT * FROM $table WHERE biblionumber = ?" : - ($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" : - ($table eq 'reserves' ) ? "SELECT * FROM $table WHERE borrowernumber = ? and biblionumber = ?" : - ($table eq 'borrowers' ) ? "SELECT * FROM $table WHERE borrowernumber = ?" : - ($table eq 'branches' ) ? "SELECT * FROM $table WHERE branchcode = ?" : - ($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 'opac_news' ) ? "SELECT * FROM $table WHERE idnew = ?" : - ($table eq 'borrower_modifications') ? "SELECT * FROM $table WHERE ( borrowernumber = 0 OR borrowernumber = ? ) AND ( verification_token = '' OR verification_token = ? ) AND ( verification_token != '' OR borrowernumber != 0 )" : + ($table eq 'biblio' ) ? "SELECT * FROM $table WHERE biblionumber = ?" : + ($table eq 'biblioitems' ) ? "SELECT * FROM $table WHERE biblionumber = ?" : + ($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" : + ($table eq 'reserves' ) ? "SELECT * FROM $table WHERE borrowernumber = ? and biblionumber = ?" : + ($table eq 'borrowers' ) ? "SELECT * FROM $table WHERE borrowernumber = ?" : + ($table eq 'branches' ) ? "SELECT * FROM $table WHERE branchcode = ?" : + ($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 '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 = ?" : undef ; unless ($query) { warn "ERROR: No _parseletter_sth query for table '$table'"; @@ -613,28 +771,25 @@ sub _parseletter_sth { parameters : - $letter : a hash to letter fields (title & content useful) - $table : the Koha table to parse. - - $values : table record hashref + - $values_in : table record hashref parse all fields from a table, and replace values in title & content with the appropriate value (not exported sub, used only internally) =cut sub _parseletter { - my ( $letter, $table, $values ) = @_; + my ( $letter, $table, $values_in ) = @_; - if ( $table eq 'reserves' && $values->{'waitingdate'} ) { - my @waitingdate = split /-/, $values->{'waitingdate'}; - - $values->{'expirationdate'} = ''; - if( C4::Context->preference('ExpireReservesMaxPickUpDelay') && - C4::Context->preference('ReservesMaxPickUpDelay') ) { - my $dt = dt_from_string(); - $dt->add( days => C4::Context->preference('ReservesMaxPickUpDelay') ); - $values->{'expirationdate'} = output_pref({ dt => $dt, dateonly => 1 }); - } + # Work on a local copy of $values_in (passed by reference) to avoid side effects + # in callers ( by changing / formatting values ) + my $values = $values_in ? { %$values_in } : {}; - $values->{'waitingdate'} = output_pref({ dt => dt_from_string( $values->{'waitingdate'} ), dateonly => 1 }); + if ( $table eq 'borrowers' && $values->{'dateexpiry'} ){ + $values->{'dateexpiry'} = output_pref({ dt => dt_from_string( $values->{'dateexpiry'} ), dateonly => 1 }); + } + if ( $table eq 'reserves' && $values->{'waitingdate'} ) { + $values->{'waitingdate'} = output_pref({ dt => dt_from_string( $values->{'waitingdate'} ), dateonly => 1 }); } if ($letter->{content} && $letter->{content} =~ /<>/) { @@ -643,14 +798,17 @@ sub _parseletter { } while ( my ($field, $val) = each %$values ) { - my $replacetablefield = "<<$table.$field>>"; - my $replacefield = "<<$field>>"; $val =~ s/\p{P}$// if $val && $table=~/biblio/; #BZ 9886: Assuming that we want to eliminate ISBD punctuation here #Therefore adding the test on biblio. This includes biblioitems, #but excludes items. Removed unneeded global and lookahead. - $val = GetAuthorisedValueByCode ('ROADTYPE', $val, 0) if $table=~/^borrowers$/ && $field=~/^streettype$/; + if ( $table=~/^borrowers$/ && $field=~/^streettype$/ ) { + my $av = Koha::AuthorisedValues->search({ category => 'ROADTYPE', authorised_value => $val }); + $val = $av->count ? $av->next->lib : ''; + } + + # Dates replacement my $replacedby = defined ($val) ? $val : ''; if ( $replacedby and not $replacedby =~ m|0000-00-00| @@ -659,19 +817,34 @@ sub _parseletter { { # If the value is XXXX-YY-ZZ[ AA:BB:CC] we assume it is a date my $dateonly = defined $1 ? 0 : 1; #$1 refers to the capture group wrapped in parentheses. In this case, that's the hours, minutes, seconds. - eval { - $replacedby = output_pref({ dt => dt_from_string( $replacedby ), dateonly => $dateonly }); - }; - warn "$replacedby seems to be a date but an error occurs on generating it ($@)" if $@; + my $re_dateonly_filter = qr{ $field( \s* \| \s* dateonly\s*)?>> }xms; + + for my $letter_field ( qw( title content ) ) { + my $filter_string_used = q{}; + if ( $letter->{ $letter_field } =~ $re_dateonly_filter ) { + # We overwrite $dateonly if the filter exists and we have a time in the datetime + $filter_string_used = $1 || q{}; + $dateonly = $1 unless $dateonly; + } + my $replacedby_date = eval { + output_pref({ dt => dt_from_string( $replacedby ), dateonly => $dateonly }); + }; + + if ( $letter->{ $letter_field } ) { + $letter->{ $letter_field } =~ s/\Q<<$table.$field$filter_string_used>>\E/$replacedby_date/g; + $letter->{ $letter_field } =~ s/\Q<<$field$filter_string_used>>\E/$replacedby_date/g; + } + } + } + # Other fields replacement + else { + for my $letter_field ( qw( title content ) ) { + if ( $letter->{ $letter_field } ) { + $letter->{ $letter_field } =~ s/<<$table.$field>>/$replacedby/g; + $letter->{ $letter_field } =~ s/<<$field>>/$replacedby/g; + } + } } - ($letter->{title} ) and do { - $letter->{title} =~ s/$replacetablefield/$replacedby/g; - $letter->{title} =~ s/$replacefield/$replacedby/g; - }; - ($letter->{content}) and do { - $letter->{content} =~ s/$replacetablefield/$replacedby/g; - $letter->{content} =~ s/$replacefield/$replacedby/g; - }; } if ($table eq 'borrowers' && $letter->{content}) { @@ -758,19 +931,44 @@ ENDSQL =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. +Sends all of the 'pending' items in the message queue, unless +parameters are passed. -returns number of messages sent. +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. + +The verbose parameter can be used to generate debugging output. +It is also optional. + +Returns number of messages sent. =cut sub SendQueuedMessages { my $params = shift; - my $unsent_messages = _get_unsent_messages(); + my $which_unsent_messages = { + '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'}, @@ -782,7 +980,34 @@ sub SendQueuedMessages { _send_message_by_email( $message, $params->{'username'}, $params->{'password'}, $params->{'method'} ); } elsif ( lc( $message->{'message_transport_type'} ) eq 'sms' ) { - _send_message_by_sms( $message ); + if ( C4::Context->preference('SMSSendDriver') eq 'Email' ) { + 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'} or $debug; + _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'} or $debug; + 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 ); + } } } return scalar( @$unsent_messages ); @@ -884,17 +1109,67 @@ sub GetMessageTransportTypes { return $mtts; } +=head2 GetMessage + + my $message = C4::Letters::Message($message_id); + +=cut + +sub GetMessage { + my ( $message_id ) = @_; + 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 + FROM message_queue + WHERE message_id = ? + |, {}, $message_id ); +} + +=head2 ResendMessage + + Attempt to resend a message which has failed previously. + + my $has_been_resent = C4::Letters::ResendMessage($message_id); + + Updates the message to 'pending' status so that + it will be resent later on. + + returns 1 on success, 0 on failure, undef if no message was found + +=cut + +sub ResendMessage { + my $message_id = shift; + return unless $message_id; + + my $message = GetMessage( $message_id ); + return unless $message; + my $rv = 0; + if ( $message->{status} ne 'pending' ) { + $rv = C4::Letters::_set_message_status({ + message_id => $message_id, + status => 'pending', + }); + $rv = $rv > 0? 1: 0; + # Clear destination email address to force address update + _update_message_to_address( $message_id, undef ) if $rv && + $message->{message_transport_type} eq 'email'; + } + return $rv; +} + =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 @@ -930,27 +1205,49 @@ 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) + 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.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 = ? + }; 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->{'limit'} ) { $statement .= ' limit ? '; push @query_params, $params->{'limit'}; @@ -968,16 +1265,16 @@ 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' } ); 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? @@ -987,20 +1284,21 @@ sub _send_message_by_email { } } - my $utf8 = decode('MIME-Header', $message->{'subject'} ); - $message->{subject}= encode('MIME-Header', $utf8); - my $subject = encode('utf8', $message->{'subject'}); - my $content = encode('utf8', $message->{'content'}); + # Encode subject line separately + $message->{subject} = encode('MIME-Header', $message->{'subject'} ); + my $subject = $message->{'subject'}; + + my $content = encode('UTF-8', $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 $branchdetail = GetBranchDetail( $member->{'branchcode'} ); - $branch_email = $branchdetail->{'branchemail'}; - $branch_replyto = $branchdetail->{'branchreplyto'}; - $branch_returnpath = $branchdetail->{'branchreturnpath'}; + if ($patron) { + my $library = $patron->library; + $branch_email = $library->branchemail; + $branch_replyto = $library->branchreplyto; + $branch_returnpath = $library->branchreturnpath; } my $email = Koha::Email->new(); my %sendmail_params = $email->create_message_headers( @@ -1016,12 +1314,13 @@ sub _send_message_by_email { ); $sendmail_params{'Auth'} = {user => $username, pass => $password, method => $method} if $username; - if ( my $bcc = C4::Context->preference('OverdueNoticeBcc') ) { + if ( my $bcc = C4::Context->preference('NoticeBcc') ) { $sendmail_params{ Bcc } = $bcc; } _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 - if ( sendmail( %sendmail_params ) ) { + + if ( Mail::Sendmail::sendmail( %sendmail_params ) ) { _set_message_status( { message_id => $message->{'message_id'}, status => 'sent' } ); return 1; @@ -1072,9 +1371,9 @@ 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' } ); return; @@ -1086,7 +1385,7 @@ sub _send_message_by_sms { 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'}, @@ -1100,6 +1399,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; @@ -1115,6 +1420,262 @@ sub _set_message_status { return $result; } +sub _process_tt { + my ( $params ) = @_; + + my $content = $params->{content}; + my $tables = $params->{tables}; + my $loops = $params->{loops}; + my $substitute = $params->{substitute} || {}; + + my $use_template_cache = C4::Context->config('template_cache_dir') && defined $ENV{GATEWAY_INTERFACE}; + my $template = Template->new( + { + EVAL_PERL => 1, + ABSOLUTE => 1, + PLUGIN_BASE => 'Koha::Template::Plugin', + COMPILE_EXT => $use_template_cache ? '.ttc' : '', + COMPILE_DIR => $use_template_cache ? C4::Context->config('template_cache_dir') : '', + FILTERS => {}, + ENCODING => 'UTF-8', + } + ) or die Template->error(); + + 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(); + + return $output; +} + +sub _get_tt_params { + 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', + }, + 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', + plural => 'borrowers', + pk => 'borrowernumber', + }, + branches => { + module => 'Koha::Libraries', + singular => 'branch', + plural => 'branches', + pk => 'branchcode', + }, + items => { + module => 'Koha::Items', + singular => 'item', + plural => 'items', + pk => 'itemnumber', + }, + opac_news => { + module => 'Koha::News', + singular => 'news', + 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' ], + }, + serial => { + module => 'Koha::Serials', + singular => 'serial', + plural => 'serials', + pk => 'serialid', + }, + subscription => { + module => 'Koha::Subscriptions', + singular => 'subscription', + plural => 'subscriptions', + pk => 'subscriptionid', + }, + suggestions => { + module => 'Koha::Suggestions', + singular => 'suggestion', + plural => 'suggestions', + pk => 'suggestionid', + }, + issues => { + module => 'Koha::Checkouts', + singular => 'checkout', + 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', + }, + }; + + foreach my $table ( keys %$tables ) { + next unless $config->{$table}; + + my $ref = ref( $tables->{$table} ) || q{}; + my $module = $config->{$table}->{module}; + + if ( can_load( modules => { $module => undef } ) ) { + my $pk = $config->{$table}->{pk}; + my $fk = $config->{$table}->{fk}; + + 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 + if ( ref( $fk ) eq 'ARRAY' ) { # Foreign key is multi-column + my $search; + foreach my $key ( @$fk ) { + $search->{$key} = $id->{$key}; + } + $object = $module->search( $search )->last(); + } else { # Foreign key is single column + $object = $module->search( { $fk => $id } )->last(); + } + } else { # using the table's primary key for lookup + $object = $module->find($id); + } + $params->{ $config->{$table}->{singular} } = $object; + } + else { # $ref eq 'ARRAY' + my $object; + if ( @{ $tables->{$table} } == 1 ) { # Param is a single key + $object = $module->search( { $pk => $tables->{$table} } )->last(); + } + else { # Params are mutliple foreign keys + croak "Multiple foreign keys (table $table) should be passed using an hashref"; + } + $params->{ $config->{$table}->{singular} } = $object; + } + } + else { + croak "ERROR LOADING MODULE $module: $Module::Load::Conditional::ERROR"; + } + } + + $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__