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 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
  20 use strict;
  21 use warnings;
  22 use C4::Context;
  23
  24 use vars qw($VERSION);
  25
  26 BEGIN {
  27     # set the version for version checking
  28     $VERSION = 3.07.00.049;
  29 }
  30
  31 =head1 NAME
  32
  33 C4::Members::Messaging - manage patron messaging preferences
  34
  35 =head1 SYNOPSIS
  36
  37   use C4::Members::Messaging
  38
  39 =head1 DESCRIPTION
  40
  41 This 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
  53 returns: a hashref of messaging preferences for a borrower or patron category for a particlar message_name
  54
  55 Requires either a borrowernumber or a categorycode key, but not both.
  56
  57 =cut
  58
  59 sub 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';
  65 SELECT 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
  72 FROM   borrower_message_preferences
  73 LEFT JOIN borrower_message_transport_preferences
  74 ON     borrower_message_transport_preferences.borrower_message_preference_id = borrower_message_preferences.borrower_message_preference_id
  75 LEFT JOIN message_attributes
  76 ON     message_attributes.message_attribute_id = borrower_message_preferences.message_attribute_id
  77 JOIN message_transports
  78 ON     message_transports.message_attribute_id = message_attributes.message_attribute_id
  79 AND    message_transports.message_transport_type = borrower_message_transport_preferences.message_transport_type
  80 WHERE  message_attributes.message_name = ?
  81 END_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
 108 This method defines how a user (or a default for a patron category) wants to get a certain
 109 message delivered.  The list of valid message types can be delivered can be found in the
 110 C<message_attributes> table, and the list of valid message transports can be
 111 found 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
 119 returns nothing useful.
 120
 121 =cut
 122
 123 sub 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';
 142 DELETE FROM borrower_message_preferences
 143   WHERE message_attribute_id = ?
 144 END_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';
 158 INSERT INTO borrower_message_preferences
 159 (borrower_message_preference_id, borrowernumber, categorycode, message_attribute_id, days_in_advance, wants_digest)
 160 VALUES
 161 (NULL, ?, ?, ?, ?, ?)
 162 END_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';
 177 INSERT INTO borrower_message_transport_preferences
 178 (borrower_message_preference_id, message_transport_type)
 179 VALUES
 180 (?, ?)
 181 END_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
 194 returns a hashref of messaging options available.
 195
 196 =cut
 197
 198 sub GetMessagingOptions {
 199
 200     my $sql = <<'END_SQL';
 201 select 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
 205 END_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
 228 Given a borrowernumber and a patron category code (from the C<borrowernumber> and C<categorycode> keys
 229 in the parameter hashref), replace all of the patron's current messaging preferences with
 230 whatever defaults are defined for the patron category.
 231
 232 =cut
 233
 234 sub 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
 262 The actual messages which will be sent via a cron job running
 263 F<misc/cronjobs/process_message_queue.pl>.
 264
 265 =head2 message_attributes
 266
 267 What kinds of messages can be sent?
 268
 269 =head2 message_transport_types
 270
 271 What transports can messages be sent vith?  (email, sms, etc.)
 272
 273 =head2 message_transports
 274
 275 How are message_attributes and message_transport_types correlated?
 276
 277 =head2 borrower_message_preferences
 278
 279 What messages do the borrowers want to receive?
 280
 281 =head2 borrower_message_transport_preferences
 282
 283 What 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
 293 Add a new template to the `letter` table.
 294
 295 =item 2.
 296
 297 Insert a row into the `message_attributes` table.
 298
 299 =item 3.
 300
 301 Insert rows into `message_transports` for each message_transport_type.
 302
 303 =back
 304
 305 =head1 SEE ALSO
 306
 307 L<C4::Letters>
 308
 309 =head1 AUTHOR
 310
 311 Koha Development Team <http://koha-community.org/>
 312
 313 Andrew Moore <andrew.moore@liblime.com>
 314
 315 =cut
 316
 317 1;