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