C4/Letters.pm

   1 package C4::Letters;
   2
   3 # Copyright 2000-2002 Katipo Communications
   4 #
   5 # This file is part of Koha.
   6 #
   7 # Koha is free software; you can redistribute it and/or modify it under the
   8 # terms of the GNU General Public License as published by the Free Software
   9 # Foundation; either version 2 of the License, or (at your option) any later
  10 # version.
  11 #
  12 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
  13 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
  14 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
  15 #
  16 # You should have received a copy of the GNU General Public License along
  17 # with Koha; if not, write to the Free Software Foundation, Inc.,
  18 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
  19
  20 use strict;
  21 use warnings;
  22
  23 use MIME::Lite;
  24 use Mail::Sendmail;
  25 use Encode;
  26 use Carp;
  27
  28 use C4::Members;
  29 use C4::Branch;
  30 use C4::Log;
  31 use C4::SMS;
  32 use C4::Debug;
  33 use Date::Calc qw( Add_Delta_Days );
  34 use Encode;
  35 use Carp;
  36
  37 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
  38
  39 BEGIN {
  40         require Exporter;
  41         # set the version for version checking
  42         $VERSION = 3.01;
  43         @ISA = qw(Exporter);
  44         @EXPORT = qw(
  45         &GetLetters &getletter &addalert &getalert &delalert &findrelatedto &SendAlerts GetPrintMessages
  46         );
  47 }
  48
  49 =head1 NAME
  50
  51 C4::Letters - Give functions for Letters management
  52
  53 =head1 SYNOPSIS
  54
  55   use C4::Letters;
  56
  57 =head1 DESCRIPTION
  58
  59   "Letters" is the tool used in Koha to manage informations sent to the patrons and/or the library. This include some cron jobs like
  60   late issues, as well as other tasks like sending a mail to users that have subscribed to a "serial issue alert" (= being warned every time a new issue has arrived at the library)
  61
  62   Letters are managed through "alerts" sent by Koha on some events. All "alert" related functions are in this module too.
  63
  64 =head2 GetLetters([$category])
  65
  66   $letters = &GetLetters($category);
  67   returns informations about letters.
  68   if needed, $category filters for letters given category
  69   Create a letter selector with the following code
  70
  71 =head3 in PERL SCRIPT
  72
  73 my $letters = GetLetters($cat);
  74 my @letterloop;
  75 foreach my $thisletter (keys %$letters) {
  76     my $selected = 1 if $thisletter eq $letter;
  77     my %row =(
  78         value => $thisletter,
  79         selected => $selected,
  80         lettername => $letters->{$thisletter},
  81     );
  82     push @letterloop, \%row;
  83 }
  84 $template->param(LETTERLOOP => \@letterloop);
  85
  86 =head3 in TEMPLATE
  87
  88     <select name="letter">
  89         <option value="">Default</option>
  90     <!-- TMPL_LOOP name="LETTERLOOP" -->
  91         <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="lettername" --></option>
  92     <!-- /TMPL_LOOP -->
  93     </select>
  94
  95 =cut
  96
  97 sub GetLetters (;$) {
  98
  99     # returns a reference to a hash of references to ALL letters...
 100     my $cat = shift;
 101     my %letters;
 102     my $dbh = C4::Context->dbh;
 103     my $sth;
 104     if (defined $cat) {
 105         my $query = "SELECT * FROM letter WHERE module = ? ORDER BY name";
 106         $sth = $dbh->prepare($query);
 107         $sth->execute($cat);
 108     }
 109     else {
 110         my $query = "SELECT * FROM letter ORDER BY name";
 111         $sth = $dbh->prepare($query);
 112         $sth->execute;
 113     }
 114     while ( my $letter = $sth->fetchrow_hashref ) {
 115         $letters{ $letter->{'code'} } = $letter->{'name'};
 116     }
 117     return \%letters;
 118 }
 119
 120 sub getletter ($$) {
 121     my ( $module, $code ) = @_;
 122     my $dbh = C4::Context->dbh;
 123     my $sth = $dbh->prepare("select * from letter where module=? and code=?");
 124     $sth->execute( $module, $code );
 125     my $line = $sth->fetchrow_hashref;
 126     return $line;
 127 }
 128
 129 =head2 addalert ($borrowernumber, $type, $externalid)
 130
 131     parameters :
 132     - $borrowernumber : the number of the borrower subscribing to the alert
 133     - $type : the type of alert.
 134     - $externalid : the primary key of the object to put alert on. For issues, the alert is made on subscriptionid.
 135
 136     create an alert and return the alertid (primary key)
 137
 138 =cut
 139
 140 sub addalert ($$$) {
 141     my ( $borrowernumber, $type, $externalid ) = @_;
 142     my $dbh = C4::Context->dbh;
 143     my $sth =
 144       $dbh->prepare(
 145         "insert into alert (borrowernumber, type, externalid) values (?,?,?)");
 146     $sth->execute( $borrowernumber, $type, $externalid );
 147
 148     # get the alert number newly created and return it
 149     my $alertid = $dbh->{'mysql_insertid'};
 150     return $alertid;
 151 }
 152
 153 =head2 delalert ($alertid)
 154
 155     parameters :
 156     - alertid : the alert id
 157     deletes the alert
 158
 159 =cut
 160
 161 sub delalert ($) {
 162     my $alertid = shift or die "delalert() called without valid argument (alertid)";    # it's gonna die anyway.
 163     $debug and warn "delalert: deleting alertid $alertid";
 164     my $sth = C4::Context->dbh->prepare("delete from alert where alertid=?");
 165     $sth->execute($alertid);
 166 }
 167
 168 =head2 getalert ([$borrowernumber], [$type], [$externalid])
 169
 170     parameters :
 171     - $borrowernumber : the number of the borrower subscribing to the alert
 172     - $type : the type of alert.
 173     - $externalid : the primary key of the object to put alert on. For issues, the alert is made on subscriptionid.
 174     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.
 175
 176 =cut
 177
 178 sub getalert (;$$$) {
 179     my ( $borrowernumber, $type, $externalid ) = @_;
 180     my $dbh   = C4::Context->dbh;
 181     my $query = "SELECT * FROM alert WHERE";
 182     my @bind;
 183     if ($borrowernumber and $borrowernumber =~ /^\d+$/) {
 184         $query .= " borrowernumber=? AND ";
 185         push @bind, $borrowernumber;
 186     }
 187     if ($type) {
 188         $query .= " type=? AND ";
 189         push @bind, $type;
 190     }
 191     if ($externalid) {
 192         $query .= " externalid=? AND ";
 193         push @bind, $externalid;
 194     }
 195     $query =~ s/ AND $//;
 196     my $sth = $dbh->prepare($query);
 197     $sth->execute(@bind);
 198     return $sth->fetchall_arrayref({});
 199 }
 200
 201 =head2 findrelatedto($type, $externalid)
 202
 203         parameters :
 204         - $type : the type of alert
 205         - $externalid : the id of the "object" to query
 206
 207         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.
 208         When type=issue, the id is related to a subscriptionid and this sub returns the name of the biblio.
 209
 210 =cut
 211
 212 # outmoded POD:
 213 # When type=virtual, the id is related to a virtual shelf and this sub returns the name of the sub
 214
 215 sub findrelatedto ($$) {
 216     my $type       = shift or return undef;
 217     my $externalid = shift or return undef;
 218     my $q = ($type eq 'issue'   ) ?
 219 "select title as result from subscription left join biblio on subscription.biblionumber=biblio.biblionumber where subscriptionid=?" :
 220             ($type eq 'borrower') ?
 221 "select concat(firstname,' ',surname) from borrowers where borrowernumber=?" : undef;
 222     unless ($q) {
 223         warn "findrelatedto(): Illegal type '$type'";
 224         return undef;
 225     }
 226     my $sth = C4::Context->dbh->prepare($q);
 227     $sth->execute($externalid);
 228     my ($result) = $sth->fetchrow;
 229     return $result;
 230 }
 231
 232 =head2 SendAlerts
 233
 234     parameters :
 235     - $type : the type of alert
 236     - $externalid : the id of the "object" to query
 237     - $letter : the letter to send.
 238
 239     send an alert to all borrowers having put an alert on a given subject.
 240
 241 =cut
 242
 243 sub SendAlerts {
 244     my ( $type, $externalid, $letter ) = @_;
 245     my $dbh = C4::Context->dbh;
 246     my $strsth;
 247     if ( $type eq 'issue' ) {
 248
 249         #               warn "sending issues...";
 250         my $letter = getletter( 'serial', $letter );
 251
 252         # prepare the letter...
 253         # search the biblionumber
 254         my $sth =
 255           $dbh->prepare(
 256             "SELECT biblionumber FROM subscription WHERE subscriptionid=?");
 257         $sth->execute($externalid);
 258         my ($biblionumber) = $sth->fetchrow;
 259
 260         # parsing branch info
 261         my $userenv = C4::Context->userenv;
 262         parseletter( $letter, 'branches', $userenv->{branch} );
 263
 264         # parsing librarian name
 265         $letter->{content} =~ s/<<LibrarianFirstname>>/$userenv->{firstname}/g;
 266         $letter->{content} =~ s/<<LibrarianSurname>>/$userenv->{surname}/g;
 267         $letter->{content} =~
 268           s/<<LibrarianEmailaddress>>/$userenv->{emailaddress}/g;
 269
 270         # parsing biblio information
 271         parseletter( $letter, 'biblio',      $biblionumber );
 272         parseletter( $letter, 'biblioitems', $biblionumber );
 273
 274         # find the list of borrowers to alert
 275         my $alerts = getalert( '', 'issue', $externalid );
 276         foreach (@$alerts) {
 277
 278             # and parse borrower ...
 279             my $innerletter = $letter;
 280             my $borinfo = C4::Members::GetMember('borrowernumber' => $_->{'borrowernumber'});
 281             parseletter( $innerletter, 'borrowers', $_->{'borrowernumber'} );
 282
 283             # ... then send mail
 284             if ( $borinfo->{email} ) {
 285                 my %mail = (
 286                     To      => $borinfo->{email},
 287                     From    => $borinfo->{email},
 288                     Subject => "" . $innerletter->{title},
 289                     Message => "" . $innerletter->{content},
 290                     'Content-Type' => 'text/plain; charset="utf8"',
 291                     );
 292                 sendmail(%mail) or carp $Mail::Sendmail::error;
 293
 294             }
 295         }
 296     }
 297     elsif ( $type eq 'claimacquisition' ) {
 298
 299         $letter = getletter( 'claimacquisition', $letter );
 300
 301         # prepare the letter...
 302         # search the biblionumber
 303         $strsth = qq{
 304             SELECT aqorders.*,aqbasket.*,biblio.*,biblioitems.*,aqbooksellers.*
 305             FROM aqorders
 306             LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno
 307             LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
 308             LEFT JOIN biblioitems ON aqorders.biblioitemnumber=biblioitems.biblioitemnumber
 309             LEFT JOIN aqbooksellers ON aqbasket.booksellerid=aqbooksellers.id
 310             WHERE aqorders.ordernumber IN (
 311         }
 312           . join( ",", @$externalid ) . ")";
 313     }
 314     elsif ( $type eq 'claimissues' ) {
 315
 316         $letter = getletter( 'claimissues', $letter );
 317
 318         # prepare the letter...
 319         # search the biblionumber
 320         $strsth = qq{
 321             SELECT serial.*,subscription.*, biblio.*, aqbooksellers.*
 322             FROM serial
 323             LEFT JOIN subscription ON serial.subscriptionid=subscription.subscriptionid
 324             LEFT JOIN biblio ON serial.biblionumber=biblio.biblionumber
 325             LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id
 326             WHERE serial.serialid IN (
 327         }
 328           . join( ",", @$externalid ) . ")";
 329     }
 330
 331     if ( $type eq 'claimacquisition' or $type eq 'claimissues' ) {
 332         my $sthorders = $dbh->prepare($strsth);
 333         $sthorders->execute;
 334         my @fields = map {
 335             $sthorders->{mysql_table}[$_] . "." . $sthorders->{NAME}[$_] }
 336             (0 .. $#{$sthorders->{NAME}} ) ;
 337
 338         my @orders_infos;
 339         while ( my $row = $sthorders->fetchrow_arrayref() ) {
 340             my %rec = ();
 341             @rec{@fields} = @$row;
 342             push @orders_infos, \%rec;
 343         }
 344
 345         # parsing branch info
 346         my $userenv = C4::Context->userenv;
 347         parseletter( $letter, 'branches', $userenv->{branch} );
 348
 349         # parsing librarian name
 350         $letter->{content} =~ s/<<LibrarianFirstname>>/$userenv->{firstname}/g;
 351         $letter->{content} =~ s/<<LibrarianSurname>>/$userenv->{surname}/g;
 352         $letter->{content} =~ s/<<LibrarianEmailaddress>>/$userenv->{emailaddress}/g;
 353
 354         # Get Fields remplacement
 355         my $order_format = $1 if ( $letter->{content} =~ m/(<order>.*<\/order>)/xms );
 356
 357         # Foreach field to remplace
 358         while ( $letter->{content} =~ m/<<([^>]*)>>/g ) {
 359             my $field = $1;
 360             my $value = $orders_infos[0]->{$field} || "";
 361             $value = sprintf("%.2f", $value) if $field =~ /price/;
 362             $letter->{content} =~ s/<<$field>>/$value/g;
 363         }
 364
 365         if ( $order_format ) {
 366             # For each order
 367             foreach my $infos ( @orders_infos ) {
 368                 my $order_content = $order_format;
 369                 # We replace by value
 370                 while ( $order_content =~ m/<<([^>]*)>>/g ) {
 371                     my $field = $1;
 372                     my $value = $infos->{$field} || "";
 373                     $value = sprintf("%.2f", $value) if $field =~ /price/;
 374                     $order_content =~ s/(<<$field>>)/$value/g;
 375                 }
 376                 $order_content =~ s/<\/{0,1}?order>//g;
 377                 $letter->{content} =~ s/<order>.*<\/order>/$order_content\n$order_format/xms;
 378             }
 379             $letter->{content} =~ s/<order>.*<\/order>//xms;
 380         }
 381
 382         my $innerletter = $letter;
 383
 384         # ... then send mail
 385         if (   $orders_infos[0]->{'aqbooksellers.bookselleremail'}
 386             || $orders_infos[0]->{'aqbooksellers.contemail'} ) {
 387             my $to = $orders_infos[0]->{'aqbooksellers.bookselleremail'};
 388             $to .= ", " if $to;
 389             $to .= $orders_infos[0]->{'aqbooksellers.contemail'} || "";
 390             my %mail = (
 391                 To             => $to,
 392                 From           => $userenv->{emailaddress},
 393                 Subject        => "" . $innerletter->{title},
 394                 Message        => "" . $innerletter->{content},
 395                 'Content-Type' => 'text/plain; charset="utf8"',
 396             );
 397             sendmail(%mail) or carp $Mail::Sendmail::error;
 398             warn "sending to $mail{To} From $mail{From} subj $mail{Subject} Mess $mail{Message}";
 399             if ( C4::Context->preference("LetterLog") ) {
 400                 logaction( "ACQUISITION", "Send Acquisition claim letter", "", "order list : " . join( ",", @$externalid ) . "\n$innerletter->{title}\n$innerletter->{content}" ) if $type eq 'claimacquisition';
 401                 logaction( "ACQUISITION", "CLAIM ISSUE", undef, "To=" . $mail{To} . " Title=" . $innerletter->{title} . " Content=" . $innerletter->{content} ) if $type eq 'claimissues';
 402             }
 403         } else {
 404             die "This bookseller has no email\n";
 405         }
 406
 407         warn "sending to From $userenv->{emailaddress} subj $innerletter->{title} Mess $innerletter->{content}";
 408     }
 409
 410     # send an "account details" notice to a newly created user
 411     elsif ( $type eq 'members' ) {
 412         # must parse the password special, before it's hashed.
 413         $letter->{content} =~ s/<<borrowers.password>>/$externalid->{'password'}/g;
 414
 415         parseletter( $letter, 'borrowers', $externalid->{'borrowernumber'});
 416         parseletter( $letter, 'branches', $externalid->{'branchcode'} );
 417
 418         my $branchdetails = GetBranchDetail($externalid->{'branchcode'});
 419         my %mail = (
 420                 To      =>     $externalid->{'emailaddr'},
 421                 From    =>  $branchdetails->{'branchemail'} || C4::Context->preference("KohaAdminEmailAddress"),
 422                 Subject => $letter->{'title'},
 423                 Message => $letter->{'content'},
 424                 'Content-Type' => 'text/plain; charset="utf8"',
 425         );
 426         sendmail(%mail) or carp $Mail::Sendmail::error;
 427     }
 428 }
 429
 430 =head2 parseletter($letter, $table, $pk)
 431
 432     parameters :
 433     - $letter : a hash to letter fields (title & content useful)
 434     - $table : the Koha table to parse.
 435     - $pk : the primary key to query on the $table table
 436     parse all fields from a table, and replace values in title & content with the appropriate value
 437     (not exported sub, used only internally)
 438
 439 =cut
 440
 441 our %handles = ();
 442 our %columns = ();
 443
 444 sub parseletter_sth {
 445     my $table = shift;
 446     unless ($table) {
 447         carp "ERROR: parseletter_sth() called without argument (table)";
 448         return;
 449     }
 450     # check cache first
 451     (defined $handles{$table}) and return $handles{$table};
 452     my $query =
 453     ($table eq 'biblio'       ) ? "SELECT * FROM $table WHERE   biblionumber = ?"                      :
 454     ($table eq 'biblioitems'  ) ? "SELECT * FROM $table WHERE   biblionumber = ?"                      :
 455     ($table eq 'items'        ) ? "SELECT * FROM $table WHERE     itemnumber = ?"                      :
 456     ($table eq 'issues'       ) ? "SELECT * FROM $table WHERE     itemnumber = ?"                      :
 457     ($table eq 'reserves'     ) ? "SELECT * FROM $table WHERE borrowernumber = ? and biblionumber = ?" :
 458     ($table eq 'borrowers'    ) ? "SELECT * FROM $table WHERE borrowernumber = ?"                      :
 459     ($table eq 'branches'     ) ? "SELECT * FROM $table WHERE     branchcode = ?"                      :
 460     ($table eq 'suggestions'  ) ? "SELECT * FROM $table WHERE   suggestionid = ?"                      :
 461     ($table eq 'aqbooksellers') ? "SELECT * FROM $table WHERE             id = ?"                      : undef ;
 462     unless ($query) {
 463         warn "ERROR: No parseletter_sth query for table '$table'";
 464         return;     # nothing to get
 465     }
 466     unless ($handles{$table} = C4::Context->dbh->prepare($query)) {
 467         warn "ERROR: Failed to prepare query: '$query'";
 468         return;
 469     }
 470     return $handles{$table};    # now cache is populated for that $table
 471 }
 472
 473 sub parseletter {
 474     my ( $letter, $table, $pk, $pk2 ) = @_;
 475     unless ($letter) {
 476         carp "ERROR: parseletter() 1st argument 'letter' empty";
 477         return;
 478     }
 479     my $sth = parseletter_sth($table);
 480     unless ($sth) {
 481         warn "parseletter_sth('$table') failed to return a valid sth.  No substitution will be done for that table.";
 482         return;
 483     }
 484     if ( $pk2 ) {
 485         $sth->execute($pk, $pk2);
 486     } else {
 487         $sth->execute($pk);
 488     }
 489
 490     my $values = $sth->fetchrow_hashref;
 491
 492     # TEMPORARY hack until the expirationdate column is added to reserves
 493     if ( $table eq 'reserves' && $values->{'waitingdate'} ) {
 494         my @waitingdate = split /-/, $values->{'waitingdate'};
 495
 496         $values->{'expirationdate'} = C4::Dates->new(
 497             sprintf(
 498                 '%04d-%02d-%02d',
 499                 Add_Delta_Days( @waitingdate, C4::Context->preference( 'ReservesMaxPickUpDelay' ) )
 500             ),
 501             'iso'
 502         )->output();
 503     }
 504
 505
 506     # and get all fields from the table
 507     my $columns = C4::Context->dbh->prepare("SHOW COLUMNS FROM $table");
 508     $columns->execute;
 509     while ( ( my $field ) = $columns->fetchrow_array ) {
 510         my $replacefield = "<<$table.$field>>";
 511         $values->{$field} =~ s/\p{P}(?=$)//g if $values->{$field};
 512         my $replacedby   = $values->{$field} || '';
 513         ($letter->{title}  ) and $letter->{title}   =~ s/$replacefield/$replacedby/g;
 514         ($letter->{content}) and $letter->{content} =~ s/$replacefield/$replacedby/g;
 515     }
 516     return $letter;
 517 }
 518
 519 =head2 EnqueueLetter
 520
 521   my $success = EnqueueLetter( { letter => $letter,
 522         borrowernumber => '12', message_transport_type => 'email' } )
 523
 524 places a letter in the message_queue database table, which will
 525 eventually get processed (sent) by the process_message_queue.pl
 526 cronjob when it calls SendQueuedMessages.
 527
 528 return true on success
 529
 530 =cut
 531
 532 sub EnqueueLetter ($) {
 533     my $params = shift or return undef;
 534
 535     return unless exists $params->{'letter'};
 536     return unless exists $params->{'borrowernumber'};
 537     return unless exists $params->{'message_transport_type'};
 538
 539     # If we have any attachments we should encode then into the body.
 540     if ( $params->{'attachments'} ) {
 541         $params->{'letter'} = _add_attachments(
 542             {   letter      => $params->{'letter'},
 543                 attachments => $params->{'attachments'},
 544                 message     => MIME::Lite->new( Type => 'multipart/mixed' ),
 545             }
 546         );
 547     }
 548
 549     my $dbh       = C4::Context->dbh();
 550     my $statement = << 'ENDSQL';
 551 INSERT INTO message_queue
 552 ( borrowernumber, subject, content, metadata, letter_code, message_transport_type, status, time_queued, to_address, from_address, content_type )
 553 VALUES
 554 ( ?,              ?,       ?,       ?,        ?,           ?,                      ?,      NOW(),       ?,          ?,            ? )
 555 ENDSQL
 556
 557     my $sth    = $dbh->prepare($statement);
 558     my $result = $sth->execute(
 559         $params->{'borrowernumber'},              # borrowernumber
 560         $params->{'letter'}->{'title'},           # subject
 561         $params->{'letter'}->{'content'},         # content
 562         $params->{'letter'}->{'metadata'} || '',  # metadata
 563         $params->{'letter'}->{'code'}     || '',  # letter_code
 564         $params->{'message_transport_type'},      # message_transport_type
 565         'pending',                                # status
 566         $params->{'to_address'},                  # to_address
 567         $params->{'from_address'},                # from_address
 568         $params->{'letter'}->{'content-type'},    # content_type
 569     );
 570     return $result;
 571 }
 572
 573 =head2 SendQueuedMessages ([$hashref])
 574
 575   my $sent = SendQueuedMessages( { verbose => 1 } );
 576
 577 sends all of the 'pending' items in the message queue.
 578
 579 returns number of messages sent.
 580
 581 =cut
 582
 583 sub SendQueuedMessages (;$) {
 584     my $params = shift;
 585
 586     my $unsent_messages = _get_unsent_messages();
 587     MESSAGE: foreach my $message ( @$unsent_messages ) {
 588         # warn Data::Dumper->Dump( [ $message ], [ 'message' ] );
 589         warn sprintf( 'sending %s message to patron: %s',
 590                       $message->{'message_transport_type'},
 591                       $message->{'borrowernumber'} || 'Admin' )
 592           if $params->{'verbose'} or $debug;
 593         # This is just begging for subclassing
 594         next MESSAGE if ( lc($message->{'message_transport_type'}) eq 'rss' );
 595         if ( lc( $message->{'message_transport_type'} ) eq 'email' ) {
 596             _send_message_by_email( $message, $params->{'username'}, $params->{'password'}, $params->{'method'} );
 597         }
 598         elsif ( lc( $message->{'message_transport_type'} ) eq 'sms' ) {
 599             _send_message_by_sms( $message );
 600         }
 601     }
 602     return scalar( @$unsent_messages );
 603 }
 604
 605 =head2 GetRSSMessages
 606
 607   my $message_list = GetRSSMessages( { limit => 10, borrowernumber => '14' } )
 608
 609 returns a listref of all queued RSS messages for a particular person.
 610
 611 =cut
 612
 613 sub GetRSSMessages {
 614     my $params = shift;
 615
 616     return unless $params;
 617     return unless ref $params;
 618     return unless $params->{'borrowernumber'};
 619
 620     return _get_unsent_messages( { message_transport_type => 'rss',
 621                                    limit                  => $params->{'limit'},
 622                                    borrowernumber         => $params->{'borrowernumber'}, } );
 623 }
 624
 625 =head2 GetPrintMessages
 626
 627   my $message_list = GetPrintMessages( { borrowernumber => $borrowernumber } )
 628
 629 Returns a arrayref of all queued print messages (optionally, for a particular
 630 person).
 631
 632 =cut
 633
 634 sub GetPrintMessages {
 635     my $params = shift || {};
 636
 637     return _get_unsent_messages( { message_transport_type => 'print',
 638                                    borrowernumber         => $params->{'borrowernumber'}, } );
 639 }
 640
 641 =head2 GetQueuedMessages ([$hashref])
 642
 643   my $messages = GetQueuedMessage( { borrowernumber => '123', limit => 20 } );
 644
 645 fetches messages out of the message queue.
 646
 647 returns:
 648 list of hashes, each has represents a message in the message queue.
 649
 650 =cut
 651
 652 sub GetQueuedMessages {
 653     my $params = shift;
 654
 655     my $dbh = C4::Context->dbh();
 656     my $statement = << 'ENDSQL';
 657 SELECT message_id, borrowernumber, subject, content, message_transport_type, status, time_queued
 658 FROM message_queue
 659 ENDSQL
 660
 661     my @query_params;
 662     my @whereclauses;
 663     if ( exists $params->{'borrowernumber'} ) {
 664         push @whereclauses, ' borrowernumber = ? ';
 665         push @query_params, $params->{'borrowernumber'};
 666     }
 667
 668     if ( @whereclauses ) {
 669         $statement .= ' WHERE ' . join( 'AND', @whereclauses );
 670     }
 671
 672     if ( defined $params->{'limit'} ) {
 673         $statement .= ' LIMIT ? ';
 674         push @query_params, $params->{'limit'};
 675     }
 676
 677     my $sth = $dbh->prepare( $statement );
 678     my $result = $sth->execute( @query_params );
 679     return $sth->fetchall_arrayref({});
 680 }
 681
 682 =head2 _add_attachements
 683
 684 named parameters:
 685 letter - the standard letter hashref
 686 attachments - listref of attachments. each attachment is a hashref of:
 687   type - the mime type, like 'text/plain'
 688   content - the actual attachment
 689   filename - the name of the attachment.
 690 message - a MIME::Lite object to attach these to.
 691
 692 returns your letter object, with the content updated.
 693
 694 =cut
 695
 696 sub _add_attachments {
 697     my $params = shift;
 698
 699     return unless 'HASH' eq ref $params;
 700     foreach my $required_parameter (qw( letter attachments message )) {
 701         return unless exists $params->{$required_parameter};
 702     }
 703     return $params->{'letter'} unless @{ $params->{'attachments'} };
 704
 705     # First, we have to put the body in as the first attachment
 706     $params->{'message'}->attach(
 707         Type => 'TEXT',
 708         Data => $params->{'letter'}->{'content'},
 709     );
 710
 711     foreach my $attachment ( @{ $params->{'attachments'} } ) {
 712         $params->{'message'}->attach(
 713             Type     => $attachment->{'type'},
 714             Data     => $attachment->{'content'},
 715             Filename => $attachment->{'filename'},
 716         );
 717     }
 718     # we're forcing list context here to get the header, not the count back from grep.
 719     ( $params->{'letter'}->{'content-type'} ) = grep( /^Content-Type:/, split( /\n/, $params->{'message'}->header_as_string ) );
 720     $params->{'letter'}->{'content-type'} =~ s/^Content-Type:\s+//;
 721     $params->{'letter'}->{'content'} = $params->{'message'}->body_as_string;
 722
 723     return $params->{'letter'};
 724
 725 }
 726
 727 sub _get_unsent_messages (;$) {
 728     my $params = shift;
 729
 730     my $dbh = C4::Context->dbh();
 731     my $statement = << 'ENDSQL';
 732 SELECT message_id, borrowernumber, subject, content, message_transport_type, status, time_queued, from_address, to_address, content_type
 733   FROM message_queue
 734  WHERE status = ?
 735 ENDSQL
 736
 737     my @query_params = ('pending');
 738     if ( ref $params ) {
 739         if ( $params->{'message_transport_type'} ) {
 740             $statement .= ' AND message_transport_type = ? ';
 741             push @query_params, $params->{'message_transport_type'};
 742         }
 743         if ( $params->{'borrowernumber'} ) {
 744             $statement .= ' AND borrowernumber = ? ';
 745             push @query_params, $params->{'borrowernumber'};
 746         }
 747         if ( $params->{'limit'} ) {
 748             $statement .= ' limit ? ';
 749             push @query_params, $params->{'limit'};
 750         }
 751     }
 752     $debug and warn "_get_unsent_messages SQL: $statement";
 753     $debug and warn "_get_unsent_messages params: " . join(',',@query_params);
 754     my $sth = $dbh->prepare( $statement );
 755     my $result = $sth->execute( @query_params );
 756     return $sth->fetchall_arrayref({});
 757 }
 758
 759 sub _send_message_by_email ($;$$$) {
 760     my $message = shift or return;
 761     my ($username, $password, $method) = @_;
 762
 763     my $to_address = $message->{to_address};
 764     unless ($to_address) {
 765         my $member = C4::Members::GetMember( 'borrowernumber' => $message->{'borrowernumber'} );
 766         unless ($member) {
 767             warn "FAIL: No 'to_address' and INVALID borrowernumber ($message->{borrowernumber})";
 768             _set_message_status( { message_id => $message->{'message_id'},
 769                                    status     => 'failed' } );
 770             return;
 771         }
 772         my $which_address = C4::Context->preference('AutoEmailPrimaryAddress');
 773         # If the system preference is set to 'first valid' (value == OFF), look up email address
 774         if ($which_address eq 'OFF') {
 775             $to_address = GetFirstValidEmailAddress( $message->{'borrowernumber'} );
 776         } else {
 777             $to_address = $member->{$which_address};
 778         }
 779         unless ($to_address) {
 780             # warn "FAIL: No 'to_address' and no email for " . ($member->{surname} ||'') . ", borrowernumber ($message->{borrowernumber})";
 781             # warning too verbose for this more common case?
 782             _set_message_status( { message_id => $message->{'message_id'},
 783                                    status     => 'failed' } );
 784             return;
 785         }
 786     }
 787
 788     my $utf8   = decode('MIME-Header', $message->{'subject'} );
 789     $message->{subject}= encode('MIME-Header', $utf8);
 790     my $content = encode('utf8', $message->{'content'});
 791     my %sendmail_params = (
 792         To   => $to_address,
 793         From => $message->{'from_address'} || C4::Context->preference('KohaAdminEmailAddress'),
 794         Subject => encode('utf8', $message->{'subject'}),
 795         charset => 'utf8',
 796         Message => $content,
 797         'content-type' => $message->{'content_type'} || 'text/plain; charset="UTF-8"',
 798     );
 799     $sendmail_params{'Auth'} = {user => $username, pass => $password, method => $method} if $username;
 800     if ( my $bcc = C4::Context->preference('OverdueNoticeBcc') ) {
 801        $sendmail_params{ Bcc } = $bcc;
 802     }
 803
 804     _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
 805     if ( sendmail( %sendmail_params ) ) {
 806         _set_message_status( { message_id => $message->{'message_id'},
 807                 status     => 'sent' } );
 808         return 1;
 809     } else {
 810         _set_message_status( { message_id => $message->{'message_id'},
 811                 status     => 'failed' } );
 812         carp $Mail::Sendmail::error;
 813         return;
 814     }
 815 }
 816
 817 sub _send_message_by_sms ($) {
 818     my $message = shift or return undef;
 819     my $member = C4::Members::GetMember( 'borrowernumber' => $message->{'borrowernumber'} );
 820     return unless $member->{'smsalertnumber'};
 821
 822     my $success = C4::SMS->send_sms( { destination => $member->{'smsalertnumber'},
 823                                        message     => $message->{'content'},
 824                                      } );
 825     _set_message_status( { message_id => $message->{'message_id'},
 826                            status     => ($success ? 'sent' : 'failed') } );
 827     return $success;
 828 }
 829
 830 sub _update_message_to_address {
 831     my ($id, $to)= @_;
 832     my $dbh = C4::Context->dbh();
 833     $dbh->do('UPDATE message_queue SET to_address=? WHERE message_id=?',undef,($to,$id));
 834 }
 835
 836 sub _set_message_status ($) {
 837     my $params = shift or return undef;
 838
 839     foreach my $required_parameter ( qw( message_id status ) ) {
 840         return undef unless exists $params->{ $required_parameter };
 841     }
 842
 843     my $dbh = C4::Context->dbh();
 844     my $statement = 'UPDATE message_queue SET status= ? WHERE message_id = ?';
 845     my $sth = $dbh->prepare( $statement );
 846     my $result = $sth->execute( $params->{'status'},
 847                                 $params->{'message_id'} );
 848     return $result;
 849 }
 850
 851
 852 1;
 853 __END__