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
  28 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
  29
  30 BEGIN {
  31         require Exporter;
  32         # set the version for version checking
  33         $VERSION = 3.01;
  34         @ISA = qw(Exporter);
  35         @EXPORT = qw(
  36         &GetLetters &getletter &addalert &getalert &delalert &findrelatedto &SendAlerts
  37         );
  38 }
  39
  40 =head1 NAME
  41
  42 C4::Letters - Give functions for Letters management
  43
  44 =head1 SYNOPSIS
  45
  46   use C4::Letters;
  47
  48 =head1 DESCRIPTION
  49
  50   "Letters" is the tool used in Koha to manage informations sent to the patrons and/or the library. This include some cron jobs like
  51   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)
  52
  53   Letters are managed through "alerts" sent by Koha on some events. All "alert" related functions are in this module too.
  54
  55 =cut
  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 =~ /^\d+$/) {
 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;
 198 }
 199
 200 =head2 findrelatedto
 201
 202         parameters :
 203         - $type : the type of alert
 204         - $externalid : the id of the "object" to query
 205
 206         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.
 207         When type=issue, the id is related to a subscriptionid and this sub returns the name of the biblio.
 208         When type=virtual, the id is related to a virtual shelf and this sub returns the name of the sub
 209 =cut
 210
 211 sub findrelatedto {
 212     my ( $type, $externalid ) = @_;
 213     my $dbh = C4::Context->dbh;
 214     my $sth;
 215     if ( $type eq 'issue' ) {
 216         $sth =
 217           $dbh->prepare(
 218 "select title as result from subscription left join biblio on subscription.biblionumber=biblio.biblionumber where subscriptionid=?"
 219           );
 220     }
 221     if ( $type eq 'borrower' ) {
 222         $sth =
 223           $dbh->prepare(
 224 "select concat(firstname,' ',surname) from borrowers where borrowernumber=?"
 225           );
 226     }
 227     $sth->execute($externalid);
 228     my ($result) = $sth->fetchrow;
 229     return $result;
 230 }
 231
 232 =head2 SendAlerts
 233
 234     parameters :
 235     - $type : the type of alert
 236     - $externalid : the id of the "object" to query
 237     - $letter : the letter to send.
 238
 239     send an alert to all borrowers having put an alert on a given subject.
 240
 241 =cut
 242
 243 sub SendAlerts {
 244     my ( $type, $externalid, $letter ) = @_;
 245     my $dbh = C4::Context->dbh;
 246     if ( $type eq 'issue' ) {
 247
 248         #               warn "sending issues...";
 249         my $letter = getletter( 'serial', $letter );
 250
 251         # prepare the letter...
 252         # search the biblionumber
 253         my $sth =
 254           $dbh->prepare(
 255             "SELECT biblionumber FROM subscription WHERE subscriptionid=?");
 256         $sth->execute($externalid);
 257         my ($biblionumber) = $sth->fetchrow;
 258
 259         # parsing branch info
 260         my $userenv = C4::Context->userenv;
 261         parseletter( $letter, 'branches', $userenv->{branch} );
 262
 263         # parsing librarian name
 264         $letter->{content} =~ s/<<LibrarianFirstname>>/$userenv->{firstname}/g;
 265         $letter->{content} =~ s/<<LibrarianSurname>>/$userenv->{surname}/g;
 266         $letter->{content} =~
 267           s/<<LibrarianEmailaddress>>/$userenv->{emailaddress}/g;
 268
 269         # parsing biblio information
 270         parseletter( $letter, 'biblio',      $biblionumber );
 271         parseletter( $letter, 'biblioitems', $biblionumber );
 272
 273         # find the list of borrowers to alert
 274         my $alerts = getalert( '', 'issue', $externalid );
 275         foreach (@$alerts) {
 276
 277             # and parse borrower ...
 278             my $innerletter = $letter;
 279             my $borinfo = GetMember( $_->{'borrowernumber'}, 'borrowernumber' );
 280             parseletter( $innerletter, 'borrowers', $_->{'borrowernumber'} );
 281
 282             # ... then send mail
 283             if ( $borinfo->{email} ) {
 284                 my %mail = (
 285                     To      => $borinfo->{email},
 286                     From    => $borinfo->{email},
 287                     Subject => "" . $innerletter->{title},
 288                     Message => "" . $innerletter->{content},
 289                 );
 290                 sendmail(%mail);
 291
 292 # warn "sending to $mail{To} From $mail{From} subj $mail{Subject} Mess $mail{Message}";
 293             }
 294         }
 295     }
 296     elsif ( $type eq 'claimacquisition' ) {
 297
 298         #               warn "sending issues...";
 299         my $letter = getletter( 'claimacquisition', $letter );
 300
 301         # prepare the letter...
 302         # search the biblionumber
 303         my $strsth =
 304 "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 ("
 305           . join( ",", @$externalid ) . ")";
 306         my $sthorders = $dbh->prepare($strsth);
 307         $sthorders->execute;
 308         my $dataorders = $sthorders->fetchall_arrayref( {} );
 309         parseletter( $letter, 'aqbooksellers',
 310             $dataorders->[0]->{booksellerid} );
 311         my $sthbookseller =
 312           $dbh->prepare("select * from aqbooksellers where id=?");
 313         $sthbookseller->execute( $dataorders->[0]->{booksellerid} );
 314         my $databookseller = $sthbookseller->fetchrow_hashref;
 315
 316         # parsing branch info
 317         my $userenv = C4::Context->userenv;
 318         parseletter( $letter, 'branches', $userenv->{branch} );
 319
 320         # parsing librarian name
 321         $letter->{content} =~ s/<<LibrarianFirstname>>/$userenv->{firstname}/g;
 322         $letter->{content} =~ s/<<LibrarianSurname>>/$userenv->{surname}/g;
 323         $letter->{content} =~
 324           s/<<LibrarianEmailaddress>>/$userenv->{emailaddress}/g;
 325         foreach my $data (@$dataorders) {
 326             my $line = $1 if ( $letter->{content} =~ m/(<<.*>>)/ );
 327             foreach my $field ( keys %$data ) {
 328                 $line =~ s/(<<[^\.]+.$field>>)/$data->{$field}/;
 329             }
 330             $letter->{content} =~ s/(<<.*>>)/$line\n$1/;
 331         }
 332         $letter->{content} =~ s/<<[^>]*>>//g;
 333         my $innerletter = $letter;
 334
 335         # ... then send mail
 336         if (   $databookseller->{bookselleremail}
 337             || $databookseller->{contemail} )
 338         {
 339             my %mail = (
 340                 To => $databookseller->{bookselleremail}
 341                   . (
 342                     $databookseller->{contemail}
 343                     ? "," . $databookseller->{contemail}
 344                     : ""
 345                   ),
 346                 From           => $userenv->{emailaddress},
 347                 Subject        => "" . $innerletter->{title},
 348                 Message        => "" . $innerletter->{content},
 349                 'Content-Type' => 'text/plain; charset="utf8"',
 350             );
 351             sendmail(%mail);
 352             warn
 353 "sending to $mail{To} From $mail{From} subj $mail{Subject} Mess $mail{Message}";
 354         }
 355         if ( C4::Context->preference("LetterLog") ) {
 356             logaction(
 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                 "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 1;
 489 __END__