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