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 with
  17 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
  18 # Suite 330, Boston, MA  02111-1307 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
  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 GetQueuedMessages ([$hashref])
 671
 672 =over 4
 673
 674 my $messages = GetQueuedMessage( { borrowernumber => '123', limit => 20 } );
 675
 676 fetches messages out of the message queue.
 677
 678 returns:
 679 list of hashes, each has represents a message in the message queue.
 680
 681 =back
 682
 683 =cut
 684
 685 sub GetQueuedMessages {
 686     my $params = shift;
 687
 688     my $dbh = C4::Context->dbh();
 689     my $statement = << 'ENDSQL';
 690 SELECT message_id, borrowernumber, subject, content, message_transport_type, status, time_queued
 691 FROM message_queue
 692 ENDSQL
 693
 694     my @query_params;
 695     my @whereclauses;
 696     if ( exists $params->{'borrowernumber'} ) {
 697         push @whereclauses, ' borrowernumber = ? ';
 698         push @query_params, $params->{'borrowernumber'};
 699     }
 700
 701     if ( @whereclauses ) {
 702         $statement .= ' WHERE ' . join( 'AND', @whereclauses );
 703     }
 704
 705     if ( defined $params->{'limit'} ) {
 706         $statement .= ' LIMIT ? ';
 707         push @query_params, $params->{'limit'};
 708     }
 709
 710     my $sth = $dbh->prepare( $statement );
 711     my $result = $sth->execute( @query_params );
 712     return $sth->fetchall_arrayref({});
 713 }
 714
 715 =head2 _add_attachements
 716
 717 named parameters:
 718 letter - the standard letter hashref
 719 attachments - listref of attachments. each attachment is a hashref of:
 720   type - the mime type, like 'text/plain'
 721   content - the actual attachment
 722   filename - the name of the attachment.
 723 message - a MIME::Lite object to attach these to.
 724
 725 returns your letter object, with the content updated.
 726
 727 =cut
 728
 729 sub _add_attachments {
 730     my $params = shift;
 731
 732     return unless 'HASH' eq ref $params;
 733     foreach my $required_parameter (qw( letter attachments message )) {
 734         return unless exists $params->{$required_parameter};
 735     }
 736     return $params->{'letter'} unless @{ $params->{'attachments'} };
 737
 738     # First, we have to put the body in as the first attachment
 739     $params->{'message'}->attach(
 740         Type => 'TEXT',
 741         Data => $params->{'letter'}->{'content'},
 742     );
 743
 744     foreach my $attachment ( @{ $params->{'attachments'} } ) {
 745         $params->{'message'}->attach(
 746             Type     => $attachment->{'type'},
 747             Data     => $attachment->{'content'},
 748             Filename => $attachment->{'filename'},
 749         );
 750     }
 751     # we're forcing list context here to get the header, not the count back from grep.
 752     ( $params->{'letter'}->{'content-type'} ) = grep( /^Content-Type:/, split( /\n/, $params->{'message'}->header_as_string ) );
 753     $params->{'letter'}->{'content-type'} =~ s/^Content-Type:\s+//;
 754     $params->{'letter'}->{'content'} = $params->{'message'}->body_as_string;
 755
 756     return $params->{'letter'};
 757
 758 }
 759
 760 sub _get_unsent_messages (;$) {
 761     my $params = shift;
 762
 763     my $dbh = C4::Context->dbh();
 764     my $statement = << 'ENDSQL';
 765 SELECT message_id, borrowernumber, subject, content, message_transport_type, status, time_queued, from_address, to_address, content_type
 766   FROM message_queue
 767  WHERE status = ?
 768 ENDSQL
 769
 770     my @query_params = ('pending');
 771     if ( ref $params ) {
 772         if ( $params->{'message_transport_type'} ) {
 773             $statement .= ' AND message_transport_type = ? ';
 774             push @query_params, $params->{'message_transport_type'};
 775         }
 776         if ( $params->{'borrowernumber'} ) {
 777             $statement .= ' AND borrowernumber = ? ';
 778             push @query_params, $params->{'borrowernumber'};
 779         }
 780         if ( $params->{'limit'} ) {
 781             $statement .= ' limit ? ';
 782             push @query_params, $params->{'limit'};
 783         }
 784     }
 785     $debug and warn "_get_unsent_messages SQL: $statement";
 786     $debug and warn "_get_unsent_messages params: " . join(',',@query_params);
 787     my $sth = $dbh->prepare( $statement );
 788     my $result = $sth->execute( @query_params );
 789     return $sth->fetchall_arrayref({});
 790 }
 791
 792 sub _send_message_by_email ($;$$$) {
 793     my $message = shift or return;
 794
 795     my $to_address = $message->{to_address};
 796     unless ($to_address) {
 797         my $member = C4::Members::GetMember( 'borrowernumber' => $message->{'borrowernumber'} );
 798         unless ($member) {
 799             warn "FAIL: No 'to_address' and INVALID borrowernumber ($message->{borrowernumber})";
 800             _set_message_status( { message_id => $message->{'message_id'},
 801                                    status     => 'failed' } );
 802             return;
 803         }
 804         unless ($to_address = $member->{email}) {   # assigment, not comparison
 805             # warn "FAIL: No 'to_address' and no email for " . ($member->{surname} ||'') . ", borrowernumber ($message->{borrowernumber})";
 806             # warning too verbose for this more common case?
 807             _set_message_status( { message_id => $message->{'message_id'},
 808                                    status     => 'failed' } );
 809             return;
 810         }
 811     }
 812
 813         my $content = encode('utf8', $message->{'content'});
 814     my %sendmail_params = (
 815         To   => $to_address,
 816         From => $message->{'from_address'} || C4::Context->preference('KohaAdminEmailAddress'),
 817         Subject => $message->{'subject'},
 818         charset => 'utf8',
 819         Message => $content,
 820         'content-type' => $message->{'content_type'} || 'text/plain; charset="UTF-8"',
 821     );
 822     if ( my $bcc = C4::Context->preference('OverdueNoticeBcc') ) {
 823        $sendmail_params{ Bcc } = $bcc;
 824     }
 825
 826
 827     if ( sendmail( %sendmail_params ) ) {
 828         _set_message_status( { message_id => $message->{'message_id'},
 829                 status     => 'sent' } );
 830         return 1;
 831     } else {
 832         _set_message_status( { message_id => $message->{'message_id'},
 833                 status     => 'failed' } );
 834         carp $Mail::Sendmail::error;
 835         return;
 836     }
 837 }
 838
 839 sub _send_message_by_sms ($) {
 840     my $message = shift or return undef;
 841     my $member = C4::Members::GetMember( 'borrowernumber' => $message->{'borrowernumber'} );
 842     return unless $member->{'smsalertnumber'};
 843
 844     my $success = C4::SMS->send_sms( { destination => $member->{'smsalertnumber'},
 845                                        message     => $message->{'content'},
 846                                      } );
 847     _set_message_status( { message_id => $message->{'message_id'},
 848                            status     => ($success ? 'sent' : 'failed') } );
 849     return $success;
 850 }
 851
 852 sub _set_message_status ($) {
 853     my $params = shift or return undef;
 854
 855     foreach my $required_parameter ( qw( message_id status ) ) {
 856         return undef unless exists $params->{ $required_parameter };
 857     }
 858
 859     my $dbh = C4::Context->dbh();
 860     my $statement = 'UPDATE message_queue SET status= ? WHERE message_id = ?';
 861     my $sth = $dbh->prepare( $statement );
 862     my $result = $sth->execute( $params->{'status'},
 863                                 $params->{'message_id'} );
 864     return $result;
 865 }
 866
 867
 868 1;
 869 __END__