fixing permissions on scripts
[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 require Exporter;
28
29 our ( $VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS );
30
31 # set the version for version checking
32 $VERSION = do { my @v = '$Revision$' =~ /\d+/g;
33     shift(@v) . "." . join( "_", map { sprintf "%03d", $_ } @v );
34 };
35
36 =head1 NAME
37
38 C4::Letters - Give functions for Letters management
39
40 =head1 SYNOPSIS
41
42   use C4::Letters;
43
44 =head1 DESCRIPTION
45
46   "Letters" is the tool used in Koha to manage informations sent to the patrons and/or the library. This include some cron jobs like
47   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)
48
49   Letters are managed through "alerts" sent by Koha on some events. All "alert" related functions are in this module too.
50
51 =cut
52
53 @ISA = qw(Exporter);
54 @EXPORT =
55   qw(&GetLetters &getletter &addalert &getalert &delalert &findrelatedto &SendAlerts);
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 if $#result >= 0;    # return only if there is one result.
198     return;
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 =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->{emailaddress} ) {
285                 my %mail = (
286                     To      => $borinfo->{emailaddress},
287                     From    => $userenv->{emailaddress},
288                     Subject => "" . $innerletter->{title},
289                     Message => "" . $innerletter->{content},
290                 );
291                 sendmail(%mail);
292
293 #                               warn "sending to $mail{To} From $mail{From} subj $mail{Subject} Mess $mail{Message}";
294             }
295         }
296     }
297     elsif ( $type eq 'claimacquisition' ) {
298
299         #               warn "sending issues...";
300         my $letter = getletter( 'claimacquisition', $letter );
301
302         # prepare the letter...
303         # search the biblionumber
304         my $strsth =
305 "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 ("
306           . join( ",", @$externalid ) . ")";
307         my $sthorders = $dbh->prepare($strsth);
308         $sthorders->execute;
309         my $dataorders = $sthorders->fetchall_arrayref( {} );
310         parseletter( $letter, 'aqbooksellers',
311             $dataorders->[0]->{booksellerid} );
312         my $sthbookseller =
313           $dbh->prepare("select * from aqbooksellers where id=?");
314         $sthbookseller->execute( $dataorders->[0]->{booksellerid} );
315         my $databookseller = $sthbookseller->fetchrow_hashref;
316
317         # parsing branch info
318         my $userenv = C4::Context->userenv;
319         parseletter( $letter, 'branches', $userenv->{branch} );
320
321         # parsing librarian name
322         $letter->{content} =~ s/<<LibrarianFirstname>>/$userenv->{firstname}/g;
323         $letter->{content} =~ s/<<LibrarianSurname>>/$userenv->{surname}/g;
324         $letter->{content} =~
325           s/<<LibrarianEmailaddress>>/$userenv->{emailaddress}/g;
326         foreach my $data (@$dataorders) {
327             my $line = $1 if ( $letter->{content} =~ m/(<<.*>>)/ );
328             foreach my $field ( keys %$data ) {
329                 $line =~ s/(<<[^\.]+.$field>>)/$data->{$field}/;
330             }
331             $letter->{content} =~ s/(<<.*>>)/$line\n$1/;
332         }
333         $letter->{content} =~ s/<<[^>]*>>//g;
334         my $innerletter = $letter;
335
336         # ... then send mail
337         if (   $databookseller->{bookselleremail}
338             || $databookseller->{contemail} )
339         {
340             my %mail = (
341                 To => $databookseller->{bookselleremail}
342                   . (
343                     $databookseller->{contemail}
344                     ? "," . $databookseller->{contemail}
345                     : ""
346                   ),
347                 From           => $userenv->{emailaddress},
348                 Subject        => "" . $innerletter->{title},
349                 Message        => "" . $innerletter->{content},
350                 'Content-Type' => 'text/plain; charset="utf8"',
351             );
352             sendmail(%mail);
353             warn
354 "sending to $mail{To} From $mail{From} subj $mail{Subject} Mess $mail{Message}";
355         }
356         if ( C4::Context->preference("LetterLog") ) {
357             logaction(
358                 $userenv->{number},
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.title 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             );
422             sendmail(%mail);
423             &logaction(
424                 C4::Context->userenv->{'number'},
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 }
440
441 =head2 parseletter
442
443     parameters :
444     - $letter : a hash to letter fields (title & content useful)
445     - $table : the Koha table to parse.
446     - $pk : the primary key to query on the $table table
447     parse all fields from a table, and replace values in title & content with the appropriate value
448     (not exported sub, used only internally)
449
450 =cut
451
452 sub parseletter {
453     my ( $letter, $table, $pk ) = @_;
454
455     #   warn "Parseletter : ($letter,$table,$pk)";
456     my $dbh = C4::Context->dbh;
457     my $sth;
458     if ( $table eq 'biblio' ) {
459         $sth = $dbh->prepare("select * from biblio where biblionumber=?");
460     }
461     elsif ( $table eq 'biblioitems' ) {
462         $sth = $dbh->prepare("select * from biblioitems where biblionumber=?");
463     }
464     elsif ( $table eq 'borrowers' ) {
465         $sth = $dbh->prepare("select * from borrowers where borrowernumber=?");
466     }
467     elsif ( $table eq 'branches' ) {
468         $sth = $dbh->prepare("select * from branches where branchcode=?");
469     }
470     elsif ( $table eq 'aqbooksellers' ) {
471         $sth = $dbh->prepare("select * from aqbooksellers where id=?");
472     }
473     $sth->execute($pk);
474
475     # store the result in an hash
476     my $values = $sth->fetchrow_hashref;
477
478     # and get all fields from the table
479     $sth = $dbh->prepare("show columns from $table");
480     $sth->execute;
481     while ( ( my $field ) = $sth->fetchrow_array ) {
482         my $replacefield = "<<$table.$field>>";
483         my $replacedby   = $values->{$field};
484
485         #               warn "REPLACE $replacefield by $replacedby";
486         $letter->{title}   =~ s/$replacefield/$replacedby/g;
487         $letter->{content} =~ s/$replacefield/$replacedby/g;
488     }
489 }
490
491 END { }    # module clean-up code here (global destructor)