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