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