File Coverage

File:C4/Members/Messaging.pm
Coverage:12.8%

linestmtbrancondsubtimecode
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
20
16
16
16
16
506
112
766
use strict;
21
16
16
16
16
145
97
1010
use warnings;
22
16
16
16
16
333
120
271
use C4::Context;
23
24
16
16
16
16
102
51
990
use vars qw($VERSION);
25
26BEGIN {
27    # set the version for version checking
28
16
16
19218
    $VERSION = 3.00;
29}
30
31 - 57
=head1 NAME

C4::Members::Messaging - manage patron messaging preferences

=head1 SYNOPSIS

  use C4::Members::Messaging

=head1 DESCRIPTION

This module lets you modify a patron's messaging preferences.

=head1 FUNCTIONS

=head2 GetMessagingPreferences

  my $preferences = C4::Members::Messaging::GetMessagingPreferences( { borrowernumber => $borrower->{'borrowernumber'},
                                                                       message_name   => 'DUE' } );

  my $preferences = C4::Members::Messaging::GetMessagingPreferences( { categorycode => 'LIBRARY',
                                                                       message_name   => 'DUE' } );

returns: a hashref of messaging preferences for a borrower or patron category for a particlar message_name

Requires either a borrowernumber or a categorycode key, but not both.

=cut
58
59sub GetMessagingPreferences {
60
0
0
    my $params = shift;
61
62
0
0
    return unless exists $params->{message_name};
63
0
0
0
    return unless exists $params->{borrowernumber} xor exists $params->{categorycode}; # yes, xor
64
0
    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
0
    my @bind_params = ( $params->{'message_name'} );
84
0
0
    if ( exists $params->{'borrowernumber'} ) {
85
0
        $sql .= " AND borrower_message_preferences.borrowernumber = ? ";
86
0
        push @bind_params, $params->{borrowernumber};
87    } else {
88
0
        $sql .= " AND borrower_message_preferences.categorycode = ? ";
89
0
        push @bind_params, $params->{categorycode};
90    }
91
92
0
    my $sth = C4::Context->dbh->prepare($sql);
93
0
    $sth->execute(@bind_params);
94
0
    my $return;
95
0
    my %transports; # helps build a list of unique message_transport_types
96
0
    ROW: while ( my $row = $sth->fetchrow_hashref() ) {
97
0
0
        next ROW unless $row->{'message_attribute_id'};
98
0
0
        $return->{'days_in_advance'} = $row->{'days_in_advance'} if defined $row->{'days_in_advance'};
99
0
0
        $return->{'wants_digest'} = $row->{'wants_digest'} if defined $row->{'wants_digest'};
100
0
        $return->{'letter_code'} = $row->{'letter_code'};
101
0
        $transports{$row->{'message_transport_type'}} = 1;
102    }
103
0
0
    @{$return->{'transports'}} = keys %transports;
104
0
    return $return;
105}
106
107 - 122
=head2 SetMessagingPreference

This method defines how a user (or a default for a patron category) wants to get a certain 
message delivered.  The list of valid message types can be delivered can be found in the
C<message_attributes> table, and the list of valid message transports can be
found in the C<message_transport_types> table.

  C4::Members::Messaging::SetMessagingPreference( { borrowernumber          => $borrower->{'borrowernumber'}
                                                    message_attribute_id    => $message_attribute_id,
                                                    message_transport_types => [ qw( email sms ) ],
                                                    days_in_advance         => 5
                                                    wants_digest            => 1 } )

returns nothing useful.

=cut
123
124sub SetMessagingPreference {
125
0
0
    my $params = shift;
126
127
0
0
0
    unless (exists $params->{borrowernumber} xor exists $params->{categorycode}) { # yes, xor
128
0
        warn "SetMessagingPreference called without exactly one of borrowernumber or categorycode";
129
0
        return;
130    }
131
0
    foreach my $required ( qw( message_attribute_id message_transport_types ) ) {
132
0
0
        if ( ! exists $params->{ $required } ) {
133
0
            warn "SetMessagingPreference called without required parameter: $required";
134
0
            return;
135        }
136    }
137
0
0
    $params->{'days_in_advance'} = undef unless exists ( $params->{'days_in_advance'} );
138
0
0
    $params->{'wants_digest'} = 0 unless exists ( $params->{'wants_digest'} );
139
140
0
    my $dbh = C4::Context->dbh();
141
142
0
    my $delete_sql = <<'END_SQL';
143DELETE FROM borrower_message_preferences
144  WHERE message_attribute_id = ?
145END_SQL
146
0
    my @bind_params = ( $params->{'message_attribute_id'} );
147
0
0
    if ( exists $params->{'borrowernumber'} ) {
148
0
        $delete_sql .= " AND borrowernumber = ? ";
149
0
        push @bind_params, $params->{borrowernumber};
150    } else {
151
0
        $delete_sql .= " AND categorycode = ? ";
152
0
        push @bind_params, $params->{categorycode};
153    }
154
0
    my $sth = $dbh->prepare( $delete_sql );
155
0
    my $deleted = $sth->execute( @bind_params );
156
157
0
0
    if ( $params->{'message_transport_types'} ) {
158
0
        my $insert_bmp = <<'END_SQL';
159INSERT INTO borrower_message_preferences
160(borrower_message_preference_id, borrowernumber, categorycode, message_attribute_id, days_in_advance, wants_digest)
161VALUES
162(NULL, ?, ?, ?, ?, ?)
163END_SQL
164
165
0
        $sth = C4::Context->dbh()->prepare($insert_bmp);
166        # set up so that we can easily construct the insert SQL
167
0
0
        $params->{'borrowernumber'} = undef unless exists ( $params->{'borrowernumber'} );
168
0
0
        $params->{'categorycode'} = undef unless exists ( $params->{'categorycode'} );
169
0
        my $success = $sth->execute( $params->{'borrowernumber'},
170                                     $params->{'categorycode'},
171                                     $params->{'message_attribute_id'},
172                                     $params->{'days_in_advance'},
173                                     $params->{'wants_digest'} );
174        # my $borrower_message_preference_id = $dbh->last_insert_id();
175
0
        my $borrower_message_preference_id = $dbh->{'mysql_insertid'};
176
177
0
        my $insert_bmtp = <<'END_SQL';
178INSERT INTO borrower_message_transport_preferences
179(borrower_message_preference_id, message_transport_type)
180VALUES
181(?, ?)
182END_SQL
183
0
        $sth = C4::Context->dbh()->prepare($insert_bmtp);
184
0
0
        foreach my $transport ( @{$params->{'message_transport_types'}}) {
185
0
            my $success = $sth->execute( $borrower_message_preference_id, $transport );
186        }
187    }
188
0
    return;
189}
190
191 - 197
=head2 GetMessagingOptions

  my $messaging_options = C4::Members::Messaging::GetMessagingOptions()

returns a hashref of messaging options available.

=cut
198
199sub GetMessagingOptions {
200
201
0
0
    my $sql = <<'END_SQL';
202select message_attributes.message_attribute_id, takes_days, message_name, message_transport_type, is_digest
203  FROM message_attributes
204  LEFT JOIN message_transports
205    ON message_attributes.message_attribute_id = message_transports.message_attribute_id
206END_SQL
207
208
0
    my $sth = C4::Context->dbh->prepare($sql);
209
0
    $sth->execute();
210
0
    my $choices;
211
0
    while ( my $row = $sth->fetchrow_hashref() ) {
212
0
        $choices->{ $row->{'message_name'} }->{'message_attribute_id'} = $row->{'message_attribute_id'};
213
0
        $choices->{ $row->{'message_name'} }->{'message_name'} = $row->{'message_name'};
214
0
        $choices->{ $row->{'message_name'} }->{'takes_days'} = $row->{'takes_days'};
215
0
0
        $choices->{ $row->{'message_name'} }->{'has_digest'} = 1 if $row->{'is_digest'};
216
0
        $choices->{ $row->{'message_name'} }->{'transport_' . $row->{'message_transport_type'}} = ' ';
217    }
218
219
0
    my @return = values %$choices;
220    # warn( Data::Dumper->Dump( [ \@return ], [ 'return' ] ) );
221
0
    return \@return;
222}
223
224 - 233
=head2 SetMessagingPreferencesFromDefaults

  C4::Members::Messaging::SetMessagingPreferenceFromDefaults( { borrowernumber => $borrower->{'borrowernumber'}
                                                                categorycode   => 'CPL' } );

Given a borrowernumber and a patron category code (from the C<borrowernumber> and C<categorycode> keys
in the parameter hashref), replace all of the patron's current messaging preferences with
whatever defaults are defined for the patron category.

=cut
234
235sub SetMessagingPreferencesFromDefaults {
236
0
0
    my $params = shift;
237
238
0
    foreach my $required ( qw( borrowernumber categorycode ) ) {
239
0
0
        unless ( exists $params->{ $required } ) {
240
0
            die "SetMessagingPreferencesFromDefaults called without required parameter: $required";
241        }
242    }
243
244
0
    my $messaging_options = GetMessagingOptions();
245
0
    OPTION: foreach my $option ( @$messaging_options ) {
246
0
        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
0
        $default_pref->{message_attribute_id} = $option->{'message_attribute_id'};
252
0
        $default_pref->{message_transport_types} = $default_pref->{transports};
253
0
        $default_pref->{borrowernumber} = $params->{borrowernumber};
254
0
        SetMessagingPreference( $default_pref );
255    }
256}
257
258 - 315
=head1 TABLES

=head2 message_queue

The actual messages which will be sent via a cron job running
F<misc/cronjobs/process_message_queue.pl>.

=head2 message_attributes

What kinds of messages can be sent?

=head2 message_transport_types

What transports can messages be sent vith?  (email, sms, etc.)

=head2 message_transports

How are message_attributes and message_transport_types correlated?

=head2 borrower_message_preferences

What messages do the borrowers want to receive?

=head2 borrower_message_transport_preferences

What transport should a message be sent with?

=head1 CONFIG

=head2 Adding a New Kind of Message to the System

=over 4

=item 1.

Add a new template to the `letter` table.

=item 2.

Insert a row into the `message_attributes` table.

=item 3.

Insert rows into `message_transports` for each message_transport_type.

=back

=head1 SEE ALSO

L<C4::Letters>

=head1 AUTHOR

Koha Development Team <http://koha-community.org/>

Andrew Moore <andrew.moore@liblime.com>

=cut
316
3171;