C4/Letters.pm

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