# 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., 59 Temple Place,
-# Suite 330, Boston, MA 02111-1307 USA
+# 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.
use strict;
use warnings;
use MIME::Lite;
use Mail::Sendmail;
-use Encode;
-use Carp;
use C4::Members;
+use C4::Branch;
use C4::Log;
use C4::SMS;
use C4::Debug;
parameters :
- alertid : the alert id
deletes the alert
-
+
=cut
sub delalert ($) {
sub SendAlerts {
my ( $type, $externalid, $letter ) = @_;
my $dbh = C4::Context->dbh;
+ my $strsth;
if ( $type eq 'issue' ) {
# warn "sending issues...";
# and parse borrower ...
my $innerletter = $letter;
- my $borinfo = GetMember( 'borrowernumber' => $_->{'borrowernumber'});
+ my $borinfo = C4::Members::GetMember('borrowernumber' => $_->{'borrowernumber'});
parseletter( $innerletter, 'borrowers', $_->{'borrowernumber'} );
# ... then send mail
);
sendmail(%mail) or carp $Mail::Sendmail::error;
-# warn "sending to $mail{To} From $mail{From} subj $mail{Subject} Mess $mail{Message}";
}
}
}
elsif ( $type eq 'claimacquisition' ) {
- # warn "sending issues...";
- my $letter = getletter( 'claimacquisition', $letter );
+ $letter = getletter( 'claimacquisition', $letter );
# prepare the letter...
# search the biblionumber
- my $strsth =
-"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 where aqorders.ordernumber IN ("
- . join( ",", @$externalid ) . ")";
- my $sthorders = $dbh->prepare($strsth);
- $sthorders->execute;
- my $dataorders = $sthorders->fetchall_arrayref( {} );
- parseletter( $letter, 'aqbooksellers',
- $dataorders->[0]->{booksellerid} );
- my $sthbookseller =
- $dbh->prepare("select * from aqbooksellers where id=?");
- $sthbookseller->execute( $dataorders->[0]->{booksellerid} );
- my $databookseller = $sthbookseller->fetchrow_hashref;
-
- # parsing branch info
- my $userenv = C4::Context->userenv;
- parseletter( $letter, 'branches', $userenv->{branch} );
-
- # parsing librarian name
- $letter->{content} =~ s/<<LibrarianFirstname>>/$userenv->{firstname}/g;
- $letter->{content} =~ s/<<LibrarianSurname>>/$userenv->{surname}/g;
- $letter->{content} =~
- s/<<LibrarianEmailaddress>>/$userenv->{emailaddress}/g;
- foreach my $data (@$dataorders) {
- my $line = $1 if ( $letter->{content} =~ m/(<<.*>>)/ );
- foreach my $field ( keys %$data ) {
- $line =~ s/(<<[^\.]+.$field>>)/$data->{$field}/;
- }
- $letter->{content} =~ s/(<<.*>>)/$line\n$1/;
- }
- $letter->{content} =~ s/<<[^>]*>>//g;
- my $innerletter = $letter;
-
- # ... then send mail
- if ( $databookseller->{bookselleremail}
- || $databookseller->{contemail} )
- {
- my %mail = (
- To => $databookseller->{bookselleremail}
- . (
- $databookseller->{contemail}
- ? "," . $databookseller->{contemail}
- : ""
- ),
- From => $userenv->{emailaddress},
- Subject => "" . $innerletter->{title},
- Message => "" . $innerletter->{content},
- 'Content-Type' => 'text/plain; charset="utf8"',
- );
- sendmail(%mail) or carp $Mail::Sendmail::error;
- warn
-"sending to $mail{To} From $mail{From} subj $mail{Subject} Mess $mail{Message}";
- }
- if ( C4::Context->preference("LetterLog") ) {
- logaction(
- "ACQUISITION",
- "Send Acquisition claim letter",
- "",
- "order list : "
- . join( ",", @$externalid )
- . "\n$innerletter->{title}\n$innerletter->{content}"
- );
+ $strsth = qq{
+ SELECT aqorders.*,aqbasket.*,biblio.*,biblioitems.*,aqbooksellers.*
+ 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
+ WHERE aqorders.ordernumber IN (
}
+ . join( ",", @$externalid ) . ")";
}
elsif ( $type eq 'claimissues' ) {
- # warn "sending issues...";
- my $letter = getletter( 'claimissues', $letter );
+ $letter = getletter( 'claimissues', $letter );
# prepare the letter...
# search the biblionumber
- my $strsth =
-"select serial.*,subscription.*, biblio.* from serial LEFT JOIN subscription on serial.subscriptionid=subscription.subscriptionid LEFT JOIN biblio on serial.biblionumber=biblio.biblionumber where serial.serialid IN ("
+ $strsth = qq{
+ SELECT serial.*,subscription.*, biblio.*, aqbooksellers.*
+ FROM serial
+ LEFT JOIN subscription ON serial.subscriptionid=subscription.subscriptionid
+ LEFT JOIN biblio ON serial.biblionumber=biblio.biblionumber
+ LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id
+ WHERE serial.serialid IN (
+ }
. join( ",", @$externalid ) . ")";
+ }
+
+ if ( $type eq 'claimacquisition' or $type eq 'claimissues' ) {
my $sthorders = $dbh->prepare($strsth);
$sthorders->execute;
- my $dataorders = $sthorders->fetchall_arrayref( {} );
- parseletter( $letter, 'aqbooksellers',
- $dataorders->[0]->{aqbooksellerid} );
- my $sthbookseller =
- $dbh->prepare("select * from aqbooksellers where id=?");
- $sthbookseller->execute( $dataorders->[0]->{aqbooksellerid} );
- my $databookseller = $sthbookseller->fetchrow_hashref;
+ my @fields = map {
+ $sthorders->{mysql_table}[$_] . "." . $sthorders->{NAME}[$_] }
+ (0 .. $#{$sthorders->{NAME}} ) ;
+
+ my @orders_infos;
+ while ( my $row = $sthorders->fetchrow_arrayref() ) {
+ my %rec = ();
+ @rec{@fields} = @$row;
+ push @orders_infos, \%rec;
+ }
# parsing branch info
my $userenv = C4::Context->userenv;
# parsing librarian name
$letter->{content} =~ s/<<LibrarianFirstname>>/$userenv->{firstname}/g;
$letter->{content} =~ s/<<LibrarianSurname>>/$userenv->{surname}/g;
- $letter->{content} =~
- s/<<LibrarianEmailaddress>>/$userenv->{emailaddress}/g;
- foreach my $data (@$dataorders) {
- my $line = $1 if ( $letter->{content} =~ m/(<<.*>>)/ );
- foreach my $field ( keys %$data ) {
- $line =~ s/(<<[^\.]+.$field>>)/$data->{$field}/;
- }
- $letter->{content} =~ s/(<<.*>>)/$line\n$1/;
+ $letter->{content} =~ s/<<LibrarianEmailaddress>>/$userenv->{emailaddress}/g;
+
+ # Get Fields remplacement
+ my $order_format = $1 if ( $letter->{content} =~ m/(<order>.*<\/order>)/xms );
+
+ # Foreach field to remplace
+ while ( $letter->{content} =~ m/<<([^>]*)>>/g ) {
+ my $field = $1;
+ my $value = $orders_infos[0]->{$field} || "";
+ $value = sprintf("%.2f", $value) if $field =~ /price/;
+ $letter->{content} =~ s/<<$field>>/$value/g;
}
- $letter->{content} =~ s/<<[^>]*>>//g;
- my $innerletter = $letter;
- # ... then send mail
- if ( $databookseller->{bookselleremail}
- || $databookseller->{contemail} ) {
- my $mail_to = $databookseller->{bookselleremail};
- if ($databookseller->{contemail}) {
- if (!$mail_to) {
- $mail_to = $databookseller->{contemail};
- } else {
- $mail_to .= q|,|;
- $mail_to .= $databookseller->{contemail};
+ if ( $order_format ) {
+ # For each order
+ foreach my $infos ( @orders_infos ) {
+ my $order_content = $order_format;
+ # We replace by value
+ while ( $order_content =~ m/<<([^>]*)>>/g ) {
+ my $field = $1;
+ my $value = $infos->{$field} || "";
+ $value = sprintf("%.2f", $value) if $field =~ /price/;
+ $order_content =~ s/(<<$field>>)/$value/g;
}
+ $order_content =~ s/<\/{0,1}?order>//g;
+ $letter->{content} =~ s/<order>.*<\/order>/$order_content\n$order_format/xms;
}
- my $mail_subj = $innerletter->{title};
- my $mail_msg = $innerletter->{content};
- $mail_msg ||= q{};
- $mail_subj ||= q{};
+ $letter->{content} =~ s/<order>.*<\/order>//xms;
+ }
+
+ my $innerletter = $letter;
+ # ... then send mail
+ if ( $orders_infos[0]->{'aqbooksellers.bookselleremail'}
+ || $orders_infos[0]->{'aqbooksellers.contemail'} ) {
+ my $to = $orders_infos[0]->{'aqbooksellers.bookselleremail'};
+ $to .= ", " if $to;
+ $to .= $orders_infos[0]->{'aqbooksellers.contemail'} || "";
my %mail = (
- To => $mail_to,
- From => $userenv->{emailaddress},
- Subject => $mail_subj,
- Message => $mail_msg,
+ To => $to,
+ From => $userenv->{emailaddress},
+ Subject => Encode::encode( "utf8", "" . $innerletter->{title} ),
+ Message => Encode::encode( "utf8", "" . $innerletter->{content} ),
'Content-Type' => 'text/plain; charset="utf8"',
);
sendmail(%mail) or carp $Mail::Sendmail::error;
- logaction(
- "ACQUISITION",
- "CLAIM ISSUE",
- undef,
- "To="
- . $databookseller->{contemail}
- . " Title="
- . $innerletter->{title}
- . " Content="
- . $innerletter->{content}
- ) if C4::Context->preference("LetterLog");
+ warn "sending to $mail{To} From $mail{From} subj $mail{Subject} Mess $mail{Message}" if $debug;
+ if ( C4::Context->preference("LetterLog") ) {
+ logaction( "ACQUISITION", "Send Acquisition claim letter", "", "order list : " . join( ",", @$externalid ) . "\n$innerletter->{title}\n$innerletter->{content}" ) if $type eq 'claimacquisition';
+ logaction( "ACQUISITION", "CLAIM ISSUE", undef, "To=" . $mail{To} . " Title=" . $innerletter->{title} . " Content=" . $innerletter->{content} ) if $type eq 'claimissues';
+ }
+ } else {
+ return {error => "no_email" };
}
- warn
-"sending to From $userenv->{emailaddress} subj $innerletter->{title} Mess $innerletter->{content}";
- }
- # send an "account details" notice to a newly created user
+
+ warn "sending to From $userenv->{emailaddress} subj $innerletter->{title} Mess $innerletter->{content}" if $debug;
+ }
+
+ # send an "account details" notice to a newly created user
elsif ( $type eq 'members' ) {
- $letter->{content} =~ s/<<borrowers.title>>/$externalid->{'title'}/g;
- $letter->{content} =~ s/<<borrowers.firstname>>/$externalid->{'firstname'}/g;
- $letter->{content} =~ s/<<borrowers.surname>>/$externalid->{'surname'}/g;
- $letter->{content} =~ s/<<borrowers.userid>>/$externalid->{'userid'}/g;
+ # must parse the password special, before it's hashed.
$letter->{content} =~ s/<<borrowers.password>>/$externalid->{'password'}/g;
+ parseletter( $letter, 'borrowers', $externalid->{'borrowernumber'});
+ parseletter( $letter, 'branches', $externalid->{'branchcode'} );
+
+ my $branchdetails = GetBranchDetail($externalid->{'branchcode'});
my %mail = (
To => $externalid->{'emailaddr'},
- From => C4::Context->preference("KohaAdminEmailAddress"),
+ From => $branchdetails->{'branchemail'} || C4::Context->preference("KohaAdminEmailAddress"),
Subject => $letter->{'title'},
Message => $letter->{'content'},
'Content-Type' => 'text/plain; charset="utf8"',
($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 'suggestions' ) ? "SELECT * FROM $table WHERE borrowernumber = ? and biblionumber = ?" :
+ ($table eq 'issues' ) ? "SELECT * FROM $table WHERE itemnumber = ?" :
($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 borrowernumber = ? and biblionumber = ?" :
+ ($table eq 'suggestions' ) ? "SELECT * FROM $table WHERE suggestionid = ?" :
($table eq 'aqbooksellers') ? "SELECT * FROM $table WHERE id = ?" : undef ;
unless ($query) {
warn "ERROR: No parseletter_sth query for table '$table'";
=head2 EnqueueLetter
-=over 4
-
-my $success = EnqueueLetter( { letter => $letter, borrowernumber => '12', message_transport_type => 'email' } )
+ my $success = EnqueueLetter( { letter => $letter,
+ borrowernumber => '12', message_transport_type => 'email' } )
places a letter in the message_queue database table, which will
eventually get processed (sent) by the process_message_queue.pl
return true on success
-=back
-
=cut
sub EnqueueLetter ($) {
=head2 SendQueuedMessages ([$hashref])
-=over 4
+ my $sent = SendQueuedMessages( { verbose => 1 } );
sends all of the 'pending' items in the message queue.
-my $sent = SendQueuedMessages( { verbose => 1 } );
-
returns number of messages sent.
-=back
-
=cut
sub SendQueuedMessages (;$) {
# This is just begging for subclassing
next MESSAGE if ( lc($message->{'message_transport_type'}) eq 'rss' );
if ( lc( $message->{'message_transport_type'} ) eq 'email' ) {
- _send_message_by_email( $message );
+ _send_message_by_email( $message, $params->{'username'}, $params->{'password'}, $params->{'method'} );
}
elsif ( lc( $message->{'message_transport_type'} ) eq 'sms' ) {
_send_message_by_sms( $message );
=head2 GetRSSMessages
-=over 4
-
-my $message_list = GetRSSMessages( { limit => 10, borrowernumber => '14' } )
+ my $message_list = GetRSSMessages( { limit => 10, borrowernumber => '14' } )
returns a listref of all queued RSS messages for a particular person.
-=back
-
=cut
sub GetRSSMessages {
=head2 GetPrintMessages
-=over 4
-
-my $message_list = GetPrintMessages( { borrowernumber => $borrowernumber } )
+ my $message_list = GetPrintMessages( { borrowernumber => $borrowernumber } )
Returns a arrayref of all queued print messages (optionally, for a particular
person).
-=back
-
=cut
sub GetPrintMessages {
=head2 GetQueuedMessages ([$hashref])
-=over 4
-
-my $messages = GetQueuedMessage( { borrowernumber => '123', limit => 20 } );
+ my $messages = GetQueuedMessage( { borrowernumber => '123', limit => 20 } );
fetches messages out of the message queue.
returns:
list of hashes, each has represents a message in the message queue.
-=back
-
=cut
sub GetQueuedMessages {
sub _send_message_by_email ($;$$$) {
my $message = shift or return;
+ my ($username, $password, $method) = @_;
my $to_address = $message->{to_address};
unless ($to_address) {
status => 'failed' } );
return;
}
- unless ($to_address = $member->{email}) { # assigment, not comparison
+ 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};
+ }
+ 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'},
}
}
- my $content = encode('utf8', $message->{'content'});
+ my $utf8 = decode('MIME-Header', $message->{'subject'} );
+ $message->{subject}= encode('MIME-Header', $utf8);
+ my $content = encode('utf8', $message->{'content'});
my %sendmail_params = (
To => $to_address,
From => $message->{'from_address'} || C4::Context->preference('KohaAdminEmailAddress'),
- Subject => $message->{'subject'},
+ Subject => encode('utf8', $message->{'subject'}),
charset => 'utf8',
Message => $content,
'content-type' => $message->{'content_type'} || 'text/plain; charset="UTF-8"',
);
+ $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' } );
return $success;
}
+sub _update_message_to_address {
+ my ($id, $to)= @_;
+ my $dbh = C4::Context->dbh();
+ $dbh->do('UPDATE message_queue SET to_address=? WHERE message_id=?',undef,($to,$id));
+}
+
sub _set_message_status ($) {
my $params = shift or return undef;
projects / koha.git / blobdiff