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 C4::Suggestions;
  25 use C4::Members;
  26 require Exporter;
  27
  28 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
  29
  30 # set the version for version checking
  31 $VERSION = 0.01;
  32
  33 =head1 NAME
  34
  35 C4::Letters - Give functions for Letters management
  36
  37 =head1 SYNOPSIS
  38
  39   use C4::Letters;
  40
  41 =head1 DESCRIPTION
  42
  43   "Letters" is the tool used in Koha to manage informations sent to the patrons and/or the library. This include some cron jobs like
  44   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)
  45
  46   Letters are managed through "alerts" sent by Koha on some events. All "alert" related functions are in this module too.
  47
  48 =cut
  49
  50 @ISA = qw(Exporter);
  51 @EXPORT = qw(&GetLetterList &getletter &addalert &getalert &delalert &findrelatedto &sendalerts);
  52
  53 =head2 GetLetterList
  54
  55         parameter : $module : the name of the module
  56         This sub returns an array of hashes with all letters from a given module
  57         Each hash entry contains :
  58         - module : the module name
  59         - code : the code of the letter, char(20)
  60         - name : the complete name of the letter, char(200)
  61         - title : the title that will be used as "subject" in mails, char(200)
  62         - content : the content of the letter. Each field to be replaced by a value at runtime is enclosed in << and >>. The fields usually have the same name as in the DB
  63
  64 =cut
  65
  66 sub GetLetterList {
  67         my ($module) = @_;
  68         my $dbh = C4::Context->dbh;
  69         my $sth = $dbh->prepare("select * from letter where module=?");
  70         $sth->execute($module);
  71         my @result;
  72         while (my $line = $sth->fetchrow_hashref) {
  73                 push @result,$line;
  74         }
  75         return @result;
  76 }
  77
  78 sub getletter {
  79         my ($module,$code) = @_;
  80         my $dbh = C4::Context->dbh;
  81         my $sth = $dbh->prepare("select * from letter where module=? and code=?");
  82         $sth->execute($module,$code);
  83         my $line = $sth->fetchrow_hashref;
  84         return $line;
  85 }
  86
  87 =head2 addalert
  88
  89         parameters :
  90         - $borrowernumber : the number of the borrower subscribing to the alert
  91         - $type : the type of alert.
  92         - externalid : the primary key of the object to put alert on. For issues, the alert is made on subscriptionid.
  93
  94         create an alert and return the alertid (primary key)
  95
  96 =cut
  97
  98 sub addalert {
  99         my ($borrowernumber,$type,$externalid) = @_;
 100         my $dbh=C4::Context->dbh;
 101         my $sth = $dbh->prepare("insert into alert (borrowernumber, type, externalid) values (?,?,?)");
 102         $sth->execute($borrowernumber,$type,$externalid);
 103         # get the alert number newly created and return it
 104         my $alertid = $dbh->{'mysql_insertid'};
 105         return $alertid;
 106 }
 107
 108 =head2 delalert
 109         parameters :
 110         - alertid : the alert id
 111         deletes the alert
 112 =cut
 113
 114 sub delalert {
 115         my ($alertid)=@_;
 116 #       warn "ALERTID : $alertid";
 117         my $dbh = C4::Context->dbh;
 118         my $sth = $dbh->prepare("delete from alert where alertid=?");
 119         $sth->execute($alertid);
 120 }
 121
 122 =head2 getalert
 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         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.
 129
 130 =cut
 131
 132 sub getalert {
 133         my ($borrowernumber,$type,$externalid) = @_;
 134         my $dbh=C4::Context->dbh;
 135         my $query = "select * from alert where";
 136         my @bind;
 137         if ($borrowernumber) {
 138                 $query .= " borrowernumber=? and";
 139                 push @bind,$borrowernumber;
 140         }
 141         if ($type) {
 142                 $query .= " type=? and";
 143                 push @bind,$type;
 144         }
 145         if ($externalid) {
 146                 $query .= " externalid=? and";
 147                 push @bind,$externalid;
 148         }
 149         $query =~ s/ and$//;
 150         my $sth = $dbh->prepare($query);
 151         $sth->execute(@bind);
 152         my @result;
 153         while (my $line = $sth->fetchrow_hashref) {
 154                 push @result,$line;
 155         }
 156         return \@result if $#result >=0; # return only if there is one result.
 157         return;
 158 }
 159
 160 =head2 findrelatedto
 161         parameters :
 162         - $type : the type of alert
 163         - $externalid : the id of the "object" to query
 164
 165         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.
 166         When type=issue, the id is related to a subscriptionid and this sub returns the name of the biblio.
 167         When type=virtual, the id is related to a virtual shelf and this sub returns the name of the sub
 168 =cut
 169
 170 sub findrelatedto {
 171         my ($type,$externalid) = @_;
 172         my $dbh=C4::Context->dbh;
 173         my $sth;
 174         if ($type eq 'issue') {
 175                 $sth=$dbh->prepare("select title as result from subscription left join biblio on subscription.biblionumber=biblio.biblionumber where subscriptionid=?");
 176         }
 177         if ($type eq 'borrower') {
 178                 $sth=$dbh->prepare("select concat(firstname,' ',surname) from borrowers where borrowernumber=?");
 179         }
 180         $sth->execute($externalid);
 181         my ($result) = $sth->fetchrow;
 182         return $result;
 183 }
 184
 185 =head2 sendalert
 186         parameters :
 187         - $type : the type of alert
 188         - $externalid : the id of the "object" to query
 189         - $letter : the letter to send.
 190
 191         send an alert to all borrowers having put an alert on a given subject.
 192
 193 =cut
 194
 195 sub sendalerts {
 196         my ($type,$externalid,$letter)=@_;
 197         my $dbh=C4::Context->dbh;
 198         if ($type eq 'issue') {
 199 #               warn "sending issues...";
 200                 my $letter = getletter('serial',$letter);
 201                 # prepare the letter...
 202                 # search the biblionumber
 203                 my $sth=$dbh->prepare("select biblionumber from subscription where subscriptionid=?");
 204                 $sth->execute($externalid);
 205                 my ($biblionumber)=$sth->fetchrow;
 206                 # parsing branch info
 207                 my $userenv = C4::Context->userenv;
 208                 parseletter($letter,'branches',$userenv->{branch});
 209                 # parsing librarian name
 210                 $letter->{content} =~ s/<<LibrarianFirstname>>/$userenv->{firstname}/g;
 211                 $letter->{content} =~ s/<<LibrarianSurname>>/$userenv->{surname}/g;
 212                 $letter->{content} =~ s/<<LibrarianEmailaddress>>/$userenv->{emailaddress}/g;
 213                 # parsing biblio information
 214                 parseletter($letter,'biblio',$biblionumber);
 215                 parseletter($letter,'biblioitems',$biblionumber);
 216                 # find the list of borrowers to alert
 217                 my $alerts = getalert('','issue',$externalid);
 218                 foreach (@$alerts) {
 219                         # and parse borrower ...
 220                         my $innerletter = $letter;
 221                         my $borinfo = getmember('',$_->{'borrowernumber'});
 222                         parseletter($innerletter,'borrowers',$_->{'borrowernumber'});
 223                         # ... then send mail
 224                         if ($borinfo->{emailaddress}) {
 225                                 my %mail = ( To => $borinfo->{emailaddress},
 226                                                         From => $userenv->{emailaddress},
 227                                                         Subject => "".$innerletter->{title},
 228                                                         Message => "".$innerletter->{content},
 229                                                         );
 230                                 sendmail(%mail);
 231 #                               warn "sending to $mail{To} From $mail{From} subj $mail{Subject} Mess $mail{Message}";
 232                         }
 233                 }
 234         }
 235 }
 236
 237 =head2
 238         parameters :
 239         - $letter : a hash to letter fields (title & content useful)
 240         - $table : the Koha table to parse.
 241         - $pk : the primary key to query on the $table table
 242         parse all fields from a table, and replace values in title & content with the appropriate value
 243         (not exported sub, used only internally)
 244 =cut
 245 sub parseletter {
 246         my ($letter,$table,$pk) = @_;
 247 #       warn "Parseletter : ($letter,$table,$pk)";
 248         my $dbh=C4::Context->dbh;
 249         my $sth;
 250         if ($table eq 'biblio') {
 251                 $sth = $dbh->prepare("select * from biblio where biblionumber=?");
 252         } elsif ($table eq 'biblioitems') {
 253                 $sth = $dbh->prepare("select * from biblioitems where biblionumber=?");
 254         } elsif ($table eq 'borrowers') {
 255                 $sth = $dbh->prepare("select * from borrowers where borrowernumber=?");
 256         } elsif ($table eq 'branches') {
 257                 $sth = $dbh->prepare("select * from branches where branchcode=?");
 258         }
 259         $sth->execute($pk);
 260         # store the result in an hash
 261         my $values = $sth->fetchrow_hashref;
 262         # and get all fields from the table
 263         $sth = $dbh->prepare("show columns from $table");
 264         $sth->execute;
 265         while ((my $field) = $sth->fetchrow_array) {
 266                 my $replacefield="<<$table.$field>>";
 267                 my $replacedby = $values->{$field};
 268 #               warn "REPLACE $replacefield by $replacedby";
 269                 $letter->{title} =~ s/$replacefield/$replacedby/g;
 270                 $letter->{content} =~ s/$replacefield/$replacedby/g;
 271         }
 272 }
 273
 274 END { }       # module clean-up code here (global destructor)