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     if ( $type eq 'issue' ) {
 247
 248         #               warn "sending issues...";
 249         my $letter = getletter( 'serial', $letter );
 250
 251         # prepare the letter...
 252         # search the biblionumber
 253         my $sth =
 254           $dbh->prepare(
 255             "SELECT biblionumber FROM subscription WHERE subscriptionid=?");
 256         $sth->execute($externalid);
 257         my ($biblionumber) = $sth->fetchrow;
 258
 259         # parsing branch info
 260         my $userenv = C4::Context->userenv;
 261         parseletter( $letter, 'branches', $userenv->{branch} );
 262
 263         # parsing librarian name
 264         $letter->{content} =~ s/<<LibrarianFirstname>>/$userenv->{firstname}/g;
 265         $letter->{content} =~ s/<<LibrarianSurname>>/$userenv->{surname}/g;
 266         $letter->{content} =~
 267           s/<<LibrarianEmailaddress>>/$userenv->{emailaddress}/g;
 268
 269         # parsing biblio information
 270         parseletter( $letter, 'biblio',      $biblionumber );
 271         parseletter( $letter, 'biblioitems', $biblionumber );
 272
 273         # find the list of borrowers to alert
 274         my $alerts = getalert( '', 'issue', $externalid );
 275         foreach (@$alerts) {
 276
 277             # and parse borrower ...
 278             my $innerletter = $letter;
 279             my $borinfo = C4::Members::GetMember('borrowernumber' => $_->{'borrowernumber'});
 280             parseletter( $innerletter, 'borrowers', $_->{'borrowernumber'} );
 281
 282             # ... then send mail
 283             if ( $borinfo->{email} ) {
 284                 my %mail = (
 285                     To      => $borinfo->{email},
 286                     From    => $borinfo->{email},
 287                     Subject => "" . $innerletter->{title},
 288                     Message => "" . $innerletter->{content},
 289                     'Content-Type' => 'text/plain; charset="utf8"',
 290                     );
 291                 sendmail(%mail) or carp $Mail::Sendmail::error;
 292
 293 # warn "sending to $mail{To} From $mail{From} subj $mail{Subject} Mess $mail{Message}";
 294             }
 295         }
 296     }
 297     elsif ( $type eq 'claimacquisition' ) {
 298
 299         #               warn "sending issues...";
 300         my $letter = getletter( 'claimacquisition', $letter );
 301
 302         # prepare the letter...
 303         # search the biblionumber
 304         my $strsth =
 305 "select aqorders.*,aqbasket.*,biblio.*,biblioitems.* from aqorders LEFT JOIN aqbasket on aqbasket.basketno=aqorders.basketno LEFT JOIN biblio on aqorders.biblionumber=biblio.biblionumber LEFT JOIN biblioitems on aqorders.biblioitemnumber=biblioitems.biblioitemnumber where aqorders.ordernumber IN ("
 306           . join( ",", @$externalid ) . ")";
 307         my $sthorders = $dbh->prepare($strsth);
 308         $sthorders->execute;
 309         my $dataorders = $sthorders->fetchall_arrayref( {} );
 310         parseletter( $letter, 'aqbooksellers',
 311             $dataorders->[0]->{booksellerid} );
 312         my $sthbookseller =
 313           $dbh->prepare("select * from aqbooksellers where id=?");
 314         $sthbookseller->execute( $dataorders->[0]->{booksellerid} );
 315         my $databookseller = $sthbookseller->fetchrow_hashref;
 316
 317         # parsing branch info
 318         my $userenv = C4::Context->userenv;
 319         parseletter( $letter, 'branches', $userenv->{branch} );
 320
 321         # parsing librarian name
 322         $letter->{content} =~ s/<<LibrarianFirstname>>/$userenv->{firstname}/g;
 323         $letter->{content} =~ s/<<LibrarianSurname>>/$userenv->{surname}/g;
 324         $letter->{content} =~
 325           s/<<LibrarianEmailaddress>>/$userenv->{emailaddress}/g;
 326         foreach my $data ( @{$dataorders} ) {
 327             if ( $letter->{content} =~ m/(<<.*>>)/ ) {
 328                 my $line = $1;
 329                 foreach my $field ( keys %{$data} ) {
 330                     $line =~ s/(<<[^\.]+.$field>>)/$data->{$field}/;
 331                 }
 332                 $letter->{content} =~ s/(<<.*>>)/$line\n$1/;
 333             }
 334         }
 335         $letter->{content} =~ s/<<[^>]*>>//g;
 336         my $innerletter = $letter;
 337
 338         # ... then send mail
 339         if (   $databookseller->{bookselleremail}
 340             || $databookseller->{contemail} )
 341         {
 342             my %mail = (
 343                 To => $databookseller->{bookselleremail}
 344                   . (
 345                     $databookseller->{contemail}
 346                     ? "," . $databookseller->{contemail}
 347                     : ""
 348                   ),
 349                 From           => $userenv->{emailaddress},
 350                 Subject        => "" . $innerletter->{title},
 351                 Message        => "" . $innerletter->{content},
 352                 'Content-Type' => 'text/plain; charset="utf8"',
 353             );
 354             sendmail(%mail) or carp $Mail::Sendmail::error;
 355         }
 356         if ( C4::Context->preference("LetterLog") ) {
 357             logaction(
 358                 "ACQUISITION",
 359                 "Send Acquisition claim letter",
 360                 "",
 361                 "order list : "
 362                   . join( ",", @$externalid )
 363                   . "\n$innerletter->{title}\n$innerletter->{content}"
 364             );
 365         }
 366     }
 367     elsif ( $type eq 'claimissues' ) {
 368
 369         #               warn "sending issues...";
 370         my $letter = getletter( 'claimissues', $letter );
 371
 372         # prepare the letter...
 373         # search the biblionumber
 374         my $strsth =
 375 "select serial.*,subscription.*, biblio.* from serial LEFT JOIN subscription on serial.subscriptionid=subscription.subscriptionid LEFT JOIN biblio on serial.biblionumber=biblio.biblionumber where serial.serialid IN ("
 376           . join( ",", @$externalid ) . ")";
 377         my $sthorders = $dbh->prepare($strsth);
 378         $sthorders->execute;
 379         my $dataorders = $sthorders->fetchall_arrayref( {} );
 380         parseletter( $letter, 'aqbooksellers',
 381             $dataorders->[0]->{aqbooksellerid} );
 382         my $sthbookseller =
 383           $dbh->prepare("select * from aqbooksellers where id=?");
 384         $sthbookseller->execute( $dataorders->[0]->{aqbooksellerid} );
 385         my $databookseller = $sthbookseller->fetchrow_hashref;
 386
 387         # parsing branch info
 388         my $userenv = C4::Context->userenv;
 389         parseletter( $letter, 'branches', $userenv->{branch} );
 390
 391         # parsing librarian name
 392         $letter->{content} =~ s/<<LibrarianFirstname>>/$userenv->{firstname}/g;
 393         $letter->{content} =~ s/<<LibrarianSurname>>/$userenv->{surname}/g;
 394         $letter->{content} =~
 395           s/<<LibrarianEmailaddress>>/$userenv->{emailaddress}/g;
 396         foreach my $data ( @{$dataorders} ) {
 397             if ( $letter->{content} =~ m/(<<.*>>)/ ) {
 398                 my $line = $1;
 399                 foreach my $field ( keys %{$data} ) {
 400                     $line =~ s/(<<[^\.]+.$field>>)/$data->{$field}/;
 401                 }
 402                 $letter->{content} =~ s/(<<.*>>)/$line\n$1/;
 403             }
 404         }
 405         $letter->{content} =~ s/<<[^>]*>>//g;
 406         my $innerletter = $letter;
 407
 408         # ... then send mail
 409         if (   $databookseller->{bookselleremail}
 410             || $databookseller->{contemail} ) {
 411             my $mail_to = $databookseller->{bookselleremail};
 412             if ($databookseller->{contemail}) {
 413                 if (!$mail_to) {
 414                     $mail_to = $databookseller->{contemail};
 415                 } else {
 416                     $mail_to .= q|,|;
 417                     $mail_to .= $databookseller->{contemail};
 418                 }
 419             }
 420             my $mail_subj = $innerletter->{title};
 421             my $mail_msg  = $innerletter->{content};
 422             $mail_msg  ||= q{};
 423             $mail_subj ||= q{};
 424
 425             my %mail = (
 426                 To => $mail_to,
 427                 From    => $userenv->{emailaddress},
 428                 Subject => $mail_subj,
 429                 Message => $mail_msg,
 430                 'Content-Type' => 'text/plain; charset="utf8"',
 431             );
 432             sendmail(%mail) or carp $Mail::Sendmail::error;
 433             logaction(
 434                 "ACQUISITION",
 435                 "CLAIM ISSUE",
 436                 undef,
 437                 "To="
 438                   . $databookseller->{contemail}
 439                   . " Title="
 440                   . $innerletter->{title}
 441                   . " Content="
 442                   . $innerletter->{content}
 443             ) if C4::Context->preference("LetterLog");
 444         }
 445     }
 446    # send an "account details" notice to a newly created user
 447     elsif ( $type eq 'members' ) {
 448         # must parse the password special, before it's hashed.
 449         $letter->{content} =~ s/<<borrowers.password>>/$externalid->{'password'}/g;
 450
 451         parseletter( $letter, 'borrowers', $externalid->{'borrowernumber'});
 452         parseletter( $letter, 'branches', $externalid->{'branchcode'} );
 453
 454         my $branchdetails = GetBranchDetail($externalid->{'branchcode'});
 455         my %mail = (
 456                 To      =>     $externalid->{'emailaddr'},
 457                 From    =>  $branchdetails->{'branchemail'} || C4::Context->preference("KohaAdminEmailAddress"),
 458                 Subject => $letter->{'title'},
 459                 Message => $letter->{'content'},
 460                 'Content-Type' => 'text/plain; charset="utf8"',
 461         );
 462         sendmail(%mail) or carp $Mail::Sendmail::error;
 463     }
 464 }
 465
 466 =head2 parseletter($letter, $table, $pk)
 467
 468     parameters :
 469     - $letter : a hash to letter fields (title & content useful)
 470     - $table : the Koha table to parse.
 471     - $pk : the primary key to query on the $table table
 472     parse all fields from a table, and replace values in title & content with the appropriate value
 473     (not exported sub, used only internally)
 474
 475 =cut
 476
 477 our %handles = ();
 478 our %columns = ();
 479
 480 sub parseletter_sth {
 481     my $table = shift;
 482     unless ($table) {
 483         carp "ERROR: parseletter_sth() called without argument (table)";
 484         return;
 485     }
 486     # check cache first
 487     (defined $handles{$table}) and return $handles{$table};
 488     my $query =
 489     ($table eq 'biblio'       ) ? "SELECT * FROM $table WHERE   biblionumber = ?"                      :
 490     ($table eq 'biblioitems'  ) ? "SELECT * FROM $table WHERE   biblionumber = ?"                      :
 491     ($table eq 'items'        ) ? "SELECT * FROM $table WHERE     itemnumber = ?"                      :
 492     ($table eq 'issues'       ) ? "SELECT * FROM $table WHERE     itemnumber = ?"                      :
 493     ($table eq 'suggestions'  ) ? "SELECT * FROM $table WHERE borrowernumber = ? and biblionumber = ?" :
 494     ($table eq 'reserves'     ) ? "SELECT * FROM $table WHERE borrowernumber = ? and biblionumber = ?" :
 495     ($table eq 'borrowers'    ) ? "SELECT * FROM $table WHERE borrowernumber = ?"                      :
 496     ($table eq 'branches'     ) ? "SELECT * FROM $table WHERE     branchcode = ?"                      :
 497     ($table eq 'suggestions'  ) ? "SELECT * FROM $table WHERE   suggestionid = ?"                      :
 498     ($table eq 'aqbooksellers') ? "SELECT * FROM $table WHERE             id = ?"                      : undef ;
 499     unless ($query) {
 500         warn "ERROR: No parseletter_sth query for table '$table'";
 501         return;     # nothing to get
 502     }
 503     unless ($handles{$table} = C4::Context->dbh->prepare($query)) {
 504         warn "ERROR: Failed to prepare query: '$query'";
 505         return;
 506     }
 507     return $handles{$table};    # now cache is populated for that $table
 508 }
 509
 510 sub parseletter {
 511     my ( $letter, $table, $pk, $pk2 ) = @_;
 512     unless ($letter) {
 513         carp "ERROR: parseletter() 1st argument 'letter' empty";
 514         return;
 515     }
 516     my $sth = parseletter_sth($table);
 517     unless ($sth) {
 518         warn "parseletter_sth('$table') failed to return a valid sth.  No substitution will be done for that table.";
 519         return;
 520     }
 521     if ( $pk2 ) {
 522         $sth->execute($pk, $pk2);
 523     } else {
 524         $sth->execute($pk);
 525     }
 526
 527     my $values = $sth->fetchrow_hashref;
 528
 529     # TEMPORARY hack until the expirationdate column is added to reserves
 530     if ( $table eq 'reserves' && $values->{'waitingdate'} ) {
 531         my @waitingdate = split /-/, $values->{'waitingdate'};
 532
 533         $values->{'expirationdate'} = C4::Dates->new(
 534             sprintf(
 535                 '%04d-%02d-%02d',
 536                 Add_Delta_Days( @waitingdate, C4::Context->preference( 'ReservesMaxPickUpDelay' ) )
 537             ),
 538             'iso'
 539         )->output();
 540     }
 541
 542
 543     # and get all fields from the table
 544     my $columns = C4::Context->dbh->prepare("SHOW COLUMNS FROM $table");
 545     $columns->execute;
 546     while ( ( my $field ) = $columns->fetchrow_array ) {
 547         my $replacefield = "<<$table.$field>>";
 548         $values->{$field} =~ s/\p{P}(?=$)//g if $values->{$field};
 549         my $replacedby   = $values->{$field} || '';
 550         ($letter->{title}  ) and $letter->{title}   =~ s/$replacefield/$replacedby/g;
 551         ($letter->{content}) and $letter->{content} =~ s/$replacefield/$replacedby/g;
 552     }
 553     return $letter;
 554 }
 555
 556 =head2 EnqueueLetter
 557
 558   my $success = EnqueueLetter( { letter => $letter,
 559         borrowernumber => '12', message_transport_type => 'email' } )
 560
 561 places a letter in the message_queue database table, which will
 562 eventually get processed (sent) by the process_message_queue.pl
 563 cronjob when it calls SendQueuedMessages.
 564
 565 return true on success
 566
 567 =cut
 568
 569 sub EnqueueLetter ($) {
 570     my $params = shift or return undef;
 571
 572     return unless exists $params->{'letter'};
 573     return unless exists $params->{'borrowernumber'};
 574     return unless exists $params->{'message_transport_type'};
 575
 576     # If we have any attachments we should encode then into the body.
 577     if ( $params->{'attachments'} ) {
 578         $params->{'letter'} = _add_attachments(
 579             {   letter      => $params->{'letter'},
 580                 attachments => $params->{'attachments'},
 581                 message     => MIME::Lite->new( Type => 'multipart/mixed' ),
 582             }
 583         );
 584     }
 585
 586     my $dbh       = C4::Context->dbh();
 587     my $statement = << 'ENDSQL';
 588 INSERT INTO message_queue
 589 ( borrowernumber, subject, content, metadata, letter_code, message_transport_type, status, time_queued, to_address, from_address, content_type )
 590 VALUES
 591 ( ?,              ?,       ?,       ?,        ?,           ?,                      ?,      NOW(),       ?,          ?,            ? )
 592 ENDSQL
 593
 594     my $sth    = $dbh->prepare($statement);
 595     my $result = $sth->execute(
 596         $params->{'borrowernumber'},              # borrowernumber
 597         $params->{'letter'}->{'title'},           # subject
 598         $params->{'letter'}->{'content'},         # content
 599         $params->{'letter'}->{'metadata'} || '',  # metadata
 600         $params->{'letter'}->{'code'}     || '',  # letter_code
 601         $params->{'message_transport_type'},      # message_transport_type
 602         'pending',                                # status
 603         $params->{'to_address'},                  # to_address
 604         $params->{'from_address'},                # from_address
 605         $params->{'letter'}->{'content-type'},    # content_type
 606     );
 607     return $result;
 608 }
 609
 610 =head2 SendQueuedMessages ([$hashref])
 611
 612   my $sent = SendQueuedMessages( { verbose => 1 } );
 613
 614 sends all of the 'pending' items in the message queue.
 615
 616 returns number of messages sent.
 617
 618 =cut
 619
 620 sub SendQueuedMessages (;$) {
 621     my $params = shift;
 622
 623     my $unsent_messages = _get_unsent_messages();
 624     MESSAGE: foreach my $message ( @$unsent_messages ) {
 625         # warn Data::Dumper->Dump( [ $message ], [ 'message' ] );
 626         warn sprintf( 'sending %s message to patron: %s',
 627                       $message->{'message_transport_type'},
 628                       $message->{'borrowernumber'} || 'Admin' )
 629           if $params->{'verbose'} or $debug;
 630         # This is just begging for subclassing
 631         next MESSAGE if ( lc($message->{'message_transport_type'}) eq 'rss' );
 632         if ( lc( $message->{'message_transport_type'} ) eq 'email' ) {
 633             _send_message_by_email( $message, $params->{'username'}, $params->{'password'}, $params->{'method'} );
 634         }
 635         elsif ( lc( $message->{'message_transport_type'} ) eq 'sms' ) {
 636             _send_message_by_sms( $message );
 637         }
 638     }
 639     return scalar( @$unsent_messages );
 640 }
 641
 642 =head2 GetRSSMessages
 643
 644   my $message_list = GetRSSMessages( { limit => 10, borrowernumber => '14' } )
 645
 646 returns a listref of all queued RSS messages for a particular person.
 647
 648 =cut
 649
 650 sub GetRSSMessages {
 651     my $params = shift;
 652
 653     return unless $params;
 654     return unless ref $params;
 655     return unless $params->{'borrowernumber'};
 656
 657     return _get_unsent_messages( { message_transport_type => 'rss',
 658                                    limit                  => $params->{'limit'},
 659                                    borrowernumber         => $params->{'borrowernumber'}, } );
 660 }
 661
 662 =head2 GetPrintMessages
 663
 664   my $message_list = GetPrintMessages( { borrowernumber => $borrowernumber } )
 665
 666 Returns a arrayref of all queued print messages (optionally, for a particular
 667 person).
 668
 669 =cut
 670
 671 sub GetPrintMessages {
 672     my $params = shift || {};
 673
 674     return _get_unsent_messages( { message_transport_type => 'print',
 675                                    borrowernumber         => $params->{'borrowernumber'}, } );
 676 }
 677
 678 =head2 GetQueuedMessages ([$hashref])
 679
 680   my $messages = GetQueuedMessage( { borrowernumber => '123', limit => 20 } );
 681
 682 fetches messages out of the message queue.
 683
 684 returns:
 685 list of hashes, each has represents a message in the message queue.
 686
 687 =cut
 688
 689 sub GetQueuedMessages {
 690     my $params = shift;
 691
 692     my $dbh = C4::Context->dbh();
 693     my $statement = << 'ENDSQL';
 694 SELECT message_id, borrowernumber, subject, content, message_transport_type, status, time_queued
 695 FROM message_queue
 696 ENDSQL
 697
 698     my @query_params;
 699     my @whereclauses;
 700     if ( exists $params->{'borrowernumber'} ) {
 701         push @whereclauses, ' borrowernumber = ? ';
 702         push @query_params, $params->{'borrowernumber'};
 703     }
 704
 705     if ( @whereclauses ) {
 706         $statement .= ' WHERE ' . join( 'AND', @whereclauses );
 707     }
 708
 709     if ( defined $params->{'limit'} ) {
 710         $statement .= ' LIMIT ? ';
 711         push @query_params, $params->{'limit'};
 712     }
 713
 714     my $sth = $dbh->prepare( $statement );
 715     my $result = $sth->execute( @query_params );
 716     return $sth->fetchall_arrayref({});
 717 }
 718
 719 =head2 _add_attachements
 720
 721 named parameters:
 722 letter - the standard letter hashref
 723 attachments - listref of attachments. each attachment is a hashref of:
 724   type - the mime type, like 'text/plain'
 725   content - the actual attachment
 726   filename - the name of the attachment.
 727 message - a MIME::Lite object to attach these to.
 728
 729 returns your letter object, with the content updated.
 730
 731 =cut
 732
 733 sub _add_attachments {
 734     my $params = shift;
 735
 736     return unless 'HASH' eq ref $params;
 737     foreach my $required_parameter (qw( letter attachments message )) {
 738         return unless exists $params->{$required_parameter};
 739     }
 740     return $params->{'letter'} unless @{ $params->{'attachments'} };
 741
 742     # First, we have to put the body in as the first attachment
 743     $params->{'message'}->attach(
 744         Type => 'TEXT',
 745         Data => $params->{'letter'}->{'content'},
 746     );
 747
 748     foreach my $attachment ( @{ $params->{'attachments'} } ) {
 749         $params->{'message'}->attach(
 750             Type     => $attachment->{'type'},
 751             Data     => $attachment->{'content'},
 752             Filename => $attachment->{'filename'},
 753         );
 754     }
 755     # we're forcing list context here to get the header, not the count back from grep.
 756     ( $params->{'letter'}->{'content-type'} ) = grep( /^Content-Type:/, split( /\n/, $params->{'message'}->header_as_string ) );
 757     $params->{'letter'}->{'content-type'} =~ s/^Content-Type:\s+//;
 758     $params->{'letter'}->{'content'} = $params->{'message'}->body_as_string;
 759
 760     return $params->{'letter'};
 761
 762 }
 763
 764 sub _get_unsent_messages (;$) {
 765     my $params = shift;
 766
 767     my $dbh = C4::Context->dbh();
 768     my $statement = << 'ENDSQL';
 769 SELECT message_id, borrowernumber, subject, content, message_transport_type, status, time_queued, from_address, to_address, content_type
 770   FROM message_queue
 771  WHERE status = ?
 772 ENDSQL
 773
 774     my @query_params = ('pending');
 775     if ( ref $params ) {
 776         if ( $params->{'message_transport_type'} ) {
 777             $statement .= ' AND message_transport_type = ? ';
 778             push @query_params, $params->{'message_transport_type'};
 779         }
 780         if ( $params->{'borrowernumber'} ) {
 781             $statement .= ' AND borrowernumber = ? ';
 782             push @query_params, $params->{'borrowernumber'};
 783         }
 784         if ( $params->{'limit'} ) {
 785             $statement .= ' limit ? ';
 786             push @query_params, $params->{'limit'};
 787         }
 788     }
 789     $debug and warn "_get_unsent_messages SQL: $statement";
 790     $debug and warn "_get_unsent_messages params: " . join(',',@query_params);
 791     my $sth = $dbh->prepare( $statement );
 792     my $result = $sth->execute( @query_params );
 793     return $sth->fetchall_arrayref({});
 794 }
 795
 796 sub _send_message_by_email ($;$$$) {
 797     my $message = shift or return;
 798     my ($username, $password, $method) = @_;
 799
 800     my $to_address = $message->{to_address};
 801     unless ($to_address) {
 802         my $member = C4::Members::GetMember( 'borrowernumber' => $message->{'borrowernumber'} );
 803         unless ($member) {
 804             warn "FAIL: No 'to_address' and INVALID borrowernumber ($message->{borrowernumber})";
 805             _set_message_status( { message_id => $message->{'message_id'},
 806                                    status     => 'failed' } );
 807             return;
 808         }
 809         my $which_address = C4::Context->preference('AutoEmailPrimaryAddress');
 810         # If the system preference is set to 'first valid' (value == OFF), look up email address
 811         if ($which_address eq 'OFF') {
 812             $to_address = GetFirstValidEmailAddress( $message->{'borrowernumber'} );
 813         } else {
 814             $to_address = $member->{$which_address};
 815         }
 816         unless ($to_address) {
 817             # warn "FAIL: No 'to_address' and no email for " . ($member->{surname} ||'') . ", borrowernumber ($message->{borrowernumber})";
 818             # warning too verbose for this more common case?
 819             _set_message_status( { message_id => $message->{'message_id'},
 820                                    status     => 'failed' } );
 821             return;
 822         }
 823     }
 824
 825     my $utf8   = decode('MIME-Header', $message->{'subject'} );
 826     $message->{subject}= encode('MIME-Header', $utf8);
 827     my $content = encode('utf8', $message->{'content'});
 828     my %sendmail_params = (
 829         To   => $to_address,
 830         From => $message->{'from_address'} || C4::Context->preference('KohaAdminEmailAddress'),
 831         Subject => encode('utf8', $message->{'subject'}),
 832         charset => 'utf8',
 833         Message => $content,
 834         'content-type' => $message->{'content_type'} || 'text/plain; charset="UTF-8"',
 835     );
 836     $sendmail_params{'Auth'} = {user => $username, pass => $password, method => $method} if $username;
 837     if ( my $bcc = C4::Context->preference('OverdueNoticeBcc') ) {
 838        $sendmail_params{ Bcc } = $bcc;
 839     }
 840
 841
 842     if ( sendmail( %sendmail_params ) ) {
 843         _set_message_status( { message_id => $message->{'message_id'},
 844                 status     => 'sent' } );
 845         return 1;
 846     } else {
 847         _set_message_status( { message_id => $message->{'message_id'},
 848                 status     => 'failed' } );
 849         carp $Mail::Sendmail::error;
 850         return;
 851     }
 852 }
 853
 854 sub _send_message_by_sms ($) {
 855     my $message = shift or return undef;
 856     my $member = C4::Members::GetMember( 'borrowernumber' => $message->{'borrowernumber'} );
 857     return unless $member->{'smsalertnumber'};
 858
 859     my $success = C4::SMS->send_sms( { destination => $member->{'smsalertnumber'},
 860                                        message     => $message->{'content'},
 861                                      } );
 862     _set_message_status( { message_id => $message->{'message_id'},
 863                            status     => ($success ? 'sent' : 'failed') } );
 864     return $success;
 865 }
 866
 867 sub _set_message_status ($) {
 868     my $params = shift or return undef;
 869
 870     foreach my $required_parameter ( qw( message_id status ) ) {
 871         return undef unless exists $params->{ $required_parameter };
 872     }
 873
 874     my $dbh = C4::Context->dbh();
 875     my $statement = 'UPDATE message_queue SET status= ? WHERE message_id = ?';
 876     my $sth = $dbh->prepare( $statement );
 877     my $result = $sth->execute( $params->{'status'},
 878                                 $params->{'message_id'} );
 879     return $result;
 880 }
 881
 882
 883 1;
 884 __END__