Bug 8818: make sure we load modules before using them
[koha.git] / C4 / Letters.pm
index 89213fe..f646241 100644 (file)
@@ -31,6 +31,7 @@ use C4::SMS;
 use C4::Debug;
 use Date::Calc qw( Add_Delta_Days );
 use Encode;
+use Unicode::Normalize;
 use Carp;
 
 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
@@ -38,7 +39,7 @@ use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
 BEGIN {
        require Exporter;
        # set the version for version checking
-       $VERSION = 3.01;
+    $VERSION = 3.07.00.049;
        @ISA = qw(Exporter);
        @EXPORT = qw(
        &GetLetters &GetPreparedLetter &GetWrappedLetter &addalert &getalert &delalert &findrelatedto &SendAlerts &GetPrintMessages
@@ -93,7 +94,7 @@ $template->param(LETTERLOOP => \@letterloop);
 
 =cut
 
-sub GetLetters (;$) {
+sub GetLetters {
 
     # returns a reference to a hash of references to ALL letters...
     my $cat = shift;
@@ -116,11 +117,43 @@ sub GetLetters (;$) {
     return \%letters;
 }
 
+=head2 GetLetter( %params )
+
+    retrieves the letter template
+
+    %params hash:
+      module => letter module, mandatory
+      letter_code => letter code, mandatory
+      branchcode => for letter selection, if missing default system letter taken
+    Return value:
+      letter fields hashref (title & content useful)
+
+=cut
+
+sub GetLetter {
+    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 $letter = getletter( $module, $letter_code, $branchcode )
+        or warn( "No $module $letter_code letter"),
+            return;
+
+    return $letter;
+}
+
 my %letter;
-sub getletter ($$$) {
+sub getletter {
     my ( $module, $code, $branchcode ) = @_;
 
-    if (C4::Context->preference('IndependantBranches') && $branchcode){
+    $branchcode ||= '';
+
+    if ( C4::Context->preference('IndependantBranches')
+            and $branchcode
+            and C4::Context->userenv ) {
+
         $branchcode = C4::Context->userenv->{'branch'};
     }
 
@@ -149,7 +182,7 @@ sub getletter ($$$) {
 
 =cut
 
-sub addalert ($$$) {
+sub addalert {
     my ( $borrowernumber, $type, $externalid ) = @_;
     my $dbh = C4::Context->dbh;
     my $sth =
@@ -170,7 +203,7 @@ sub addalert ($$$) {
 
 =cut
 
-sub delalert ($) {
+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=?");
@@ -187,7 +220,7 @@ sub delalert ($) {
 
 =cut
 
-sub getalert (;$$$) {
+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";
@@ -224,16 +257,16 @@ sub getalert (;$$$) {
 # 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 undef;
-    my $externalid = shift or return undef;
+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 undef;
+        return;
     }
     my $sth = C4::Context->dbh->prepare($q);
     $sth->execute($externalid);
@@ -407,6 +440,8 @@ sub SendAlerts {
 
 =head2 GetPreparedLetter( %params )
 
+    retrieves letter template and performs substituion processing
+
     %params hash:
       module => letter module, mandatory
       letter_code => letter code, mandatory
@@ -434,14 +469,65 @@ sub GetPreparedLetter {
     my $module      = $params{module} or croak "No module";
     my $letter_code = $params{letter_code} or croak "No letter_code";
     my $branchcode  = $params{branchcode} || '';
+    my $tables = $params{tables};
+    my $substitute = $params{substitute};
+    my $repeat = $params{repeat};
 
     my $letter = getletter( $module, $letter_code, $branchcode )
         or warn( "No $module $letter_code letter"),
             return;
 
+    my $prepared_letter = GetProcessedLetter(
+        module => $module,
+        letter_code => $letter_code,
+        letter => $letter,
+        branchcode => $branchcode,
+        tables => $tables,
+        substitute => $substitute,
+        repeat => $repeat
+    );
+
+    return $prepared_letter;
+}
+
+=head2 GetProcessedLetter( %params )
+
+    given a letter, with possible pre-processing do standard processing
+    allows one to perform letter template processing beforehand
+
+    %params hash:
+      module => letter module, mandatory
+      letter_code => letter code, mandatory
+      letter => letter, mandatory
+      branchcode => for letter selection, if missing default system letter taken
+      tables => a hashref with table names as keys. Values are either:
+        - a scalar - primary key value
+        - an arrayref - primary key values
+        - a hashref - full record
+      substitute => custom substitution key/value pairs
+      repeat => records to be substituted on consecutive lines:
+        - an arrayref - tries to guess what needs substituting by
+          taking remaining << >> tokensr; not recommended
+        - a hashref token => @tables - replaces <token> << >> << >> </token>
+          subtemplate for each @tables row; table is a hashref as above
+      want_librarian => boolean,  if set to true triggers librarian details
+        substitution from the userenv
+    Return value:
+      letter fields hashref (title & content useful)
+
+=cut
+
+sub GetProcessedLetter {
+    my %params = @_;
+
+    my $module      = $params{module} or croak "No module";
+    my $letter_code = $params{letter_code} or croak "No letter_code";
+    my $letter = $params{letter} or croak "No letter";
+    my $branchcode  = $params{branchcode} || '';
     my $tables = $params{tables};
     my $substitute = $params{substitute};
     my $repeat = $params{repeat};
+
     $tables || $substitute || $repeat
       or carp( "ERROR: nothing to substitute - both 'tables' and 'substitute' are empty" ),
          return;
@@ -552,17 +638,18 @@ sub _parseletter_sth {
     # check cache first
     (defined $handles{$table}) and return $handles{$table};
     my $query = 
-    ($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 '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   suggestionid = ?"                      :
-    ($table eq 'aqbooksellers') ? "SELECT * FROM $table WHERE             id = ?"                      :
-    ($table eq 'aqorders'     ) ? "SELECT * FROM $table WHERE    ordernumber = ?"                      :
-    ($table eq 'opac_news'    ) ? "SELECT * FROM $table WHERE          idnew = ?"                      :
+    ($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 'issues'       ) ? "SELECT * FROM $table WHERE     itemnumber = ?"                                 :
+    ($table eq 'old_issues'   ) ? "SELECT * FROM $table WHERE     itemnumber = ? ORDER BY timestamp DESC LIMIT 1" :
+    ($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   suggestionid = ?"                                 :
+    ($table eq 'aqbooksellers') ? "SELECT * FROM $table WHERE             id = ?"                                 :
+    ($table eq 'aqorders'     ) ? "SELECT * FROM $table WHERE    ordernumber = ?"                                 :
+    ($table eq 'opac_news'    ) ? "SELECT * FROM $table WHERE          idnew = ?"                                 :
     undef ;
     unless ($query) {
         warn "ERROR: No _parseletter_sth query for table '$table'";
@@ -661,17 +748,30 @@ places a letter in the message_queue database table, which will
 eventually get processed (sent) by the process_message_queue.pl
 cronjob when it calls SendQueuedMessages.
 
-return true on success
+return message_id on success
 
 =cut
 
-sub EnqueueLetter ($) {
-    my $params = shift or return undef;
+sub EnqueueLetter {
+    my $params = shift or return;
 
     return unless exists $params->{'letter'};
     return unless exists $params->{'borrowernumber'};
     return unless exists $params->{'message_transport_type'};
 
+    my $content = $params->{letter}->{content};
+    $content =~ s/\s+//g if(defined $content);
+    if ( not defined $content or $content eq '' ) {
+        warn "Trying to add an empty message to the message queue" if $debug;
+        return;
+    }
+
+    # It was found that the some utf8 codes, cause the text to be truncated from that point onward when stored,
+    # so we normalize utf8 with NFC so that mysql will store 'all' of the content in its TEXT column type
+    # Note: It is also done in _add_attachments accordingly.
+    $params->{'letter'}->{'title'} = NFC($params->{'letter'}->{'title'});     # subject
+    $params->{'letter'}->{'content'} = NFC($params->{'letter'}->{'content'});
+
     # If we have any attachments we should encode then into the body.
     if ( $params->{'attachments'} ) {
         $params->{'letter'} = _add_attachments(
@@ -703,7 +803,7 @@ ENDSQL
         $params->{'from_address'},                # from_address
         $params->{'letter'}->{'content-type'},    # content_type
     );
-    return $result;
+    return $dbh->last_insert_id(undef,undef,'message_queue', undef);
 }
 
 =head2 SendQueuedMessages ([$hashref]) 
@@ -716,7 +816,7 @@ returns number of messages sent.
 
 =cut
 
-sub SendQueuedMessages (;$) {
+sub SendQueuedMessages {
     my $params = shift;
 
     my $unsent_messages = _get_unsent_messages();
@@ -771,7 +871,8 @@ sub GetPrintMessages {
     my $params = shift || {};
     
     return _get_unsent_messages( { message_transport_type => 'print',
-                                   borrowernumber         => $params->{'borrowernumber'}, } );
+                                   borrowernumber         => $params->{'borrowernumber'},
+                                 } );
 }
 
 =head2 GetQueuedMessages ([$hashref])
@@ -841,11 +942,17 @@ sub _add_attachments {
     $message->attach(
         Type => $letter->{'content-type'} || 'TEXT',
         Data => $letter->{'is_html'}
-            ? _wrap_html($letter->{'content'}, $letter->{'title'})
-            : $letter->{'content'},
+            ? _wrap_html($letter->{'content'}, NFC($letter->{'title'}))
+            : NFC($letter->{'content'}),
     );
 
     foreach my $attachment ( @$attachments ) {
+
+        if ($attachment->{'content'} =~ m/text/o) { # NFC normailze any "text" related  content-type attachments
+            $attachment->{'content'} = NFC($attachment->{'content'});
+        }
+        $attachment->{'filename'} = NFC($attachment->{'filename'});
+
         $message->attach(
             Type     => $attachment->{'type'},
             Data     => $attachment->{'content'},
@@ -861,13 +968,14 @@ sub _add_attachments {
 
 }
 
-sub _get_unsent_messages (;$) {
+sub _get_unsent_messages {
     my $params = shift;
 
     my $dbh = C4::Context->dbh();
     my $statement = << 'ENDSQL';
-SELECT message_id, borrowernumber, subject, content, message_transport_type, status, time_queued, from_address, to_address, content_type
-  FROM message_queue
+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
+  FROM message_queue mq
+  LEFT JOIN borrowers b ON b.borrowernumber = mq.borrowernumber
  WHERE status = ?
 ENDSQL
 
@@ -886,6 +994,7 @@ ENDSQL
             push @query_params, $params->{'limit'};
         }
     }
+
     $debug and warn "_get_unsent_messages SQL: $statement";
     $debug and warn "_get_unsent_messages params: " . join(',',@query_params);
     my $sth = $dbh->prepare( $statement );
@@ -893,7 +1002,7 @@ ENDSQL
     return $sth->fetchall_arrayref({});
 }
 
-sub _send_message_by_email ($;$$$) {
+sub _send_message_by_email {
     my $message = shift or return;
     my ($username, $password, $method) = @_;
 
@@ -975,8 +1084,8 @@ $content
 EOS
 }
 
-sub _send_message_by_sms ($) {
-    my $message = shift or return undef;
+sub _send_message_by_sms {
+    my $message = shift or return;
     my $member = C4::Members::GetMember( 'borrowernumber' => $message->{'borrowernumber'} );
     return unless $member->{'smsalertnumber'};
 
@@ -994,11 +1103,11 @@ sub _update_message_to_address {
     $dbh->do('UPDATE message_queue SET to_address=? WHERE message_id=?',undef,($to,$id));
 }
 
-sub _set_message_status ($) {
-    my $params = shift or return undef;
+sub _set_message_status {
+    my $params = shift or return;
 
     foreach my $required_parameter ( qw( message_id status ) ) {
-        return undef unless exists $params->{ $required_parameter };
+        return unless exists $params->{ $required_parameter };
     }
 
     my $dbh = C4::Context->dbh();