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