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