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