Bug 2176 (3/5): adding methods to manage message_queue, new advance_notices.pl, new...
[koha.git] / 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
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 ) = @_;
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     }
478     elsif ( $table eq 'biblioitems' ) {
479         $sth = $dbh->prepare("select * from biblioitems where biblionumber=?");
480     }
481     elsif ( $table eq 'borrowers' ) {
482         $sth = $dbh->prepare("select * from borrowers where borrowernumber=?");
483     }
484     elsif ( $table eq 'branches' ) {
485         $sth = $dbh->prepare("select * from branches where branchcode=?");
486     }
487     elsif ( $table eq 'aqbooksellers' ) {
488         $sth = $dbh->prepare("select * from aqbooksellers where id=?");
489     }
490     $sth->execute($pk);
491
492     # store the result in an hash
493     my $values = $sth->fetchrow_hashref;
494
495     # and get all fields from the table
496     $sth = $dbh->prepare("show columns from $table");
497     $sth->execute;
498     while ( ( my $field ) = $sth->fetchrow_array ) {
499         my $replacefield = "<<$table.$field>>";
500         my $replacedby   = $values->{$field};
501
502         #               warn "REPLACE $replacefield by $replacedby";
503         $letter->{title}   =~ s/$replacefield/$replacedby/g;
504         $letter->{content} =~ s/$replacefield/$replacedby/g;
505     }
506 }
507
508 =head2 EnqueueLetter
509
510 =over 4
511
512 my $success = EnqueueLetter( { letter => $letter, borrowernumber => '12', message_transport_type => 'email' } )
513
514 places a letter in the message_queue database table, which will
515 eventually get processed (sent) by the process_message_queue.pl
516 cronjob when it calls SendQueuedMessages.
517
518 return true on success
519
520 =back
521
522 =cut
523
524 sub EnqueueLetter {
525     my $params = shift;
526
527     return unless exists $params->{'letter'};
528     return unless exists $params->{'borrowernumber'};
529     return unless exists $params->{'message_transport_type'};
530     
531     my $dbh = C4::Context->dbh();
532     my $statement = << 'ENDSQL';
533 INSERT INTO message_queue
534 ( borrowernumber, subject, content, message_transport_type, status, time_queued )
535 VALUES
536 ( ?,              ?,       ?,       ?,                      ?,      NOW() )
537 ENDSQL
538
539     my $sth = $dbh->prepare( $statement );
540     my $result = $sth->execute( $params->{'borrowernumber'},         # borrowernumber
541                                 $params->{'letter'}->{'title'},      # subject
542                                 $params->{'letter'}->{'content'},    # content
543                                 $params->{'message_transport_type'}, # message_transport_type
544                                 'pending',                           # status
545                            );
546     return $result;
547 }
548
549 =head2 SendQueuedMessages
550
551 =over 4
552
553 SendQueuedMessages()
554
555 sends all of the 'pending' items in the message queue.
556
557 my $sent = SendQueuedMessages( { verbose => 1 } )
558
559 returns number of messages sent.
560
561 =back
562
563 =cut
564
565 sub SendQueuedMessages {
566     my $params = shift;
567
568     my $unsent_messages = _get_unsent_messages();
569     MESSAGE: foreach my $message ( @$unsent_messages ) {
570         # warn Data::Dumper->Dump( [ $message ], [ 'message' ] );
571         warn "sending $message->{'message_transport_type'} message to patron $message->{'borrowernumber'}" if $params->{'verbose'};
572         # This is just begging for subclassing
573         next MESSAGE if ( lc( $message->{'message_transport_type'} eq 'rss' ) );
574         if ( lc( $message->{'message_transport_type'} ) eq 'email' ) {
575             _send_message_by_email( $message );
576         }
577         if ( lc( $message->{'message_transport_type'} ) eq 'sms' ) {
578             _send_message_by_sms( $message );
579         }
580     }
581     return scalar( @$unsent_messages );
582 }
583
584 sub _get_unsent_messages {
585
586     my $dbh = C4::Context->dbh();
587     my $statement = << 'ENDSQL';
588 SELECT message_id, borrowernumber, subject, content, type, status, time_queued
589 FROM message_queue
590 WHERE status = 'pending'
591 ENDSQL
592
593     my $sth = $dbh->prepare( $statement );
594     my $result = $sth->execute();
595     my $unsent_messages = $sth->fetchall_arrayref({});
596     return $unsent_messages;
597 }
598
599 sub _send_message_by_email {
600     my $message = shift;
601
602     my $member = C4::Members::GetMember( $message->{'borrowernumber'} );
603     return unless $member->{'email'};
604
605     my $success = sendmail( To      => $member->{'email'},
606                             From    => C4::Context->preference('KohaAdminEmailAddress'),
607                             Subject => $message->{'subject'},
608                             Message => $message->{'content'},
609                        );
610     if ( $success ) {
611         # warn "OK. Log says:\n", $Mail::Sendmail::log;
612         _set_message_status( { message_id => $message->{'message_id'},
613                                status     => 'sent' } );
614         return $success;
615     } else {
616         # warn $Mail::Sendmail::error;
617         _set_message_status( { message_id => $message->{'message_id'},
618                                status     => 'failed' } );
619         return;
620     }
621 }
622
623 sub _send_message_by_sms {
624     my $message = shift;
625
626     my $member = C4::Members::GetMember( $message->{'borrowernumber'} );
627     return unless $member->{'smsalertnumber'};
628
629     my $success = C4::SMS->send_sms( { destination => $member->{'smsalertnumber'},
630                                        message     => $message->{'content'},
631                                      } );
632     if ( $success ) {
633         _set_message_status( { message_id => $message->{'message_id'},
634                                status     => 'sent' } );
635         return $success;
636     } else {
637         _set_message_status( { message_id => $message->{'message_id'},
638                                status     => 'failed' } );
639         return;
640     }
641 }
642
643 sub _set_message_status {
644     my $params = shift;
645
646     foreach my $required_parameter ( qw( message_id status ) ) {
647         return unless exists $params->{ $required_parameter };
648     }
649
650     my $dbh = C4::Context->dbh();
651     my $statement = 'UPDATE message_queue SET status= ? WHERE message_id = ?';
652     my $sth = $dbh->prepare( $statement );
653     my $result = $sth->execute( $params->{'status'},
654                                 $params->{'message_id'} );
655     return $result;
656 }
657
658
659 1;
660 __END__