Filename | /usr/share/koha/lib/C4/Message.pm |
Statements | Executed 20 statements in 1.24ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
1 | 1 | 1 | 20µs | 25µs | BEGIN@22 | C4::Message::
1 | 1 | 1 | 19µs | 21µs | BEGIN@24 | C4::Message::
1 | 1 | 1 | 18µs | 68µs | BEGIN@26 | C4::Message::
1 | 1 | 1 | 11µs | 193µs | BEGIN@25 | C4::Message::
1 | 1 | 1 | 11µs | 25µs | BEGIN@23 | C4::Message::
1 | 1 | 1 | 11µs | 53µs | BEGIN@27 | C4::Message::
0 | 0 | 0 | 0s | 0s | AUTOLOAD | C4::Message::
0 | 0 | 0 | 0s | 0s | DESTROY | C4::Message::
0 | 0 | 0 | 0s | 0s | __ANON__[:287] | C4::Message::
0 | 0 | 0 | 0s | 0s | _metadata | C4::Message::
0 | 0 | 0 | 0s | 0s | _to_address | C4::Message::
0 | 0 | 0 | 0s | 0s | append | C4::Message::
0 | 0 | 0 | 0s | 0s | enqueue | C4::Message::
0 | 0 | 0 | 0s | 0s | find | C4::Message::
0 | 0 | 0 | 0s | 0s | find_last_message | C4::Message::
0 | 0 | 0 | 0s | 0s | metadata | C4::Message::
0 | 0 | 0 | 0s | 0s | new | C4::Message::
0 | 0 | 0 | 0s | 0s | render_metadata | C4::Message::
0 | 0 | 0 | 0s | 0s | update | C4::Message::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
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 | 3 | 31µs | 2 | 29µs | # spent 25µs (20+4) within C4::Message::BEGIN@22 which was called:
# once (20µs+4µs) by C4::Circulation::BEGIN@35 at line 22 # spent 25µs making 1 call to C4::Message::BEGIN@22
# spent 4µs making 1 call to strict::import |
23 | 3 | 27µs | 2 | 39µs | # spent 25µs (11+14) within C4::Message::BEGIN@23 which was called:
# once (11µs+14µs) by C4::Circulation::BEGIN@35 at line 23 # spent 25µs making 1 call to C4::Message::BEGIN@23
# spent 14µs making 1 call to warnings::import |
24 | 3 | 26µs | 2 | 23µs | # spent 21µs (19+2) within C4::Message::BEGIN@24 which was called:
# once (19µs+2µs) by C4::Circulation::BEGIN@35 at line 24 # spent 21µs making 1 call to C4::Message::BEGIN@24
# spent 2µs making 1 call to C4::Context::import |
25 | 3 | 34µs | 2 | 374µs | # spent 193µs (11+182) within C4::Message::BEGIN@25 which was called:
# once (11µs+182µs) by C4::Circulation::BEGIN@35 at line 25 # spent 193µs making 1 call to C4::Message::BEGIN@25
# spent 182µs making 1 call to Exporter::import |
26 | 3 | 38µs | 2 | 118µs | # spent 68µs (18+50) within C4::Message::BEGIN@26 which was called:
# once (18µs+50µs) by C4::Circulation::BEGIN@35 at line 26 # spent 68µs making 1 call to C4::Message::BEGIN@26
# spent 50µs making 1 call to Exporter::import |
27 | 3 | 1.07ms | 2 | 94µs | # spent 53µs (11+42) within C4::Message::BEGIN@27 which was called:
# once (11µs+42µs) by C4::Circulation::BEGIN@35 at line 27 # spent 53µs making 1 call to C4::Message::BEGIN@27
# spent 42µs making 1 call to Exporter::import |
28 | |||||
29 | =head1 NAME | ||||
30 | |||||
- - | |||||
71 | 1 | 300ns | our $AUTOLOAD; | ||
72 | |||||
73 | |||||
74 | =head2 Class Methods | ||||
75 | |||||
- - | |||||
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 | |||||
- - | |||||
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 | |||||
- - | |||||
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 | |||||
- - | |||||
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 | |||||
- - | |||||
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 | |||||
- - | |||||
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 | |||||
- - | |||||
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 | |||||
- - | |||||
334 | =head3 $message->borrowernumber | ||||
335 | |||||
- - | |||||
338 | =head3 $message->subject | ||||
339 | |||||
- - | |||||
342 | =head3 $message->content | ||||
343 | |||||
- - | |||||
346 | =head3 $message->metadata | ||||
347 | |||||
- - | |||||
350 | =head3 $message->letter_code | ||||
351 | |||||
- - | |||||
354 | =head3 $message->message_transport_type | ||||
355 | |||||
- - | |||||
358 | =head3 $message->status | ||||
359 | |||||
- - | |||||
362 | =head3 $message->time_queued | ||||
363 | |||||
- - | |||||
366 | =head3 $message->to_address | ||||
367 | |||||
- - | |||||
370 | =head3 $message->from_address | ||||
371 | |||||
- - | |||||
374 | =head3 $message->content_type | ||||
375 | |||||
- - | |||||
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 | 4µs | 1; | ||
397 | |||||
398 | =head1 SEE ALSO | ||||
399 | |||||
- - |