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   my $success = EnqueueLetter( { letter => $letter,
 556         borrowernumber => '12', message_transport_type => 'email' } )
 557
 558 places a letter in the message_queue database table, which will
 559 eventually get processed (sent) by the process_message_queue.pl
 560 cronjob when it calls SendQueuedMessages.
 561
 562 return true on success
 563
 564 =cut
 565
 566 sub EnqueueLetter ($) {
 567     my $params = shift or return undef;
 568
 569     return unless exists $params->{'letter'};
 570     return unless exists $params->{'borrowernumber'};
 571     return unless exists $params->{'message_transport_type'};
 572
 573     # If we have any attachments we should encode then into the body.
 574     if ( $params->{'attachments'} ) {
 575         $params->{'letter'} = _add_attachments(
 576             {   letter      => $params->{'letter'},
 577                 attachments => $params->{'attachments'},
 578                 message     => MIME::Lite->new( Type => 'multipart/mixed' ),
 579             }
 580         );
 581     }
 582
 583     my $dbh       = C4::Context->dbh();
 584     my $statement = << 'ENDSQL';
 585 INSERT INTO message_queue
 586 ( borrowernumber, subject, content, metadata, letter_code, message_transport_type, status, time_queued, to_address, from_address, content_type )
 587 VALUES
 588 ( ?,              ?,       ?,       ?,        ?,           ?,                      ?,      NOW(),       ?,          ?,            ? )
 589 ENDSQL
 590
 591     my $sth    = $dbh->prepare($statement);
 592     my $result = $sth->execute(
 593         $params->{'borrowernumber'},              # borrowernumber
 594         $params->{'letter'}->{'title'},           # subject
 595         $params->{'letter'}->{'content'},         # content
 596         $params->{'letter'}->{'metadata'} || '',  # metadata
 597         $params->{'letter'}->{'code'}     || '',  # letter_code
 598         $params->{'message_transport_type'},      # message_transport_type
 599         'pending',                                # status
 600         $params->{'to_address'},                  # to_address
 601         $params->{'from_address'},                # from_address
 602         $params->{'letter'}->{'content-type'},    # content_type
 603     );
 604     return $result;
 605 }
 606
 607 =head2 SendQueuedMessages ([$hashref])
 608
 609   my $sent = SendQueuedMessages( { verbose => 1 } );
 610
 611 sends all of the 'pending' items in the message queue.
 612
 613 returns number of messages sent.
 614
 615 =cut
 616
 617 sub SendQueuedMessages (;$) {
 618     my $params = shift;
 619
 620     my $unsent_messages = _get_unsent_messages();
 621     MESSAGE: foreach my $message ( @$unsent_messages ) {
 622         # warn Data::Dumper->Dump( [ $message ], [ 'message' ] );
 623         warn sprintf( 'sending %s message to patron: %s',
 624                       $message->{'message_transport_type'},
 625                       $message->{'borrowernumber'} || 'Admin' )
 626           if $params->{'verbose'} or $debug;
 627         # This is just begging for subclassing
 628         next MESSAGE if ( lc($message->{'message_transport_type'}) eq 'rss' );
 629         if ( lc( $message->{'message_transport_type'} ) eq 'email' ) {
 630             _send_message_by_email( $message );
 631         }
 632         elsif ( lc( $message->{'message_transport_type'} ) eq 'sms' ) {
 633             _send_message_by_sms( $message );
 634         }
 635     }
 636     return scalar( @$unsent_messages );
 637 }
 638
 639 =head2 GetRSSMessages
 640
 641   my $message_list = GetRSSMessages( { limit => 10, borrowernumber => '14' } )
 642
 643 returns a listref of all queued RSS messages for a particular person.
 644
 645 =cut
 646
 647 sub GetRSSMessages {
 648     my $params = shift;
 649
 650     return unless $params;
 651     return unless ref $params;
 652     return unless $params->{'borrowernumber'};
 653
 654     return _get_unsent_messages( { message_transport_type => 'rss',
 655                                    limit                  => $params->{'limit'},
 656                                    borrowernumber         => $params->{'borrowernumber'}, } );
 657 }
 658
 659 =head2 GetPrintMessages
 660
 661   my $message_list = GetPrintMessages( { borrowernumber => $borrowernumber } )
 662
 663 Returns a arrayref of all queued print messages (optionally, for a particular
 664 person).
 665
 666 =cut
 667
 668 sub GetPrintMessages {
 669     my $params = shift || {};
 670
 671     return _get_unsent_messages( { message_transport_type => 'print',
 672                                    borrowernumber         => $params->{'borrowernumber'}, } );
 673 }
 674
 675 =head2 GetQueuedMessages ([$hashref])
 676
 677   my $messages = GetQueuedMessage( { borrowernumber => '123', limit => 20 } );
 678
 679 fetches messages out of the message queue.
 680
 681 returns:
 682 list of hashes, each has represents a message in the message queue.
 683
 684 =cut
 685
 686 sub GetQueuedMessages {
 687     my $params = shift;
 688
 689     my $dbh = C4::Context->dbh();
 690     my $statement = << 'ENDSQL';
 691 SELECT message_id, borrowernumber, subject, content, message_transport_type, status, time_queued
 692 FROM message_queue
 693 ENDSQL
 694
 695     my @query_params;
 696     my @whereclauses;
 697     if ( exists $params->{'borrowernumber'} ) {
 698         push @whereclauses, ' borrowernumber = ? ';
 699         push @query_params, $params->{'borrowernumber'};
 700     }
 701
 702     if ( @whereclauses ) {
 703         $statement .= ' WHERE ' . join( 'AND', @whereclauses );
 704     }
 705
 706     if ( defined $params->{'limit'} ) {
 707         $statement .= ' LIMIT ? ';
 708         push @query_params, $params->{'limit'};
 709     }
 710
 711     my $sth = $dbh->prepare( $statement );
 712     my $result = $sth->execute( @query_params );
 713     return $sth->fetchall_arrayref({});
 714 }
 715
 716 =head2 _add_attachements
 717
 718 named parameters:
 719 letter - the standard letter hashref
 720 attachments - listref of attachments. each attachment is a hashref of:
 721   type - the mime type, like 'text/plain'
 722   content - the actual attachment
 723   filename - the name of the attachment.
 724 message - a MIME::Lite object to attach these to.
 725
 726 returns your letter object, with the content updated.
 727
 728 =cut
 729
 730 sub _add_attachments {
 731     my $params = shift;
 732
 733     return unless 'HASH' eq ref $params;
 734     foreach my $required_parameter (qw( letter attachments message )) {
 735         return unless exists $params->{$required_parameter};
 736     }
 737     return $params->{'letter'} unless @{ $params->{'attachments'} };
 738
 739     # First, we have to put the body in as the first attachment
 740     $params->{'message'}->attach(
 741         Type => 'TEXT',
 742         Data => $params->{'letter'}->{'content'},
 743     );
 744
 745     foreach my $attachment ( @{ $params->{'attachments'} } ) {
 746         $params->{'message'}->attach(
 747             Type     => $attachment->{'type'},
 748             Data     => $attachment->{'content'},
 749             Filename => $attachment->{'filename'},
 750         );
 751     }
 752     # we're forcing list context here to get the header, not the count back from grep.
 753     ( $params->{'letter'}->{'content-type'} ) = grep( /^Content-Type:/, split( /\n/, $params->{'message'}->header_as_string ) );
 754     $params->{'letter'}->{'content-type'} =~ s/^Content-Type:\s+//;
 755     $params->{'letter'}->{'content'} = $params->{'message'}->body_as_string;
 756
 757     return $params->{'letter'};
 758
 759 }
 760
 761 sub _get_unsent_messages (;$) {
 762     my $params = shift;
 763
 764     my $dbh = C4::Context->dbh();
 765     my $statement = << 'ENDSQL';
 766 SELECT message_id, borrowernumber, subject, content, message_transport_type, status, time_queued, from_address, to_address, content_type
 767   FROM message_queue
 768  WHERE status = ?
 769 ENDSQL
 770
 771     my @query_params = ('pending');
 772     if ( ref $params ) {
 773         if ( $params->{'message_transport_type'} ) {
 774             $statement .= ' AND message_transport_type = ? ';
 775             push @query_params, $params->{'message_transport_type'};
 776         }
 777         if ( $params->{'borrowernumber'} ) {
 778             $statement .= ' AND borrowernumber = ? ';
 779             push @query_params, $params->{'borrowernumber'};
 780         }
 781         if ( $params->{'limit'} ) {
 782             $statement .= ' limit ? ';
 783             push @query_params, $params->{'limit'};
 784         }
 785     }
 786     $debug and warn "_get_unsent_messages SQL: $statement";
 787     $debug and warn "_get_unsent_messages params: " . join(',',@query_params);
 788     my $sth = $dbh->prepare( $statement );
 789     my $result = $sth->execute( @query_params );
 790     return $sth->fetchall_arrayref({});
 791 }
 792
 793 sub _send_message_by_email ($;$$$) {
 794     my $message = shift or return;
 795
 796     my $to_address = $message->{to_address};
 797     unless ($to_address) {
 798         my $member = C4::Members::GetMember( 'borrowernumber' => $message->{'borrowernumber'} );
 799         unless ($member) {
 800             warn "FAIL: No 'to_address' and INVALID borrowernumber ($message->{borrowernumber})";
 801             _set_message_status( { message_id => $message->{'message_id'},
 802                                    status     => 'failed' } );
 803             return;
 804         }
 805         my $which_address = C4::Context->preference('AutoEmailPrimaryAddress');
 806         $to_address = $member->{$which_address};
 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 => $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__