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 = 3.00;
  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 =
  53   qw(&GetLetters &getletter &addalert &getalert &delalert &findrelatedto &SendAlerts);
  54
  55 =head2 GetLetters
  56
  57   $letters = &getletters($category);
  58   returns informations about letters.
  59   if needed, $category filters for letters given category
  60   Create a letter selector with the following code
  61
  62 =head3 in PERL SCRIPT
  63
  64 my $letters = GetLetters($cat);
  65 my @letterloop;
  66 foreach my $thisletter (keys %$letters) {
  67     my $selected = 1 if $thisletter eq $letter;
  68     my %row =(
  69         value => $thisletter,
  70         selected => $selected,
  71         lettername => $letters->{$thisletter},
  72     );
  73     push @letterloop, \%row;
  74 }
  75
  76 =head3 in TEMPLATE
  77
  78     <select name="letter">
  79         <option value="">Default</option>
  80     <!-- TMPL_LOOP name="letterloop" -->
  81         <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="lettername" --></option>
  82     <!-- /TMPL_LOOP -->
  83     </select>
  84
  85 =cut
  86
  87 sub GetLetters {
  88
  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     }
 100     else {
 101         my $query = " SELECT * FROM letter ORDER BY name";
 102         $sth = $dbh->prepare($query);
 103         $sth->execute;
 104     }
 105     while ( my $letter = $sth->fetchrow_hashref ) {
 106         $letters{ $letter->{'code'} } = $letter->{'name'};
 107     }
 108     return \%letters;
 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 =
 135       $dbh->prepare(
 136         "insert into alert (borrowernumber, type, externalid) values (?,?,?)");
 137     $sth->execute( $borrowernumber, $type, $externalid );
 138
 139     # get the alert number newly created and return it
 140     my $alertid = $dbh->{'mysql_insertid'};
 141     return $alertid;
 142 }
 143
 144 =head2 delalert
 145
 146     parameters :
 147     - alertid : the alert id
 148     deletes the alert
 149
 150 =cut
 151
 152 sub delalert {
 153     my ($alertid) = @_;
 154
 155     #warn "ALERTID : $alertid";
 156     my $dbh = C4::Context->dbh;
 157     my $sth = $dbh->prepare("delete from alert where alertid=?");
 158     $sth->execute($alertid);
 159 }
 160
 161 =head2 getalert
 162
 163     parameters :
 164     - $borrowernumber : the number of the borrower subscribing to the alert
 165     - $type : the type of alert.
 166     - externalid : the primary key of the object to put alert on. For issues, the alert is made on subscriptionid.
 167     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.
 168
 169 =cut
 170
 171 sub getalert {
 172     my ( $borrowernumber, $type, $externalid ) = @_;
 173     my $dbh   = C4::Context->dbh;
 174     my $query = "select * from alert where";
 175     my @bind;
 176     if ($borrowernumber) {
 177         $query .= " borrowernumber=? and";
 178         push @bind, $borrowernumber;
 179     }
 180     if ($type) {
 181         $query .= " type=? and";
 182         push @bind, $type;
 183     }
 184     if ($externalid) {
 185         $query .= " externalid=? and";
 186         push @bind, $externalid;
 187     }
 188     $query =~ s/ and$//;
 189     my $sth = $dbh->prepare($query);
 190     $sth->execute(@bind);
 191     my @result;
 192     while ( my $line = $sth->fetchrow_hashref ) {
 193         push @result, $line;
 194     }
 195     return \@result if $#result >= 0;    # return only if there is one result.
 196     return;
 197 }
 198
 199 =head2 findrelatedto
 200
 201         parameters :
 202         - $type : the type of alert
 203         - $externalid : the id of the "object" to query
 204
 205         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.
 206         When type=issue, the id is related to a subscriptionid and this sub returns the name of the biblio.
 207         When type=virtual, the id is related to a virtual shelf and this sub returns the name of the sub
 208 =cut
 209
 210 sub findrelatedto {
 211     my ( $type, $externalid ) = @_;
 212     my $dbh = C4::Context->dbh;
 213     my $sth;
 214     if ( $type eq 'issue' ) {
 215         $sth =
 216           $dbh->prepare(
 217 "select title as result from subscription left join biblio on subscription.biblionumber=biblio.biblionumber where subscriptionid=?"
 218           );
 219     }
 220     if ( $type eq 'borrower' ) {
 221         $sth =
 222           $dbh->prepare(
 223 "select concat(firstname,' ',surname) from borrowers where borrowernumber=?"
 224           );
 225     }
 226     $sth->execute($externalid);
 227     my ($result) = $sth->fetchrow;
 228     return $result;
 229 }
 230
 231 =head2 SendAlerts
 232
 233     parameters :
 234     - $type : the type of alert
 235     - $externalid : the id of the "object" to query
 236     - $letter : the letter to send.
 237
 238     send an alert to all borrowers having put an alert on a given subject.
 239
 240 =cut
 241
 242 sub SendAlerts {
 243     my ( $type, $externalid, $letter ) = @_;
 244     my $dbh = C4::Context->dbh;
 245     if ( $type eq 'issue' ) {
 246
 247         #               warn "sending issues...";
 248         my $letter = getletter( 'serial', $letter );
 249
 250         # prepare the letter...
 251         # search the biblionumber
 252         my $sth =
 253           $dbh->prepare(
 254             "select biblionumber from subscription where subscriptionid=?");
 255         $sth->execute($externalid);
 256         my ($biblionumber) = $sth->fetchrow;
 257
 258         # parsing branch info
 259         my $userenv = C4::Context->userenv;
 260         parseletter( $letter, 'branches', $userenv->{branch} );
 261
 262         # parsing librarian name
 263         $letter->{content} =~ s/<<LibrarianFirstname>>/$userenv->{firstname}/g;
 264         $letter->{content} =~ s/<<LibrarianSurname>>/$userenv->{surname}/g;
 265         $letter->{content} =~
 266           s/<<LibrarianEmailaddress>>/$userenv->{emailaddress}/g;
 267
 268         # parsing biblio information
 269         parseletter( $letter, 'biblio',      $biblionumber );
 270         parseletter( $letter, 'biblioitems', $biblionumber );
 271
 272         # find the list of borrowers to alert
 273         my $alerts = getalert( '', 'issue', $externalid );
 274         foreach (@$alerts) {
 275
 276             # and parse borrower ...
 277             my $innerletter = $letter;
 278             my $borinfo = GetMember( $_->{'borrowernumber'}, 'borrowernumber' );
 279             parseletter( $innerletter, 'borrowers', $_->{'borrowernumber'} );
 280
 281             # ... then send mail
 282             if ( $borinfo->{emailaddress} ) {
 283                 my %mail = (
 284                     To      => $borinfo->{emailaddress},
 285                     From    => $userenv->{emailaddress},
 286                     Subject => "" . $innerletter->{title},
 287                     Message => "" . $innerletter->{content},
 288                 );
 289                 sendmail(%mail);
 290
 291 # warn "sending to $mail{To} From $mail{From} subj $mail{Subject} Mess $mail{Message}";
 292             }
 293         }
 294     }
 295     elsif ( $type eq 'claimacquisition' ) {
 296
 297         #               warn "sending issues...";
 298         my $letter = getletter( 'claimacquisition', $letter );
 299
 300         # prepare the letter...
 301         # search the biblionumber
 302         my $strsth =
 303 "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 ("
 304           . join( ",", @$externalid ) . ")";
 305         my $sthorders = $dbh->prepare($strsth);
 306         $sthorders->execute;
 307         my $dataorders = $sthorders->fetchall_arrayref( {} );
 308         parseletter( $letter, 'aqbooksellers',
 309             $dataorders->[0]->{booksellerid} );
 310         my $sthbookseller =
 311           $dbh->prepare("select * from aqbooksellers where id=?");
 312         $sthbookseller->execute( $dataorders->[0]->{booksellerid} );
 313         my $databookseller = $sthbookseller->fetchrow_hashref;
 314
 315         # parsing branch info
 316         my $userenv = C4::Context->userenv;
 317         parseletter( $letter, 'branches', $userenv->{branch} );
 318
 319         # parsing librarian name
 320         $letter->{content} =~ s/<<LibrarianFirstname>>/$userenv->{firstname}/g;
 321         $letter->{content} =~ s/<<LibrarianSurname>>/$userenv->{surname}/g;
 322         $letter->{content} =~
 323           s/<<LibrarianEmailaddress>>/$userenv->{emailaddress}/g;
 324         foreach my $data (@$dataorders) {
 325             my $line = $1 if ( $letter->{content} =~ m/(<<.*>>)/ );
 326             foreach my $field ( keys %$data ) {
 327                 $line =~ s/(<<[^\.]+.$field>>)/$data->{$field}/;
 328             }
 329             $letter->{content} =~ s/(<<.*>>)/$line\n$1/;
 330         }
 331         $letter->{content} =~ s/<<[^>]*>>//g;
 332         my $innerletter = $letter;
 333
 334         # ... then send mail
 335         if (   $databookseller->{bookselleremail}
 336             || $databookseller->{contemail} )
 337         {
 338             my %mail = (
 339                 To => $databookseller->{bookselleremail}
 340                   . (
 341                     $databookseller->{contemail}
 342                     ? "," . $databookseller->{contemail}
 343                     : ""
 344                   ),
 345                 From           => $userenv->{emailaddress},
 346                 Subject        => "" . $innerletter->{title},
 347                 Message        => "" . $innerletter->{content},
 348                 'Content-Type' => 'text/plain; charset="utf8"',
 349             );
 350             sendmail(%mail);
 351             warn
 352 "sending to $mail{To} From $mail{From} subj $mail{Subject} Mess $mail{Message}";
 353         }
 354         if ( C4::Context->preference("LetterLog") ) {
 355             logaction(
 356                 $userenv->{number},
 357                 "ACQUISITION",
 358                 "Send Acquisition claim letter",
 359                 "",
 360                 "order list : "
 361                   . join( ",", @$externalid )
 362                   . "\n$innerletter->{title}\n$innerletter->{content}"
 363             );
 364         }
 365     }
 366     elsif ( $type eq 'claimissues' ) {
 367
 368         #               warn "sending issues...";
 369         my $letter = getletter( 'claimissues', $letter );
 370
 371         # prepare the letter...
 372         # search the biblionumber
 373         my $strsth =
 374 "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 ("
 375           . join( ",", @$externalid ) . ")";
 376         my $sthorders = $dbh->prepare($strsth);
 377         $sthorders->execute;
 378         my $dataorders = $sthorders->fetchall_arrayref( {} );
 379         parseletter( $letter, 'aqbooksellers',
 380             $dataorders->[0]->{aqbooksellerid} );
 381         my $sthbookseller =
 382           $dbh->prepare("select * from aqbooksellers where id=?");
 383         $sthbookseller->execute( $dataorders->[0]->{aqbooksellerid} );
 384         my $databookseller = $sthbookseller->fetchrow_hashref;
 385
 386         # parsing branch info
 387         my $userenv = C4::Context->userenv;
 388         parseletter( $letter, 'branches', $userenv->{branch} );
 389
 390         # parsing librarian name
 391         $letter->{content} =~ s/<<LibrarianFirstname>>/$userenv->{firstname}/g;
 392         $letter->{content} =~ s/<<LibrarianSurname>>/$userenv->{surname}/g;
 393         $letter->{content} =~
 394           s/<<LibrarianEmailaddress>>/$userenv->{emailaddress}/g;
 395         foreach my $data (@$dataorders) {
 396             my $line = $1 if ( $letter->{content} =~ m/(<<.*>>)/ );
 397             foreach my $field ( keys %$data ) {
 398                 $line =~ s/(<<[^\.]+.$field>>)/$data->{$field}/;
 399             }
 400             $letter->{content} =~ s/(<<.*>>)/$line\n$1/;
 401         }
 402         $letter->{content} =~ s/<<[^>]*>>//g;
 403         my $innerletter = $letter;
 404
 405         # ... then send mail
 406         if (   $databookseller->{bookselleremail}
 407             || $databookseller->{contemail} )
 408         {
 409             my %mail = (
 410                 To => $databookseller->{bookselleremail}
 411                   . (
 412                     $databookseller->{contemail}
 413                     ? "," . $databookseller->{contemail}
 414                     : ""
 415                   ),
 416                 From    => $userenv->{emailaddress},
 417                 Subject => "" . $innerletter->{title},
 418                 Message => "" . $innerletter->{content},
 419             );
 420             sendmail(%mail);
 421             &logaction(
 422                 C4::Context->userenv->{'number'},
 423                 "ACQUISITION",
 424                 "CLAIM ISSUE",
 425                 undef,
 426                 "To="
 427                   . $databookseller->{contemail}
 428                   . " Title="
 429                   . $innerletter->{title}
 430                   . " Content="
 431                   . $innerletter->{content}
 432             ) if C4::Context->preference("LetterLog");
 433         }
 434         warn
 435 "sending to From $userenv->{emailaddress} subj $innerletter->{title} Mess $innerletter->{content}";
 436     }
 437 }
 438
 439 =head2 parseletter
 440
 441     parameters :
 442     - $letter : a hash to letter fields (title & content useful)
 443     - $table : the Koha table to parse.
 444     - $pk : the primary key to query on the $table table
 445     parse all fields from a table, and replace values in title & content with the appropriate value
 446     (not exported sub, used only internally)
 447
 448 =cut
 449
 450 sub parseletter {
 451     my ( $letter, $table, $pk ) = @_;
 452
 453     #   warn "Parseletter : ($letter,$table,$pk)";
 454     my $dbh = C4::Context->dbh;
 455     my $sth;
 456     if ( $table eq 'biblio' ) {
 457         $sth = $dbh->prepare("select * from biblio where biblionumber=?");
 458     }
 459     elsif ( $table eq 'biblioitems' ) {
 460         $sth = $dbh->prepare("select * from biblioitems where biblionumber=?");
 461     }
 462     elsif ( $table eq 'borrowers' ) {
 463         $sth = $dbh->prepare("select * from borrowers where borrowernumber=?");
 464     }
 465     elsif ( $table eq 'branches' ) {
 466         $sth = $dbh->prepare("select * from branches where branchcode=?");
 467     }
 468     elsif ( $table eq 'aqbooksellers' ) {
 469         $sth = $dbh->prepare("select * from aqbooksellers where id=?");
 470     }
 471     $sth->execute($pk);
 472
 473     # store the result in an hash
 474     my $values = $sth->fetchrow_hashref;
 475
 476     # and get all fields from the table
 477     $sth = $dbh->prepare("show columns from $table");
 478     $sth->execute;
 479     while ( ( my $field ) = $sth->fetchrow_array ) {
 480         my $replacefield = "<<$table.$field>>";
 481         my $replacedby   = $values->{$field};
 482
 483         #               warn "REPLACE $replacefield by $replacedby";
 484         $letter->{title}   =~ s/$replacefield/$replacedby/g;
 485         $letter->{content} =~ s/$replacefield/$replacedby/g;
 486     }
 487 }
 488
 489 END { }    # module clean-up code here (global destructor)