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)