C4/Letters.pm

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