help.pl - bugfix module usage (HTML::Template::Pro)
[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) {
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 =cut
210
211 sub findrelatedto {
212     my ( $type, $externalid ) = @_;
213     my $dbh = C4::Context->dbh;
214     my $sth;
215     if ( $type eq 'issue' ) {
216         $sth =
217           $dbh->prepare(
218 "select title as result from subscription left join biblio on subscription.biblionumber=biblio.biblionumber where subscriptionid=?"
219           );
220     }
221     if ( $type eq 'borrower' ) {
222         $sth =
223           $dbh->prepare(
224 "select concat(firstname,' ',surname) from borrowers where borrowernumber=?"
225           );
226     }
227     $sth->execute($externalid);
228     my ($result) = $sth->fetchrow;
229     return $result;
230 }
231
232 =head2 SendAlerts
233
234     parameters :
235     - $type : the type of alert
236     - $externalid : the id of the "object" to query
237     - $letter : the letter to send.
238
239     send an alert to all borrowers having put an alert on a given subject.
240
241 =cut
242
243 sub SendAlerts {
244     my ( $type, $externalid, $letter ) = @_;
245     my $dbh = C4::Context->dbh;
246     if ( $type eq 'issue' ) {
247
248         #               warn "sending issues...";
249         my $letter = getletter( 'serial', $letter );
250
251         # prepare the letter...
252         # search the biblionumber
253         my $sth =
254           $dbh->prepare(
255             "select biblionumber from subscription where subscriptionid=?");
256         $sth->execute($externalid);
257         my ($biblionumber) = $sth->fetchrow;
258
259         # parsing branch info
260         my $userenv = C4::Context->userenv;
261         parseletter( $letter, 'branches', $userenv->{branch} );
262
263         # parsing librarian name
264         $letter->{content} =~ s/<<LibrarianFirstname>>/$userenv->{firstname}/g;
265         $letter->{content} =~ s/<<LibrarianSurname>>/$userenv->{surname}/g;
266         $letter->{content} =~
267           s/<<LibrarianEmailaddress>>/$userenv->{emailaddress}/g;
268
269         # parsing biblio information
270         parseletter( $letter, 'biblio',      $biblionumber );
271         parseletter( $letter, 'biblioitems', $biblionumber );
272
273         # find the list of borrowers to alert
274         my $alerts = getalert( '', 'issue', $externalid );
275         foreach (@$alerts) {
276
277             # and parse borrower ...
278             my $innerletter = $letter;
279             my $borinfo = GetMember( $_->{'borrowernumber'}, 'borrowernumber' );
280             parseletter( $innerletter, 'borrowers', $_->{'borrowernumber'} );
281
282             # ... then send mail
283             if ( $borinfo->{emailaddress} ) {
284                 my %mail = (
285                     To      => $borinfo->{emailaddress},
286                     From    => $userenv->{emailaddress},
287                     Subject => "" . $innerletter->{title},
288                     Message => "" . $innerletter->{content},
289                 );
290                 sendmail(%mail);
291
292 # warn "sending to $mail{To} From $mail{From} subj $mail{Subject} Mess $mail{Message}";
293             }
294         }
295     }
296     elsif ( $type eq 'claimacquisition' ) {
297
298         #               warn "sending issues...";
299         my $letter = getletter( 'claimacquisition', $letter );
300
301         # prepare the letter...
302         # search the biblionumber
303         my $strsth =
304 "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 ("
305           . join( ",", @$externalid ) . ")";
306         my $sthorders = $dbh->prepare($strsth);
307         $sthorders->execute;
308         my $dataorders = $sthorders->fetchall_arrayref( {} );
309         parseletter( $letter, 'aqbooksellers',
310             $dataorders->[0]->{booksellerid} );
311         my $sthbookseller =
312           $dbh->prepare("select * from aqbooksellers where id=?");
313         $sthbookseller->execute( $dataorders->[0]->{booksellerid} );
314         my $databookseller = $sthbookseller->fetchrow_hashref;
315
316         # parsing branch info
317         my $userenv = C4::Context->userenv;
318         parseletter( $letter, 'branches', $userenv->{branch} );
319
320         # parsing librarian name
321         $letter->{content} =~ s/<<LibrarianFirstname>>/$userenv->{firstname}/g;
322         $letter->{content} =~ s/<<LibrarianSurname>>/$userenv->{surname}/g;
323         $letter->{content} =~
324           s/<<LibrarianEmailaddress>>/$userenv->{emailaddress}/g;
325         foreach my $data (@$dataorders) {
326             my $line = $1 if ( $letter->{content} =~ m/(<<.*>>)/ );
327             foreach my $field ( keys %$data ) {
328                 $line =~ s/(<<[^\.]+.$field>>)/$data->{$field}/;
329             }
330             $letter->{content} =~ s/(<<.*>>)/$line\n$1/;
331         }
332         $letter->{content} =~ s/<<[^>]*>>//g;
333         my $innerletter = $letter;
334
335         # ... then send mail
336         if (   $databookseller->{bookselleremail}
337             || $databookseller->{contemail} )
338         {
339             my %mail = (
340                 To => $databookseller->{bookselleremail}
341                   . (
342                     $databookseller->{contemail}
343                     ? "," . $databookseller->{contemail}
344                     : ""
345                   ),
346                 From           => $userenv->{emailaddress},
347                 Subject        => "" . $innerletter->{title},
348                 Message        => "" . $innerletter->{content},
349                 'Content-Type' => 'text/plain; charset="utf8"',
350             );
351             sendmail(%mail);
352             warn
353 "sending to $mail{To} From $mail{From} subj $mail{Subject} Mess $mail{Message}";
354         }
355         if ( C4::Context->preference("LetterLog") ) {
356             logaction(
357                 $userenv->{number},
358                 "ACQUISITION",
359                 "Send Acquisition claim letter",
360                 "",
361                 "order list : "
362                   . join( ",", @$externalid )
363                   . "\n$innerletter->{title}\n$innerletter->{content}"
364             );
365         }
366     }
367     elsif ( $type eq 'claimissues' ) {
368
369         #               warn "sending issues...";
370         my $letter = getletter( 'claimissues', $letter );
371
372         # prepare the letter...
373         # search the biblionumber
374         my $strsth =
375 "select serial.*,subscription.*, biblio.* from serial LEFT JOIN subscription on serial.subscriptionid=subscription.subscriptionid LEFT JOIN biblio on serial.biblionumber=biblio.biblionumber where serial.serialid IN ("
376           . join( ",", @$externalid ) . ")";
377         my $sthorders = $dbh->prepare($strsth);
378         $sthorders->execute;
379         my $dataorders = $sthorders->fetchall_arrayref( {} );
380         parseletter( $letter, 'aqbooksellers',
381             $dataorders->[0]->{aqbooksellerid} );
382         my $sthbookseller =
383           $dbh->prepare("select * from aqbooksellers where id=?");
384         $sthbookseller->execute( $dataorders->[0]->{aqbooksellerid} );
385         my $databookseller = $sthbookseller->fetchrow_hashref;
386
387         # parsing branch info
388         my $userenv = C4::Context->userenv;
389         parseletter( $letter, 'branches', $userenv->{branch} );
390
391         # parsing librarian name
392         $letter->{content} =~ s/<<LibrarianFirstname>>/$userenv->{firstname}/g;
393         $letter->{content} =~ s/<<LibrarianSurname>>/$userenv->{surname}/g;
394         $letter->{content} =~
395           s/<<LibrarianEmailaddress>>/$userenv->{emailaddress}/g;
396         foreach my $data (@$dataorders) {
397             my $line = $1 if ( $letter->{content} =~ m/(<<.*>>)/ );
398             foreach my $field ( keys %$data ) {
399                 $line =~ s/(<<[^\.]+.$field>>)/$data->{$field}/;
400             }
401             $letter->{content} =~ s/(<<.*>>)/$line\n$1/;
402         }
403         $letter->{content} =~ s/<<[^>]*>>//g;
404         my $innerletter = $letter;
405
406         # ... then send mail
407         if (   $databookseller->{bookselleremail}
408             || $databookseller->{contemail} )
409         {
410             my %mail = (
411                 To => $databookseller->{bookselleremail}
412                   . (
413                     $databookseller->{contemail}
414                     ? "," . $databookseller->{contemail}
415                     : ""
416                   ),
417                 From    => $userenv->{emailaddress},
418                 Subject => "" . $innerletter->{title},
419                 Message => "" . $innerletter->{content},
420             );
421             sendmail(%mail);
422             &logaction(
423                 C4::Context->userenv->{'number'},
424                 "ACQUISITION",
425                 "CLAIM ISSUE",
426                 undef,
427                 "To="
428                   . $databookseller->{contemail}
429                   . " Title="
430                   . $innerletter->{title}
431                   . " Content="
432                   . $innerletter->{content}
433             ) if C4::Context->preference("LetterLog");
434         }
435         warn
436 "sending to From $userenv->{emailaddress} subj $innerletter->{title} Mess $innerletter->{content}";
437     }
438 }
439
440 =head2 parseletter
441
442     parameters :
443     - $letter : a hash to letter fields (title & content useful)
444     - $table : the Koha table to parse.
445     - $pk : the primary key to query on the $table table
446     parse all fields from a table, and replace values in title & content with the appropriate value
447     (not exported sub, used only internally)
448
449 =cut
450
451 sub parseletter {
452     my ( $letter, $table, $pk ) = @_;
453
454     #   warn "Parseletter : ($letter,$table,$pk)";
455     my $dbh = C4::Context->dbh;
456     my $sth;
457     if ( $table eq 'biblio' ) {
458         $sth = $dbh->prepare("select * from biblio where biblionumber=?");
459     }
460     elsif ( $table eq 'biblioitems' ) {
461         $sth = $dbh->prepare("select * from biblioitems where biblionumber=?");
462     }
463     elsif ( $table eq 'borrowers' ) {
464         $sth = $dbh->prepare("select * from borrowers where borrowernumber=?");
465     }
466     elsif ( $table eq 'branches' ) {
467         $sth = $dbh->prepare("select * from branches where branchcode=?");
468     }
469     elsif ( $table eq 'aqbooksellers' ) {
470         $sth = $dbh->prepare("select * from aqbooksellers where id=?");
471     }
472     $sth->execute($pk);
473
474     # store the result in an hash
475     my $values = $sth->fetchrow_hashref;
476
477     # and get all fields from the table
478     $sth = $dbh->prepare("show columns from $table");
479     $sth->execute;
480     while ( ( my $field ) = $sth->fetchrow_array ) {
481         my $replacefield = "<<$table.$field>>";
482         my $replacedby   = $values->{$field};
483
484         #               warn "REPLACE $replacefield by $replacedby";
485         $letter->{title}   =~ s/$replacefield/$replacedby/g;
486         $letter->{content} =~ s/$replacefield/$replacedby/g;
487     }
488 }
489
490 1;
491 __END__