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 'issues'       ) ? "SELECT * FROM $table WHERE     itemnumber = ?"                      :
 489     ($table eq 'reserves'     ) ? "SELECT * FROM $table WHERE borrowernumber = ? and biblionumber = ?" :
 490     ($table eq 'borrowers'    ) ? "SELECT * FROM $table WHERE borrowernumber = ?"                      :
 491     ($table eq 'branches'     ) ? "SELECT * FROM $table WHERE     branchcode = ?"                      :
 492     ($table eq 'suggestions'  ) ? "SELECT * FROM $table WHERE   suggestionid = ?"                      :
 493     ($table eq 'aqbooksellers') ? "SELECT * FROM $table WHERE             id = ?"                      : undef ;
 494     unless ($query) {
 495         warn "ERROR: No parseletter_sth query for table '$table'";
 496         return;     # nothing to get
 497     }
 498     unless ($handles{$table} = C4::Context->dbh->prepare($query)) {
 499         warn "ERROR: Failed to prepare query: '$query'";
 500         return;
 501     }
 502     return $handles{$table};    # now cache is populated for that $table
 503 }
 504
 505 sub parseletter {
 506     my ( $letter, $table, $pk, $pk2 ) = @_;
 507     unless ($letter) {
 508         carp "ERROR: parseletter() 1st argument 'letter' empty";
 509         return;
 510     }
 511     my $sth = parseletter_sth($table);
 512     unless ($sth) {
 513         warn "parseletter_sth('$table') failed to return a valid sth.  No substitution will be done for that table.";
 514         return;
 515     }
 516     if ( $pk2 ) {
 517         $sth->execute($pk, $pk2);
 518     } else {
 519         $sth->execute($pk);
 520     }
 521
 522     my $values = $sth->fetchrow_hashref;
 523
 524     # TEMPORARY hack until the expirationdate column is added to reserves
 525     if ( $table eq 'reserves' && $values->{'waitingdate'} ) {
 526         my @waitingdate = split /-/, $values->{'waitingdate'};
 527
 528         $values->{'expirationdate'} = C4::Dates->new(
 529             sprintf(
 530                 '%04d-%02d-%02d',
 531                 Add_Delta_Days( @waitingdate, C4::Context->preference( 'ReservesMaxPickUpDelay' ) )
 532             ),
 533             'iso'
 534         )->output();
 535     }
 536
 537
 538     # and get all fields from the table
 539     my $columns = C4::Context->dbh->prepare("SHOW COLUMNS FROM $table");
 540     $columns->execute;
 541     while ( ( my $field ) = $columns->fetchrow_array ) {
 542         my $replacefield = "<<$table.$field>>";
 543         $values->{$field} =~ s/\p{P}(?=$)//g if $values->{$field};
 544         my $replacedby   = $values->{$field} || '';
 545         ($letter->{title}  ) and $letter->{title}   =~ s/$replacefield/$replacedby/g;
 546         ($letter->{content}) and $letter->{content} =~ s/$replacefield/$replacedby/g;
 547     }
 548     return $letter;
 549 }
 550
 551 =head2 EnqueueLetter
 552
 553   my $success = EnqueueLetter( { letter => $letter,
 554         borrowernumber => '12', message_transport_type => 'email' } )
 555
 556 places a letter in the message_queue database table, which will
 557 eventually get processed (sent) by the process_message_queue.pl
 558 cronjob when it calls SendQueuedMessages.
 559
 560 return true on success
 561
 562 =cut
 563
 564 sub EnqueueLetter ($) {
 565     my $params = shift or return undef;
 566
 567     return unless exists $params->{'letter'};
 568     return unless exists $params->{'borrowernumber'};
 569     return unless exists $params->{'message_transport_type'};
 570
 571     # If we have any attachments we should encode then into the body.
 572     if ( $params->{'attachments'} ) {
 573         $params->{'letter'} = _add_attachments(
 574             {   letter      => $params->{'letter'},
 575                 attachments => $params->{'attachments'},
 576                 message     => MIME::Lite->new( Type => 'multipart/mixed' ),
 577             }
 578         );
 579     }
 580
 581     my $dbh       = C4::Context->dbh();
 582     my $statement = << 'ENDSQL';
 583 INSERT INTO message_queue
 584 ( borrowernumber, subject, content, metadata, letter_code, message_transport_type, status, time_queued, to_address, from_address, content_type )
 585 VALUES
 586 ( ?,              ?,       ?,       ?,        ?,           ?,                      ?,      NOW(),       ?,          ?,            ? )
 587 ENDSQL
 588
 589     my $sth    = $dbh->prepare($statement);
 590     my $result = $sth->execute(
 591         $params->{'borrowernumber'},              # borrowernumber
 592         $params->{'letter'}->{'title'},           # subject
 593         $params->{'letter'}->{'content'},         # content
 594         $params->{'letter'}->{'metadata'} || '',  # metadata
 595         $params->{'letter'}->{'code'}     || '',  # letter_code
 596         $params->{'message_transport_type'},      # message_transport_type
 597         'pending',                                # status
 598         $params->{'to_address'},                  # to_address
 599         $params->{'from_address'},                # from_address
 600         $params->{'letter'}->{'content-type'},    # content_type
 601     );
 602     return $result;
 603 }
 604
 605 =head2 SendQueuedMessages ([$hashref])
 606
 607   my $sent = SendQueuedMessages( { verbose => 1 } );
 608
 609 sends all of the 'pending' items in the message queue.
 610
 611 returns number of messages sent.
 612
 613 =cut
 614
 615 sub SendQueuedMessages (;$) {
 616     my $params = shift;
 617
 618     my $unsent_messages = _get_unsent_messages();
 619     MESSAGE: foreach my $message ( @$unsent_messages ) {
 620         # warn Data::Dumper->Dump( [ $message ], [ 'message' ] );
 621         warn sprintf( 'sending %s message to patron: %s',
 622                       $message->{'message_transport_type'},
 623                       $message->{'borrowernumber'} || 'Admin' )
 624           if $params->{'verbose'} or $debug;
 625         # This is just begging for subclassing
 626         next MESSAGE if ( lc($message->{'message_transport_type'}) eq 'rss' );
 627         if ( lc( $message->{'message_transport_type'} ) eq 'email' ) {
 628             _send_message_by_email( $message, $params->{'username'}, $params->{'password'}, $params->{'method'} );
 629         }
 630         elsif ( lc( $message->{'message_transport_type'} ) eq 'sms' ) {
 631             _send_message_by_sms( $message );
 632         }
 633     }
 634     return scalar( @$unsent_messages );
 635 }
 636
 637 =head2 GetRSSMessages
 638
 639   my $message_list = GetRSSMessages( { limit => 10, borrowernumber => '14' } )
 640
 641 returns a listref of all queued RSS messages for a particular person.
 642
 643 =cut
 644
 645 sub GetRSSMessages {
 646     my $params = shift;
 647
 648     return unless $params;
 649     return unless ref $params;
 650     return unless $params->{'borrowernumber'};
 651
 652     return _get_unsent_messages( { message_transport_type => 'rss',
 653                                    limit                  => $params->{'limit'},
 654                                    borrowernumber         => $params->{'borrowernumber'}, } );
 655 }
 656
 657 =head2 GetPrintMessages
 658
 659   my $message_list = GetPrintMessages( { borrowernumber => $borrowernumber } )
 660
 661 Returns a arrayref of all queued print messages (optionally, for a particular
 662 person).
 663
 664 =cut
 665
 666 sub GetPrintMessages {
 667     my $params = shift || {};
 668
 669     return _get_unsent_messages( { message_transport_type => 'print',
 670                                    borrowernumber         => $params->{'borrowernumber'}, } );
 671 }
 672
 673 =head2 GetQueuedMessages ([$hashref])
 674
 675   my $messages = GetQueuedMessage( { borrowernumber => '123', limit => 20 } );
 676
 677 fetches messages out of the message queue.
 678
 679 returns:
 680 list of hashes, each has represents a message in the message queue.
 681
 682 =cut
 683
 684 sub GetQueuedMessages {
 685     my $params = shift;
 686
 687     my $dbh = C4::Context->dbh();
 688     my $statement = << 'ENDSQL';
 689 SELECT message_id, borrowernumber, subject, content, message_transport_type, status, time_queued
 690 FROM message_queue
 691 ENDSQL
 692
 693     my @query_params;
 694     my @whereclauses;
 695     if ( exists $params->{'borrowernumber'} ) {
 696         push @whereclauses, ' borrowernumber = ? ';
 697         push @query_params, $params->{'borrowernumber'};
 698     }
 699
 700     if ( @whereclauses ) {
 701         $statement .= ' WHERE ' . join( 'AND', @whereclauses );
 702     }
 703
 704     if ( defined $params->{'limit'} ) {
 705         $statement .= ' LIMIT ? ';
 706         push @query_params, $params->{'limit'};
 707     }
 708
 709     my $sth = $dbh->prepare( $statement );
 710     my $result = $sth->execute( @query_params );
 711     return $sth->fetchall_arrayref({});
 712 }
 713
 714 =head2 _add_attachements
 715
 716 named parameters:
 717 letter - the standard letter hashref
 718 attachments - listref of attachments. each attachment is a hashref of:
 719   type - the mime type, like 'text/plain'
 720   content - the actual attachment
 721   filename - the name of the attachment.
 722 message - a MIME::Lite object to attach these to.
 723
 724 returns your letter object, with the content updated.
 725
 726 =cut
 727
 728 sub _add_attachments {
 729     my $params = shift;
 730
 731     return unless 'HASH' eq ref $params;
 732     foreach my $required_parameter (qw( letter attachments message )) {
 733         return unless exists $params->{$required_parameter};
 734     }
 735     return $params->{'letter'} unless @{ $params->{'attachments'} };
 736
 737     # First, we have to put the body in as the first attachment
 738     $params->{'message'}->attach(
 739         Type => 'TEXT',
 740         Data => $params->{'letter'}->{'content'},
 741     );
 742
 743     foreach my $attachment ( @{ $params->{'attachments'} } ) {
 744         $params->{'message'}->attach(
 745             Type     => $attachment->{'type'},
 746             Data     => $attachment->{'content'},
 747             Filename => $attachment->{'filename'},
 748         );
 749     }
 750     # we're forcing list context here to get the header, not the count back from grep.
 751     ( $params->{'letter'}->{'content-type'} ) = grep( /^Content-Type:/, split( /\n/, $params->{'message'}->header_as_string ) );
 752     $params->{'letter'}->{'content-type'} =~ s/^Content-Type:\s+//;
 753     $params->{'letter'}->{'content'} = $params->{'message'}->body_as_string;
 754
 755     return $params->{'letter'};
 756
 757 }
 758
 759 sub _get_unsent_messages (;$) {
 760     my $params = shift;
 761
 762     my $dbh = C4::Context->dbh();
 763     my $statement = << 'ENDSQL';
 764 SELECT message_id, borrowernumber, subject, content, message_transport_type, status, time_queued, from_address, to_address, content_type
 765   FROM message_queue
 766  WHERE status = ?
 767 ENDSQL
 768
 769     my @query_params = ('pending');
 770     if ( ref $params ) {
 771         if ( $params->{'message_transport_type'} ) {
 772             $statement .= ' AND message_transport_type = ? ';
 773             push @query_params, $params->{'message_transport_type'};
 774         }
 775         if ( $params->{'borrowernumber'} ) {
 776             $statement .= ' AND borrowernumber = ? ';
 777             push @query_params, $params->{'borrowernumber'};
 778         }
 779         if ( $params->{'limit'} ) {
 780             $statement .= ' limit ? ';
 781             push @query_params, $params->{'limit'};
 782         }
 783     }
 784     $debug and warn "_get_unsent_messages SQL: $statement";
 785     $debug and warn "_get_unsent_messages params: " . join(',',@query_params);
 786     my $sth = $dbh->prepare( $statement );
 787     my $result = $sth->execute( @query_params );
 788     return $sth->fetchall_arrayref({});
 789 }
 790
 791 sub _send_message_by_email ($;$$$) {
 792     my $message = shift or return;
 793     my ($username, $password, $method) = @_;
 794
 795     my $to_address = $message->{to_address};
 796     unless ($to_address) {
 797         my $member = C4::Members::GetMember( 'borrowernumber' => $message->{'borrowernumber'} );
 798         unless ($member) {
 799             warn "FAIL: No 'to_address' and INVALID borrowernumber ($message->{borrowernumber})";
 800             _set_message_status( { message_id => $message->{'message_id'},
 801                                    status     => 'failed' } );
 802             return;
 803         }
 804         my $which_address = C4::Context->preference('AutoEmailPrimaryAddress');
 805         # If the system preference is set to 'first valid' (value == OFF), look up email address
 806         if ($which_address eq 'OFF') {
 807             $to_address = GetFirstValidEmailAddress( $message->{'borrowernumber'} );
 808         } else {
 809             $to_address = $member->{$which_address};
 810         }
 811         unless ($to_address) {
 812             # warn "FAIL: No 'to_address' and no email for " . ($member->{surname} ||'') . ", borrowernumber ($message->{borrowernumber})";
 813             # warning too verbose for this more common case?
 814             _set_message_status( { message_id => $message->{'message_id'},
 815                                    status     => 'failed' } );
 816             return;
 817         }
 818     }
 819
 820     my $utf8   = decode('MIME-Header', $message->{'subject'} );
 821     $message->{subject}= encode('MIME-Header', $utf8);
 822     my $content = encode('utf8', $message->{'content'});
 823     my %sendmail_params = (
 824         To   => $to_address,
 825         From => $message->{'from_address'} || C4::Context->preference('KohaAdminEmailAddress'),
 826         Subject => encode('utf8', $message->{'subject'}),
 827         charset => 'utf8',
 828         Message => $content,
 829         'content-type' => $message->{'content_type'} || 'text/plain; charset="UTF-8"',
 830     );
 831     $sendmail_params{'Auth'} = {user => $username, pass => $password, method => $method} if $username;
 832     if ( my $bcc = C4::Context->preference('OverdueNoticeBcc') ) {
 833        $sendmail_params{ Bcc } = $bcc;
 834     }
 835
 836     _update_message_to_address($message->{'message_id'},$to_address) unless $message->{to_address}; #if initial message address was empty, coming here means that a to address was found and queue should be updated
 837     if ( sendmail( %sendmail_params ) ) {
 838         _set_message_status( { message_id => $message->{'message_id'},
 839                 status     => 'sent' } );
 840         return 1;
 841     } else {
 842         _set_message_status( { message_id => $message->{'message_id'},
 843                 status     => 'failed' } );
 844         carp $Mail::Sendmail::error;
 845         return;
 846     }
 847 }
 848
 849 sub _send_message_by_sms ($) {
 850     my $message = shift or return undef;
 851     my $member = C4::Members::GetMember( 'borrowernumber' => $message->{'borrowernumber'} );
 852     return unless $member->{'smsalertnumber'};
 853
 854     my $success = C4::SMS->send_sms( { destination => $member->{'smsalertnumber'},
 855                                        message     => $message->{'content'},
 856                                      } );
 857     _set_message_status( { message_id => $message->{'message_id'},
 858                            status     => ($success ? 'sent' : 'failed') } );
 859     return $success;
 860 }
 861
 862 sub _update_message_to_address {
 863     my ($id, $to)= @_;
 864     my $dbh = C4::Context->dbh();
 865     $dbh->do('UPDATE message_queue SET to_address=? WHERE message_id=?',undef,($to,$id));
 866 }
 867
 868 sub _set_message_status ($) {
 869     my $params = shift or return undef;
 870
 871     foreach my $required_parameter ( qw( message_id status ) ) {
 872         return undef unless exists $params->{ $required_parameter };
 873     }
 874
 875     my $dbh = C4::Context->dbh();
 876     my $statement = 'UPDATE message_queue SET status= ? WHERE message_id = ?';
 877     my $sth = $dbh->prepare( $statement );
 878     my $result = $sth->execute( $params->{'status'},
 879                                 $params->{'message_id'} );
 880     return $result;
 881 }
 882
 883
 884 1;
 885 __END__