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