Bug 19612: Fix XSS in members/memberentry.pl
[koha.git] / C4 / Letters.pm
index 8308bac..42893f1 100644 (file)
@@ -37,6 +37,7 @@ use Koha::SMS::Providers;
 
 use Koha::Email;
 use Koha::DateUtils qw( format_sqldatetime dt_from_string );
+use Koha::Patrons;
 
 use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
 
@@ -106,7 +107,6 @@ sub GetLetters {
     );
 
     Return a hashref of letter templates.
-    The key will be the message transport type.
 
 =cut
 
@@ -117,16 +117,15 @@ sub GetLetterTemplates {
     my $code      = $params->{code};
     my $branchcode = $params->{branchcode} // '';
     my $dbh       = C4::Context->dbh;
-    my $letters   = $dbh->selectall_hashref(
+    my $letters   = $dbh->selectall_arrayref(
         q|
-            SELECT module, code, branchcode, name, is_html, title, content, message_transport_type
+            SELECT module, code, branchcode, name, is_html, title, content, message_transport_type, lang
             FROM letter
             WHERE module = ?
             AND code = ?
             and branchcode = ?
         |
-        , 'message_transport_type'
-        , undef
+        , { Slice => {} }
         , $module, $code, $branchcode
     );
 
@@ -200,14 +199,14 @@ sub GetLettersAvailableForALibrary {
 }
 
 sub getletter {
-    my ( $module, $code, $branchcode, $message_transport_type ) = @_;
+    my ( $module, $code, $branchcode, $message_transport_type, $lang) = @_;
     $message_transport_type //= '%';
+    $lang = 'default' unless( $lang && C4::Context->preference('TranslateNotices') );
 
-    if ( C4::Context->preference('IndependentBranches')
-            and $branchcode
-            and C4::Context->userenv ) {
 
-        $branchcode = C4::Context->userenv->{'branch'};
+    my $only_my_library = C4::Context->only_my_library;
+    if ( $only_my_library and $branchcode ) {
+        $branchcode = C4::Context::mybranch();
     }
     $branchcode //= '';
 
@@ -217,9 +216,10 @@ sub getletter {
         FROM letter
         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};
@@ -249,14 +249,17 @@ sub DelLetter {
     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|| )
-    , undef, $branchcode, $module, $code, ( $mtt ? $mtt : () ) );
+    |
+    . ( $mtt ? q| AND message_transport_type = ?| : q|| )
+    . ( $lang? q| AND lang = ?| : q|| )
+    , undef, $branchcode, $module, $code, ( $mtt ? $mtt : () ), ( $lang ? $lang : () ) );
 }
 
 =head2 addalert ($borrowernumber, $type, $externalid)
@@ -412,8 +415,9 @@ sub SendAlerts {
         # find the list of borrowers to alert
         my $alerts = getalert( '', 'issue', $subscriptionid );
         foreach (@$alerts) {
-            my $borinfo = C4::Members::GetMember('borrowernumber' => $_->{'borrowernumber'});
-            my $email = $borinfo->{email} or next;
+            my $patron = Koha::Patrons->find( $_->{borrowernumber} );
+            next unless $patron; # Just in case
+            my $email = $patron->email or next;
 
 #                    warn "sending issues...";
             my $userenv = C4::Context->userenv;
@@ -426,7 +430,7 @@ sub SendAlerts {
                     'branches'    => $_->{branchcode},
                     'biblio'      => $biblionumber,
                     'biblioitems' => $biblionumber,
-                    'borrowers'   => $borinfo,
+                    'borrowers'   => $patron->unblessed,
                     'subscription' => $subscriptionid,
                     'serial' => $externalid,
                 },
@@ -572,10 +576,11 @@ sub SendAlerts {
         $letter->{content} =~ s/<order>(.*?)<\/order>/$1/gxms;
 
         # ... then send mail
+        my $library = Koha::Libraries->find( $userenv->{branch} );
         my %mail = (
             To => join( ',', @email),
             Cc             => join( ',', @cc),
-            From           => $userenv->{emailaddress},
+            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'} ),
@@ -684,14 +689,19 @@ sub GetPreparedLetter {
     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 )
-        or warn( "No $module $letter_code letter transported by " . $mtt ),
-            return;
+    my $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 history syntax
+    my $loops  = $params{loops} || {}; # loops is not supported for historical notices syntax
     my $repeat = $params{repeat};
     %$tables || %$substitute || $repeat || %$loops
       or carp( "ERROR: nothing to substitute - both 'tables', 'loops' and 'substitute' are empty" ),
@@ -772,6 +782,7 @@ sub GetPreparedLetter {
             content => $letter->{content},
             tables  => $tables,
             loops  => $loops,
+            substitute => $substitute,
         }
     );
 
@@ -870,17 +881,7 @@ sub _parseletter {
     }
 
     if ( $table eq 'reserves' && $values->{'waitingdate'} ) {
-        my @waitingdate = split /-/, $values->{'waitingdate'};
-
-        $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} =~ /<<today>>/) {
@@ -1022,18 +1023,19 @@ ENDSQL
 
 =head2 SendQueuedMessages ([$hashref]) 
 
-  my $sent = SendQueuedMessages( { verbose => 1 } );
+    my $sent = SendQueuedMessages({ verbose => 1, limit => 50 });
 
-sends all of the 'pending' items in the message queue.
+Sends all of the 'pending' items in the message queue, unless the optional
+limit parameter is passed too. The verbose parameter is also optional.
 
-returns number of messages sent.
+Returns number of messages sent.
 
 =cut
 
 sub SendQueuedMessages {
     my $params = shift;
 
-    my $unsent_messages = _get_unsent_messages();
+    my $unsent_messages = _get_unsent_messages( { limit => $params->{limit} } );
     MESSAGE: foreach my $message ( @$unsent_messages ) {
         # warn Data::Dumper->Dump( [ $message ], [ 'message' ] );
         warn sprintf( 'sending %s message to patron: %s',
@@ -1047,9 +1049,21 @@ sub SendQueuedMessages {
         }
         elsif ( lc( $message->{'message_transport_type'} ) eq 'sms' ) {
             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'} );
+                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();
+                _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 );
@@ -1255,12 +1269,12 @@ 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 ) {
@@ -1289,16 +1303,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?
@@ -1317,8 +1331,8 @@ sub _send_message_by_email {
     my $branch_email = undef;
     my $branch_replyto = undef;
     my $branch_returnpath = undef;
-    if ($member) {
-        my $library = Koha::Libraries->find( $member->{branchcode} );
+    if ($patron) {
+        my $library = $patron->library;
         $branch_email      = $library->branchemail;
         $branch_replyto    = $library->branchreplyto;
         $branch_returnpath = $library->branchreturnpath;
@@ -1337,7 +1351,7 @@ 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;
     }
 
@@ -1394,9 +1408,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;
@@ -1408,7 +1422,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'},
@@ -1443,6 +1457,7 @@ sub _process_tt {
     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(
@@ -1457,7 +1472,9 @@ sub _process_tt {
         }
     ) or die Template->error();
 
-    my $tt_params = { %{ _get_tt_params( $tables ) }, %{ _get_tt_params( $loops, 'is_a_loop' ) } };
+    my $tt_params = { %{ _get_tt_params( $tables ) }, %{ _get_tt_params( $loops, 'is_a_loop' ) }, %$substitute };
+
+    $content = qq|[% USE KohaDates %]$content|;
 
     my $output;
     $template->process( \$content, $tt_params, \$output ) || croak "ERROR PROCESSING TEMPLATE: " . $template->error();
@@ -1509,7 +1526,7 @@ sub _get_tt_params {
             pk       => 'idnew',
         },
         aqorders => {
-            module   => 'Koha::Tmp::Orders', # Should Koha::Acquisition::Orders when will be based on Koha::Objects
+            module   => 'Koha::Acquisition::Orders',
             singular => 'order',
             plural   => 'orders',
             pk       => 'ordernumber',
@@ -1544,6 +1561,18 @@ sub _get_tt_params {
             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',
@@ -1563,10 +1592,23 @@ sub _get_tt_params {
             my $fk = $config->{$table}->{fk};
 
             if ( $is_a_loop ) {
-                unless ( ref( $tables->{$table} ) eq 'ARRAY' ) {
+                my $values = $tables->{$table} || [];
+                unless ( ref( $values ) eq 'ARRAY' ) {
                     croak "ERROR processing table $table. Wrong API call.";
                 }
-                my $objects = $module->search( { $pk => { -in => $tables->{$table} } } );
+                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' ) {
@@ -1578,9 +1620,9 @@ sub _get_tt_params {
                         foreach my $key ( @$fk ) {
                             $search->{$key} = $id->{$key};
                         }
-                        $object = $module->search( $search )->next();
+                        $object = $module->search( $search )->last();
                     } else { # Foreign key is single column
-                        $object = $module->search( { $fk => $id } )->next();
+                        $object = $module->search( { $fk => $id } )->last();
                     }
                 } else { # using the table's primary key for lookup
                     $object = $module->find($id);
@@ -1590,7 +1632,7 @@ sub _get_tt_params {
             else {    # $ref eq 'ARRAY'
                 my $object;
                 if ( @{ $tables->{$table} } == 1 ) {    # Param is a single key
-                    $object = $module->search( { $pk => $tables->{$table} } )->next();
+                    $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";
@@ -1603,11 +1645,44 @@ sub _get_tt_params {
         }
     }
 
-    $params->{today} = dt_from_string();
+    $params->{today} = output_pref({ dt => dt_from_string, dateformat => 'iso' });
 
     return $params;
 }
 
+=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__