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