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