C4/Letters.pm

   1 package C4::Letters;
   2
   3
   4 # Copyright 2000-2002 Katipo Communications
   5 #
   6 # This file is part of Koha.
   7 #
   8 # Koha is free software; you can redistribute it and/or modify it under the
   9 # terms of the GNU General Public License as published by the Free Software
  10 # Foundation; either version 2 of the License, or (at your option) any later
  11 # version.
  12 #
  13 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
  14 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
  15 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
  16 #
  17 # You should have received a copy of the GNU General Public License along with
  18 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
  19 # Suite 330, Boston, MA  02111-1307 USA
  20
  21 use strict;
  22 use Mail::Sendmail;
  23 use C4::Date;
  24 use Date::Manip;
  25 use C4::Suggestions;
  26 use C4::Members;
  27 use C4::Log;
  28 require Exporter;
  29
  30 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
  31
  32 # set the version for version checking
  33 $VERSION = do { my @v = '$Revision$' =~ /\d+/g;
  34     shift(@v) . "." . join( "_", map { sprintf "%03d", $_ } @v );
  35 };
  36
  37 =head1 NAME
  38
  39 C4::Letters - Give functions for Letters management
  40
  41 =head1 SYNOPSIS
  42
  43   use C4::Letters;
  44
  45 =head1 DESCRIPTION
  46
  47   "Letters" is the tool used in Koha to manage informations sent to the patrons and/or the library. This include some cron jobs like
  48   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)
  49
  50   Letters are managed through "alerts" sent by Koha on some events. All "alert" related functions are in this module too.
  51
  52 =cut
  53
  54 @ISA = qw(Exporter);
  55 @EXPORT = qw(&GetLetters &getletter &addalert &getalert &delalert &findrelatedto &SendAlerts);
  56
  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 =(value => $thisletter,
  72                 selected => $selected,
  73                 lettername => $letters->{$thisletter},
  74             );
  75     push @letterloop, \%row;
  76 }
  77
  78 =head3 in TEMPLATE
  79             <select name="letter">
  80                 <option value="">Default</option>
  81             <!-- TMPL_LOOP name="letterloop" -->
  82                 <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="lettername" --></option>
  83             <!-- /TMPL_LOOP -->
  84             </select>
  85
  86 =cut
  87
  88 sub GetLetters {
  89 # returns a reference to a hash of references to ALL letters...
  90     my $cat = shift;
  91     my %letters;
  92     my $dbh = C4::Context->dbh;
  93     $dbh->quote($cat);
  94     my $sth;
  95        if ($cat ne ""){
  96         my $query = "SELECT * FROM letter WHERE module = ? ORDER BY name";
  97         $sth = $dbh->prepare($query);
  98         $sth->execute($cat);
  99     } else {
 100         my $query = " SELECT * FROM letter ORDER BY name";
 101         $sth = $dbh->prepare($query);
 102         $sth->execute;
 103     }
 104     while (my $letter=$sth->fetchrow_hashref){
 105         $letters{$letter->{'code'}}=$letter->{'name'};
 106     }
 107     return \%letters;
 108 }
 109
 110
 111 sub getletter {
 112         my ($module,$code) = @_;
 113         my $dbh = C4::Context->dbh;
 114         my $sth = $dbh->prepare("select * from letter where module=? and code=?");
 115         $sth->execute($module,$code);
 116         my $line = $sth->fetchrow_hashref;
 117         return $line;
 118 }
 119
 120 =head2 addalert
 121
 122         parameters :
 123         - $borrowernumber : the number of the borrower subscribing to the alert
 124         - $type : the type of alert.
 125         - externalid : the primary key of the object to put alert on. For issues, the alert is made on subscriptionid.
 126
 127         create an alert and return the alertid (primary key)
 128
 129 =cut
 130
 131 sub addalert {
 132         my ($borrowernumber,$type,$externalid) = @_;
 133         my $dbh=C4::Context->dbh;
 134         my $sth = $dbh->prepare("insert into alert (borrowernumber, type, externalid) values (?,?,?)");
 135         $sth->execute($borrowernumber,$type,$externalid);
 136         # get the alert number newly created and return it
 137         my $alertid = $dbh->{'mysql_insertid'};
 138         return $alertid;
 139 }
 140
 141 =head2 delalert
 142         parameters :
 143         - alertid : the alert id
 144         deletes the alert
 145 =cut
 146
 147 sub delalert {
 148         my ($alertid)=@_;
 149 #       warn "ALERTID : $alertid";
 150         my $dbh = C4::Context->dbh;
 151         my $sth = $dbh->prepare("delete from alert where alertid=?");
 152         $sth->execute($alertid);
 153 }
 154
 155 =head2 getalert
 156
 157         parameters :
 158         - $borrowernumber : the number of the borrower subscribing to the alert
 159         - $type : the type of alert.
 160         - externalid : the primary key of the object to put alert on. For issues, the alert is made on subscriptionid.
 161         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.
 162
 163 =cut
 164
 165 sub getalert {
 166         my ($borrowernumber,$type,$externalid) = @_;
 167         my $dbh=C4::Context->dbh;
 168         my $query = "select * from alert where";
 169         my @bind;
 170         if ($borrowernumber) {
 171                 $query .= " borrowernumber=? and";
 172                 push @bind,$borrowernumber;
 173         }
 174         if ($type) {
 175                 $query .= " type=? and";
 176                 push @bind,$type;
 177         }
 178         if ($externalid) {
 179                 $query .= " externalid=? and";
 180                 push @bind,$externalid;
 181         }
 182         $query =~ s/ and$//;
 183         my $sth = $dbh->prepare($query);
 184         $sth->execute(@bind);
 185         my @result;
 186         while (my $line = $sth->fetchrow_hashref) {
 187                 push @result,$line;
 188         }
 189         return \@result if $#result >=0; # return only if there is one result.
 190         return;
 191 }
 192
 193 =head2 findrelatedto
 194         parameters :
 195         - $type : the type of alert
 196         - $externalid : the id of the "object" to query
 197
 198         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.
 199         When type=issue, the id is related to a subscriptionid and this sub returns the name of the biblio.
 200         When type=virtual, the id is related to a virtual shelf and this sub returns the name of the sub
 201 =cut
 202
 203 sub findrelatedto {
 204         my ($type,$externalid) = @_;
 205         my $dbh=C4::Context->dbh;
 206         my $sth;
 207         if ($type eq 'issue') {
 208                 $sth=$dbh->prepare("select title as result from subscription left join biblio on subscription.biblionumber=biblio.biblionumber where subscriptionid=?");
 209         }
 210         if ($type eq 'borrower') {
 211                 $sth=$dbh->prepare("select concat(firstname,' ',surname) from borrowers where borrowernumber=?");
 212         }
 213         $sth->execute($externalid);
 214         my ($result) = $sth->fetchrow;
 215         return $result;
 216 }
 217
 218 =head2 SendAlerts
 219
 220         parameters :
 221         - $type : the type of alert
 222         - $externalid : the id of the "object" to query
 223         - $letter : the letter to send.
 224
 225         send an alert to all borrowers having put an alert on a given subject.
 226
 227 =cut
 228
 229 sub SendAlerts {
 230         my ($type,$externalid,$letter)=@_;
 231         my $dbh=C4::Context->dbh;
 232         if ($type eq 'issue') {
 233 #               warn "sending issues...";
 234                 my $letter = getletter('serial',$letter);
 235                 # prepare the letter...
 236                 # search the biblionumber
 237                 my $sth=$dbh->prepare("select biblionumber from subscription where subscriptionid=?");
 238                 $sth->execute($externalid);
 239                 my ($biblionumber)=$sth->fetchrow;
 240                 # parsing branch info
 241                 my $userenv = C4::Context->userenv;
 242                 parseletter($letter,'branches',$userenv->{branch});
 243                 # parsing librarian name
 244                 $letter->{content} =~ s/<<LibrarianFirstname>>/$userenv->{firstname}/g;
 245                 $letter->{content} =~ s/<<LibrarianSurname>>/$userenv->{surname}/g;
 246                 $letter->{content} =~ s/<<LibrarianEmailaddress>>/$userenv->{emailaddress}/g;
 247                 # parsing biblio information
 248                 parseletter($letter,'biblio',$biblionumber);
 249                 parseletter($letter,'biblioitems',$biblionumber);
 250                 # find the list of borrowers to alert
 251                 my $alerts = getalert('','issue',$externalid);
 252                 foreach (@$alerts) {
 253                         # and parse borrower ...
 254                         my $innerletter = $letter;
 255                         my $borinfo = GetMember('',$_->{'borrowernumber'});
 256                         parseletter($innerletter,'borrowers',$_->{'borrowernumber'});
 257                         # ... then send mail
 258                         if ($borinfo->{emailaddress}) {
 259                                 my %mail = ( To => $borinfo->{emailaddress},
 260                                                         From => $userenv->{emailaddress},
 261                                                         Subject => "".$innerletter->{title},
 262                                                         Message => "".$innerletter->{content},
 263                                                         );
 264                                 sendmail(%mail);
 265 #                               warn "sending to $mail{To} From $mail{From} subj $mail{Subject} Mess $mail{Message}";
 266                         }
 267                 }
 268         }
 269         elsif ($type eq 'claimacquisition') {
 270 #               warn "sending issues...";
 271                 my $letter = getletter('claimacquisition',$letter);
 272                 # prepare the letter...
 273                 # search the biblionumber
 274                 my $strsth="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 (".join(",",@$externalid).")";
 275         my $sthorders=$dbh->prepare($strsth);
 276                 $sthorders->execute;
 277         my $dataorders=$sthorders->fetchall_arrayref({});
 278                 parseletter($letter,'aqbooksellers',$dataorders->[0]->{booksellerid});
 279                 my $sthbookseller = $dbh->prepare("select * from aqbooksellers where id=?");
 280         $sthbookseller->execute($dataorders->[0]->{booksellerid});
 281         my $databookseller=$sthbookseller->fetchrow_hashref;
 282                 # parsing branch info
 283                 my $userenv = C4::Context->userenv;
 284                 parseletter($letter,'branches',$userenv->{branch});
 285                 # parsing librarian name
 286                 $letter->{content} =~ s/<<LibrarianFirstname>>/$userenv->{firstname}/g;
 287                 $letter->{content} =~ s/<<LibrarianSurname>>/$userenv->{surname}/g;
 288                 $letter->{content} =~ s/<<LibrarianEmailaddress>>/$userenv->{emailaddress}/g;
 289         foreach my $data (@$dataorders){
 290           my $line=$1 if ($letter->{content}=~m/(<<.*>>)/);
 291           foreach my $field (keys %$data){
 292             $line =~ s/(<<[^\.]+.$field>>)/$data->{$field}/;
 293           }
 294           $letter->{content}=~ s/(<<.*>>)/$line\n\1/;
 295         }
 296         $letter->{content} =~ s/<<[^>]*>>//g;
 297                 my $innerletter = $letter;
 298         # ... then send mail
 299         if ($databookseller->{bookselleremail}||$databookseller->{contemail}) {
 300             my %mail = ( To => $databookseller->{bookselleremail}.($databookseller->{contemail}?",".$databookseller->{contemail}:""),
 301                         From => $userenv->{emailaddress},
 302                         Subject => "".$innerletter->{title},
 303                         Message => "".$innerletter->{content},
 304                         'Content-Type' => 'text/plain; charset="utf8"',
 305                         );
 306             sendmail(%mail);
 307                         warn "sending to $mail{To} From $mail{From} subj $mail{Subject} Mess $mail{Message}";
 308         }
 309         if (C4::Context->preference("LetterLog")){
 310            logaction($userenv->{number},"ACQUISITION","Send Acquisition claim letter","","order list : ".join(",",@$externalid)."\n$innerletter->{title}\n$innerletter->{content}")
 311         }
 312     }
 313         elsif ($type eq 'claimissues') {
 314 #               warn "sending issues...";
 315                 my $letter = getletter('claimissues',$letter);
 316                 # prepare the letter...
 317                 # search the biblionumber
 318                 my $strsth="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 (".join(",",@$externalid).")";
 319         my $sthorders=$dbh->prepare($strsth);
 320                 $sthorders->execute;
 321         my $dataorders=$sthorders->fetchall_arrayref({});
 322                 parseletter($letter,'aqbooksellers',$dataorders->[0]->{aqbooksellerid});
 323                 my $sthbookseller = $dbh->prepare("select * from aqbooksellers where id=?");
 324         $sthbookseller->execute($dataorders->[0]->{aqbooksellerid});
 325         my $databookseller=$sthbookseller->fetchrow_hashref;
 326                 # parsing branch info
 327                 my $userenv = C4::Context->userenv;
 328                 parseletter($letter,'branches',$userenv->{branch});
 329                 # parsing librarian name
 330                 $letter->{content} =~ s/<<LibrarianFirstname>>/$userenv->{firstname}/g;
 331                 $letter->{content} =~ s/<<LibrarianSurname>>/$userenv->{surname}/g;
 332                 $letter->{content} =~ s/<<LibrarianEmailaddress>>/$userenv->{emailaddress}/g;
 333         foreach my $data (@$dataorders){
 334           my $line=$1 if ($letter->{content}=~m/(<<.*>>)/);
 335           foreach my $field (keys %$data){
 336             $line =~ s/(<<[^\.]+.$field>>)/$data->{$field}/;
 337           }
 338           $letter->{content}=~ s/(<<.*>>)/$line\n\1/;
 339         }
 340         $letter->{content} =~ s/<<[^>]*>>//g;
 341                 my $innerletter = $letter;
 342         # ... then send mail
 343         if ($databookseller->{bookselleremail}||$databookseller->{contemail}) {
 344             my %mail = ( To => $databookseller->{bookselleremail}.($databookseller->{contemail}?",".$databookseller->{contemail}:""),
 345                         From => $userenv->{emailaddress},
 346                         Subject => "".$innerletter->{title},
 347                         Message => "".$innerletter->{content},
 348                         );
 349             sendmail(%mail);
 350                 &logaction(
 351                     C4::Context->userenv->{'number'},
 352                     "ACQUISITION",
 353                     "CLAIM ISSUE",
 354                     undef,
 355                     "To=".$databookseller->{contemail}.
 356                     " Title=".$innerletter->{title}.
 357                     " Content=".$innerletter->{content}
 358                 ) if C4::Context->preference("LetterLog");
 359         }
 360                 warn "sending to From $userenv->{emailaddress} subj $innerletter->{title} Mess $innerletter->{content}";
 361         }
 362 }
 363
 364 =head2 parseletter
 365
 366         parameters :
 367         - $letter : a hash to letter fields (title & content useful)
 368         - $table : the Koha table to parse.
 369         - $pk : the primary key to query on the $table table
 370         parse all fields from a table, and replace values in title & content with the appropriate value
 371         (not exported sub, used only internally)
 372
 373 =cut
 374
 375 sub parseletter {
 376         my ($letter,$table,$pk) = @_;
 377 #       warn "Parseletter : ($letter,$table,$pk)";
 378         my $dbh=C4::Context->dbh;
 379         my $sth;
 380         if ($table eq 'biblio') {
 381                 $sth = $dbh->prepare("select * from biblio where biblionumber=?");
 382         } elsif ($table eq 'biblioitems') {
 383                 $sth = $dbh->prepare("select * from biblioitems where biblionumber=?");
 384         } elsif ($table eq 'borrowers') {
 385                 $sth = $dbh->prepare("select * from borrowers where borrowernumber=?");
 386         } elsif ($table eq 'branches') {
 387                 $sth = $dbh->prepare("select * from branches where branchcode=?");
 388         } elsif ($table eq 'aqbooksellers') {
 389                 $sth = $dbh->prepare("select * from aqbooksellers where id=?");
 390         }
 391         $sth->execute($pk);
 392         # store the result in an hash
 393         my $values = $sth->fetchrow_hashref;
 394         # and get all fields from the table
 395         $sth = $dbh->prepare("show columns from $table");
 396         $sth->execute;
 397         while ((my $field) = $sth->fetchrow_array) {
 398                 my $replacefield="<<$table.$field>>";
 399                 my $replacedby = $values->{$field};
 400 #               warn "REPLACE $replacefield by $replacedby";
 401                 $letter->{title} =~ s/$replacefield/$replacedby/g;
 402                 $letter->{content} =~ s/$replacefield/$replacedby/g;
 403         }
 404 }
 405
 406 END { }       # module clean-up code here (global destructor)