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