Bug 22330: (QA follow-up) Remove duplicate use lines, combine and sort remaning lines
[koha.git] / C4 / Letters.pm
index 62579eb..cbe6559 100644 (file)
@@ -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,
@@ -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( {} );
@@ -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'},
@@ -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;
@@ -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;