X-Git-Url: http://git.rot13.org/?a=blobdiff_plain;f=C4%2FLetters.pm;h=f3278900cf300334f5cd4a1f20658432c73ec5a2;hb=eb04d174d91201b05b6e348dc672f9351dc0aaf0;hp=f646241e8e1163d570f07d5c35485627b8f91f9a;hpb=4f44847c11add59ab7d0c55aeffac1fa2835cc1f;p=koha.git diff --git a/C4/Letters.pm b/C4/Letters.pm index f646241e8e..f3278900cf 100644 --- a/C4/Letters.pm +++ b/C4/Letters.pm @@ -4,18 +4,18 @@ 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; @@ -23,27 +23,30 @@ use warnings; use MIME::Lite; use Mail::Sendmail; +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 Koha::SMS::Providers; + use Date::Calc qw( Add_Delta_Days ); use Encode; -use Unicode::Normalize; use Carp; +use Koha::Email; +use Koha::DateUtils qw( format_sqldatetime ); -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 - ); + require Exporter; + @ISA = qw(Exporter); + @EXPORT = qw( + &GetLetters &GetLettersAvailableForALibrary &GetLetterTemplates &DelLetter &GetPreparedLetter &GetWrappedLetter &addalert &getalert &delalert &findrelatedto &SendAlerts &GetPrintMessages &GetMessageTransportTypes + ); } =head1 NAME @@ -61,116 +64,213 @@ C4::Letters - Give functions for Letters management Letters are managed through "alerts" sent by Koha on some events. All "alert" related functions are in this module too. -=head2 GetLetters([$category]) +=head2 GetLetters([$module]) - $letters = &GetLetters($category); + $letters = &GetLetters($module); returns informations about letters. - if needed, $category filters for letters given category - Create a letter selector with the following code - -=head3 in PERL SCRIPT - -my $letters = GetLetters($cat); -my @letterloop; -foreach my $thisletter (keys %$letters) { - my $selected = 1 if $thisletter eq $letter; - my %row =( - value => $thisletter, - selected => $selected, - lettername => $letters->{$thisletter}, + if needed, $module filters for letters given module + +=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 + 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 => {} } + , ( $module ? $module : () ) + , ( $code ? $code : () ) + , ( defined $branchcode ? $branchcode : () ) ); - push @letterloop, \%row; + + return $letters; } -$template->param(LETTERLOOP => \@letterloop); -=head3 in TEMPLATE +=head2 GetLetterTemplates + + my $letter_templates = GetLetterTemplates( + { + module => 'circulation', + code => 'my code', + branchcode => 'CPL', # '' for default, + } + ); - + Return a hashref of letter templates. + The key will be the message transport type. =cut -sub GetLetters { +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_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 + ); - # returns a reference to a hash of references to ALL letters... - my $cat = shift; - my %letters; - my $dbh = C4::Context->dbh; - my $sth; - if (defined $cat) { - my $query = "SELECT * FROM letter WHERE module = ? ORDER BY name"; - $sth = $dbh->prepare($query); - $sth->execute($cat); - } - else { - my $query = "SELECT * FROM letter ORDER BY name"; - $sth = $dbh->prepare($query); - $sth->execute; - } - while ( my $letter = $sth->fetchrow_hashref ) { - $letters{ $letter->{'code'} } = $letter->{'name'}; - } - return \%letters; + return $letters; } -=head2 GetLetter( %params ) +=head2 GetLettersAvailableForALibrary - retrieves the letter template + my $letters = GetLettersAvailableForALibrary( + { + branchcode => 'CPL', # '' for default + module => 'circulation', + } + ); - %params hash: - module => letter module, mandatory - letter_code => letter code, mandatory - branchcode => for letter selection, if missing default system letter taken - Return value: - letter fields hashref (title & content useful) + 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 GetLetter { - my %params = @_; +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 : () ) + ); - my $module = $params{module} or croak "No module"; - my $letter_code = $params{letter_code} or croak "No letter_code"; - my $branchcode = $params{branchcode} || ''; + 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 : () ) + ); + } - my $letter = getletter( $module, $letter_code, $branchcode ) - or warn( "No $module $letter_code letter"), - return; + my %letters; + for my $l (@$default_letters) { + $letters{ $l->{code} } = $l; + } + 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 ]; - return $letter; } -my %letter; +# 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 ) = @_; + my ( $module, $code, $branchcode, $message_transport_type ) = @_; + $message_transport_type //= '%'; - $branchcode ||= ''; - - if ( C4::Context->preference('IndependantBranches') + if ( C4::Context->preference('IndependentBranches') and $branchcode and C4::Context->userenv ) { $branchcode = C4::Context->userenv->{'branch'}; } + $branchcode //= ''; - if ( my $l = $letter{$module}{$code}{$branchcode} ) { + if ( my $l = $letter{$module}{$code}{$branchcode}{$message_transport_type} ) { return { %$l }; # deep copy } my $dbh = C4::Context->dbh; - my $sth = $dbh->prepare("select * from letter where module=? and code=? and (branchcode = ? or branchcode = '') order by branchcode desc limit 1"); - $sth->execute( $module, $code, $branchcode ); + 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}; - $letter{$module}{$code}{$branchcode} = $line; + $letter{$module}{$code}{$branchcode}{$message_transport_type} = $line; return { %$line }; } + +=head2 DelLetter + + DelLetter( + { + branchcode => 'CPL', + module => 'circulation', + code => 'my code', + [ mtt => 'email', ] + } + ); + + Delete the letter. The mtt parameter is facultative. + If not given, all templates mathing the other parameters will be removed. + +=cut + +sub DelLetter { + my ($params) = @_; + my $branchcode = $params->{branchcode}; + my $module = $params->{module}; + my $code = $params->{code}; + my $mtt = $params->{mtt}; + 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 : @@ -245,12 +345,12 @@ sub getalert { =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. + 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 @@ -291,25 +391,34 @@ 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 ); + my $alerts = getalert( '', 'issue', $subscriptionid ); foreach (@$alerts) { - my $borinfo = C4::Members::GetMember('borrowernumber' => $_->{'borrowernumber'}); my $email = $borinfo->{email} or next; - # warn "sending issues..."; +# warn "sending issues..."; my $userenv = C4::Context->userenv; + my $library = Koha::Libraries->find( $_->{branchcode} ); my $letter = GetPreparedLetter ( module => 'serial', letter_code => $letter_code, @@ -319,18 +428,30 @@ sub SendAlerts { 'biblio' => $biblionumber, 'biblioitems' => $biblionumber, 'borrowers' => $borinfo, + 'subscription' => $subscriptionid, + 'serial' => $externalid, }, want_librarian => 1, ) or return; # ... then send mail - my %mail = ( - To => $email, - From => $email, - Subject => Encode::encode( "utf8", "" . $letter->{title} ), - Message => Encode::encode( "utf8", "" . $letter->{content} ), - 'Content-Type' => 'text/plain; charset="utf8"', - ); + my $message = Koha::Email->new(); + my %mail = $message->create_message_headers( + { + 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"', + } + ); sendmail(%mail) or carp $Mail::Sendmail::error; } } @@ -340,13 +461,11 @@ sub SendAlerts { # search the biblionumber my $strsth = $type eq 'claimacquisition' ? qq{ - SELECT aqorders.*,aqbasket.*,biblio.*,biblioitems.*,aqbooksellers.*, - aqbooksellers.id AS booksellerid + 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.biblioitemnumber=biblioitems.biblioitemnumber - LEFT JOIN aqbooksellers ON aqbasket.booksellerid=aqbooksellers.id + LEFT JOIN biblioitems ON aqorders.biblionumber=biblioitems.biblionumber WHERE aqorders.ordernumber IN ( } : qq{ @@ -358,6 +477,12 @@ sub SendAlerts { LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id WHERE serial.serialid IN ( }; + + if (!@$externalid){ + carp "No Order seleted"; + return { error => "no_order_seleted" }; + } + $strsth .= join( ",", @$externalid ) . ")"; my $sthorders = $dbh->prepare($strsth); $sthorders->execute; @@ -367,14 +492,24 @@ sub SendAlerts { $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 $sthcontact = + $dbh->prepare("SELECT * FROM aqcontacts WHERE booksellerid=? AND $type=1 ORDER BY $addressee DESC"); + $sthcontact->execute( $dataorders->[0]->{booksellerid} ); + my $datacontact = $sthcontact->fetchrow_hashref; my @email; + my @cc; push @email, $databookseller->{bookselleremail} if $databookseller->{bookselleremail}; - push @email, $databookseller->{contemail} if $databookseller->{contemail}; + push @email, $datacontact->{email} if ( $datacontact && $datacontact->{email} ); unless (@email) { warn "Bookseller $dataorders->[0]->{booksellerid} without emails"; return { error => "no_email" }; } + my $addlcontact; + while ($addlcontact = $sthcontact->fetchrow_hashref) { + push @cc, $addlcontact->{email} if ( $addlcontact && $addlcontact->{email} ); + } my $userenv = C4::Context->userenv; my $letter = GetPreparedLetter ( @@ -384,27 +519,48 @@ sub SendAlerts { tables => { 'branches' => $userenv->{branch}, 'aqbooksellers' => $databookseller, + 'aqcontacts' => $datacontact, }, repeat => $dataorders, want_librarian => 1, ) or return; + # 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( "utf8", "" . $letter->{title} ), - Message => Encode::encode( "utf8", "" . $letter->{content} ), - 'Content-Type' => 'text/plain; charset="utf8"', + 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"', ); - sendmail(%mail) or carp $Mail::Sendmail::error; + + $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) ) { + carp $Mail::Sendmail::error; + return { error => $Mail::Sendmail::error }; + } logaction( "ACQUISITION", $type eq 'claimissues' ? "CLAIM ISSUE" : "ACQUISITION CLAIM", undef, "To=" - . $databookseller->{contemail} + . join( ',', @email ) . " Title=" . $letter->{title} . " Content=" @@ -413,26 +569,35 @@ 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'}, tables => { - 'branches' => $branchdetails, + 'branches' => $library, 'borrowers' => $externalid->{'borrowernumber'}, }, substitute => { 'borrowers.password' => $externalid->{'password'} }, want_librarian => 1, ) or return; - return { error => "no_email" } unless $externalid->{'emailaddr'}; - my %mail = ( - To => $externalid->{'emailaddr'}, - From => $branchdetails->{'branchemail'} || C4::Context->preference("KohaAdminEmailAddress"), - Subject => Encode::encode( "utf8", $letter->{'title'} ), - Message => Encode::encode( "utf8", $letter->{'content'} ), - 'Content-Type' => 'text/plain; charset="utf8"', + 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"', + } ); sendmail(%mail) or carp $Mail::Sendmail::error; } @@ -440,8 +605,6 @@ sub SendAlerts { =head2 GetPreparedLetter( %params ) - retrieves letter template and performs substituion processing - %params hash: module => letter module, mandatory letter_code => letter code, mandatory @@ -469,65 +632,15 @@ sub GetPreparedLetter { my $module = $params{module} or croak "No module"; my $letter_code = $params{letter_code} or croak "No letter_code"; my $branchcode = $params{branchcode} || ''; - my $tables = $params{tables}; - my $substitute = $params{substitute}; - my $repeat = $params{repeat}; + my $mtt = $params{message_transport_type} || 'email'; - my $letter = getletter( $module, $letter_code, $branchcode ) - or warn( "No $module $letter_code letter"), + my $letter = getletter( $module, $letter_code, $branchcode, $mtt ) + or warn( "No $module $letter_code letter transported by " . $mtt ), return; - my $prepared_letter = GetProcessedLetter( - module => $module, - letter_code => $letter_code, - letter => $letter, - branchcode => $branchcode, - tables => $tables, - substitute => $substitute, - repeat => $repeat - ); - - return $prepared_letter; -} - -=head2 GetProcessedLetter( %params ) - - given a letter, with possible pre-processing do standard processing - allows one to perform letter template processing beforehand - - %params hash: - module => letter module, mandatory - letter_code => letter code, mandatory - letter => letter, mandatory - branchcode => for letter selection, if missing default system letter taken - tables => a hashref with table names as keys. Values are either: - - a scalar - primary key value - - an arrayref - primary key values - - a hashref - full record - substitute => custom substitution key/value pairs - repeat => records to be substituted on consecutive lines: - - an arrayref - tries to guess what needs substituting by - taking remaining << >> tokensr; not recommended - - a hashref token => @tables - replaces << >> << >> - subtemplate for each @tables row; table is a hashref as above - want_librarian => boolean, if set to true triggers librarian details - substitution from the userenv - Return value: - letter fields hashref (title & content useful) - -=cut - -sub GetProcessedLetter { - my %params = @_; - - my $module = $params{module} or croak "No module"; - my $letter_code = $params{letter_code} or croak "No letter_code"; - my $letter = $params{letter} or croak "No letter"; - my $branchcode = $params{branchcode} || ''; my $tables = $params{tables}; my $substitute = $params{substitute}; my $repeat = $params{repeat}; - $tables || $substitute || $repeat or carp( "ERROR: nothing to substitute - both 'tables' and 'substitute' are empty" ), return; @@ -535,11 +648,18 @@ sub GetProcessedLetter { 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; } } + my $OPACBaseURL = C4::Context->preference('OPACBaseURL'); + $letter->{content} =~ s/<>/$OPACBaseURL/go; + if ($want_librarian) { # parsing librarian name my $userenv = C4::Context->userenv; @@ -613,7 +733,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."; @@ -622,44 +741,50 @@ sub _substitute_tables { $sth->execute( $ref ? @$param : $param ); $values = $sth->fetchrow_hashref; + $sth->finish(); } _parseletter ( $letter, $table, $values ); } } -my %handles = (); sub _parseletter_sth { my $table = shift; + my $sth; unless ($table) { carp "ERROR: _parseletter_sth() called without argument (table)"; return; } - # check cache first - (defined $handles{$table}) and return $handles{$table}; + # NOTE: we used to check whether we had a statement handle cached in + # a %handles module-level variable. This was a dumb move and + # 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 '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 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'"; return; # nothing to get } - unless ($handles{$table} = C4::Context->dbh->prepare($query)) { + unless ($sth = C4::Context->dbh->prepare_cached($query)) { warn "ERROR: Failed to prepare query: '$query'"; return; } - return $handles{$table}; # now cache is populated for that $table + return $sth; # now cache is populated for that $table } =head2 _parseletter($letter, $table, $values) @@ -667,55 +792,87 @@ 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 -my %columns = (); sub _parseletter { - my ( $letter, $table, $values ) = @_; + my ( $letter, $table, $values_in ) = @_; + + # 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 } : {}; + + if ( $table eq 'borrowers' && $values->{'dateexpiry'} ){ + $values->{'dateexpiry'} = format_sqldatetime( $values->{'dateexpiry'} ); + } - # TEMPORARY hack until the expirationdate column is added to reserves if ( $table eq 'reserves' && $values->{'waitingdate'} ) { my @waitingdate = split /-/, $values->{'waitingdate'}; - $values->{'expirationdate'} = C4::Dates->new( - sprintf( - '%04d-%02d-%02d', - Add_Delta_Days( @waitingdate, C4::Context->preference( 'ReservesMaxPickUpDelay' ) ) - ), - 'iso' - )->output(); + $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 @da = localtime(); - my $todaysdate = "$da[2]:$da[1] " . C4::Dates->today(); + my $todaysdate = output_pref( DateTime->now() ); $letter->{content} =~ s/<>/$todaysdate/go; } - # and get all fields from the table -# my $columns = $columns{$table}; -# unless ($columns) { -# $columns = $columns{$table} = C4::Context->dbh->selectcol_arrayref("SHOW COLUMNS FROM $table"); -# } -# foreach my $field (@$columns) { - while ( my ($field, $val) = each %$values ) { - my $replacetablefield = "<<$table.$field>>"; - my $replacefield = "<<$field>>"; - $val =~ s/\p{P}(?=$)//g if $val; + $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$/; + + # Dates replacement my $replacedby = defined ($val) ? $val : ''; - ($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 ( $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})?$| ) + { + # 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. + 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; + } + eval { + $replacedby = 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/g; + $letter->{ $letter_field } =~ s/\Q<<$field$filter_string_used>>\E/$replacedby/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; + } + } + } } if ($table eq 'borrowers' && $letter->{content}) { @@ -756,7 +913,7 @@ sub EnqueueLetter { my $params = shift or return; return unless exists $params->{'letter'}; - return unless exists $params->{'borrowernumber'}; +# return unless exists $params->{'borrowernumber'}; return unless exists $params->{'message_transport_type'}; my $content = $params->{letter}->{content}; @@ -766,12 +923,6 @@ sub EnqueueLetter { return; } - # It was found that the some utf8 codes, cause the text to be truncated from that point onward when stored, - # so we normalize utf8 with NFC so that mysql will store 'all' of the content in its TEXT column type - # Note: It is also done in _add_attachments accordingly. - $params->{'letter'}->{'title'} = NFC($params->{'letter'}->{'title'}); # subject - $params->{'letter'}->{'content'} = NFC($params->{'letter'}->{'content'}); - # If we have any attachments we should encode then into the body. if ( $params->{'attachments'} ) { $params->{'letter'} = _add_attachments( @@ -832,7 +983,14 @@ 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 $member = C4::Members::GetMember( 'borrowernumber' => $message->{'borrowernumber'} ); + my $sms_provider = Koha::SMS::Providers->find( $member->{'sms_provider_id'} ); + $message->{to_address} .= '@' . $sms_provider->domain(); + _send_message_by_email( $message, $params->{'username'}, $params->{'password'}, $params->{'method'} ); + } else { + _send_message_by_sms( $message ); + } } } return scalar( @$unsent_messages ); @@ -916,6 +1074,74 @@ ENDSQL return $sth->fetchall_arrayref({}); } +=head2 GetMessageTransportTypes + + my @mtt = GetMessageTransportTypes(); + + returns an arrayref of transport types + +=cut + +sub GetMessageTransportTypes { + my $dbh = C4::Context->dbh(); + my $mtts = $dbh->selectcol_arrayref(" + SELECT message_transport_type + FROM message_transport_types + ORDER BY message_transport_type + "); + 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: @@ -942,17 +1168,11 @@ sub _add_attachments { $message->attach( Type => $letter->{'content-type'} || 'TEXT', Data => $letter->{'is_html'} - ? _wrap_html($letter->{'content'}, NFC($letter->{'title'})) - : NFC($letter->{'content'}), + ? _wrap_html($letter->{'content'}, $letter->{'title'}) + : $letter->{'content'}, ); foreach my $attachment ( @$attachments ) { - - if ($attachment->{'content'} =~ m/text/o) { # NFC normailze any "text" related content-type attachments - $attachment->{'content'} = NFC($attachment->{'content'}); - } - $attachment->{'filename'} = NFC($attachment->{'filename'}); - $message->attach( Type => $attachment->{'type'}, Data => $attachment->{'content'}, @@ -973,7 +1193,7 @@ sub _get_unsent_messages { 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 +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 = ? @@ -1006,22 +1226,16 @@ sub _send_message_by_email { my $message = shift or return; my ($username, $password, $method) = @_; - my $to_address = $message->{to_address}; + my $member = C4::Members::GetMember( 'borrowernumber' => $message->{'borrowernumber'} ); + my $to_address = $message->{'to_address'}; unless ($to_address) { - my $member = C4::Members::GetMember( 'borrowernumber' => $message->{'borrowernumber'} ); unless ($member) { warn "FAIL: No 'to_address' and INVALID borrowernumber ($message->{borrowernumber})"; _set_message_status( { message_id => $message->{'message_id'}, status => 'failed' } ); return; } - my $which_address = C4::Context->preference('AutoEmailPrimaryAddress'); - # If the system preference is set to 'first valid' (value == OFF), look up email address - if ($which_address eq 'OFF') { - $to_address = GetFirstValidEmailAddress( $message->{'borrowernumber'} ); - } else { - $to_address = $member->{$which_address}; - } + $to_address = C4::Members::GetNoticeEmailAddress( $message->{'borrowernumber'} ); 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? @@ -1033,24 +1247,39 @@ 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'}); + my $subject = encode('UTF-8', $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 %sendmail_params = ( - To => $to_address, - From => $message->{'from_address'} || C4::Context->preference('KohaAdminEmailAddress'), - Subject => $subject, - charset => 'utf8', - Message => $is_html ? _wrap_html($content, $subject) : $content, - 'content-type' => $content_type, + 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; + $branch_replyto = $library->branchreplyto; + $branch_returnpath = $library->branchreturnpath; + } + my $email = Koha::Email->new(); + my %sendmail_params = $email->create_message_headers( + { + 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 + } ); + $sendmail_params{'Auth'} = {user => $username, pass => $password, method => $method} if $username; if ( my $bcc = C4::Context->preference('OverdueNoticeBcc') ) { $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 ) ) { _set_message_status( { message_id => $message->{'message_id'}, status => 'sent' } ); @@ -1084,10 +1313,37 @@ $content EOS } +sub _is_duplicate { + my ( $message ) = @_; + my $dbh = C4::Context->dbh; + my $count = $dbh->selectrow_array(q| + SELECT COUNT(*) + FROM message_queue + WHERE message_transport_type = ? + AND borrowernumber = ? + AND letter_code = ? + AND CAST(time_queued AS date) = CAST(NOW() AS date) + AND status="sent" + AND content = ? + |, {}, $message->{message_transport_type}, $message->{borrowernumber}, $message->{letter_code}, $message->{content} ); + return $count; +} + sub _send_message_by_sms { my $message = shift or return; my $member = C4::Members::GetMember( 'borrowernumber' => $message->{'borrowernumber'} ); - return unless $member->{'smsalertnumber'}; + + unless ( $member->{smsalertnumber} ) { + _set_message_status( { message_id => $message->{'message_id'}, + status => 'failed' } ); + return; + } + + if ( _is_duplicate( $message ) ) { + _set_message_status( { message_id => $message->{'message_id'}, + status => 'failed' } ); + return; + } my $success = C4::SMS->send_sms( { destination => $member->{'smsalertnumber'}, message => $message->{'content'},