C4/Message.pm

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