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             my $line = $1 if ( $letter->{content} =~ m/(<<.*>>)/ );
 328             foreach my $field ( keys %$data ) {
 329                 $line =~ s/(<<[^\.]+.$field>>)/$data->{$field}/;
 330             }
 331             $letter->{content} =~ s/(<<.*>>)/$line\n$1/;
 332         }
 333         $letter->{content} =~ s/<<[^>]*>>//g;
 334         my $innerletter = $letter;
 335
 336         # ... then send mail
 337         if (   $databookseller->{bookselleremail}
 338             || $databookseller->{contemail} )
 339         {
 340             my %mail = (
 341                 To => $databookseller->{bookselleremail}
 342                   . (
 343                     $databookseller->{contemail}
 344                     ? "," . $databookseller->{contemail}
 345                     : ""
 346                   ),
 347                 From           => $userenv->{emailaddress},
 348                 Subject        => "" . $innerletter->{title},
 349                 Message        => "" . $innerletter->{content},
 350                 'Content-Type' => 'text/plain; charset="utf8"',
 351             );
 352             sendmail(%mail) or carp $Mail::Sendmail::error;
 353         }
 354         if ( C4::Context->preference("LetterLog") ) {
 355             logaction(
 356                 "ACQUISITION",
 357                 "Send Acquisition claim letter",
 358                 "",
 359                 "order list : "
 360                   . join( ",", @$externalid )
 361                   . "\n$innerletter->{title}\n$innerletter->{content}"
 362             );
 363         }
 364     }
 365     elsif ( $type eq 'claimissues' ) {
 366
 367         #               warn "sending issues...";
 368         my $letter = getletter( 'claimissues', $letter );
 369
 370         # prepare the letter...
 371         # search the biblionumber
 372         my $strsth =
 373 "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 ("
 374           . join( ",", @$externalid ) . ")";
 375         my $sthorders = $dbh->prepare($strsth);
 376         $sthorders->execute;
 377         my $dataorders = $sthorders->fetchall_arrayref( {} );
 378         parseletter( $letter, 'aqbooksellers',
 379             $dataorders->[0]->{aqbooksellerid} );
 380         my $sthbookseller =
 381           $dbh->prepare("select * from aqbooksellers where id=?");
 382         $sthbookseller->execute( $dataorders->[0]->{aqbooksellerid} );
 383         my $databookseller = $sthbookseller->fetchrow_hashref;
 384
 385         # parsing branch info
 386         my $userenv = C4::Context->userenv;
 387         parseletter( $letter, 'branches', $userenv->{branch} );
 388
 389         # parsing librarian name
 390         $letter->{content} =~ s/<<LibrarianFirstname>>/$userenv->{firstname}/g;
 391         $letter->{content} =~ s/<<LibrarianSurname>>/$userenv->{surname}/g;
 392         $letter->{content} =~
 393           s/<<LibrarianEmailaddress>>/$userenv->{emailaddress}/g;
 394         foreach my $data (@$dataorders) {
 395             my $line = $1 if ( $letter->{content} =~ m/(<<.*>>)/ );
 396             foreach my $field ( keys %$data ) {
 397                 $line =~ s/(<<[^\.]+.$field>>)/$data->{$field}/;
 398             }
 399             $letter->{content} =~ s/(<<.*>>)/$line\n$1/;
 400         }
 401         $letter->{content} =~ s/<<[^>]*>>//g;
 402         my $innerletter = $letter;
 403
 404         # ... then send mail
 405         if (   $databookseller->{bookselleremail}
 406             || $databookseller->{contemail} ) {
 407             my $mail_to = $databookseller->{bookselleremail};
 408             if ($databookseller->{contemail}) {
 409                 if (!$mail_to) {
 410                     $mail_to = $databookseller->{contemail};
 411                 } else {
 412                     $mail_to .= q|,|;
 413                     $mail_to .= $databookseller->{contemail};
 414                 }
 415             }
 416             my $mail_subj = $innerletter->{title};
 417             my $mail_msg  = $innerletter->{content};
 418             $mail_msg  ||= q{};
 419             $mail_subj ||= q{};
 420
 421             my %mail = (
 422                 To => $mail_to,
 423                 From    => $userenv->{emailaddress},
 424                 Subject => $mail_subj,
 425                 Message => $mail_msg,
 426                 'Content-Type' => 'text/plain; charset="utf8"',
 427             );
 428             sendmail(%mail) or carp $Mail::Sendmail::error;
 429             logaction(
 430                 "ACQUISITION",
 431                 "CLAIM ISSUE",
 432                 undef,
 433                 "To="
 434                   . $databookseller->{contemail}
 435                   . " Title="
 436                   . $innerletter->{title}
 437                   . " Content="
 438                   . $innerletter->{content}
 439             ) if C4::Context->preference("LetterLog");
 440         }
 441     }
 442    # send an "account details" notice to a newly created user
 443     elsif ( $type eq 'members' ) {
 444         # must parse the password special, before it's hashed.
 445         $letter->{content} =~ s/<<borrowers.password>>/$externalid->{'password'}/g;
 446
 447         parseletter( $letter, 'borrowers', $externalid->{'borrowernumber'});
 448         parseletter( $letter, 'branches', $externalid->{'branchcode'} );
 449
 450         my $branchdetails = GetBranchDetail($externalid->{'branchcode'});
 451         my %mail = (
 452                 To      =>     $externalid->{'emailaddr'},
 453                 From    =>  $branchdetails->{'branchemail'} || C4::Context->preference("KohaAdminEmailAddress"),
 454                 Subject => $letter->{'title'},
 455                 Message => $letter->{'content'},
 456                 'Content-Type' => 'text/plain; charset="utf8"',
 457         );
 458         sendmail(%mail) or carp $Mail::Sendmail::error;
 459     }
 460 }
 461
 462 =head2 parseletter($letter, $table, $pk)
 463
 464     parameters :
 465     - $letter : a hash to letter fields (title & content useful)
 466     - $table : the Koha table to parse.
 467     - $pk : the primary key to query on the $table table
 468     parse all fields from a table, and replace values in title & content with the appropriate value
 469     (not exported sub, used only internally)
 470
 471 =cut
 472
 473 our %handles = ();
 474 our %columns = ();
 475
 476 sub parseletter_sth {
 477     my $table = shift;
 478     unless ($table) {
 479         carp "ERROR: parseletter_sth() called without argument (table)";
 480         return;
 481     }
 482     # check cache first
 483     (defined $handles{$table}) and return $handles{$table};
 484     my $query =
 485     ($table eq 'biblio'       ) ? "SELECT * FROM $table WHERE   biblionumber = ?"                      :
 486     ($table eq 'biblioitems'  ) ? "SELECT * FROM $table WHERE   biblionumber = ?"                      :
 487     ($table eq 'items'        ) ? "SELECT * FROM $table WHERE     itemnumber = ?"                      :
 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   suggestionid = ?"                      :
 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     # TEMPORARY hack until the expirationdate column is added to reserves
 524     if ( $table eq 'reserves' && $values->{'waitingdate'} ) {
 525         my @waitingdate = split /-/, $values->{'waitingdate'};
 526
 527         $values->{'expirationdate'} = C4::Dates->new(
 528             sprintf(
 529                 '%04d-%02d-%02d',
 530                 Add_Delta_Days( @waitingdate, C4::Context->preference( 'ReservesMaxPickUpDelay' ) )
 531             ),
 532             'iso'
 533         )->output();
 534     }
 535
 536
 537     # and get all fields from the table
 538     my $columns = C4::Context->dbh->prepare("SHOW COLUMNS FROM $table");
 539     $columns->execute;
 540     while ( ( my $field ) = $columns->fetchrow_array ) {
 541         my $replacefield = "<<$table.$field>>";
 542         $values->{$field} =~ s/\p{P}(?=$)//g if $values->{$field};
 543         my $replacedby   = $values->{$field} || '';
 544         ($letter->{title}  ) and $letter->{title}   =~ s/$replacefield/$replacedby/g;
 545         ($letter->{content}) and $letter->{content} =~ s/$replacefield/$replacedby/g;
 546     }
 547     return $letter;
 548 }
 549
 550 =head2 EnqueueLetter
 551
 552   my $success = EnqueueLetter( { letter => $letter,
 553         borrowernumber => '12', message_transport_type => 'email' } )
 554
 555 places a letter in the message_queue database table, which will
 556 eventually get processed (sent) by the process_message_queue.pl
 557 cronjob when it calls SendQueuedMessages.
 558
 559 return true on success
 560
 561 =cut
 562
 563 sub EnqueueLetter ($) {
 564     my $params = shift or return undef;
 565
 566     return unless exists $params->{'letter'};
 567     return unless exists $params->{'borrowernumber'};
 568     return unless exists $params->{'message_transport_type'};
 569
 570     # If we have any attachments we should encode then into the body.
 571     if ( $params->{'attachments'} ) {
 572         $params->{'letter'} = _add_attachments(
 573             {   letter      => $params->{'letter'},
 574                 attachments => $params->{'attachments'},
 575                 message     => MIME::Lite->new( Type => 'multipart/mixed' ),
 576             }
 577         );
 578     }
 579
 580     my $dbh       = C4::Context->dbh();
 581     my $statement = << 'ENDSQL';
 582 INSERT INTO message_queue
 583 ( borrowernumber, subject, content, metadata, letter_code, message_transport_type, status, time_queued, to_address, from_address, content_type )
 584 VALUES
 585 ( ?,              ?,       ?,       ?,        ?,           ?,                      ?,      NOW(),       ?,          ?,            ? )
 586 ENDSQL
 587
 588     my $sth    = $dbh->prepare($statement);
 589     my $result = $sth->execute(
 590         $params->{'borrowernumber'},              # borrowernumber
 591         $params->{'letter'}->{'title'},           # subject
 592         $params->{'letter'}->{'content'},         # content
 593         $params->{'letter'}->{'metadata'} || '',  # metadata
 594         $params->{'letter'}->{'code'}     || '',  # letter_code
 595         $params->{'message_transport_type'},      # message_transport_type
 596         'pending',                                # status
 597         $params->{'to_address'},                  # to_address
 598         $params->{'from_address'},                # from_address
 599         $params->{'letter'}->{'content-type'},    # content_type
 600     );
 601     return $result;
 602 }
 603
 604 =head2 SendQueuedMessages ([$hashref])
 605
 606   my $sent = SendQueuedMessages( { verbose => 1 } );
 607
 608 sends all of the 'pending' items in the message queue.
 609
 610 returns number of messages sent.
 611
 612 =cut
 613
 614 sub SendQueuedMessages (;$) {
 615     my $params = shift;
 616
 617     my $unsent_messages = _get_unsent_messages();
 618     MESSAGE: foreach my $message ( @$unsent_messages ) {
 619         # warn Data::Dumper->Dump( [ $message ], [ 'message' ] );
 620         warn sprintf( 'sending %s message to patron: %s',
 621                       $message->{'message_transport_type'},
 622                       $message->{'borrowernumber'} || 'Admin' )
 623           if $params->{'verbose'} or $debug;
 624         # This is just begging for subclassing
 625         next MESSAGE if ( lc($message->{'message_transport_type'}) eq 'rss' );
 626         if ( lc( $message->{'message_transport_type'} ) eq 'email' ) {
 627             _send_message_by_email( $message, $params->{'username'}, $params->{'password'}, $params->{'method'} );
 628         }
 629         elsif ( lc( $message->{'message_transport_type'} ) eq 'sms' ) {
 630             _send_message_by_sms( $message );
 631         }
 632     }
 633     return scalar( @$unsent_messages );
 634 }
 635
 636 =head2 GetRSSMessages
 637
 638   my $message_list = GetRSSMessages( { limit => 10, borrowernumber => '14' } )
 639
 640 returns a listref of all queued RSS messages for a particular person.
 641
 642 =cut
 643
 644 sub GetRSSMessages {
 645     my $params = shift;
 646
 647     return unless $params;
 648     return unless ref $params;
 649     return unless $params->{'borrowernumber'};
 650
 651     return _get_unsent_messages( { message_transport_type => 'rss',
 652                                    limit                  => $params->{'limit'},
 653                                    borrowernumber         => $params->{'borrowernumber'}, } );
 654 }
 655
 656 =head2 GetPrintMessages
 657
 658   my $message_list = GetPrintMessages( { borrowernumber => $borrowernumber } )
 659
 660 Returns a arrayref of all queued print messages (optionally, for a particular
 661 person).
 662
 663 =cut
 664
 665 sub GetPrintMessages {
 666     my $params = shift || {};
 667
 668     return _get_unsent_messages( { message_transport_type => 'print',
 669                                    borrowernumber         => $params->{'borrowernumber'}, } );
 670 }
 671
 672 =head2 GetQueuedMessages ([$hashref])
 673
 674   my $messages = GetQueuedMessage( { borrowernumber => '123', limit => 20 } );
 675
 676 fetches messages out of the message queue.
 677
 678 returns:
 679 list of hashes, each has represents a message in the message queue.
 680
 681 =cut
 682
 683 sub GetQueuedMessages {
 684     my $params = shift;
 685
 686     my $dbh = C4::Context->dbh();
 687     my $statement = << 'ENDSQL';
 688 SELECT message_id, borrowernumber, subject, content, message_transport_type, status, time_queued
 689 FROM message_queue
 690 ENDSQL
 691
 692     my @query_params;
 693     my @whereclauses;
 694     if ( exists $params->{'borrowernumber'} ) {
 695         push @whereclauses, ' borrowernumber = ? ';
 696         push @query_params, $params->{'borrowernumber'};
 697     }
 698
 699     if ( @whereclauses ) {
 700         $statement .= ' WHERE ' . join( 'AND', @whereclauses );
 701     }
 702
 703     if ( defined $params->{'limit'} ) {
 704         $statement .= ' LIMIT ? ';
 705         push @query_params, $params->{'limit'};
 706     }
 707
 708     my $sth = $dbh->prepare( $statement );
 709     my $result = $sth->execute( @query_params );
 710     return $sth->fetchall_arrayref({});
 711 }
 712
 713 =head2 _add_attachements
 714
 715 named parameters:
 716 letter - the standard letter hashref
 717 attachments - listref of attachments. each attachment is a hashref of:
 718   type - the mime type, like 'text/plain'
 719   content - the actual attachment
 720   filename - the name of the attachment.
 721 message - a MIME::Lite object to attach these to.
 722
 723 returns your letter object, with the content updated.
 724
 725 =cut
 726
 727 sub _add_attachments {
 728     my $params = shift;
 729
 730     return unless 'HASH' eq ref $params;
 731     foreach my $required_parameter (qw( letter attachments message )) {
 732         return unless exists $params->{$required_parameter};
 733     }
 734     return $params->{'letter'} unless @{ $params->{'attachments'} };
 735
 736     # First, we have to put the body in as the first attachment
 737     $params->{'message'}->attach(
 738         Type => 'TEXT',
 739         Data => $params->{'letter'}->{'content'},
 740     );
 741
 742     foreach my $attachment ( @{ $params->{'attachments'} } ) {
 743         $params->{'message'}->attach(
 744             Type     => $attachment->{'type'},
 745             Data     => $attachment->{'content'},
 746             Filename => $attachment->{'filename'},
 747         );
 748     }
 749     # we're forcing list context here to get the header, not the count back from grep.
 750     ( $params->{'letter'}->{'content-type'} ) = grep( /^Content-Type:/, split( /\n/, $params->{'message'}->header_as_string ) );
 751     $params->{'letter'}->{'content-type'} =~ s/^Content-Type:\s+//;
 752     $params->{'letter'}->{'content'} = $params->{'message'}->body_as_string;
 753
 754     return $params->{'letter'};
 755
 756 }
 757
 758 sub _get_unsent_messages (;$) {
 759     my $params = shift;
 760
 761     my $dbh = C4::Context->dbh();
 762     my $statement = << 'ENDSQL';
 763 SELECT message_id, borrowernumber, subject, content, message_transport_type, status, time_queued, from_address, to_address, content_type
 764   FROM message_queue
 765  WHERE status = ?
 766 ENDSQL
 767
 768     my @query_params = ('pending');
 769     if ( ref $params ) {
 770         if ( $params->{'message_transport_type'} ) {
 771             $statement .= ' AND message_transport_type = ? ';
 772             push @query_params, $params->{'message_transport_type'};
 773         }
 774         if ( $params->{'borrowernumber'} ) {
 775             $statement .= ' AND borrowernumber = ? ';
 776             push @query_params, $params->{'borrowernumber'};
 777         }
 778         if ( $params->{'limit'} ) {
 779             $statement .= ' limit ? ';
 780             push @query_params, $params->{'limit'};
 781         }
 782     }
 783     $debug and warn "_get_unsent_messages SQL: $statement";
 784     $debug and warn "_get_unsent_messages params: " . join(',',@query_params);
 785     my $sth = $dbh->prepare( $statement );
 786     my $result = $sth->execute( @query_params );
 787     return $sth->fetchall_arrayref({});
 788 }
 789
 790 sub _send_message_by_email ($;$$$) {
 791     my $message = shift or return;
 792     my ($username, $password, $method) = @_;
 793
 794     my $to_address = $message->{to_address};
 795     unless ($to_address) {
 796         my $member = C4::Members::GetMember( 'borrowernumber' => $message->{'borrowernumber'} );
 797         unless ($member) {
 798             warn "FAIL: No 'to_address' and INVALID borrowernumber ($message->{borrowernumber})";
 799             _set_message_status( { message_id => $message->{'message_id'},
 800                                    status     => 'failed' } );
 801             return;
 802         }
 803         my $which_address = C4::Context->preference('AutoEmailPrimaryAddress');
 804         # If the system preference is set to 'first valid' (value == OFF), look up email address
 805         if ($which_address eq 'OFF') {
 806             $to_address = GetFirstValidEmailAddress( $message->{'borrowernumber'} );
 807         } else {
 808             $to_address = $member->{$which_address};
 809         }
 810         unless ($to_address) {
 811             # warn "FAIL: No 'to_address' and no email for " . ($member->{surname} ||'') . ", borrowernumber ($message->{borrowernumber})";
 812             # warning too verbose for this more common case?
 813             _set_message_status( { message_id => $message->{'message_id'},
 814                                    status     => 'failed' } );
 815             return;
 816         }
 817     }
 818
 819         my $content = encode('utf8', $message->{'content'});
 820     my %sendmail_params = (
 821         To   => $to_address,
 822         From => $message->{'from_address'} || C4::Context->preference('KohaAdminEmailAddress'),
 823         Subject => encode('utf8', $message->{'subject'}),
 824         charset => 'utf8',
 825         Message => $content,
 826         'content-type' => $message->{'content_type'} || 'text/plain; charset="UTF-8"',
 827     );
 828     $sendmail_params{'Auth'} = {user => $username, pass => $password, method => $method} if $username;
 829     if ( my $bcc = C4::Context->preference('OverdueNoticeBcc') ) {
 830        $sendmail_params{ Bcc } = $bcc;
 831     }
 832
 833
 834     if ( sendmail( %sendmail_params ) ) {
 835         _set_message_status( { message_id => $message->{'message_id'},
 836                 status     => 'sent' } );
 837         return 1;
 838     } else {
 839         _set_message_status( { message_id => $message->{'message_id'},
 840                 status     => 'failed' } );
 841         carp $Mail::Sendmail::error;
 842         return;
 843     }
 844 }
 845
 846 sub _send_message_by_sms ($) {
 847     my $message = shift or return undef;
 848     my $member = C4::Members::GetMember( 'borrowernumber' => $message->{'borrowernumber'} );
 849     return unless $member->{'smsalertnumber'};
 850
 851     my $success = C4::SMS->send_sms( { destination => $member->{'smsalertnumber'},
 852                                        message     => $message->{'content'},
 853                                      } );
 854     _set_message_status( { message_id => $message->{'message_id'},
 855                            status     => ($success ? 'sent' : 'failed') } );
 856     return $success;
 857 }
 858
 859 sub _set_message_status ($) {
 860     my $params = shift or return undef;
 861
 862     foreach my $required_parameter ( qw( message_id status ) ) {
 863         return undef unless exists $params->{ $required_parameter };
 864     }
 865
 866     my $dbh = C4::Context->dbh();
 867     my $statement = 'UPDATE message_queue SET status= ? WHERE message_id = ?';
 868     my $sth = $dbh->prepare( $statement );
 869     my $result = $sth->execute( $params->{'status'},
 870                                 $params->{'message_id'} );
 871     return $result;
 872 }
 873
 874
 875 1;
 876 __END__