Bug 16805: Log in with database admin user breaks OPAC
[koha_ffzg] / C4 / Letters.pm
index 7b3261b..737c8cd 100644 (file)
@@ -22,6 +22,11 @@ use warnings;
 
 use MIME::Lite;
 use Mail::Sendmail;
+use Date::Calc qw( Add_Delta_Days );
+use Encode;
+use Carp;
+use Template;
+use Module::Load::Conditional qw(can_load);
 
 use C4::Koha qw(GetAuthorisedValueByCode);
 use C4::Members;
@@ -33,18 +38,13 @@ use C4::Debug;
 use Koha::DateUtils;
 use Koha::SMS::Providers;
 
-use Date::Calc qw( Add_Delta_Days );
-use Encode;
-use Carp;
 use Koha::Email;
-use Koha::DateUtils qw( format_sqldatetime );
+use Koha::DateUtils qw( format_sqldatetime dt_from_string );
 
-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 &GetLettersAvailableForALibrary &GetLetterTemplates &DelLetter &GetPreparedLetter &GetWrappedLetter &addalert &getalert &delalert &findrelatedto &SendAlerts &GetPrintMessages &GetMessageTransportTypes
@@ -202,12 +202,6 @@ sub GetLettersAvailableForALibrary {
 
 }
 
-# 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, $message_transport_type ) = @_;
     $message_transport_type //= '%';
@@ -220,10 +214,6 @@ sub getletter {
     }
     $branchcode //= '';
 
-    if ( my $l = $letter{$module}{$code}{$branchcode}{$message_transport_type} ) {
-        return { %$l }; # deep copy
-    }
-
     my $dbh = C4::Context->dbh;
     my $sth = $dbh->prepare(q{
         SELECT *
@@ -236,7 +226,6 @@ sub getletter {
     my $line = $sth->fetchrow_hashref
       or return;
     $line->{'content-type'} = 'text/html; charset="UTF-8"' if $line->{is_html};
-    $letter{$module}{$code}{$branchcode}{$message_transport_type} = $line;
     return { %$line };
 }
 
@@ -325,21 +314,20 @@ sub delalert {
 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";
+    my $query = "SELECT a.*, b.branchcode FROM alert a JOIN borrowers b USING(borrowernumber) WHERE 1";
     my @bind;
     if ($borrowernumber and $borrowernumber =~ /^\d+$/) {
-        $query .= " borrowernumber=? AND ";
+        $query .= " AND borrowernumber=?";
         push @bind, $borrowernumber;
     }
     if ($type) {
-        $query .= " type=? AND ";
+        $query .= " AND type=?";
         push @bind, $type;
     }
     if ($externalid) {
-        $query .= " externalid=? AND ";
+        $query .= " AND externalid=?";
         push @bind, $externalid;
     }
-    $query =~ s/ AND $//;
     my $sth = $dbh->prepare($query);
     $sth->execute(@bind);
     return $sth->fetchall_arrayref({});
@@ -420,7 +408,7 @@ sub SendAlerts {
 
 #                    warn "sending issues...";
             my $userenv = C4::Context->userenv;
-            my $branchdetails = GetBranchDetail($_->{'branchcode'});
+            my $library = Koha::Libraries->find( $_->{branchcode} );
             my $letter = GetPreparedLetter (
                 module => 'serial',
                 letter_code => $letter_code,
@@ -441,9 +429,9 @@ sub SendAlerts {
             my %mail = $message->create_message_headers(
                 {
                     to      => $email,
-                    from    => $branchdetails->{'branchemail'},
-                    replyto => $branchdetails->{'branchreplyto'},
-                    sender  => $branchdetails->{'branchreturnpath'},
+                    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'} ),
@@ -571,13 +559,13 @@ 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'} },
@@ -588,9 +576,9 @@ sub SendAlerts {
         my %mail  = $email->create_message_headers(
             {
                 to      => $externalid->{'emailaddr'},
-                from    => $branchdetails->{'branchemail'},
-                replyto => $branchdetails->{'branchreplyto'},
-                sender  => $branchdetails->{'branchreturnpath'},
+                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'} ),
@@ -717,8 +705,14 @@ sub GetPreparedLetter {
         }
     }
 
+    $letter->{content} = _process_tt(
+        {
+            content => $letter->{content},
+            tables  => $tables,
+        }
+    );
+
     $letter->{content} =~ s/<<\S*>>//go; #remove any stragglers
-#   $letter->{content} =~ s/<<[^>]*>>//go;
 
     return $letter;
 }
@@ -856,13 +850,13 @@ sub _parseletter {
                     $filter_string_used = $1 || q{};
                     $dateonly = $1 unless $dateonly;
                 }
-                eval {
-                    $replacedby = output_pref({ dt => dt_from_string( $replacedby ), dateonly => $dateonly });
+                my $replacedby_date = eval {
+                    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;
+                    $letter->{ $letter_field } =~ s/\Q<<$table.$field$filter_string_used>>\E/$replacedby_date/g;
+                    $letter->{ $letter_field } =~ s/\Q<<$field$filter_string_used>>\E/$replacedby_date/g;
                 }
             }
         }
@@ -1094,6 +1088,56 @@ sub GetMessageTransportTypes {
     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:
@@ -1206,11 +1250,11 @@ sub _send_message_by_email {
     my $branch_email = undef;
     my $branch_replyto = undef;
     my $branch_returnpath = undef;
-    if ($member){
-        my $branchdetail = GetBranchDetail( $member->{'branchcode'} );
-        $branch_email = $branchdetail->{'branchemail'};
-        $branch_replyto = $branchdetail->{'branchreplyto'};
-        $branch_returnpath = $branchdetail->{'branchreturnpath'};
+    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(
@@ -1326,6 +1370,151 @@ sub _set_message_status {
     return $result;
 }
 
+sub _process_tt {
+    my ( $params ) = @_;
+
+    my $content = $params->{content};
+    my $tables = $params->{tables};
+
+    my $use_template_cache = C4::Context->config('template_cache_dir') && defined $ENV{GATEWAY_INTERFACE};
+    my $template           = Template->new(
+        {
+            EVAL_PERL    => 1,
+            ABSOLUTE     => 1,
+            PLUGIN_BASE  => 'Koha::Template::Plugin',
+            COMPILE_EXT  => $use_template_cache ? '.ttc' : '',
+            COMPILE_DIR  => $use_template_cache ? C4::Context->config('template_cache_dir') : '',
+            FILTERS      => {},
+            ENCODING     => 'UTF-8',
+        }
+    ) or die Template->error();
+
+    my $tt_params = _get_tt_params( $tables );
+
+    my $output;
+    $template->process( \$content, $tt_params, \$output ) || croak "ERROR PROCESSING TEMPLATE: " . $template->error();
+
+    return $output;
+}
+
+sub _get_tt_params {
+    my ($tables) = @_;
+
+    my $params;
+
+    my $config = {
+        biblio => {
+            module   => 'Koha::Biblios',
+            singular => 'biblio',
+            plural   => 'biblios',
+            pk       => 'biblionumber',
+        },
+        borrowers => {
+            module   => 'Koha::Patrons',
+            singular => 'borrower',
+            plural   => 'borrowers',
+            pk       => 'borrowernumber',
+        },
+        branches => {
+            module   => 'Koha::Libraries',
+            singular => 'branch',
+            plural   => 'branches',
+            pk       => 'branchcode',
+        },
+        items => {
+            module   => 'Koha::Items',
+            singular => 'item',
+            plural   => 'items',
+            pk       => 'itemnumber',
+        },
+        opac_news => {
+            module   => 'Koha::News',
+            singular => 'news',
+            plural   => 'news',
+            pk       => 'idnew',
+        },
+        reserves => {
+            module   => 'Koha::Holds',
+            singular => 'hold',
+            plural   => 'holds',
+            fk       => [ 'borrowernumber', 'biblionumber' ],
+        },
+        serial => {
+            module   => 'Koha::Serials',
+            singular => 'serial',
+            plural   => 'serials',
+            pk       => 'serialid',
+        },
+        subscription => {
+            module   => 'Koha::Subscriptions',
+            singular => 'subscription',
+            plural   => 'subscriptions',
+            pk       => 'subscriptionid',
+        },
+        suggestions => {
+            module   => 'Koha::Suggestions',
+            singular => 'suggestion',
+            plural   => 'suggestions',
+            pk       => 'suggestionid',
+        },
+        issues => {
+            module   => 'Koha::Checkouts',
+            singular => 'checkout',
+            plural   => 'checkouts',
+            fk       => 'itemnumber',
+        },
+        borrower_modifications => {
+            module   => 'Koha::Patron::Modifications',
+            singular => 'patron_modification',
+            plural   => 'patron_modifications',
+            fk       => 'verification_token',
+        },
+    };
+
+    foreach my $table ( keys %$tables ) {
+        next unless $config->{$table};
+
+        my $ref = ref( $tables->{$table} ) || q{};
+        my $module = $config->{$table}->{module};
+
+        if ( can_load( modules => { $module => undef } ) ) {
+            my $pk = $config->{$table}->{pk};
+            my $fk = $config->{$table}->{fk};
+
+            if ( $ref eq q{} || $ref eq 'HASH' ) {
+                my $id = ref $ref eq 'HASH' ? $tables->{$table}->{$pk} : $tables->{$table};
+                my $object;
+                if ( $fk ) { # Using a foreign key for lookup
+                    $object = $module->search( { $fk => $id } )->next();
+                } else { # using the table's primary key for lookup
+                    $object = $module->find($id);
+                }
+                $params->{ $config->{$table}->{singular} } = $object;
+            }
+            else {    # $ref eq 'ARRAY'
+                my $object;
+                if ( @{ $tables->{$table} } == 1 ) {    # Param is a single key
+                    $object = $module->search( { $pk => $tables->{$table} } )->next();
+                }
+                else {                                  # Params are mutliple foreign keys
+                    my @values = @{ $tables->{$table} };
+                    my @keys   = @{ $config->{$table}->{fk} };
+                    my %params = map { $_ => shift(@values) } @keys;
+                    $object = $module->search( \%params )->next();
+                }
+                $params->{ $config->{$table}->{singular} } = $object;
+            }
+        }
+        else {
+            croak "ERROR LOADING MODULE $module: $Module::Load::Conditional::ERROR";
+        }
+    }
+
+    $params->{today} = dt_from_string();
+
+    return $params;
+}
+
 
 1;
 __END__