Bug 33198: Don't calculate pickup locations per bib unless placing multiple holds
[koha.git] / 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
8 # under the terms of the GNU General Public License as published by
9 # the Free Software Foundation; either version 3 of the License, or
10 # (at your option) any later version.
11 #
12 # Koha is distributed in the hope that it will be useful, but
13 # WITHOUT ANY WARRANTY; without even the implied warranty of
14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 # GNU General Public License for more details.
16 #
17 # You should have received a copy of the GNU General Public License
18 # along with Koha; if not, see <http://www.gnu.org/licenses>.
19
20 use Modern::Perl;
21
22 use Carp qw( carp croak );
23 use Template;
24 use Module::Load::Conditional qw( can_load );
25
26 use Try::Tiny qw( catch try );
27
28 use C4::Members;
29 use C4::Log qw( logaction );
30 use C4::SMS;
31 use C4::Templates;
32 use Koha::DateUtils qw( dt_from_string output_pref );
33 use Koha::SMS::Providers;
34
35 use Koha::Email;
36 use Koha::Notice::Messages;
37 use Koha::Notice::Templates;
38 use Koha::DateUtils qw( dt_from_string output_pref );
39 use Koha::Patrons;
40 use Koha::SMTP::Servers;
41 use Koha::Subscriptions;
42
43 use constant SERIALIZED_EMAIL_CONTENT_TYPE => 'message/rfc822';
44
45 our (@ISA, @EXPORT_OK);
46 BEGIN {
47     require Exporter;
48     @ISA = qw(Exporter);
49     @EXPORT_OK = qw(
50       GetLetters
51       GetLettersAvailableForALibrary
52       GetLetterTemplates
53       DelLetter
54       GetPreparedLetter
55       GetWrappedLetter
56       SendAlerts
57       GetPrintMessages
58       GetQueuedMessages
59       GetMessage
60       GetMessageTransportTypes
61
62       EnqueueLetter
63       SendQueuedMessages
64       ResendMessage
65     );
66 }
67
68 =head1 NAME
69
70 C4::Letters - Give functions for Letters management
71
72 =head1 SYNOPSIS
73
74   use C4::Letters;
75
76 =head1 DESCRIPTION
77
78   "Letters" is the tool used in Koha to manage informations sent to the patrons and/or the library. This include some cron jobs like
79   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)
80
81   Letters are managed through "alerts" sent by Koha on some events. All "alert" related functions are in this module too.
82
83 =head2 GetLetters([$module])
84
85   $letters = &GetLetters($module);
86   returns informations about letters.
87   if needed, $module filters for letters given module
88
89   DEPRECATED - You must use Koha::Notice::Templates instead
90   The group by clause is confusing and can lead to issues
91
92 =cut
93
94 sub GetLetters {
95     my ($filters) = @_;
96     my $module    = $filters->{module};
97     my $code      = $filters->{code};
98     my $branchcode = $filters->{branchcode};
99     my $dbh       = C4::Context->dbh;
100     my $letters   = $dbh->selectall_arrayref(
101         q|
102             SELECT code, module, name
103             FROM letter
104             WHERE 1
105         |
106           . ( $module ? q| AND module = ?| : q|| )
107           . ( $code   ? q| AND code = ?|   : q|| )
108           . ( defined $branchcode   ? q| AND branchcode = ?|   : q|| )
109           . q| GROUP BY code, module, name ORDER BY name|, { Slice => {} }
110         , ( $module ? $module : () )
111         , ( $code ? $code : () )
112         , ( defined $branchcode ? $branchcode : () )
113     );
114
115     return $letters;
116 }
117
118 =head2 GetLetterTemplates
119
120     my $letter_templates = GetLetterTemplates(
121         {
122             module => 'circulation',
123             code => 'my code',
124             branchcode => 'CPL', # '' for default,
125         }
126     );
127
128     Return a hashref of letter templates.
129
130 =cut
131
132 sub GetLetterTemplates {
133     my ( $params ) = @_;
134
135     my $module    = $params->{module};
136     my $code      = $params->{code};
137     my $branchcode = $params->{branchcode} // '';
138     my $dbh       = C4::Context->dbh;
139     return Koha::Notice::Templates->search(
140         {
141             module     => $module,
142             code       => $code,
143             branchcode => $branchcode,
144             (
145                 C4::Context->preference('TranslateNotices')
146                 ? ()
147                 : ( lang => 'default' )
148             )
149         }
150     )->unblessed;
151 }
152
153 =head2 GetLettersAvailableForALibrary
154
155     my $letters = GetLettersAvailableForALibrary(
156         {
157             branchcode => 'CPL', # '' for default
158             module => 'circulation',
159         }
160     );
161
162     Return an arrayref of letters, sorted by name.
163     If a specific letter exist for the given branchcode, it will be retrieve.
164     Otherwise the default letter will be.
165
166 =cut
167
168 sub GetLettersAvailableForALibrary {
169     my ($filters)  = @_;
170     my $branchcode = $filters->{branchcode};
171     my $module     = $filters->{module};
172
173     croak "module should be provided" unless $module;
174
175     my $dbh             = C4::Context->dbh;
176     my $default_letters = $dbh->selectall_arrayref(
177         q|
178             SELECT module, code, branchcode, name
179             FROM letter
180             WHERE 1
181         |
182           . q| AND branchcode = ''|
183           . ( $module ? q| AND module = ?| : q|| )
184           . q| ORDER BY name|, { Slice => {} }
185         , ( $module ? $module : () )
186     );
187
188     my $specific_letters;
189     if ($branchcode) {
190         $specific_letters = $dbh->selectall_arrayref(
191             q|
192                 SELECT module, code, branchcode, name
193                 FROM letter
194                 WHERE 1
195             |
196               . q| AND branchcode = ?|
197               . ( $module ? q| AND module = ?| : q|| )
198               . q| ORDER BY name|, { Slice => {} }
199             , $branchcode
200             , ( $module ? $module : () )
201         );
202     }
203
204     my %letters;
205     for my $l (@$default_letters) {
206         $letters{ $l->{code} } = $l;
207     }
208     for my $l (@$specific_letters) {
209         # Overwrite the default letter with the specific one.
210         $letters{ $l->{code} } = $l;
211     }
212
213     return [ map { $letters{$_} }
214           sort { $letters{$a}->{name} cmp $letters{$b}->{name} }
215           keys %letters ];
216
217 }
218
219 =head2 DelLetter
220
221     DelLetter(
222         {
223             branchcode => 'CPL',
224             module => 'circulation',
225             code => 'my code',
226             [ mtt => 'email', ]
227         }
228     );
229
230     Delete the letter. The mtt parameter is facultative.
231     If not given, all templates mathing the other parameters will be removed.
232
233 =cut
234
235 sub DelLetter {
236     my ($params)   = @_;
237     my $branchcode = $params->{branchcode};
238     my $module     = $params->{module};
239     my $code       = $params->{code};
240     my $mtt        = $params->{mtt};
241     my $lang       = $params->{lang};
242     my $dbh        = C4::Context->dbh;
243     $dbh->do(q|
244         DELETE FROM letter
245         WHERE branchcode = ?
246           AND module = ?
247           AND code = ?
248     |
249     . ( $mtt ? q| AND message_transport_type = ?| : q|| )
250     . ( $lang? q| AND lang = ?| : q|| )
251     , undef, $branchcode, $module, $code, ( $mtt ? $mtt : () ), ( $lang ? $lang : () ) );
252 }
253
254 =head2 SendAlerts
255
256     my $err = &SendAlerts($type, $externalid, $letter_code);
257
258     Parameters:
259       - $type : the type of alert
260       - $externalid : the id of the "object" to query
261       - $letter_code : the notice template to use
262
263     C<&SendAlerts> sends an email notice directly to a patron or a vendor.
264
265     Currently it supports ($type):
266       - claim serial issues (claimissues)
267       - claim acquisition orders (claimacquisition)
268       - send acquisition orders to the vendor (orderacquisition)
269       - notify patrons about newly received serial issues (issue)
270       - notify patrons when their account is created (members)
271
272     Returns undef or { error => 'message } on failure.
273     Returns true on success.
274
275 =cut
276
277 sub SendAlerts {
278     my ( $type, $externalid, $letter_code ) = @_;
279     my $dbh = C4::Context->dbh;
280     my $error;
281
282     if ( $type eq 'issue' ) {
283
284         # prepare the letter...
285         # search the subscriptionid
286         my $sth =
287           $dbh->prepare(
288             "SELECT subscriptionid FROM serial WHERE serialid=?");
289         $sth->execute($externalid);
290         my ($subscriptionid) = $sth->fetchrow
291           or warn( "No subscription for '$externalid'" ),
292              return;
293
294         # search the biblionumber
295         $sth =
296           $dbh->prepare(
297             "SELECT biblionumber FROM subscription WHERE subscriptionid=?");
298         $sth->execute($subscriptionid);
299         my ($biblionumber) = $sth->fetchrow
300           or warn( "No biblionumber for '$subscriptionid'" ),
301              return;
302
303         # find the list of subscribers to notify
304         my $subscription = Koha::Subscriptions->find( $subscriptionid );
305         my $subscribers = $subscription->subscribers;
306         while ( my $patron = $subscribers->next ) {
307             my $email = $patron->email or next;
308
309 #                    warn "sending issues...";
310             my $userenv = C4::Context->userenv;
311             my $library = $patron->library;
312             my $letter = GetPreparedLetter (
313                 module => 'serial',
314                 letter_code => $letter_code,
315                 branchcode => $userenv->{branch},
316                 tables => {
317                     'branches'    => $library->branchcode,
318                     'biblio'      => $biblionumber,
319                     'biblioitems' => $biblionumber,
320                     'borrowers'   => $patron->unblessed,
321                     'subscription' => $subscriptionid,
322                     'serial' => $externalid,
323                 },
324                 want_librarian => 1,
325             ) or return;
326
327             # FIXME: This 'default' behaviour should be moved to Koha::Email
328             my $mail = Koha::Email->create(
329                 {
330                     to       => $email,
331                     from     => $library->branchemail,
332                     reply_to => $library->branchreplyto,
333                     sender   => $library->branchreturnpath,
334                     subject  => "" . $letter->{title},
335                 }
336             );
337
338             if ( $letter->{is_html} ) {
339                 $mail->html_body( _wrap_html( $letter->{content}, "" . $letter->{title} ) );
340             }
341             else {
342                 $mail->text_body( $letter->{content} );
343             }
344
345             my $success = try {
346                 $mail->send_or_die({ transport => $library->smtp_server->transport });
347             }
348             catch {
349                 # We expect ref($_) eq 'Email::Sender::Failure'
350                 $error = $_->message;
351
352                 carp "$_";
353                 return;
354             };
355
356             return { error => $error }
357                 unless $success;
358         }
359     }
360     elsif ( $type eq 'claimacquisition' or $type eq 'claimissues' or $type eq 'orderacquisition' ) {
361
362         # prepare the letter...
363         my $strsth;
364         my $sthorders;
365         my $dataorders;
366         my $action;
367         my $basketno;
368         if ( $type eq 'claimacquisition') {
369             $strsth = qq{
370             SELECT aqorders.*,aqbasket.*,biblio.*,biblioitems.*
371             FROM aqorders
372             LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno
373             LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
374             LEFT JOIN biblioitems ON aqorders.biblionumber=biblioitems.biblionumber
375             WHERE aqorders.ordernumber IN (
376             };
377
378             if (!@$externalid){
379                 carp "No order selected";
380                 return { error => "no_order_selected" };
381             }
382             $strsth .= join( ",", ('?') x @$externalid ) . ")";
383             $action = "ACQUISITION CLAIM";
384             $sthorders = $dbh->prepare($strsth);
385             $sthorders->execute( @$externalid );
386             $dataorders = $sthorders->fetchall_arrayref( {} );
387         }
388
389         if ($type eq 'claimissues') {
390             $strsth = qq{
391             SELECT serial.*,subscription.*, biblio.*, biblioitems.*, aqbooksellers.*,
392             aqbooksellers.id AS booksellerid
393             FROM serial
394             LEFT JOIN subscription ON serial.subscriptionid=subscription.subscriptionid
395             LEFT JOIN biblio ON serial.biblionumber=biblio.biblionumber
396             LEFT JOIN biblioitems ON serial.biblionumber = biblioitems.biblionumber
397             LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id
398             WHERE serial.serialid IN (
399             };
400
401             if (!@$externalid){
402                 carp "No issues selected";
403                 return { error => "no_issues_selected" };
404             }
405
406             $strsth .= join( ",", ('?') x @$externalid ) . ")";
407             $action = "SERIAL CLAIM";
408             $sthorders = $dbh->prepare($strsth);
409             $sthorders->execute( @$externalid );
410             $dataorders = $sthorders->fetchall_arrayref( {} );
411         }
412
413         if ( $type eq 'orderacquisition') {
414             $basketno = $externalid;
415             $strsth = qq{
416             SELECT aqorders.*,aqbasket.*,biblio.*,biblioitems.*
417             FROM aqorders
418             LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno
419             LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
420             LEFT JOIN biblioitems ON aqorders.biblionumber=biblioitems.biblionumber
421             WHERE aqbasket.basketno = ?
422             AND orderstatus IN ('new','ordered')
423             };
424
425             unless ( $basketno ) {
426                 carp "No basketnumber given";
427                 return { error => "no_basketno" };
428             }
429             $action = "ACQUISITION ORDER";
430             $sthorders = $dbh->prepare($strsth);
431             $sthorders->execute($basketno);
432             $dataorders = $sthorders->fetchall_arrayref( {} );
433         }
434
435         my $sthbookseller =
436           $dbh->prepare("select * from aqbooksellers where id=?");
437         $sthbookseller->execute( $dataorders->[0]->{booksellerid} );
438         my $databookseller = $sthbookseller->fetchrow_hashref;
439
440         my $addressee =  $type eq 'claimacquisition' || $type eq 'orderacquisition' ? 'acqprimary' : 'serialsprimary';
441
442         my $sthcontact =
443           $dbh->prepare("SELECT * FROM aqcontacts WHERE booksellerid=? AND $type=1 ORDER BY $addressee DESC");
444         $sthcontact->execute( $dataorders->[0]->{booksellerid} );
445         my $datacontact = $sthcontact->fetchrow_hashref;
446
447         my @email;
448         my @cc;
449         push @email, $datacontact->{email}           if ( $datacontact && $datacontact->{email} );
450         unless (@email) {
451             warn "Bookseller $dataorders->[0]->{booksellerid} without emails";
452             return { error => "no_email" };
453         }
454         my $addlcontact;
455         while ($addlcontact = $sthcontact->fetchrow_hashref) {
456             push @cc, $addlcontact->{email} if ( $addlcontact && $addlcontact->{email} );
457         }
458
459         my $userenv = C4::Context->userenv;
460         my $letter = GetPreparedLetter (
461             module => $type,
462             letter_code => $letter_code,
463             branchcode => $userenv->{branch},
464             tables => {
465                 'branches'      => $userenv->{branch},
466                 'aqbooksellers' => $databookseller,
467                 'aqcontacts'    => $datacontact,
468                 'aqbasket'      => $basketno,
469             },
470             repeat => $dataorders,
471             want_librarian => 1,
472         ) or return { error => "no_letter" };
473
474         # Remove the order tag
475         $letter->{content} =~ s/<order>(.*?)<\/order>/$1/gxms;
476
477         # ... then send mail
478         my $library = Koha::Libraries->find( $userenv->{branch} );
479         my $mail = Koha::Email->create(
480             {
481                 to => join( ',', @email ),
482                 cc => join( ',', @cc ),
483                 (
484                     (
485                         C4::Context->preference("ClaimsBccCopy")
486                           && ( $type eq 'claimacquisition'
487                             || $type eq 'claimissues' )
488                     )
489                     ? ( bcc => $userenv->{emailaddress} )
490                     : ()
491                 ),
492                 from => $library->branchemail
493                   || C4::Context->preference('KohaAdminEmailAddress'),
494                 subject => "" . $letter->{title},
495             }
496         );
497
498         if ( $letter->{is_html} ) {
499             $mail->html_body( _wrap_html( $letter->{content}, "" . $letter->{title} ) );
500         }
501         else {
502             $mail->text_body( "" . $letter->{content} );
503         }
504
505         my $success = try {
506             $mail->send_or_die({ transport => $library->smtp_server->transport });
507         }
508         catch {
509             # We expect ref($_) eq 'Email::Sender::Failure'
510             $error = $_->message;
511
512             carp "$_";
513             return;
514         };
515
516         return { error => $error }
517             unless $success;
518
519         my $module = $action eq 'ACQUISITION ORDER' ? 'ACQUISITIONS' : 'CLAIMS';
520         logaction(
521             $module,
522             $action,
523             undef,
524             "To="
525                 . join( ',', @email )
526                 . " Title="
527                 . $letter->{title}
528                 . " Content="
529                 . $letter->{content}
530         ) if C4::Context->preference("ClaimsLog");
531     }
532
533     # If we come here, return an OK status
534     return 1;
535 }
536
537 =head2 GetPreparedLetter( %params )
538
539     %params hash:
540       module => letter module, mandatory
541       letter_code => letter code, mandatory
542       branchcode => for letter selection, if missing default system letter taken
543       tables => a hashref with table names as keys. Values are either:
544         - a scalar - primary key value
545         - an arrayref - primary key values
546         - a hashref - full record
547       substitute => custom substitution key/value pairs
548       repeat => records to be substituted on consecutive lines:
549         - an arrayref - tries to guess what needs substituting by
550           taking remaining << >> tokensr; not recommended
551         - a hashref token => @tables - replaces <token> << >> << >> </token>
552           subtemplate for each @tables row; table is a hashref as above
553       want_librarian => boolean,  if set to true triggers librarian details
554         substitution from the userenv
555     Return value:
556       letter fields hashref (title & content useful)
557
558 =cut
559
560 sub GetPreparedLetter {
561     my %params = @_;
562
563     my $letter = $params{letter};
564     my $lang   = $params{lang} || 'default';
565
566     unless ( $letter ) {
567         my $module      = $params{module} or croak "No module";
568         my $letter_code = $params{letter_code} or croak "No letter_code";
569         my $branchcode  = $params{branchcode} || '';
570         my $mtt         = $params{message_transport_type} || 'email';
571
572         my $template = Koha::Notice::Templates->find_effective_template(
573             {
574                 module                 => $module,
575                 code                   => $letter_code,
576                 branchcode             => $branchcode,
577                 message_transport_type => $mtt,
578                 lang                   => $lang
579             }
580         );
581
582         unless ( $template ) {
583             warn( "No $module $letter_code letter transported by " . $mtt );
584             return;
585         }
586
587         $letter = $template->unblessed;
588         $letter->{'content-type'} = 'text/html; charset="UTF-8"' if $letter->{is_html};
589     }
590
591     my $tables = $params{tables} || {};
592     my $substitute = $params{substitute} || {};
593     my $loops  = $params{loops} || {}; # loops is not supported for historical notices syntax
594     my $repeat = $params{repeat};
595     %$tables || %$substitute || $repeat || %$loops
596       or carp( "ERROR: nothing to substitute - both 'tables', 'loops' and 'substitute' are empty" ),
597          return;
598     my $want_librarian = $params{want_librarian};
599
600     if (%$substitute) {
601         while ( my ($token, $val) = each %$substitute ) {
602             $val //= q{};
603             if ( $token eq 'items.content' ) {
604                 $val =~ s|\n|<br/>|g if $letter->{is_html};
605             }
606
607             $letter->{title} =~ s/<<$token>>/$val/g;
608             $letter->{content} =~ s/<<$token>>/$val/g;
609        }
610     }
611
612     my $OPACBaseURL = C4::Context->preference('OPACBaseURL');
613     $letter->{content} =~ s/<<OPACBaseURL>>/$OPACBaseURL/go;
614
615     if ($want_librarian) {
616         # parsing librarian name
617         my $userenv = C4::Context->userenv;
618         $letter->{content} =~ s/<<LibrarianFirstname>>/$userenv->{firstname}/go;
619         $letter->{content} =~ s/<<LibrarianSurname>>/$userenv->{surname}/go;
620         $letter->{content} =~ s/<<LibrarianEmailaddress>>/$userenv->{emailaddress}/go;
621     }
622
623     my ($repeat_no_enclosing_tags, $repeat_enclosing_tags);
624
625     if ($repeat) {
626         if (ref ($repeat) eq 'ARRAY' ) {
627             $repeat_no_enclosing_tags = $repeat;
628         } else {
629             $repeat_enclosing_tags = $repeat;
630         }
631     }
632
633     if ($repeat_enclosing_tags) {
634         while ( my ($tag, $tag_tables) = each %$repeat_enclosing_tags ) {
635             if ( $letter->{content} =~ m!<$tag>(.*)</$tag>!s ) {
636                 my $subcontent = $1;
637                 my @lines = map {
638                     my %subletter = ( title => '', content => $subcontent );
639                     _substitute_tables( \%subletter, $_ );
640                     $subletter{content};
641                 } @$tag_tables;
642                 $letter->{content} =~ s!<$tag>.*</$tag>!join( "\n", @lines )!se;
643             }
644         }
645     }
646
647     if (%$tables) {
648         _substitute_tables( $letter, $tables );
649     }
650
651     if ($repeat_no_enclosing_tags) {
652         if ( $letter->{content} =~ m/[^\n]*<<.*>>[^\n]*/so ) {
653             my $line = $&;
654             my $i = 1;
655             my @lines = map {
656                 my $c = $line;
657                 $c =~ s/<<count>>/$i/go;
658                 foreach my $field ( keys %{$_} ) {
659                     $c =~ s/(<<[^\.]+.$field>>)/$_->{$field}/;
660                 }
661                 $i++;
662                 $c;
663             } @$repeat_no_enclosing_tags;
664
665             my $replaceby = join( "\n", @lines );
666             $letter->{content} =~ s/\Q$line\E/$replaceby/s;
667         }
668     }
669
670     $letter->{content} = _process_tt(
671         {
672             content => $letter->{content},
673             tables  => $tables,
674             loops  => $loops,
675             substitute => $substitute,
676             lang => $lang
677         }
678     );
679
680     $letter->{title} = _process_tt(
681         {
682             content => $letter->{title},
683             tables  => $tables,
684             loops  => $loops,
685             substitute => $substitute,
686         }
687     );
688
689     $letter->{content} =~ s/<<\S*>>//go; #remove any stragglers
690
691     return $letter;
692 }
693
694 sub _substitute_tables {
695     my ( $letter, $tables ) = @_;
696     while ( my ($table, $param) = each %$tables ) {
697         next unless $param;
698
699         my $ref = ref $param;
700
701         my $values;
702         if ($ref && $ref eq 'HASH') {
703             $values = $param;
704         }
705         else {
706             my $sth = _parseletter_sth($table);
707             unless ($sth) {
708                 warn "_parseletter_sth('$table') failed to return a valid sth.  No substitution will be done for that table.";
709                 return;
710             }
711             $sth->execute( $ref ? @$param : $param );
712
713             $values = $sth->fetchrow_hashref;
714             $sth->finish();
715         }
716
717         _parseletter ( $letter, $table, $values );
718     }
719 }
720
721 sub _parseletter_sth {
722     my $table = shift;
723     my $sth;
724     unless ($table) {
725         carp "ERROR: _parseletter_sth() called without argument (table)";
726         return;
727     }
728     # NOTE: we used to check whether we had a statement handle cached in
729     #       a %handles module-level variable. This was a dumb move and
730     #       broke things for the rest of us. prepare_cached is a better
731     #       way to cache statement handles anyway.
732     my $query = 
733     ($table eq 'accountlines' )    ? "SELECT * FROM $table WHERE   accountlines_id = ?"                               :
734     ($table eq 'biblio'       )    ? "SELECT * FROM $table WHERE   biblionumber = ?"                                  :
735     ($table eq 'biblioitems'  )    ? "SELECT * FROM $table WHERE   biblionumber = ?"                                  :
736     ($table eq 'credits'      )    ? "SELECT * FROM accountlines WHERE   accountlines_id = ?"                         :
737     ($table eq 'debits'       )    ? "SELECT * FROM accountlines WHERE   accountlines_id = ?"                         :
738     ($table eq 'items'        )    ? "SELECT * FROM $table WHERE     itemnumber = ?"                                  :
739     ($table eq 'issues'       )    ? "SELECT * FROM $table WHERE     itemnumber = ?"                                  :
740     ($table eq 'old_issues'   )    ? "SELECT * FROM $table WHERE     issue_id = ?"  :
741     ($table eq 'reserves'     )    ? "SELECT * FROM $table WHERE borrowernumber = ? and biblionumber = ?"             :
742     ($table eq 'borrowers'    )    ? "SELECT * FROM $table WHERE borrowernumber = ?"                                  :
743     ($table eq 'branches'     )    ? "SELECT * FROM $table WHERE     branchcode = ?"                                  :
744     ($table eq 'suggestions'  )    ? "SELECT * FROM $table WHERE   suggestionid = ?"                                  :
745     ($table eq 'aqbooksellers')    ? "SELECT * FROM $table WHERE             id = ?"                                  :
746     ($table eq 'aqorders'     )    ? "SELECT * FROM $table WHERE    ordernumber = ?"                                  :
747     ($table eq 'aqbasket'     )    ? "SELECT * FROM $table WHERE       basketno = ?"                                  :
748     ($table eq 'illrequests'  )    ? "SELECT * FROM $table WHERE  illrequest_id = ?"                                  :
749     ($table eq 'article_requests') ? "SELECT * FROM $table WHERE             id = ?"                                  :
750     ($table eq 'borrower_modifications') ? "SELECT * FROM $table WHERE verification_token = ?" :
751     ($table eq 'subscription') ? "SELECT * FROM $table WHERE subscriptionid = ?" :
752     ($table eq 'serial') ? "SELECT * FROM $table WHERE serialid = ?" :
753     ($table eq 'problem_reports') ? "SELECT * FROM $table WHERE reportid = ?" :
754     ($table eq 'additional_contents' || $table eq 'opac_news') ? "SELECT * FROM additional_contents WHERE idnew = ?" :
755     undef ;
756     unless ($query) {
757         warn "ERROR: No _parseletter_sth query for table '$table'";
758         return;     # nothing to get
759     }
760     unless ($sth = C4::Context->dbh->prepare_cached($query)) {
761         warn "ERROR: Failed to prepare query: '$query'";
762         return;
763     }
764     return $sth;    # now cache is populated for that $table
765 }
766
767 =head2 _parseletter($letter, $table, $values)
768
769     parameters :
770     - $letter : a hash to letter fields (title & content useful)
771     - $table : the Koha table to parse.
772     - $values_in : table record hashref
773     parse all fields from a table, and replace values in title & content with the appropriate value
774     (not exported sub, used only internally)
775
776 =cut
777
778 sub _parseletter {
779     my ( $letter, $table, $values_in ) = @_;
780
781     # Work on a local copy of $values_in (passed by reference) to avoid side effects
782     # in callers ( by changing / formatting values )
783     my $values = $values_in ? { %$values_in } : {};
784
785     if ( $table eq 'borrowers' && $values->{'dateexpiry'} ){
786         $values->{'dateexpiry'} = output_pref({ dt => dt_from_string( $values->{'dateexpiry'} ), dateonly => 1 });
787     }
788
789     if ( $table eq 'reserves' && $values->{'waitingdate'} ) {
790         $values->{'waitingdate'} = output_pref({ dt => dt_from_string( $values->{'waitingdate'} ), dateonly => 1 });
791     }
792
793     if ($letter->{content} && $letter->{content} =~ /<<today>>/) {
794         my $todaysdate = output_pref( dt_from_string() );
795         $letter->{content} =~ s/<<today>>/$todaysdate/go;
796     }
797
798     while ( my ($field, $val) = each %$values ) {
799         $val =~ s/\p{P}$// if $val && $table=~/biblio/;
800             #BZ 9886: Assuming that we want to eliminate ISBD punctuation here
801             #Therefore adding the test on biblio. This includes biblioitems,
802             #but excludes items. Removed unneeded global and lookahead.
803
804         if ( $table=~/^borrowers$/ && $field=~/^streettype$/ ) {
805             my $av = Koha::AuthorisedValues->search({ category => 'ROADTYPE', authorised_value => $val });
806             $val = $av->count ? $av->next->lib : '';
807         }
808
809         # Dates replacement
810         my $replacedby   = defined ($val) ? $val : '';
811         if (    $replacedby
812             and not $replacedby =~ m|9999-12-31|
813             and $replacedby =~ m|^\d{4}-\d{2}-\d{2}( \d{2}:\d{2}:\d{2})?$| )
814         {
815             # If the value is XXXX-YY-ZZ[ AA:BB:CC] we assume it is a date
816             my $dateonly = defined $1 ? 0 : 1; #$1 refers to the capture group wrapped in parentheses. In this case, that's the hours, minutes, seconds.
817             my $re_dateonly_filter = qr{ $field( \s* \| \s* dateonly\s*)?>> }xms;
818
819             for my $letter_field ( qw( title content ) ) {
820                 my $filter_string_used = q{};
821                 if ( $letter->{ $letter_field } =~ $re_dateonly_filter ) {
822                     # We overwrite $dateonly if the filter exists and we have a time in the datetime
823                     $filter_string_used = $1 || q{};
824                     $dateonly = $1 unless $dateonly;
825                 }
826                 my $replacedby_date = eval {
827                     output_pref({ dt => dt_from_string( $replacedby ), dateonly => $dateonly });
828                 };
829
830                 if ( $letter->{ $letter_field } ) {
831                     $letter->{ $letter_field } =~ s/\Q<<$table.$field$filter_string_used>>\E/$replacedby_date/g;
832                     $letter->{ $letter_field } =~ s/\Q<<$field$filter_string_used>>\E/$replacedby_date/g;
833                 }
834             }
835         }
836         # Other fields replacement
837         else {
838             for my $letter_field ( qw( title content ) ) {
839                 if ( $letter->{ $letter_field } ) {
840                     $letter->{ $letter_field }   =~ s/<<$table.$field>>/$replacedby/g;
841                     $letter->{ $letter_field }   =~ s/<<$field>>/$replacedby/g;
842                 }
843             }
844         }
845     }
846
847     if ($table eq 'borrowers' && $letter->{content}) {
848         my $patron = Koha::Patrons->find( $values->{borrowernumber} );
849         if ( $patron ) {
850             my $attributes = $patron->extended_attributes;
851             my %attr;
852             while ( my $attribute = $attributes->next ) {
853                 my $code = $attribute->code;
854                 my $val  = $attribute->description; # FIXME - we always display intranet description here!
855                 $val =~ s/\p{P}(?=$)//g if $val;
856                 next unless $val gt '';
857                 $attr{$code} ||= [];
858                 push @{ $attr{$code} }, $val;
859             }
860             while ( my ($code, $val_ar) = each %attr ) {
861                 my $replacefield = "<<borrower-attribute:$code>>";
862                 my $replacedby   = join ',', @$val_ar;
863                 $letter->{content} =~ s/$replacefield/$replacedby/g;
864             }
865         }
866     }
867     return $letter;
868 }
869
870 =head2 EnqueueLetter
871
872   my $success = EnqueueLetter( { letter => $letter, 
873         borrowernumber => '12', message_transport_type => 'email' } )
874
875 Places a letter in the message_queue database table, which will
876 eventually get processed (sent) by the process_message_queue.pl
877 cronjob when it calls SendQueuedMessages.
878
879 Return message_id on success
880
881 Parameters
882 * letter - required; A letter hashref as returned from GetPreparedLetter
883 * message_transport_type - required; One of the available mtts
884 * borrowernumber - optional if 'to_address' is passed; The borrowernumber of the patron we enqueuing the notice for
885 * to_address - optional if 'borrowernumber' is passed; The destination email address for the notice (defaults to patron->notice_email_address)
886 * from_address - optional; The from address for the notice, defaults to patron->library->from_email_address
887 * reply_address - optional; The reply address for the notice, defaults to patron->library->reply_to
888
889 =cut
890
891 sub EnqueueLetter {
892     my $params = shift or return;
893
894     return unless exists $params->{'letter'};
895 #   return unless exists $params->{'borrowernumber'};
896     return unless exists $params->{'message_transport_type'};
897
898     my $content = $params->{letter}->{content};
899     $content =~ s/\s+//g if(defined $content);
900     if ( not defined $content or $content eq '' ) {
901         Koha::Logger->get->info("Trying to add an empty message to the message queue");
902         return;
903     }
904
905     # If we have any attachments we should encode then into the body.
906     if ( $params->{'attachments'} ) {
907         $params->{'letter'} = _add_attachments(
908             {   letter      => $params->{'letter'},
909                 attachments => $params->{'attachments'},
910             }
911         );
912     }
913
914     my $dbh       = C4::Context->dbh();
915     my $statement = << 'ENDSQL';
916 INSERT INTO message_queue
917 ( borrowernumber, subject, content, metadata, letter_code, message_transport_type, status, time_queued, to_address, from_address, reply_address, content_type, failure_code )
918 VALUES
919 ( ?,              ?,       ?,       ?,        ?,           ?,                      ?,      CAST(NOW() AS DATETIME),       ?,          ?,            ?,           ?,              ? )
920 ENDSQL
921
922     my $sth    = $dbh->prepare($statement);
923     my $result = $sth->execute(
924         $params->{'borrowernumber'},              # borrowernumber
925         $params->{'letter'}->{'title'},           # subject
926         $params->{'letter'}->{'content'},         # content
927         $params->{'letter'}->{'metadata'} || '',  # metadata
928         $params->{'letter'}->{'code'}     || '',  # letter_code
929         $params->{'message_transport_type'},      # message_transport_type
930         'pending',                                # status
931         $params->{'to_address'},                  # to_address
932         $params->{'from_address'},                # from_address
933         $params->{'reply_address'},               # reply_address
934         $params->{'letter'}->{'content-type'},    # content_type
935         $params->{'failure_code'}        || '',   # failure_code
936     );
937     return $dbh->last_insert_id(undef,undef,'message_queue', undef);
938 }
939
940 =head2 SendQueuedMessages ([$hashref]) 
941
942     my $sent = SendQueuedMessages({
943         letter_code => $letter_code,
944         borrowernumber => $who_letter_is_for,
945         limit => 50,
946         verbose => 1,
947         type => 'sms',
948     });
949
950 Sends all of the 'pending' items in the message queue, unless
951 parameters are passed.
952
953 The letter_code, borrowernumber and limit parameters are used
954 to build a parameter set for _get_unsent_messages, thus limiting
955 which pending messages will be processed. They are all optional.
956
957 The verbose parameter can be used to generate debugging output.
958 It is also optional.
959
960 Returns number of messages sent.
961
962 =cut
963
964 sub SendQueuedMessages {
965     my $params = shift;
966
967     my $which_unsent_messages  = {
968         'message_id'     => $params->{'message_id'},
969         'limit'          => $params->{'limit'} // 0,
970         'borrowernumber' => $params->{'borrowernumber'} // q{},
971         'letter_code'    => $params->{'letter_code'} // q{},
972         'message_transport_type'           => $params->{'type'} // q{},
973     };
974     my $unsent_messages = _get_unsent_messages( $which_unsent_messages );
975     MESSAGE: foreach my $message ( @$unsent_messages ) {
976         my $message_object = Koha::Notice::Messages->find( $message->{message_id} );
977         # If this fails the database is unwritable and we won't manage to send a message that continues to be marked 'pending'
978         $message_object->make_column_dirty('status');
979         return unless $message_object->store;
980
981         # warn Data::Dumper->Dump( [ $message ], [ 'message' ] );
982         warn sprintf( 'sending %s message to patron: %s',
983                       $message->{'message_transport_type'},
984                       $message->{'borrowernumber'} || 'Admin' )
985           if $params->{'verbose'};
986         # This is just begging for subclassing
987         next MESSAGE if ( lc($message->{'message_transport_type'}) eq 'rss' );
988         if ( lc( $message->{'message_transport_type'} ) eq 'email' ) {
989             _send_message_by_email( $message, $params->{'username'}, $params->{'password'}, $params->{'method'} );
990         }
991         elsif ( lc( $message->{'message_transport_type'} ) eq 'sms' ) {
992             if ( C4::Context->preference('SMSSendDriver') eq 'Email' ) {
993                 my $patron = Koha::Patrons->find( $message->{borrowernumber} );
994                 my $sms_provider = Koha::SMS::Providers->find( $patron->sms_provider_id );
995                 unless ( $sms_provider ) {
996                     warn sprintf( "Patron %s has no sms provider id set!", $message->{'borrowernumber'} ) if $params->{'verbose'};
997                     _set_message_status( { message_id => $message->{'message_id'}, status => 'failed' } );
998                     next MESSAGE;
999                 }
1000                 unless ( $patron->smsalertnumber ) {
1001                     _set_message_status( { message_id => $message->{'message_id'}, status => 'failed' } );
1002                     warn sprintf( "No smsalertnumber found for patron %s!", $message->{'borrowernumber'} ) if $params->{'verbose'};
1003                     next MESSAGE;
1004                 }
1005                 $message->{to_address}  = $patron->smsalertnumber; #Sometime this is set to email - sms should always use smsalertnumber
1006                 $message->{to_address} .= '@' . $sms_provider->domain();
1007
1008                 # Check for possible from_address override
1009                 my $from_address = C4::Context->preference('EmailSMSSendDriverFromAddress');
1010                 if ($from_address && $message->{from_address} ne $from_address) {
1011                     $message->{from_address} = $from_address;
1012                     _update_message_from_address($message->{'message_id'}, $message->{from_address});
1013                 }
1014
1015                 _update_message_to_address($message->{'message_id'}, $message->{to_address});
1016                 _send_message_by_email( $message, $params->{'username'}, $params->{'password'}, $params->{'method'} );
1017             } else {
1018                 _send_message_by_sms( $message );
1019             }
1020         }
1021     }
1022     return scalar( @$unsent_messages );
1023 }
1024
1025 =head2 GetRSSMessages
1026
1027   my $message_list = GetRSSMessages( { limit => 10, borrowernumber => '14' } )
1028
1029 returns a listref of all queued RSS messages for a particular person.
1030
1031 =cut
1032
1033 sub GetRSSMessages {
1034     my $params = shift;
1035
1036     return unless $params;
1037     return unless ref $params;
1038     return unless $params->{'borrowernumber'};
1039     
1040     return _get_unsent_messages( { message_transport_type => 'rss',
1041                                    limit                  => $params->{'limit'},
1042                                    borrowernumber         => $params->{'borrowernumber'}, } );
1043 }
1044
1045 =head2 GetPrintMessages
1046
1047   my $message_list = GetPrintMessages( { borrowernumber => $borrowernumber } )
1048
1049 Returns a arrayref of all queued print messages (optionally, for a particular
1050 person).
1051
1052 =cut
1053
1054 sub GetPrintMessages {
1055     my $params = shift || {};
1056     
1057     return _get_unsent_messages( { message_transport_type => 'print',
1058                                    borrowernumber         => $params->{'borrowernumber'},
1059                                  } );
1060 }
1061
1062 =head2 GetQueuedMessages ([$hashref])
1063
1064   my $messages = GetQueuedMessage( { borrowernumber => '123', limit => 20 } );
1065
1066 Fetches a list of messages from the message queue optionally filtered by borrowernumber
1067 and limited to specified limit.
1068
1069 Return is an arrayref of hashes, each has represents a message in the message queue.
1070
1071 =cut
1072
1073 sub GetQueuedMessages {
1074     my $params = shift;
1075
1076     my $dbh = C4::Context->dbh();
1077     my $statement = << 'ENDSQL';
1078 SELECT message_id, borrowernumber, subject, content, message_transport_type, status, time_queued, updated_on, failure_code
1079 FROM message_queue
1080 ENDSQL
1081
1082     my @query_params;
1083     my @whereclauses;
1084     if ( exists $params->{'borrowernumber'} ) {
1085         push @whereclauses, ' borrowernumber = ? ';
1086         push @query_params, $params->{'borrowernumber'};
1087     }
1088
1089     if ( @whereclauses ) {
1090         $statement .= ' WHERE ' . join( 'AND', @whereclauses );
1091     }
1092
1093     if ( defined $params->{'limit'} ) {
1094         $statement .= ' LIMIT ? ';
1095         push @query_params, $params->{'limit'};
1096     }
1097
1098     my $sth = $dbh->prepare( $statement );
1099     my $result = $sth->execute( @query_params );
1100     return $sth->fetchall_arrayref({});
1101 }
1102
1103 =head2 GetMessageTransportTypes
1104
1105   my @mtt = GetMessageTransportTypes();
1106
1107   returns an arrayref of transport types
1108
1109 =cut
1110
1111 sub GetMessageTransportTypes {
1112     my $dbh = C4::Context->dbh();
1113     my $mtts = $dbh->selectcol_arrayref("
1114         SELECT message_transport_type
1115         FROM message_transport_types
1116         ORDER BY message_transport_type
1117     ");
1118     return $mtts;
1119 }
1120
1121 =head2 GetMessage
1122
1123     my $message = C4::Letters::Message($message_id);
1124
1125 =cut
1126
1127 sub GetMessage {
1128     my ( $message_id ) = @_;
1129     return unless $message_id;
1130     my $dbh = C4::Context->dbh;
1131     return $dbh->selectrow_hashref(q|
1132         SELECT message_id, borrowernumber, subject, content, metadata, letter_code, message_transport_type, status, time_queued, updated_on, to_address, from_address, reply_address, content_type, failure_code
1133         FROM message_queue
1134         WHERE message_id = ?
1135     |, {}, $message_id );
1136 }
1137
1138 =head2 ResendMessage
1139
1140   Attempt to resend a message which has failed previously.
1141
1142   my $has_been_resent = C4::Letters::ResendMessage($message_id);
1143
1144   Updates the message to 'pending' status so that
1145   it will be resent later on.
1146
1147   returns 1 on success, 0 on failure, undef if no message was found
1148
1149 =cut
1150
1151 sub ResendMessage {
1152     my $message_id = shift;
1153     return unless $message_id;
1154
1155     my $message = GetMessage( $message_id );
1156     return unless $message;
1157     my $rv = 0;
1158     if ( $message->{status} ne 'pending' ) {
1159         $rv = C4::Letters::_set_message_status({
1160             message_id => $message_id,
1161             status => 'pending',
1162         });
1163         $rv = $rv > 0? 1: 0;
1164         # Clear destination email address to force address update
1165         _update_message_to_address( $message_id, undef ) if $rv &&
1166             $message->{message_transport_type} eq 'email';
1167     }
1168     return $rv;
1169 }
1170
1171 =head2 _add_attachements
1172
1173   _add_attachments({ letter => $letter, attachments => $attachments });
1174
1175   named parameters:
1176   letter - the standard letter hashref
1177   attachments - listref of attachments. each attachment is a hashref of:
1178     type - the mime type, like 'text/plain'
1179     content - the actual attachment
1180     filename - the name of the attachment.
1181
1182   returns your letter object, with the content updated.
1183   This routine picks the I<content> of I<letter> and generates a MIME
1184   email, attaching the passed I<attachments> using Koha::Email. The
1185   content is replaced by the string representation of the MIME object,
1186   and the content-type is updated for later handling.
1187
1188 =cut
1189
1190 sub _add_attachments {
1191     my $params = shift;
1192
1193     my $letter = $params->{letter};
1194     my $attachments = $params->{attachments};
1195     return $letter unless @$attachments;
1196
1197     my $message = Koha::Email->new;
1198
1199     if ( $letter->{is_html} ) {
1200         $message->html_body( _wrap_html( $letter->{content}, $letter->{title} ) );
1201     }
1202     else {
1203         $message->text_body( $letter->{content} );
1204     }
1205
1206     foreach my $attachment ( @$attachments ) {
1207         $message->attach(
1208             Encode::encode( "UTF-8", $attachment->{content} ),
1209             content_type => $attachment->{type} || 'application/octet-stream',
1210             name         => $attachment->{filename},
1211             disposition  => 'attachment',
1212         );
1213     }
1214
1215     $letter->{'content-type'} = SERIALIZED_EMAIL_CONTENT_TYPE;
1216     $letter->{content} = $message->as_string;
1217
1218     return $letter;
1219
1220 }
1221
1222 =head2 _get_unsent_messages
1223
1224   This function's parameter hash reference takes the following
1225   optional named parameters:
1226    message_transport_type: method of message sending (e.g. email, sms, etc.)
1227                            Can be a single string, or an arrayref of strings
1228    borrowernumber        : who the message is to be sent
1229    letter_code           : type of message being sent (e.g. PASSWORD_RESET)
1230                            Can be a single string, or an arrayref of strings
1231    message_id            : the message_id of the message. In that case the sub will return only 1 result
1232    limit                 : maximum number of messages to send
1233
1234   This function returns an array of matching hash referenced rows from
1235   message_queue with some borrower information added.
1236
1237 =cut
1238
1239 sub _get_unsent_messages {
1240     my $params = shift;
1241
1242     my $dbh = C4::Context->dbh();
1243     my $statement = qq{
1244         SELECT mq.message_id, mq.borrowernumber, mq.subject, mq.content, mq.message_transport_type, mq.status, mq.time_queued, mq.from_address, mq.reply_address, mq.to_address, mq.content_type, b.branchcode, mq.letter_code, mq.failure_code
1245         FROM message_queue mq
1246         LEFT JOIN borrowers b ON b.borrowernumber = mq.borrowernumber
1247         WHERE status = ?
1248     };
1249
1250     my @query_params = ('pending');
1251     if ( ref $params ) {
1252         if ( $params->{'borrowernumber'} ) {
1253             $statement .= ' AND mq.borrowernumber = ? ';
1254             push @query_params, $params->{'borrowernumber'};
1255         }
1256         if ( $params->{'letter_code'} ) {
1257             my @letter_codes = ref $params->{'letter_code'} eq "ARRAY" ? @{$params->{'letter_code'}} : $params->{'letter_code'};
1258             if ( @letter_codes ) {
1259                 my $q = join( ",", ("?") x @letter_codes );
1260                 $statement .= " AND mq.letter_code IN ( $q ) ";
1261                 push @query_params, @letter_codes;
1262             }
1263         }
1264         if ( $params->{'message_transport_type'} ) {
1265             my @types = ref $params->{'message_transport_type'} eq "ARRAY" ? @{$params->{'message_transport_type'}} : $params->{'message_transport_type'};
1266             if ( @types ) {
1267                 my $q = join( ",", ("?") x @types );
1268                 $statement .= " AND message_transport_type IN ( $q ) ";
1269                 push @query_params, @types;
1270             }
1271         }
1272         if ( $params->{message_id} ) {
1273             $statement .= ' AND message_id = ?';
1274             push @query_params, $params->{message_id};
1275         }
1276         if ( $params->{'limit'} ) {
1277             $statement .= ' limit ? ';
1278             push @query_params, $params->{'limit'};
1279         }
1280     }
1281
1282     my $sth = $dbh->prepare( $statement );
1283     my $result = $sth->execute( @query_params );
1284     return $sth->fetchall_arrayref({});
1285 }
1286
1287 sub _send_message_by_email {
1288     my $message = shift or return;
1289     my ($username, $password, $method) = @_;
1290
1291     my $patron = Koha::Patrons->find( $message->{borrowernumber} );
1292     my $to_address = $message->{'to_address'};
1293     unless ($to_address) {
1294         unless ($patron) {
1295             warn "FAIL: No 'to_address' and INVALID borrowernumber ($message->{borrowernumber})";
1296             _set_message_status(
1297                 {
1298                     message_id   => $message->{'message_id'},
1299                     status       => 'failed',
1300                     failure_code => 'INVALID_BORNUMBER'
1301                 }
1302             );
1303             return;
1304         }
1305         $to_address = $patron->notice_email_address;
1306         unless ($to_address) {  
1307             # warn "FAIL: No 'to_address' and no email for " . ($member->{surname} ||'') . ", borrowernumber ($message->{borrowernumber})";
1308             # warning too verbose for this more common case?
1309             _set_message_status(
1310                 {
1311                     message_id   => $message->{'message_id'},
1312                     status       => 'failed',
1313                     failure_code => 'NO_EMAIL'
1314                 }
1315             );
1316             return;
1317         }
1318     }
1319
1320     my $subject = $message->{'subject'};
1321
1322     my $content = $message->{'content'};
1323     my $content_type = $message->{'content_type'} || 'text/plain; charset="UTF-8"';
1324     my $is_html = $content_type =~ m/html/io;
1325
1326     my $branch_email = undef;
1327     my $branch_replyto = undef;
1328     my $branch_returnpath = undef;
1329     my $library;
1330
1331     if ($patron) {
1332         $library           = $patron->library;
1333         $branch_email      = $library->from_email_address;
1334         $branch_replyto    = $library->branchreplyto;
1335         $branch_returnpath = $library->branchreturnpath;
1336     }
1337
1338     # NOTE: Patron may not be defined above so branch_email may be undefined still
1339     # so we need to fallback to KohaAdminEmailAddress as a last resort.
1340     my $from_address =
1341          $message->{'from_address'}
1342       || $branch_email
1343       || C4::Context->preference('KohaAdminEmailAddress');
1344     if( !$from_address ) {
1345         _set_message_status(
1346             {
1347                 message_id   => $message->{'message_id'},
1348                 status       => 'failed',
1349                 failure_code => 'NO_FROM',
1350             }
1351         );
1352         return;
1353     };
1354     my $email;
1355
1356     try {
1357
1358         my $params = {
1359             to => $to_address,
1360             (
1361                 C4::Context->preference('NoticeBcc')
1362                 ? ( bcc => C4::Context->preference('NoticeBcc') )
1363                 : ()
1364             ),
1365             from     => $from_address,
1366             reply_to => $message->{'reply_address'} || $branch_replyto,
1367             sender   => $branch_returnpath,
1368             subject  => "" . $message->{subject}
1369         };
1370
1371         if ( $message->{'content_type'} && $message->{'content_type'} eq SERIALIZED_EMAIL_CONTENT_TYPE ) {
1372
1373             # The message has been previously composed as a valid MIME object
1374             # and serialized as a string on the DB
1375             $email = Koha::Email->new_from_string($content);
1376             $email->create($params);
1377         } else {
1378             $email = Koha::Email->create($params);
1379             if ($is_html) {
1380                 $email->html_body( _wrap_html( $content, $subject ) );
1381             } else {
1382                 $email->text_body($content);
1383             }
1384         }
1385     }
1386     catch {
1387         if ( ref($_) eq 'Koha::Exceptions::BadParameter' ) {
1388             _set_message_status(
1389                 {
1390                     message_id   => $message->{'message_id'},
1391                     status       => 'failed',
1392                     failure_code => "INVALID_EMAIL:".$_->parameter
1393                 }
1394             );
1395         } else {
1396             _set_message_status(
1397                 {
1398                     message_id   => $message->{'message_id'},
1399                     status       => 'failed',
1400                     failure_code => 'UNKNOWN_ERROR'
1401                 }
1402             );
1403         }
1404         return 0;
1405     };
1406     return unless $email;
1407
1408     my $smtp_server;
1409     if ( $library ) {
1410         $smtp_server = $library->smtp_server;
1411     }
1412     else {
1413         $smtp_server = Koha::SMTP::Servers->get_default;
1414     }
1415
1416     if ( $username ) {
1417         $smtp_server->set(
1418             {
1419                 sasl_username => $username,
1420                 sasl_password => $password,
1421             }
1422         );
1423     }
1424
1425 # if initial message address was empty, coming here means that a to address was found and
1426 # queue should be updated; same if to address was overriden by Koha::Email->create
1427     _update_message_to_address( $message->{'message_id'}, $email->email->header('To') )
1428       if !$message->{to_address}
1429       || $message->{to_address} ne $email->email->header('To');
1430
1431     try {
1432         $email->send_or_die({ transport => $smtp_server->transport });
1433
1434         _set_message_status(
1435             {
1436                 message_id => $message->{'message_id'},
1437                 status     => 'sent',
1438                 failure_code => ''
1439             }
1440         );
1441         return 1;
1442     }
1443     catch {
1444         _set_message_status(
1445             {
1446                 message_id => $message->{'message_id'},
1447                 status     => 'failed',
1448                 failure_code => 'SENDMAIL'
1449             }
1450         );
1451         carp "$_";
1452         carp "$Mail::Sendmail::error";
1453         return;
1454     };
1455 }
1456
1457 sub _wrap_html {
1458     my ($content, $title) = @_;
1459
1460     my $css = C4::Context->preference("NoticeCSS") || '';
1461     $css = qq{<link rel="stylesheet" type="text/css" href="$css">} if $css;
1462     return <<EOS;
1463 <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
1464     "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
1465 <html lang="en" xml:lang="en" xmlns="http://www.w3.org/1999/xhtml">
1466 <head>
1467 <title>$title</title>
1468 <meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
1469 $css
1470 </head>
1471 <body>
1472 $content
1473 </body>
1474 </html>
1475 EOS
1476 }
1477
1478 sub _is_duplicate {
1479     my ( $message ) = @_;
1480     my $dbh = C4::Context->dbh;
1481     my $count = $dbh->selectrow_array(q|
1482         SELECT COUNT(*)
1483         FROM message_queue
1484         WHERE message_transport_type = ?
1485         AND borrowernumber = ?
1486         AND letter_code = ?
1487         AND CAST(updated_on AS date) = CAST(NOW() AS date)
1488         AND status="sent"
1489         AND content = ?
1490     |, {}, $message->{message_transport_type}, $message->{borrowernumber}, $message->{letter_code}, $message->{content} );
1491     return $count;
1492 }
1493
1494 sub _send_message_by_sms {
1495     my $message = shift or return;
1496     my $patron = Koha::Patrons->find( $message->{borrowernumber} );
1497     _update_message_to_address($message->{message_id}, $patron->smsalertnumber) if $patron;
1498
1499     unless ( $patron and $patron->smsalertnumber ) {
1500         _set_message_status( { message_id => $message->{'message_id'},
1501                                status     => 'failed',
1502                                failure_code => 'MISSING_SMS' } );
1503         return;
1504     }
1505
1506     if ( _is_duplicate( $message ) ) {
1507         _set_message_status(
1508             {
1509                 message_id   => $message->{'message_id'},
1510                 status       => 'failed',
1511                 failure_code => 'DUPLICATE_MESSAGE'
1512             }
1513         );
1514         return;
1515     }
1516
1517     my $success = C4::SMS->send_sms(
1518         {
1519             destination => $patron->smsalertnumber,
1520             message     => $message->{'content'},
1521         }
1522     );
1523
1524     if ($success) {
1525         _set_message_status(
1526             {
1527                 message_id   => $message->{'message_id'},
1528                 status       => 'sent',
1529                 failure_code => ''
1530             }
1531         );
1532     }
1533     else {
1534         _set_message_status(
1535             {
1536                 message_id   => $message->{'message_id'},
1537                 status       => 'failed',
1538                 failure_code => 'NO_NOTES'
1539             }
1540         );
1541     }
1542
1543     return $success;
1544 }
1545
1546 sub _update_message_to_address {
1547     my ($id, $to)= @_;
1548     my $dbh = C4::Context->dbh();
1549     $dbh->do('UPDATE message_queue SET to_address=? WHERE message_id=?',undef,($to,$id));
1550 }
1551
1552 sub _update_message_from_address {
1553     my ($message_id, $from_address) = @_;
1554     my $dbh = C4::Context->dbh();
1555     $dbh->do('UPDATE message_queue SET from_address = ? WHERE message_id = ?', undef, ($from_address, $message_id));
1556 }
1557
1558 sub _set_message_status {
1559     my $params = shift or return;
1560
1561     foreach my $required_parameter ( qw( message_id status ) ) {
1562         return unless exists $params->{ $required_parameter };
1563     }
1564
1565     my $dbh = C4::Context->dbh();
1566     my $statement = 'UPDATE message_queue SET status= ?, failure_code= ? WHERE message_id = ?';
1567     my $sth = $dbh->prepare( $statement );
1568     my $result = $sth->execute( $params->{'status'},
1569                                 $params->{'failure_code'} || '',
1570                                 $params->{'message_id'} );
1571     return $result;
1572 }
1573
1574 sub _process_tt {
1575     my ( $params ) = @_;
1576
1577     my $content = $params->{content};
1578     my $tables = $params->{tables};
1579     my $loops = $params->{loops};
1580     my $substitute = $params->{substitute} || {};
1581     my $lang = defined($params->{lang}) && $params->{lang} ne 'default' ? $params->{lang} : 'en';
1582     my ($theme, $availablethemes);
1583
1584     my $htdocs = C4::Context->config('intrahtdocs');
1585     ($theme, $lang, $availablethemes)= C4::Templates::availablethemes( $htdocs, 'about.tt', 'intranet', $lang);
1586     my @includes;
1587     foreach (@$availablethemes) {
1588         push @includes, "$htdocs/$_/$lang/includes";
1589         push @includes, "$htdocs/$_/en/includes" unless $lang eq 'en';
1590     }
1591
1592     my $use_template_cache = C4::Context->config('template_cache_dir') && defined $ENV{GATEWAY_INTERFACE};
1593     my $template           = Template->new(
1594         {
1595             EVAL_PERL    => 1,
1596             ABSOLUTE     => 1,
1597             PLUGIN_BASE  => 'Koha::Template::Plugin',
1598             COMPILE_EXT  => $use_template_cache ? '.ttc' : '',
1599             COMPILE_DIR  => $use_template_cache ? C4::Context->config('template_cache_dir') : '',
1600             INCLUDE_PATH => \@includes,
1601             FILTERS      => {},
1602             ENCODING     => 'UTF-8',
1603         }
1604     ) or die Template->error();
1605
1606     my $tt_params = { %{ _get_tt_params( $tables ) }, %{ _get_tt_params( $loops, 'is_a_loop' ) }, %$substitute };
1607
1608     $content = add_tt_filters( $content );
1609     $content = qq|[% USE KohaDates %][% USE Remove_MARC_punctuation %]$content|;
1610
1611     my $output;
1612     $template->process( \$content, $tt_params, \$output ) || croak "ERROR PROCESSING TEMPLATE: " . $template->error();
1613
1614     return $output;
1615 }
1616
1617 sub _get_tt_params {
1618     my ($tables, $is_a_loop) = @_;
1619
1620     my $params;
1621     $is_a_loop ||= 0;
1622
1623     my $config = {
1624         article_requests => {
1625             module   => 'Koha::ArticleRequests',
1626             singular => 'article_request',
1627             plural   => 'article_requests',
1628             pk       => 'id',
1629         },
1630         aqbasket => {
1631             module   => 'Koha::Acquisition::Baskets',
1632             singular => 'basket',
1633             plural   => 'baskets',
1634             pk       => 'basketno',
1635         },
1636         biblio => {
1637             module   => 'Koha::Biblios',
1638             singular => 'biblio',
1639             plural   => 'biblios',
1640             pk       => 'biblionumber',
1641         },
1642         biblioitems => {
1643             module   => 'Koha::Biblioitems',
1644             singular => 'biblioitem',
1645             plural   => 'biblioitems',
1646             pk       => 'biblioitemnumber',
1647         },
1648         borrowers => {
1649             module   => 'Koha::Patrons',
1650             singular => 'borrower',
1651             plural   => 'borrowers',
1652             pk       => 'borrowernumber',
1653         },
1654         branches => {
1655             module   => 'Koha::Libraries',
1656             singular => 'branch',
1657             plural   => 'branches',
1658             pk       => 'branchcode',
1659         },
1660         credits => {
1661             module => 'Koha::Account::Lines',
1662             singular => 'credit',
1663             plural => 'credits',
1664             pk => 'accountlines_id',
1665         },
1666         debits => {
1667             module => 'Koha::Account::Lines',
1668             singular => 'debit',
1669             plural => 'debits',
1670             pk => 'accountlines_id',
1671         },
1672         items => {
1673             module   => 'Koha::Items',
1674             singular => 'item',
1675             plural   => 'items',
1676             pk       => 'itemnumber',
1677         },
1678         additional_contents => {
1679             module   => 'Koha::AdditionalContents',
1680             singular => 'additional_content',
1681             plural   => 'additional_contents',
1682             pk       => 'idnew',
1683         },
1684         opac_news => {
1685             module   => 'Koha::AdditionalContents',
1686             singular => 'news',
1687             plural   => 'news',
1688             pk       => 'idnew',
1689         },
1690         aqorders => {
1691             module   => 'Koha::Acquisition::Orders',
1692             singular => 'order',
1693             plural   => 'orders',
1694             pk       => 'ordernumber',
1695         },
1696         reserves => {
1697             module   => 'Koha::Holds',
1698             singular => 'hold',
1699             plural   => 'holds',
1700             pk       => 'reserve_id',
1701         },
1702         serial => {
1703             module   => 'Koha::Serials',
1704             singular => 'serial',
1705             plural   => 'serials',
1706             pk       => 'serialid',
1707         },
1708         subscription => {
1709             module   => 'Koha::Subscriptions',
1710             singular => 'subscription',
1711             plural   => 'subscriptions',
1712             pk       => 'subscriptionid',
1713         },
1714         suggestions => {
1715             module   => 'Koha::Suggestions',
1716             singular => 'suggestion',
1717             plural   => 'suggestions',
1718             pk       => 'suggestionid',
1719         },
1720         issues => {
1721             module   => 'Koha::Checkouts',
1722             singular => 'checkout',
1723             plural   => 'checkouts',
1724             fk       => 'itemnumber',
1725         },
1726         old_issues => {
1727             module   => 'Koha::Old::Checkouts',
1728             singular => 'old_checkout',
1729             plural   => 'old_checkouts',
1730             pk       => 'issue_id',
1731         },
1732         overdues => {
1733             module   => 'Koha::Checkouts',
1734             singular => 'overdue',
1735             plural   => 'overdues',
1736             fk       => 'itemnumber',
1737         },
1738         borrower_modifications => {
1739             module   => 'Koha::Patron::Modifications',
1740             singular => 'patron_modification',
1741             plural   => 'patron_modifications',
1742             fk       => 'verification_token',
1743         },
1744         illrequests => {
1745             module   => 'Koha::Illrequests',
1746             singular => 'illrequest',
1747             plural   => 'illrequests',
1748             pk       => 'illrequest_id'
1749         }
1750     };
1751
1752     foreach my $table ( keys %$tables ) {
1753         next unless $config->{$table};
1754
1755         my $ref = ref( $tables->{$table} ) || q{};
1756         my $module = $config->{$table}->{module};
1757
1758         if ( can_load( modules => { $module => undef } ) ) {
1759             my $pk = $config->{$table}->{pk};
1760             my $fk = $config->{$table}->{fk};
1761
1762             if ( $is_a_loop ) {
1763                 my $values = $tables->{$table} || [];
1764                 unless ( ref( $values ) eq 'ARRAY' ) {
1765                     croak "ERROR processing table $table. Wrong API call.";
1766                 }
1767                 my $key = $pk ? $pk : $fk;
1768                 # $key does not come from user input
1769                 my $objects = $module->search(
1770                     { $key => $values },
1771                     {
1772                             # We want to retrieve the data in the same order
1773                             # FIXME MySQLism
1774                             # field is a MySQLism, but they are no other way to do it
1775                             # To be generic we could do it in perl, but we will need to fetch
1776                             # all the data then order them
1777                         @$values ? ( order_by => \[ "field($key, " . join( ', ', @$values ) . ")" ] ) : ()
1778                     }
1779                 );
1780                 $params->{ $config->{$table}->{plural} } = $objects;
1781             }
1782             elsif ( $ref eq q{} || $ref eq 'HASH' ) {
1783                 my $id = ref $ref eq 'HASH' ? $tables->{$table}->{$pk} : $tables->{$table};
1784                 my $object;
1785                 if ( $fk ) { # Using a foreign key for lookup
1786                     if ( ref( $fk ) eq 'ARRAY' ) { # Foreign key is multi-column
1787                         my $search;
1788                         foreach my $key ( @$fk ) {
1789                             $search->{$key} = $id->{$key};
1790                         }
1791                         $object = $module->search( $search )->last();
1792                     } else { # Foreign key is single column
1793                         $object = $module->search( { $fk => $id } )->last();
1794                     }
1795                 } else { # using the table's primary key for lookup
1796                     $object = $module->find($id);
1797                 }
1798                 $params->{ $config->{$table}->{singular} } = $object;
1799             }
1800             else {    # $ref eq 'ARRAY'
1801                 my $object;
1802                 if ( @{ $tables->{$table} } == 1 ) {    # Param is a single key
1803                     $object = $module->search( { $pk => $tables->{$table} } )->last();
1804                 }
1805                 else {                                  # Params are mutliple foreign keys
1806                     croak "Multiple foreign keys (table $table) should be passed using an hashref";
1807                 }
1808                 $params->{ $config->{$table}->{singular} } = $object;
1809             }
1810         }
1811         else {
1812             croak "ERROR LOADING MODULE $module: $Module::Load::Conditional::ERROR";
1813         }
1814     }
1815
1816     $params->{today} = output_pref({ dt => dt_from_string, dateformat => 'iso' });
1817
1818     return $params;
1819 }
1820
1821 =head3 add_tt_filters
1822
1823 $content = add_tt_filters( $content );
1824
1825 Add TT filters to some specific fields if needed.
1826
1827 For now we only add the Remove_MARC_punctuation TT filter to biblio and biblioitem fields
1828
1829 =cut
1830
1831 sub add_tt_filters {
1832     my ( $content ) = @_;
1833     $content =~ s|\[%\s*biblio\.(.*?)\s*%\]|[% biblio.$1 \| \$Remove_MARC_punctuation %]|gxms;
1834     $content =~ s|\[%\s*biblioitem\.(.*?)\s*%\]|[% biblioitem.$1 \| \$Remove_MARC_punctuation %]|gxms;
1835     return $content;
1836 }
1837
1838 =head2 get_item_content
1839
1840     my $item = Koha::Items->find(...)->unblessed;
1841     my @item_content_fields = qw( date_due title barcode author itemnumber );
1842     my $item_content = C4::Letters::get_item_content({
1843                              item => $item,
1844                              item_content_fields => \@item_content_fields
1845                        });
1846
1847 This function generates a tab-separated list of values for the passed item. Dates
1848 are formatted following the current setup.
1849
1850 =cut
1851
1852 sub get_item_content {
1853     my ( $params ) = @_;
1854     my $item = $params->{item};
1855     my $dateonly = $params->{dateonly} || 0;
1856     my $item_content_fields = $params->{item_content_fields} || [];
1857
1858     return unless $item;
1859
1860     my @item_info = map {
1861         $_ =~ /^date|date$/
1862           ? eval {
1863             output_pref(
1864                 { dt => dt_from_string( $item->{$_} ), dateonly => $dateonly } );
1865           }
1866           : $item->{$_}
1867           || ''
1868     } @$item_content_fields;
1869     return join( "\t", @item_info ) . "\n";
1870 }
1871
1872 1;
1873 __END__