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;
 196 }
 197
 198 =head2 findrelatedto
 199
 200         parameters :
 201         - $type : the type of alert
 202         - $externalid : the id of the "object" to query
 203
 204         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.
 205         When type=issue, the id is related to a subscriptionid and this sub returns the name of the biblio.
 206         When type=virtual, the id is related to a virtual shelf and this sub returns the name of the sub
 207 =cut
 208
 209 sub findrelatedto {
 210     my ( $type, $externalid ) = @_;
 211     my $dbh = C4::Context->dbh;
 212     my $sth;
 213     if ( $type eq 'issue' ) {
 214         $sth =
 215           $dbh->prepare(
 216 "select title as result from subscription left join biblio on subscription.biblionumber=biblio.biblionumber where subscriptionid=?"
 217           );
 218     }
 219     if ( $type eq 'borrower' ) {
 220         $sth =
 221           $dbh->prepare(
 222 "select concat(firstname,' ',surname) from borrowers where borrowernumber=?"
 223           );
 224     }
 225     $sth->execute($externalid);
 226     my ($result) = $sth->fetchrow;
 227     return $result;
 228 }
 229
 230 =head2 SendAlerts
 231
 232     parameters :
 233     - $type : the type of alert
 234     - $externalid : the id of the "object" to query
 235     - $letter : the letter to send.
 236
 237     send an alert to all borrowers having put an alert on a given subject.
 238
 239 =cut
 240
 241 sub SendAlerts {
 242     my ( $type, $externalid, $letter ) = @_;
 243     my $dbh = C4::Context->dbh;
 244     if ( $type eq 'issue' ) {
 245
 246         #               warn "sending issues...";
 247         my $letter = getletter( 'serial', $letter );
 248
 249         # prepare the letter...
 250         # search the biblionumber
 251         my $sth =
 252           $dbh->prepare(
 253             "select biblionumber from subscription where subscriptionid=?");
 254         $sth->execute($externalid);
 255         my ($biblionumber) = $sth->fetchrow;
 256
 257         # parsing branch info
 258         my $userenv = C4::Context->userenv;
 259         parseletter( $letter, 'branches', $userenv->{branch} );
 260
 261         # parsing librarian name
 262         $letter->{content} =~ s/<<LibrarianFirstname>>/$userenv->{firstname}/g;
 263         $letter->{content} =~ s/<<LibrarianSurname>>/$userenv->{surname}/g;
 264         $letter->{content} =~
 265           s/<<LibrarianEmailaddress>>/$userenv->{emailaddress}/g;
 266
 267         # parsing biblio information
 268         parseletter( $letter, 'biblio',      $biblionumber );
 269         parseletter( $letter, 'biblioitems', $biblionumber );
 270
 271         # find the list of borrowers to alert
 272         my $alerts = getalert( '', 'issue', $externalid );
 273         foreach (@$alerts) {
 274
 275             # and parse borrower ...
 276             my $innerletter = $letter;
 277             my $borinfo = GetMember( $_->{'borrowernumber'}, 'borrowernumber' );
 278             parseletter( $innerletter, 'borrowers', $_->{'borrowernumber'} );
 279
 280             # ... then send mail
 281             if ( $borinfo->{emailaddress} ) {
 282                 my %mail = (
 283                     To      => $borinfo->{emailaddress},
 284                     From    => $userenv->{emailaddress},
 285                     Subject => "" . $innerletter->{title},
 286                     Message => "" . $innerletter->{content},
 287                 );
 288                 sendmail(%mail);
 289
 290 # warn "sending to $mail{To} From $mail{From} subj $mail{Subject} Mess $mail{Message}";
 291             }
 292         }
 293     }
 294     elsif ( $type eq 'claimacquisition' ) {
 295
 296         #               warn "sending issues...";
 297         my $letter = getletter( 'claimacquisition', $letter );
 298
 299         # prepare the letter...
 300         # search the biblionumber
 301         my $strsth =
 302 "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 ("
 303           . join( ",", @$externalid ) . ")";
 304         my $sthorders = $dbh->prepare($strsth);
 305         $sthorders->execute;
 306         my $dataorders = $sthorders->fetchall_arrayref( {} );
 307         parseletter( $letter, 'aqbooksellers',
 308             $dataorders->[0]->{booksellerid} );
 309         my $sthbookseller =
 310           $dbh->prepare("select * from aqbooksellers where id=?");
 311         $sthbookseller->execute( $dataorders->[0]->{booksellerid} );
 312         my $databookseller = $sthbookseller->fetchrow_hashref;
 313
 314         # parsing branch info
 315         my $userenv = C4::Context->userenv;
 316         parseletter( $letter, 'branches', $userenv->{branch} );
 317
 318         # parsing librarian name
 319         $letter->{content} =~ s/<<LibrarianFirstname>>/$userenv->{firstname}/g;
 320         $letter->{content} =~ s/<<LibrarianSurname>>/$userenv->{surname}/g;
 321         $letter->{content} =~
 322           s/<<LibrarianEmailaddress>>/$userenv->{emailaddress}/g;
 323         foreach my $data (@$dataorders) {
 324             my $line = $1 if ( $letter->{content} =~ m/(<<.*>>)/ );
 325             foreach my $field ( keys %$data ) {
 326                 $line =~ s/(<<[^\.]+.$field>>)/$data->{$field}/;
 327             }
 328             $letter->{content} =~ s/(<<.*>>)/$line\n$1/;
 329         }
 330         $letter->{content} =~ s/<<[^>]*>>//g;
 331         my $innerletter = $letter;
 332
 333         # ... then send mail
 334         if (   $databookseller->{bookselleremail}
 335             || $databookseller->{contemail} )
 336         {
 337             my %mail = (
 338                 To => $databookseller->{bookselleremail}
 339                   . (
 340                     $databookseller->{contemail}
 341                     ? "," . $databookseller->{contemail}
 342                     : ""
 343                   ),
 344                 From           => $userenv->{emailaddress},
 345                 Subject        => "" . $innerletter->{title},
 346                 Message        => "" . $innerletter->{content},
 347                 'Content-Type' => 'text/plain; charset="utf8"',
 348             );
 349             sendmail(%mail);
 350             warn
 351 "sending to $mail{To} From $mail{From} subj $mail{Subject} Mess $mail{Message}";
 352         }
 353         if ( C4::Context->preference("LetterLog") ) {
 354             logaction(
 355                 $userenv->{number},
 356                 "ACQUISITION",
 357                 "Send Acquisition claim letter",
 358                 "",
 359                 "order list : "
 360                   . join( ",", @$externalid )
 361                   . "\n$innerletter->{title}\n$innerletter->{content}"
 362             );
 363         }
 364     }
 365     elsif ( $type eq 'claimissues' ) {
 366
 367         #               warn "sending issues...";
 368         my $letter = getletter( 'claimissues', $letter );
 369
 370         # prepare the letter...
 371         # search the biblionumber
 372         my $strsth =
 373 "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 ("
 374           . join( ",", @$externalid ) . ")";
 375         my $sthorders = $dbh->prepare($strsth);
 376         $sthorders->execute;
 377         my $dataorders = $sthorders->fetchall_arrayref( {} );
 378         parseletter( $letter, 'aqbooksellers',
 379             $dataorders->[0]->{aqbooksellerid} );
 380         my $sthbookseller =
 381           $dbh->prepare("select * from aqbooksellers where id=?");
 382         $sthbookseller->execute( $dataorders->[0]->{aqbooksellerid} );
 383         my $databookseller = $sthbookseller->fetchrow_hashref;
 384
 385         # parsing branch info
 386         my $userenv = C4::Context->userenv;
 387         parseletter( $letter, 'branches', $userenv->{branch} );
 388
 389         # parsing librarian name
 390         $letter->{content} =~ s/<<LibrarianFirstname>>/$userenv->{firstname}/g;
 391         $letter->{content} =~ s/<<LibrarianSurname>>/$userenv->{surname}/g;
 392         $letter->{content} =~
 393           s/<<LibrarianEmailaddress>>/$userenv->{emailaddress}/g;
 394         foreach my $data (@$dataorders) {
 395             my $line = $1 if ( $letter->{content} =~ m/(<<.*>>)/ );
 396             foreach my $field ( keys %$data ) {
 397                 $line =~ s/(<<[^\.]+.$field>>)/$data->{$field}/;
 398             }
 399             $letter->{content} =~ s/(<<.*>>)/$line\n$1/;
 400         }
 401         $letter->{content} =~ s/<<[^>]*>>//g;
 402         my $innerletter = $letter;
 403
 404         # ... then send mail
 405         if (   $databookseller->{bookselleremail}
 406             || $databookseller->{contemail} )
 407         {
 408             my %mail = (
 409                 To => $databookseller->{bookselleremail}
 410                   . (
 411                     $databookseller->{contemail}
 412                     ? "," . $databookseller->{contemail}
 413                     : ""
 414                   ),
 415                 From    => $userenv->{emailaddress},
 416                 Subject => "" . $innerletter->{title},
 417                 Message => "" . $innerletter->{content},
 418             );
 419             sendmail(%mail);
 420             &logaction(
 421                 C4::Context->userenv->{'number'},
 422                 "ACQUISITION",
 423                 "CLAIM ISSUE",
 424                 undef,
 425                 "To="
 426                   . $databookseller->{contemail}
 427                   . " Title="
 428                   . $innerletter->{title}
 429                   . " Content="
 430                   . $innerletter->{content}
 431             ) if C4::Context->preference("LetterLog");
 432         }
 433         warn
 434 "sending to From $userenv->{emailaddress} subj $innerletter->{title} Mess $innerletter->{content}";
 435     }
 436 }
 437
 438 =head2 parseletter
 439
 440     parameters :
 441     - $letter : a hash to letter fields (title & content useful)
 442     - $table : the Koha table to parse.
 443     - $pk : the primary key to query on the $table table
 444     parse all fields from a table, and replace values in title & content with the appropriate value
 445     (not exported sub, used only internally)
 446
 447 =cut
 448
 449 sub parseletter {
 450     my ( $letter, $table, $pk ) = @_;
 451
 452     #   warn "Parseletter : ($letter,$table,$pk)";
 453     my $dbh = C4::Context->dbh;
 454     my $sth;
 455     if ( $table eq 'biblio' ) {
 456         $sth = $dbh->prepare("select * from biblio where biblionumber=?");
 457     }
 458     elsif ( $table eq 'biblioitems' ) {
 459         $sth = $dbh->prepare("select * from biblioitems where biblionumber=?");
 460     }
 461     elsif ( $table eq 'borrowers' ) {
 462         $sth = $dbh->prepare("select * from borrowers where borrowernumber=?");
 463     }
 464     elsif ( $table eq 'branches' ) {
 465         $sth = $dbh->prepare("select * from branches where branchcode=?");
 466     }
 467     elsif ( $table eq 'aqbooksellers' ) {
 468         $sth = $dbh->prepare("select * from aqbooksellers where id=?");
 469     }
 470     $sth->execute($pk);
 471
 472     # store the result in an hash
 473     my $values = $sth->fetchrow_hashref;
 474
 475     # and get all fields from the table
 476     $sth = $dbh->prepare("show columns from $table");
 477     $sth->execute;
 478     while ( ( my $field ) = $sth->fetchrow_array ) {
 479         my $replacefield = "<<$table.$field>>";
 480         my $replacedby   = $values->{$field};
 481
 482         #               warn "REPLACE $replacefield by $replacedby";
 483         $letter->{title}   =~ s/$replacefield/$replacedby/g;
 484         $letter->{content} =~ s/$replacefield/$replacedby/g;
 485     }
 486 }
 487
 488 END { }    # module clean-up code here (global destructor)