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