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 'reserves'     ) ? "SELECT * FROM $table WHERE borrowernumber = ? and biblionumber = ?" :
 494     ($table eq 'borrowers'    ) ? "SELECT * FROM $table WHERE borrowernumber = ?"                      :
 495     ($table eq 'branches'     ) ? "SELECT * FROM $table WHERE     branchcode = ?"                      :
 496     ($table eq 'suggestions'  ) ? "SELECT * FROM $table WHERE   suggestionid = ?"                      :
 497     ($table eq 'aqbooksellers') ? "SELECT * FROM $table WHERE             id = ?"                      : undef ;
 498     unless ($query) {
 499         warn "ERROR: No parseletter_sth query for table '$table'";
 500         return;     # nothing to get
 501     }
 502     unless ($handles{$table} = C4::Context->dbh->prepare($query)) {
 503         warn "ERROR: Failed to prepare query: '$query'";
 504         return;
 505     }
 506     return $handles{$table};    # now cache is populated for that $table
 507 }
 508
 509 sub parseletter {
 510     my ( $letter, $table, $pk, $pk2 ) = @_;
 511     unless ($letter) {
 512         carp "ERROR: parseletter() 1st argument 'letter' empty";
 513         return;
 514     }
 515     my $sth = parseletter_sth($table);
 516     unless ($sth) {
 517         warn "parseletter_sth('$table') failed to return a valid sth.  No substitution will be done for that table.";
 518         return;
 519     }
 520     if ( $pk2 ) {
 521         $sth->execute($pk, $pk2);
 522     } else {
 523         $sth->execute($pk);
 524     }
 525
 526     my $values = $sth->fetchrow_hashref;
 527
 528     # TEMPORARY hack until the expirationdate column is added to reserves
 529     if ( $table eq 'reserves' && $values->{'waitingdate'} ) {
 530         my @waitingdate = split /-/, $values->{'waitingdate'};
 531
 532         $values->{'expirationdate'} = C4::Dates->new(
 533             sprintf(
 534                 '%04d-%02d-%02d',
 535                 Add_Delta_Days( @waitingdate, C4::Context->preference( 'ReservesMaxPickUpDelay' ) )
 536             ),
 537             'iso'
 538         )->output();
 539     }
 540
 541
 542     # and get all fields from the table
 543     my $columns = C4::Context->dbh->prepare("SHOW COLUMNS FROM $table");
 544     $columns->execute;
 545     while ( ( my $field ) = $columns->fetchrow_array ) {
 546         my $replacefield = "<<$table.$field>>";
 547         $values->{$field} =~ s/\p{P}(?=$)//g if $values->{$field};
 548         my $replacedby   = $values->{$field} || '';
 549         ($letter->{title}  ) and $letter->{title}   =~ s/$replacefield/$replacedby/g;
 550         ($letter->{content}) and $letter->{content} =~ s/$replacefield/$replacedby/g;
 551     }
 552     return $letter;
 553 }
 554
 555 =head2 EnqueueLetter
 556
 557   my $success = EnqueueLetter( { letter => $letter,
 558         borrowernumber => '12', message_transport_type => 'email' } )
 559
 560 places a letter in the message_queue database table, which will
 561 eventually get processed (sent) by the process_message_queue.pl
 562 cronjob when it calls SendQueuedMessages.
 563
 564 return true on success
 565
 566 =cut
 567
 568 sub EnqueueLetter ($) {
 569     my $params = shift or return undef;
 570
 571     return unless exists $params->{'letter'};
 572     return unless exists $params->{'borrowernumber'};
 573     return unless exists $params->{'message_transport_type'};
 574
 575     # If we have any attachments we should encode then into the body.
 576     if ( $params->{'attachments'} ) {
 577         $params->{'letter'} = _add_attachments(
 578             {   letter      => $params->{'letter'},
 579                 attachments => $params->{'attachments'},
 580                 message     => MIME::Lite->new( Type => 'multipart/mixed' ),
 581             }
 582         );
 583     }
 584
 585     my $dbh       = C4::Context->dbh();
 586     my $statement = << 'ENDSQL';
 587 INSERT INTO message_queue
 588 ( borrowernumber, subject, content, metadata, letter_code, message_transport_type, status, time_queued, to_address, from_address, content_type )
 589 VALUES
 590 ( ?,              ?,       ?,       ?,        ?,           ?,                      ?,      NOW(),       ?,          ?,            ? )
 591 ENDSQL
 592
 593     my $sth    = $dbh->prepare($statement);
 594     my $result = $sth->execute(
 595         $params->{'borrowernumber'},              # borrowernumber
 596         $params->{'letter'}->{'title'},           # subject
 597         $params->{'letter'}->{'content'},         # content
 598         $params->{'letter'}->{'metadata'} || '',  # metadata
 599         $params->{'letter'}->{'code'}     || '',  # letter_code
 600         $params->{'message_transport_type'},      # message_transport_type
 601         'pending',                                # status
 602         $params->{'to_address'},                  # to_address
 603         $params->{'from_address'},                # from_address
 604         $params->{'letter'}->{'content-type'},    # content_type
 605     );
 606     return $result;
 607 }
 608
 609 =head2 SendQueuedMessages ([$hashref])
 610
 611   my $sent = SendQueuedMessages( { verbose => 1 } );
 612
 613 sends all of the 'pending' items in the message queue.
 614
 615 returns number of messages sent.
 616
 617 =cut
 618
 619 sub SendQueuedMessages (;$) {
 620     my $params = shift;
 621
 622     my $unsent_messages = _get_unsent_messages();
 623     MESSAGE: foreach my $message ( @$unsent_messages ) {
 624         # warn Data::Dumper->Dump( [ $message ], [ 'message' ] );
 625         warn sprintf( 'sending %s message to patron: %s',
 626                       $message->{'message_transport_type'},
 627                       $message->{'borrowernumber'} || 'Admin' )
 628           if $params->{'verbose'} or $debug;
 629         # This is just begging for subclassing
 630         next MESSAGE if ( lc($message->{'message_transport_type'}) eq 'rss' );
 631         if ( lc( $message->{'message_transport_type'} ) eq 'email' ) {
 632             _send_message_by_email( $message, $params->{'username'}, $params->{'password'}, $params->{'method'} );
 633         }
 634         elsif ( lc( $message->{'message_transport_type'} ) eq 'sms' ) {
 635             _send_message_by_sms( $message );
 636         }
 637     }
 638     return scalar( @$unsent_messages );
 639 }
 640
 641 =head2 GetRSSMessages
 642
 643   my $message_list = GetRSSMessages( { limit => 10, borrowernumber => '14' } )
 644
 645 returns a listref of all queued RSS messages for a particular person.
 646
 647 =cut
 648
 649 sub GetRSSMessages {
 650     my $params = shift;
 651
 652     return unless $params;
 653     return unless ref $params;
 654     return unless $params->{'borrowernumber'};
 655
 656     return _get_unsent_messages( { message_transport_type => 'rss',
 657                                    limit                  => $params->{'limit'},
 658                                    borrowernumber         => $params->{'borrowernumber'}, } );
 659 }
 660
 661 =head2 GetPrintMessages
 662
 663   my $message_list = GetPrintMessages( { borrowernumber => $borrowernumber } )
 664
 665 Returns a arrayref of all queued print messages (optionally, for a particular
 666 person).
 667
 668 =cut
 669
 670 sub GetPrintMessages {
 671     my $params = shift || {};
 672
 673     return _get_unsent_messages( { message_transport_type => 'print',
 674                                    borrowernumber         => $params->{'borrowernumber'}, } );
 675 }
 676
 677 =head2 GetQueuedMessages ([$hashref])
 678
 679   my $messages = GetQueuedMessage( { borrowernumber => '123', limit => 20 } );
 680
 681 fetches messages out of the message queue.
 682
 683 returns:
 684 list of hashes, each has represents a message in the message queue.
 685
 686 =cut
 687
 688 sub GetQueuedMessages {
 689     my $params = shift;
 690
 691     my $dbh = C4::Context->dbh();
 692     my $statement = << 'ENDSQL';
 693 SELECT message_id, borrowernumber, subject, content, message_transport_type, status, time_queued
 694 FROM message_queue
 695 ENDSQL
 696
 697     my @query_params;
 698     my @whereclauses;
 699     if ( exists $params->{'borrowernumber'} ) {
 700         push @whereclauses, ' borrowernumber = ? ';
 701         push @query_params, $params->{'borrowernumber'};
 702     }
 703
 704     if ( @whereclauses ) {
 705         $statement .= ' WHERE ' . join( 'AND', @whereclauses );
 706     }
 707
 708     if ( defined $params->{'limit'} ) {
 709         $statement .= ' LIMIT ? ';
 710         push @query_params, $params->{'limit'};
 711     }
 712
 713     my $sth = $dbh->prepare( $statement );
 714     my $result = $sth->execute( @query_params );
 715     return $sth->fetchall_arrayref({});
 716 }
 717
 718 =head2 _add_attachements
 719
 720 named parameters:
 721 letter - the standard letter hashref
 722 attachments - listref of attachments. each attachment is a hashref of:
 723   type - the mime type, like 'text/plain'
 724   content - the actual attachment
 725   filename - the name of the attachment.
 726 message - a MIME::Lite object to attach these to.
 727
 728 returns your letter object, with the content updated.
 729
 730 =cut
 731
 732 sub _add_attachments {
 733     my $params = shift;
 734
 735     return unless 'HASH' eq ref $params;
 736     foreach my $required_parameter (qw( letter attachments message )) {
 737         return unless exists $params->{$required_parameter};
 738     }
 739     return $params->{'letter'} unless @{ $params->{'attachments'} };
 740
 741     # First, we have to put the body in as the first attachment
 742     $params->{'message'}->attach(
 743         Type => 'TEXT',
 744         Data => $params->{'letter'}->{'content'},
 745     );
 746
 747     foreach my $attachment ( @{ $params->{'attachments'} } ) {
 748         $params->{'message'}->attach(
 749             Type     => $attachment->{'type'},
 750             Data     => $attachment->{'content'},
 751             Filename => $attachment->{'filename'},
 752         );
 753     }
 754     # we're forcing list context here to get the header, not the count back from grep.
 755     ( $params->{'letter'}->{'content-type'} ) = grep( /^Content-Type:/, split( /\n/, $params->{'message'}->header_as_string ) );
 756     $params->{'letter'}->{'content-type'} =~ s/^Content-Type:\s+//;
 757     $params->{'letter'}->{'content'} = $params->{'message'}->body_as_string;
 758
 759     return $params->{'letter'};
 760
 761 }
 762
 763 sub _get_unsent_messages (;$) {
 764     my $params = shift;
 765
 766     my $dbh = C4::Context->dbh();
 767     my $statement = << 'ENDSQL';
 768 SELECT message_id, borrowernumber, subject, content, message_transport_type, status, time_queued, from_address, to_address, content_type
 769   FROM message_queue
 770  WHERE status = ?
 771 ENDSQL
 772
 773     my @query_params = ('pending');
 774     if ( ref $params ) {
 775         if ( $params->{'message_transport_type'} ) {
 776             $statement .= ' AND message_transport_type = ? ';
 777             push @query_params, $params->{'message_transport_type'};
 778         }
 779         if ( $params->{'borrowernumber'} ) {
 780             $statement .= ' AND borrowernumber = ? ';
 781             push @query_params, $params->{'borrowernumber'};
 782         }
 783         if ( $params->{'limit'} ) {
 784             $statement .= ' limit ? ';
 785             push @query_params, $params->{'limit'};
 786         }
 787     }
 788     $debug and warn "_get_unsent_messages SQL: $statement";
 789     $debug and warn "_get_unsent_messages params: " . join(',',@query_params);
 790     my $sth = $dbh->prepare( $statement );
 791     my $result = $sth->execute( @query_params );
 792     return $sth->fetchall_arrayref({});
 793 }
 794
 795 sub _send_message_by_email ($;$$$) {
 796     my $message = shift or return;
 797     my ($username, $password, $method) = @_;
 798
 799     my $to_address = $message->{to_address};
 800     unless ($to_address) {
 801         my $member = C4::Members::GetMember( 'borrowernumber' => $message->{'borrowernumber'} );
 802         unless ($member) {
 803             warn "FAIL: No 'to_address' and INVALID borrowernumber ($message->{borrowernumber})";
 804             _set_message_status( { message_id => $message->{'message_id'},
 805                                    status     => 'failed' } );
 806             return;
 807         }
 808         my $which_address = C4::Context->preference('AutoEmailPrimaryAddress');
 809         # If the system preference is set to 'first valid' (value == OFF), look up email address
 810         if ($which_address eq 'OFF') {
 811             $to_address = GetFirstValidEmailAddress( $message->{'borrowernumber'} );
 812         } else {
 813             $to_address = $member->{$which_address};
 814         }
 815         unless ($to_address) {
 816             # warn "FAIL: No 'to_address' and no email for " . ($member->{surname} ||'') . ", borrowernumber ($message->{borrowernumber})";
 817             # warning too verbose for this more common case?
 818             _set_message_status( { message_id => $message->{'message_id'},
 819                                    status     => 'failed' } );
 820             return;
 821         }
 822     }
 823
 824     my $utf8   = decode('MIME-Header', $message->{'subject'} );
 825     $message->{subject}= encode('MIME-Header', $utf8);
 826     my $content = encode('utf8', $message->{'content'});
 827     my %sendmail_params = (
 828         To   => $to_address,
 829         From => $message->{'from_address'} || C4::Context->preference('KohaAdminEmailAddress'),
 830         Subject => encode('utf8', $message->{'subject'}),
 831         charset => 'utf8',
 832         Message => $content,
 833         'content-type' => $message->{'content_type'} || 'text/plain; charset="UTF-8"',
 834     );
 835     $sendmail_params{'Auth'} = {user => $username, pass => $password, method => $method} if $username;
 836     if ( my $bcc = C4::Context->preference('OverdueNoticeBcc') ) {
 837        $sendmail_params{ Bcc } = $bcc;
 838     }
 839
 840
 841     if ( sendmail( %sendmail_params ) ) {
 842         _set_message_status( { message_id => $message->{'message_id'},
 843                 status     => 'sent' } );
 844         return 1;
 845     } else {
 846         _set_message_status( { message_id => $message->{'message_id'},
 847                 status     => 'failed' } );
 848         carp $Mail::Sendmail::error;
 849         return;
 850     }
 851 }
 852
 853 sub _send_message_by_sms ($) {
 854     my $message = shift or return undef;
 855     my $member = C4::Members::GetMember( 'borrowernumber' => $message->{'borrowernumber'} );
 856     return unless $member->{'smsalertnumber'};
 857
 858     my $success = C4::SMS->send_sms( { destination => $member->{'smsalertnumber'},
 859                                        message     => $message->{'content'},
 860                                      } );
 861     _set_message_status( { message_id => $message->{'message_id'},
 862                            status     => ($success ? 'sent' : 'failed') } );
 863     return $success;
 864 }
 865
 866 sub _set_message_status ($) {
 867     my $params = shift or return undef;
 868
 869     foreach my $required_parameter ( qw( message_id status ) ) {
 870         return undef unless exists $params->{ $required_parameter };
 871     }
 872
 873     my $dbh = C4::Context->dbh();
 874     my $statement = 'UPDATE message_queue SET status= ? WHERE message_id = ?';
 875     my $sth = $dbh->prepare( $statement );
 876     my $result = $sth->execute( $params->{'status'},
 877                                 $params->{'message_id'} );
 878     return $result;
 879 }
 880
 881
 882 1;
 883 __END__