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