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