C4/Message.pm

   1 package C4::Message;
   2
   3 # Copyright Liblime 2009
   4 # Copyright Catalyst IT 2012
   5 #
   6 # This file is part of Koha.
   7 #
   8 # Koha is free software; you can redistribute it and/or modify it
   9 # under the terms of the GNU General Public License as published by
  10 # the Free Software Foundation; either version 3 of the License, or
  11 # (at your option) any later version.
  12 #
  13 # Koha is distributed in the hope that it will be useful, but
  14 # WITHOUT ANY WARRANTY; without even the implied warranty of
  15 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  16 # GNU General Public License for more details.
  17 #
  18 # You should have received a copy of the GNU General Public License
  19 # along with Koha; if not, see <http://www.gnu.org/licenses>.
  20
  21
  22 use strict;
  23 use warnings;
  24 use C4::Context;
  25 use C4::Letters qw( GetPreparedLetter EnqueueLetter );
  26 use YAML::XS qw( Dump );
  27 use Encode;
  28 use Carp qw( carp );
  29
  30 =head1 NAME
  31
  32 C4::Message - object for messages in the message_queue table
  33
  34 =head1 SYNOPSIS
  35
  36 How to add a new message to the queue:
  37
  38   use C4::Message;
  39   use C4::Items;
  40   my $borrower = { borrowernumber => 1 };
  41   my $item     = Koha::Items->find($itemnumber)->unblessed;
  42   my $letter =  C4::Letters::GetPreparedLetter (
  43       module => 'circulation',
  44       letter_code => 'CHECKOUT',
  45       branchcode => $branch,
  46       tables => {
  47           'biblio', $item->{biblionumber},
  48           'biblioitems', $item->{biblionumber},
  49       },
  50   );
  51   C4::Message->enqueue($letter, $borrower->{borrowernumber}, 'email');
  52
  53 How to update a borrower's last checkout message:
  54
  55   use C4::Message;
  56   my $borrower = { borrowernumber => 1 };
  57   my $message  = C4::Message->find_last_message($borrower, 'CHECKOUT', 'email');
  58   $message->append("you also checked out some other book....");
  59   $message->update;
  60
  61 =head1 DESCRIPTION
  62
  63 This module presents an OO interface to the message_queue.  Previously,
  64 you could only add messages to the message_queue via
  65 C<C4::Letters::EnqueueMessage()>.  With this module, you can also get
  66 previously inserted messages, manipulate them, and save them back to the
  67 database.
  68
  69 =cut
  70
  71
  72 our $AUTOLOAD;
  73
  74
  75 =head2 Class Methods
  76
  77 =head3 C4::Message->new(\%attributes)
  78
  79 This method creates an in-memory version of a message object.
  80
  81 =cut
  82
  83 # C4::Message->new(\%attributes) -- constructor
  84 sub new {
  85     my ($class, $opts) = @_;
  86     $opts ||= {};
  87     bless {%$opts} => $class;
  88 }
  89
  90
  91 =head3 C4::Message->find($id)
  92
  93 This method searches the message_queue table for a row with the given
  94 C<message_id> and it'll return a C4::Message object if it finds one.
  95
  96 =cut
  97
  98 # C4::Message->find($id) -- find a message by its message_id
  99 sub find {
 100     my ($class, $id) = @_;
 101     my $dbh = C4::Context->dbh;
 102     my $msgs = $dbh->selectall_arrayref(
 103         qq{SELECT * FROM message_queue WHERE message_id = ?},
 104         { Slice => {} },
 105         $id,
 106     );
 107     if (@$msgs) {
 108         return $class->new($msgs->[0]);
 109     } else {
 110         return;
 111     }
 112 }
 113
 114 =head3 C4::Message->find_last_message($borrower, $letter_code, $transport)
 115
 116 This method is used to get the borrower's most recent, pending, check-in or
 117 checkout message.  (This makes it possible to add more information to the
 118 message before it gets sent out.)
 119
 120 =cut
 121
 122 # C4::Message->find_last_message($borrower, $letter_code, $transport)
 123 # -- get the borrower's most recent pending checkin or checkout notification
 124 sub find_last_message {
 125     my ($class, $borrower, $letter_code, $transport) = @_;
 126     # $type is the message_transport_type
 127     $transport ||= 'email';
 128     my $dbh = C4::Context->dbh;
 129     my $msgs = $dbh->selectall_arrayref(
 130         qq{
 131             SELECT *
 132             FROM   message_queue
 133             WHERE  status                 = 'pending'
 134             AND    borrowernumber         = ?
 135             AND    letter_code            = ?
 136             AND    message_transport_type = ?
 137         },
 138         { Slice => {} },
 139         $borrower->{borrowernumber},
 140         $letter_code,
 141         $transport,
 142     );
 143     if (@$msgs) {
 144         return $class->new($msgs->[0]);
 145     } else {
 146         return;
 147     }
 148 }
 149
 150
 151 =head3 C4::Message->enqueue($letter, $borrower, $transport)
 152
 153 This is a front-end for C<C4::Letters::EnqueueLetter()> that adds metadata to
 154 the message.
 155
 156 =cut
 157
 158 # C4::Message->enqueue($letter, $borrower, $transport)
 159 sub enqueue {
 160     my ($class, $letter, $borrower, $transport) = @_;
 161     my $metadata   = _metadata($letter);
 162     my $to_address = _to_address($borrower, $transport);
 163
 164     # Same as render_metadata
 165     my $format ||= sub { $_[0] || "" };
 166     my $body = join('', map { $format->($_) } @{$metadata->{body}});
 167     $letter->{content} = $metadata->{header} . $body . $metadata->{footer};
 168
 169     $letter->{metadata} = Encode::decode_utf8(Dump($metadata));
 170     C4::Letters::EnqueueLetter({
 171         letter                 => $letter,
 172         borrowernumber         => $borrower->{borrowernumber},
 173         message_transport_type => $transport,
 174         to_address             => $to_address,
 175     });
 176 }
 177
 178 # based on message $transport, pick an appropriate address to send to
 179 sub _to_address {
 180     my ($borrower, $transport) = @_;
 181     my $address;
 182     if ($transport eq 'email') {
 183         $address = $borrower->{email}
 184             || $borrower->{emailpro}
 185             || $borrower->{B_email};
 186     } elsif ($transport eq 'sms') {
 187         $address = $borrower->{smsalertnumber}
 188             || $borrower->{phone}
 189             || $borrower->{phonepro}
 190             || $borrower->{B_phone};
 191     } else {
 192         warn "'$transport' is an unknown message transport.";
 193     }
 194     if (not defined $address) {
 195         warn "An appropriate $transport address "
 196             . "for borrower $borrower->{userid} "
 197             . "could not be found.";
 198     }
 199     return $address;
 200 }
 201
 202 # _metadata($letter) -- return the letter split into head/body/footer
 203 sub _metadata {
 204     my ($letter) = @_;
 205     if ($letter->{content} =~ /----/) {
 206         my ($header, $body, $footer) = split(/----\r?\n?/, $letter->{content});
 207         return {
 208             header => $header,
 209             body   => [$body],
 210             footer => $footer,
 211         };
 212     } else {
 213         return {
 214             header => '',
 215             body   => [$letter->{content}],
 216             footer => '',
 217         };
 218     }
 219 }
 220
 221 =head2 Instance Methods
 222
 223 =head3 $message->update()
 224
 225 This saves the $message object back to the database.  It needs to have
 226 already been created via C<enqueue> for this to work.
 227
 228 =cut
 229
 230 # $object->update -- save object to database
 231 sub update {
 232     my ($self) = @_;
 233     my $dbh = C4::Context->dbh;
 234     $dbh->do(
 235         qq{
 236             UPDATE message_queue
 237             SET
 238                 borrowernumber         = ?,
 239                 subject                = ?,
 240                 content                = ?,
 241                 metadata               = ?,
 242                 letter_code            = ?,
 243                 message_transport_type = ?,
 244                 status                 = ?,
 245                 time_queued            = ?,
 246                 to_address             = ?,
 247                 from_address           = ?,
 248                 content_type           = ?
 249             WHERE message_id = ?
 250         },
 251         {},
 252         $self->borrowernumber,
 253         $self->subject,
 254         $self->content,
 255         $self->{metadata}, # we want the raw YAML here
 256         $self->letter_code,
 257         $self->message_transport_type,
 258         $self->status,
 259         $self->time_queued,
 260         $self->to_address,
 261         $self->from_address,
 262         $self->content_type,
 263         $self->message_id
 264     );
 265 }
 266
 267 =head3 $message->metadata(\%new_metadata)
 268
 269 This method automatically serializes and deserializes the metadata
 270 attribute.  (It is stored in YAML format.)
 271
 272 =cut
 273
 274 # $object->metadata -- this is a YAML serialized column that contains a
 275 # structured representation of $object->content
 276 sub metadata {
 277     my ($self, $data) = @_;
 278     if ($data) {
 279         $data->{header} ||= '';
 280         $data->{body}   ||= [];
 281         $data->{footer} ||= '';
 282         $self->{metadata} = Encode::decode_utf8(Dump($data));
 283         $self->content($self->render_metadata);
 284         return $data;
 285     } else {
 286         return YAML::XS::Load(Encode::encode_utf8($self->{metadata}));
 287     }
 288 }
 289
 290 # turn $object->metadata into a string suitable for $object->content
 291 sub render_metadata {
 292     my ($self, $format) = @_;
 293     $format ||= sub { $_[0] || "" };
 294     my $metadata = $self->metadata;
 295     my $body     = $metadata->{body};
 296     my $text     = join('', map { $format->($_) } @$body);
 297     return $metadata->{header} . $text . $metadata->{footer};
 298 }
 299
 300 =head3 $message->append(\%letter)
 301
 302 If passed a hashref, this method will assume that the hashref is in the form
 303 that C<C4::Letters::getletter()> returns.  It will append the body of the
 304 letter to the message.
 305
 306 =head3 $message->append($string)
 307
 308 If passed a string, it'll append the string to the message.
 309
 310 =cut
 311
 312 # $object->append($letter_or_item) -- add a new item to a message's content
 313 sub append {
 314     my ($self, $letter_or_item, $format) = @_;
 315     my ( $item, $header, $footer );
 316     if (ref($letter_or_item)) {
 317         my $letter   = $letter_or_item;
 318         my $metadata = _metadata($letter);
 319         $header = $metadata->{header};
 320         $footer = $metadata->{footer};
 321         $item = $metadata->{body}->[0];
 322     } else {
 323         $item = $letter_or_item;
 324     }
 325     if (not $self->metadata) {
 326         carp "Can't append to messages that don't have metadata.";
 327         return;
 328     }
 329     my $metadata = $self->metadata;
 330     push @{$metadata->{body}}, $item;
 331     $metadata->{header} = $header;
 332     $metadata->{footer} = $footer;
 333     $self->metadata($metadata);
 334     my $new_content = $self->render_metadata($format);
 335     return $self->content($new_content);
 336 }
 337
 338 =head2 Attributes Accessors
 339
 340 =head3 $message->message_id
 341
 342 =cut
 343
 344 =head3 $message->borrowernumber
 345
 346 =cut
 347
 348 =head3 $message->subject
 349
 350 =cut
 351
 352 =head3 $message->content
 353
 354 =cut
 355
 356 =head3 $message->metadata
 357
 358 =cut
 359
 360 =head3 $message->letter_code
 361
 362 =cut
 363
 364 =head3 $message->message_transport_type
 365
 366 =cut
 367
 368 =head3 $message->status
 369
 370 =cut
 371
 372 =head3 $message->time_queued
 373
 374 =cut
 375
 376 =head3 $message->to_address
 377
 378 =cut
 379
 380 =head3 $message->from_address
 381
 382 =cut
 383
 384 =head3 $message->content_type
 385
 386 =cut
 387
 388 # $object->$method -- treat keys as methods
 389 sub AUTOLOAD {
 390     my ($self, @args) = @_;
 391     my $attr = $AUTOLOAD;
 392     $attr =~ s/.*://;
 393     if (ref($self->{$attr}) eq 'CODE') {
 394         $self->{$attr}->($self, @args);
 395     } else {
 396         if (@args) {
 397             $self->{$attr} = $args[0];
 398         } else {
 399             $self->{$attr};
 400         }
 401     }
 402 }
 403
 404 sub DESTROY { }
 405
 406 1;
 407
 408 =head1 SEE ALSO
 409
 410 L<C4::Circulation>, L<C4::Letters>, L<C4::Members::Messaging>
 411
 412 =head1 AUTHOR
 413
 414 John Beppu <john.beppu@liblime.com>
 415
 416 =cut