X-Git-Url: http://git.rot13.org/?a=blobdiff_plain;ds=sidebyside;f=C4%2FLetters.pm;h=cbe6559e8202e10ce48e74c68b9837159b9a29c5;hb=4ccbae8879a386a1846bb48c18b3722f936dc983;hp=0b04354f836b7bb8e70fa131c12b4e8a61e90a6a;hpb=830b5a7d7dad1d9d1593c14419496e81f7f4b24c;p=koha.git diff --git a/C4/Letters.pm b/C4/Letters.pm index 0b04354f83..cbe6559e82 100644 --- a/C4/Letters.pm +++ b/C4/Letters.pm @@ -36,8 +36,10 @@ use Koha::DateUtils; 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(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); @@ -45,7 +47,7 @@ BEGIN { require Exporter; @ISA = qw(Exporter); @EXPORT = qw( - &GetLetters &GetLettersAvailableForALibrary &GetLetterTemplates &DelLetter &GetPreparedLetter &GetWrappedLetter &addalert &getalert &delalert &findrelatedto &SendAlerts &GetPrintMessages &GetMessageTransportTypes + &GetLetters &GetLettersAvailableForALibrary &GetLetterTemplates &DelLetter &GetPreparedLetter &GetWrappedLetter &SendAlerts &GetPrintMessages &GetMessageTransportTypes ); } @@ -265,108 +267,6 @@ sub DelLetter { , undef, $branchcode, $module, $code, ( $mtt ? $mtt : () ), ( $lang ? $lang : () ) ); } -=head2 addalert ($borrowernumber, $type, $externalid) - - parameters : - - $borrowernumber : the number of the borrower subscribing to the alert - - $type : the type of alert. - - $externalid : the primary key of the object to put alert on. For issues, the alert is made on subscriptionid. - - create an alert and return the alertid (primary key) - -=cut - -sub addalert { - my ( $borrowernumber, $type, $externalid ) = @_; - my $dbh = C4::Context->dbh; - my $sth = - $dbh->prepare( - "insert into alert (borrowernumber, type, externalid) values (?,?,?)"); - $sth->execute( $borrowernumber, $type, $externalid ); - - # get the alert number newly created and return it - my $alertid = $dbh->{'mysql_insertid'}; - return $alertid; -} - -=head2 delalert ($alertid) - - parameters : - - alertid : the alert id - deletes the alert - -=cut - -sub delalert { - my $alertid = shift or die "delalert() called without valid argument (alertid)"; # it's gonna die anyway. - $debug and warn "delalert: deleting alertid $alertid"; - my $sth = C4::Context->dbh->prepare("delete from alert where alertid=?"); - $sth->execute($alertid); -} - -=head2 getalert ([$borrowernumber], [$type], [$externalid]) - - parameters : - - $borrowernumber : the number of the borrower subscribing to the alert - - $type : the type of alert. - - $externalid : the primary key of the object to put alert on. For issues, the alert is made on subscriptionid. - all parameters NON mandatory. If a parameter is omitted, the query is done without the corresponding parameter. For example, without $externalid, returns all alerts for a borrower on a topic. - -=cut - -sub getalert { - my ( $borrowernumber, $type, $externalid ) = @_; - my $dbh = C4::Context->dbh; - my $query = "SELECT a.*, b.branchcode FROM alert a JOIN borrowers b USING(borrowernumber) WHERE 1"; - my @bind; - if ($borrowernumber and $borrowernumber =~ /^\d+$/) { - $query .= " AND borrowernumber=?"; - push @bind, $borrowernumber; - } - if ($type) { - $query .= " AND type=?"; - push @bind, $type; - } - if ($externalid) { - $query .= " AND externalid=?"; - push @bind, $externalid; - } - my $sth = $dbh->prepare($query); - $sth->execute(@bind); - return $sth->fetchall_arrayref({}); -} - -=head2 findrelatedto($type, $externalid) - - parameters : - - $type : the type of alert - - $externalid : the id of the "object" to query - - In the table alert, a "id" is stored in the externalid field. This "id" is related to another table, depending on the type of the alert. - When type=issue, the id is related to a subscriptionid and this sub returns the name of the biblio. - -=cut - -# outmoded POD: -# When type=virtual, the id is related to a virtual shelf and this sub returns the name of the sub - -sub findrelatedto { - my $type = shift or return; - my $externalid = shift or return; - my $q = ($type eq 'issue' ) ? -"select title as result from subscription left join biblio on subscription.biblionumber=biblio.biblionumber where subscriptionid=?" : - ($type eq 'borrower') ? -"select concat(firstname,' ',surname) from borrowers where borrowernumber=?" : undef; - unless ($q) { - warn "findrelatedto(): Illegal type '$type'"; - return; - } - my $sth = C4::Context->dbh->prepare($q); - $sth->execute($externalid); - my ($result) = $sth->fetchrow; - return $result; -} - =head2 SendAlerts my $err = &SendAlerts($type, $externalid, $letter_code); @@ -415,22 +315,21 @@ sub SendAlerts { return; my %letter; - # find the list of borrowers to alert - my $alerts = getalert( '', 'issue', $subscriptionid ); - foreach (@$alerts) { - my $patron = Koha::Patrons->find( $_->{borrowernumber} ); - next unless $patron; # Just in case + # find the list of subscribers to notify + my $subscription = Koha::Subscriptions->find( $subscriptionid ); + my $subscribers = $subscription->subscribers; + while ( my $patron = $subscribers->next ) { my $email = $patron->email or next; # warn "sending issues..."; my $userenv = C4::Context->userenv; - my $library = Koha::Libraries->find( $_->{branchcode} ); + my $library = $patron->library; my $letter = GetPreparedLetter ( module => 'serial', letter_code => $letter_code, branchcode => $userenv->{branch}, tables => { - 'branches' => $_->{branchcode}, + 'branches' => $library->branchcode, 'biblio' => $biblionumber, 'biblioitems' => $biblionumber, 'borrowers' => $patron->unblessed, @@ -458,7 +357,7 @@ sub SendAlerts { : 'text/plain; charset="utf-8"', } ); - unless( sendmail(%mail) ) { + unless( Mail::Sendmail::sendmail(%mail) ) { carp $Mail::Sendmail::error; return { error => $Mail::Sendmail::error }; } @@ -494,22 +393,23 @@ sub SendAlerts { if ($type eq 'claimissues') { $strsth = qq{ - SELECT serial.*,subscription.*, biblio.*, aqbooksellers.*, + SELECT serial.*,subscription.*, biblio.*, biblioitems.*, aqbooksellers.*, aqbooksellers.id AS booksellerid FROM serial LEFT JOIN subscription ON serial.subscriptionid=subscription.subscriptionid LEFT JOIN biblio ON serial.biblionumber=biblio.biblionumber + LEFT JOIN biblioitems ON serial.biblionumber = biblioitems.biblionumber LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id WHERE serial.serialid IN ( }; if (!@$externalid){ - carp "No Order selected"; - return { error => "no_order_selected" }; + carp "No issues selected"; + return { error => "no_issues_selected" }; } $strsth .= join( ",", ('?') x @$externalid ) . ")"; - $action = "CLAIM ISSUE"; + $action = "SERIAL CLAIM"; $sthorders = $dbh->prepare($strsth); $sthorders->execute( @$externalid ); $dataorders = $sthorders->fetchall_arrayref( {} ); @@ -603,7 +503,7 @@ sub SendAlerts { if C4::Context->preference("ClaimsBccCopy"); } - unless ( sendmail(%mail) ) { + unless ( Mail::Sendmail::sendmail(%mail) ) { carp $Mail::Sendmail::error; return { error => $Mail::Sendmail::error }; } @@ -627,6 +527,7 @@ sub SendAlerts { module => 'members', letter_code => $letter_code, branchcode => $externalid->{'branchcode'}, + lang => $externalid->{lang} || 'default', tables => { 'branches' => $library, 'borrowers' => $externalid->{'borrowernumber'}, @@ -652,7 +553,7 @@ sub SendAlerts { : 'text/plain; charset="utf-8"', } ); - unless( sendmail(%mail) ) { + unless( Mail::Sendmail::sendmail(%mail) ) { carp $Mail::Sendmail::error; return { error => $Mail::Sendmail::error }; } @@ -688,18 +589,22 @@ 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 $lang = $params{lang} || 'default'; - - my $letter = getletter( $module, $letter_code, $branchcode, $mtt, $lang ); + my $letter = $params{letter}; unless ( $letter ) { - $letter = getletter( $module, $letter_code, $branchcode, $mtt, 'default' ) - or warn( "No $module $letter_code letter transported by " . $mtt ), - return; + 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'; + + $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} || {}; @@ -880,7 +785,7 @@ sub _parseletter { my $values = $values_in ? { %$values_in } : {}; if ( $table eq 'borrowers' && $values->{'dateexpiry'} ){ - $values->{'dateexpiry'} = format_sqldatetime( $values->{'dateexpiry'} ); + $values->{'dateexpiry'} = output_pref({ dt => dt_from_string( $values->{'dateexpiry'} ), dateonly => 1 }); } if ( $table eq 'reserves' && $values->{'waitingdate'} ) { @@ -1059,6 +964,11 @@ sub SendQueuedMessages { }; 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'}, @@ -1085,7 +995,15 @@ sub SendQueuedMessages { } $message->{to_address} = $patron->smsalertnumber; #Sometime this is set to email - sms should always use smsalertnumber $message->{to_address} .= '@' . $sms_provider->domain(); - _update_message_to_address($message->{'message_id'},$message->{to_address}); + + # 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 ); @@ -1366,9 +1284,10 @@ sub _send_message_by_email { } } - my $utf8 = decode('MIME-Header', $message->{'subject'} ); - $message->{subject}= encode('MIME-Header', $utf8); - my $subject = encode('UTF-8', $message->{'subject'}); + # 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; @@ -1401,7 +1320,7 @@ sub _send_message_by_email { _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; @@ -1480,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; @@ -1518,7 +1443,8 @@ sub _process_tt { my $tt_params = { %{ _get_tt_params( $tables ) }, %{ _get_tt_params( $loops, 'is_a_loop' ) }, %$substitute }; - $content = qq|[% USE KohaDates %]$content|; + $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(); @@ -1545,6 +1471,12 @@ sub _get_tt_params { plural => 'biblios', pk => 'biblionumber', }, + biblioitems => { + module => 'Koha::Biblioitems', + singular => 'biblioitem', + plural => 'biblioitems', + pk => 'biblioitemnumber', + }, borrowers => { module => 'Koha::Patrons', singular => 'borrower', @@ -1694,6 +1626,23 @@ sub _get_tt_params { 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;