← Index
NYTProf Performance Profile   « line view »
For svc/members/upsert
  Run on Tue Jan 13 11:50:22 2015
Reported on Tue Jan 13 12:09:50 2015

Filename/mnt/catalyst/koha/C4/Members/Messaging.pm
StatementsExecuted 10 statements in 867µs
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
111544µs559µsC4::Members::Messaging::::BEGIN@20C4::Members::Messaging::BEGIN@20
11112µs14µsC4::Members::Messaging::::BEGIN@22C4::Members::Messaging::BEGIN@22
1119µs30µsC4::Members::Messaging::::BEGIN@24C4::Members::Messaging::BEGIN@24
1118µs17µsC4::Members::Messaging::::BEGIN@21C4::Members::Messaging::BEGIN@21
1114µs4µsC4::Members::Messaging::::BEGIN@26C4::Members::Messaging::BEGIN@26
0000s0sC4::Members::Messaging::::GetMessagingOptionsC4::Members::Messaging::GetMessagingOptions
0000s0sC4::Members::Messaging::::GetMessagingPreferencesC4::Members::Messaging::GetMessagingPreferences
0000s0sC4::Members::Messaging::::SetMessagingPreferenceC4::Members::Messaging::SetMessagingPreference
0000s0sC4::Members::Messaging::::SetMessagingPreferencesFromDefaultsC4::Members::Messaging::SetMessagingPreferencesFromDefaults
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 Code
1package C4::Members::Messaging;
2
3# Copyright (C) 2008 LibLime
4#
5# This file is part of Koha.
6#
7# Koha is free software; you can redistribute it and/or modify it under the
8# terms of the GNU General Public License as published by the Free Software
9# Foundation; either version 2 of the License, or (at your option) any later
10# version.
11#
12# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
13# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
14# A PARTICULAR PURPOSE. See the GNU General Public License for more details.
15#
16# You should have received a copy of the GNU General Public License along
17# with Koha; if not, write to the Free Software Foundation, Inc.,
18# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
19
20229µs2573µs
# spent 559µs (544+15) within C4::Members::Messaging::BEGIN@20 which was called: # once (544µs+15µs) by C4::Reserves::BEGIN@34 at line 20
use strict;
# spent 559µs making 1 call to C4::Members::Messaging::BEGIN@20 # spent 15µs making 1 call to strict::import
21222µs225µs
# spent 17µs (8+8) within C4::Members::Messaging::BEGIN@21 which was called: # once (8µs+8µs) by C4::Reserves::BEGIN@34 at line 21
use warnings;
# spent 17µs making 1 call to C4::Members::Messaging::BEGIN@21 # spent 8µs making 1 call to warnings::import
22226µs216µs
# spent 14µs (12+2) within C4::Members::Messaging::BEGIN@22 which was called: # once (12µs+2µs) by C4::Reserves::BEGIN@34 at line 22
use C4::Context;
# spent 14µs making 1 call to C4::Members::Messaging::BEGIN@22 # spent 2µs making 1 call to C4::Context::import
23
24230µs252µs
# spent 30µs (9+22) within C4::Members::Messaging::BEGIN@24 which was called: # once (9µs+22µs) by C4::Reserves::BEGIN@34 at line 24
use vars qw($VERSION);
# spent 30µs making 1 call to C4::Members::Messaging::BEGIN@24 # spent 22µs making 1 call to vars::import
25
26
# spent 4µs within C4::Members::Messaging::BEGIN@26 which was called: # once (4µs+0s) by C4::Reserves::BEGIN@34 at line 29
BEGIN {
27 # set the version for version checking
2814µs $VERSION = 3.07.00.049;
291752µs14µs}
# spent 4µs making 1 call to C4::Members::Messaging::BEGIN@26
30
31=head1 NAME
32
33C4::Members::Messaging - manage patron messaging preferences
34
35=head1 SYNOPSIS
36
37 use C4::Members::Messaging
38
39=head1 DESCRIPTION
40
41This module lets you modify a patron's messaging preferences.
42
43=head1 FUNCTIONS
44
45=head2 GetMessagingPreferences
46
47 my $preferences = C4::Members::Messaging::GetMessagingPreferences( { borrowernumber => $borrower->{'borrowernumber'},
48 message_name => 'DUE' } );
49
50 my $preferences = C4::Members::Messaging::GetMessagingPreferences( { categorycode => 'LIBRARY',
51 message_name => 'DUE' } );
52
53returns: a hashref of messaging preferences for a borrower or patron category for a particlar message_name
54
55Requires either a borrowernumber or a categorycode key, but not both.
56
57=cut
58
59sub GetMessagingPreferences {
60 my $params = shift;
61
62 return unless exists $params->{message_name};
63 return unless exists $params->{borrowernumber} xor exists $params->{categorycode}; # yes, xor
64 my $sql = <<'END_SQL';
65SELECT borrower_message_preferences.*,
66 borrower_message_transport_preferences.message_transport_type,
67 message_attributes.message_name,
68 message_attributes.takes_days,
69 message_transports.is_digest,
70 message_transports.letter_module,
71 message_transports.letter_code
72FROM borrower_message_preferences
73LEFT JOIN borrower_message_transport_preferences
74ON borrower_message_transport_preferences.borrower_message_preference_id = borrower_message_preferences.borrower_message_preference_id
75LEFT JOIN message_attributes
76ON message_attributes.message_attribute_id = borrower_message_preferences.message_attribute_id
77JOIN message_transports
78ON message_transports.message_attribute_id = message_attributes.message_attribute_id
79AND message_transports.message_transport_type = borrower_message_transport_preferences.message_transport_type
80WHERE message_attributes.message_name = ?
81END_SQL
82
83 my @bind_params = ( $params->{'message_name'} );
84 if ( exists $params->{'borrowernumber'} ) {
85 $sql .= " AND borrower_message_preferences.borrowernumber = ? ";
86 push @bind_params, $params->{borrowernumber};
87 } else {
88 $sql .= " AND borrower_message_preferences.categorycode = ? ";
89 push @bind_params, $params->{categorycode};
90 }
91
92 my $sth = C4::Context->dbh->prepare($sql);
93 $sth->execute(@bind_params);
94 my $return;
95 my %transports; # helps build a list of unique message_transport_types
96 ROW: while ( my $row = $sth->fetchrow_hashref() ) {
97 next ROW unless $row->{'message_attribute_id'};
98 $return->{'days_in_advance'} = $row->{'days_in_advance'} if defined $row->{'days_in_advance'};
99 $return->{'wants_digest'} = $row->{'wants_digest'} if defined $row->{'wants_digest'};
100 $return->{'letter_code'} = $row->{'letter_code'};
101 $return->{'transports'}->{ $row->{'message_transport_type'} } = $row->{'letter_code'};
102 }
103 return $return;
104}
105
106=head2 SetMessagingPreference
107
108This method defines how a user (or a default for a patron category) wants to get a certain
109message delivered. The list of valid message types can be delivered can be found in the
110C<message_attributes> table, and the list of valid message transports can be
111found in the C<message_transport_types> table.
112
113 C4::Members::Messaging::SetMessagingPreference( { borrowernumber => $borrower->{'borrowernumber'}
114 message_attribute_id => $message_attribute_id,
115 message_transport_types => [ qw( email sms ) ],
116 days_in_advance => 5
117 wants_digest => 1 } )
118
119returns nothing useful.
120
121=cut
122
123sub SetMessagingPreference {
124 my $params = shift;
125
126 unless (exists $params->{borrowernumber} xor exists $params->{categorycode}) { # yes, xor
127 warn "SetMessagingPreference called without exactly one of borrowernumber or categorycode";
128 return;
129 }
130 foreach my $required ( qw( message_attribute_id message_transport_types ) ) {
131 if ( ! exists $params->{ $required } ) {
132 warn "SetMessagingPreference called without required parameter: $required";
133 return;
134 }
135 }
136 $params->{'days_in_advance'} = undef unless exists ( $params->{'days_in_advance'} );
137 $params->{'wants_digest'} = 0 unless exists ( $params->{'wants_digest'} );
138
139 my $dbh = C4::Context->dbh();
140
141 my $delete_sql = <<'END_SQL';
142DELETE FROM borrower_message_preferences
143 WHERE message_attribute_id = ?
144END_SQL
145 my @bind_params = ( $params->{'message_attribute_id'} );
146 if ( exists $params->{'borrowernumber'} ) {
147 $delete_sql .= " AND borrowernumber = ? ";
148 push @bind_params, $params->{borrowernumber};
149 } else {
150 $delete_sql .= " AND categorycode = ? ";
151 push @bind_params, $params->{categorycode};
152 }
153 my $sth = $dbh->prepare( $delete_sql );
154 my $deleted = $sth->execute( @bind_params );
155
156 if ( $params->{'message_transport_types'} ) {
157 my $insert_bmp = <<'END_SQL';
158INSERT INTO borrower_message_preferences
159(borrower_message_preference_id, borrowernumber, categorycode, message_attribute_id, days_in_advance, wants_digest)
160VALUES
161(NULL, ?, ?, ?, ?, ?)
162END_SQL
163
164 $sth = C4::Context->dbh()->prepare($insert_bmp);
165 # set up so that we can easily construct the insert SQL
166 $params->{'borrowernumber'} = undef unless exists ( $params->{'borrowernumber'} );
167 $params->{'categorycode'} = undef unless exists ( $params->{'categorycode'} );
168 my $success = $sth->execute( $params->{'borrowernumber'},
169 $params->{'categorycode'},
170 $params->{'message_attribute_id'},
171 $params->{'days_in_advance'},
172 $params->{'wants_digest'} );
173 # my $borrower_message_preference_id = $dbh->last_insert_id();
174 my $borrower_message_preference_id = $dbh->{'mysql_insertid'};
175
176 my $insert_bmtp = <<'END_SQL';
177INSERT INTO borrower_message_transport_preferences
178(borrower_message_preference_id, message_transport_type)
179VALUES
180(?, ?)
181END_SQL
182 $sth = C4::Context->dbh()->prepare($insert_bmtp);
183 foreach my $transport ( @{$params->{'message_transport_types'}}) {
184 my $success = $sth->execute( $borrower_message_preference_id, $transport );
185 }
186 }
187 return;
188}
189
190=head2 GetMessagingOptions
191
192 my $messaging_options = C4::Members::Messaging::GetMessagingOptions()
193
194returns a hashref of messaging options available.
195
196=cut
197
198sub GetMessagingOptions {
199
200 my $sql = <<'END_SQL';
201select message_attributes.message_attribute_id, takes_days, message_name, message_transport_type, is_digest
202 FROM message_attributes
203 LEFT JOIN message_transports
204 ON message_attributes.message_attribute_id = message_transports.message_attribute_id
205END_SQL
206
207 my $sth = C4::Context->dbh->prepare($sql);
208 $sth->execute();
209 my $choices;
210 while ( my $row = $sth->fetchrow_hashref() ) {
211 $choices->{ $row->{'message_name'} }->{'message_attribute_id'} = $row->{'message_attribute_id'};
212 $choices->{ $row->{'message_name'} }->{'message_name'} = $row->{'message_name'};
213 $choices->{ $row->{'message_name'} }->{'takes_days'} = $row->{'takes_days'};
214 $choices->{ $row->{'message_name'} }->{'has_digest'} = 1 if $row->{'is_digest'};
215 $choices->{ $row->{'message_name'} }->{'transport_' . $row->{'message_transport_type'}} = ' ';
216 }
217
218 my @return = values %$choices;
219 # warn( Data::Dumper->Dump( [ \@return ], [ 'return' ] ) );
220 return \@return;
221}
222
223=head2 SetMessagingPreferencesFromDefaults
224
225 C4::Members::Messaging::SetMessagingPreferenceFromDefaults( { borrowernumber => $borrower->{'borrowernumber'}
226 categorycode => 'CPL' } );
227
228Given a borrowernumber and a patron category code (from the C<borrowernumber> and C<categorycode> keys
229in the parameter hashref), replace all of the patron's current messaging preferences with
230whatever defaults are defined for the patron category.
231
232=cut
233
234sub SetMessagingPreferencesFromDefaults {
235 my $params = shift;
236
237 foreach my $required ( qw( borrowernumber categorycode ) ) {
238 unless ( exists $params->{ $required } ) {
239 die "SetMessagingPreferencesFromDefaults called without required parameter: $required";
240 }
241 }
242
243 my $messaging_options = GetMessagingOptions();
244 OPTION: foreach my $option ( @$messaging_options ) {
245 my $default_pref = GetMessagingPreferences( { categorycode => $params->{categorycode},
246 message_name => $option->{'message_name'} } );
247 # FIXME - except for setting the borrowernumber, it really ought to be possible
248 # to have the output of GetMessagingPreferences be able to be the input
249 # to SetMessagingPreference
250 my @message_transport_types = keys %{ $default_pref->{transports} };
251 $default_pref->{message_attribute_id} = $option->{'message_attribute_id'};
252 $default_pref->{message_transport_types} = \@message_transport_types;
253 $default_pref->{borrowernumber} = $params->{borrowernumber};
254 SetMessagingPreference( $default_pref );
255 }
256}
257
258=head1 TABLES
259
260=head2 message_queue
261
262The actual messages which will be sent via a cron job running
263F<misc/cronjobs/process_message_queue.pl>.
264
265=head2 message_attributes
266
267What kinds of messages can be sent?
268
269=head2 message_transport_types
270
271What transports can messages be sent vith? (email, sms, etc.)
272
273=head2 message_transports
274
275How are message_attributes and message_transport_types correlated?
276
277=head2 borrower_message_preferences
278
279What messages do the borrowers want to receive?
280
281=head2 borrower_message_transport_preferences
282
283What transport should a message be sent with?
284
285=head1 CONFIG
286
287=head2 Adding a New Kind of Message to the System
288
289=over 4
290
291=item 1.
292
293Add a new template to the `letter` table.
294
295=item 2.
296
297Insert a row into the `message_attributes` table.
298
299=item 3.
300
301Insert rows into `message_transports` for each message_transport_type.
302
303=back
304
305=head1 SEE ALSO
306
307L<C4::Letters>
308
309=head1 AUTHOR
310
311Koha Development Team <http://koha-community.org/>
312
313Andrew Moore <andrew.moore@liblime.com>
314
315=cut
316
31712µs1;
Report produced by the NYTProf 5.06 Perl profiler, developed by Tim Bunce and Adam Kaplan.