Bug 6554 Fix error caused by modifying $_ in a map
[koha.git] / C4 / ItemCirculationAlertPreference.pm
blob4d88fecf2e3c8f4325e2f62a66b78a955ef5968b
1 package C4::ItemCirculationAlertPreference;
3 # Copyright Liblime 2009
5 # This file is part of Koha.
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.
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.
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.
20 use strict;
21 use warnings;
22 use C4::Context;
23 use C4::Category;
24 use C4::ItemType;
25 use Carp qw(carp croak);
27 our $AUTOLOAD;
29 # helper function for validating \%opts
30 our $valid = sub {
31 my $opts = shift;
32 for (qw(branchcode categorycode item_type notification)) {
33 exists($opts->{$_}) || croak("'$_' is a required parameter.");
40 =head1 NAME
42 C4::ItemCirculationAlertPreference - manage preferences for sending alerts
44 =head1 SYNOPSIS
46 Basics:
48 use C4::ItemCirculationAlertPreference;
50 # a short-cut to reduce typing the long package name over and over again
51 my $preferences = 'C4::ItemCirculationAlertPreference';
53 Creating a restriction on sending messages:
55 my $pref = $preferences->create({
56 branchcode => 'CPL',
57 categorycode => 'YA',
58 item_type => 'BK',
59 notification => 'CHECKOUT',
60 });
62 Removing a restriction on sending messages:
64 $preferences->delete({
65 branchcode => 'CPL',
66 categorycode => 'YA',
67 item_type => 'BK',
68 notification => 'CHECKOUT',
69 });
71 =head1 DESCRIPTION
73 This class is used to manage the preferences for when an alert may be sent. By
74 default, item circulation alerts are enabled for every B<branch>, B<patron
75 category> and B<item type>.
77 However, if you would like to prevent item circulation alerts from being sent
78 for any combination of these 3 variables, a preference can be inserted into the
79 C<item_circulation_alert_preferences> table to make that a policy.
81 =head1 API
83 =head2 Class Methods
85 =cut
87 =head3 C4::ItemCirculationAlertPreference->new(\%opts)
89 This is a constructor for an in-memory C4::ItemCirculationAlertPreference
90 object. The database is not affected by this method.
92 =cut
94 sub new {
95 my ($class, $opts) = @_;
96 bless $opts => $class;
102 =head3 C4::ItemCirculationAlertPreference->create(\%opts)
104 This will find or create an item circulation alert preference. You must pass
105 it a B<branchcode>, B<categorycode>, B<item_type>, and B<notification>. Valid
106 values for these attributes are as follows:
108 =over 4
110 =item branchcode
112 branches.branchcode
114 =item categorycode
116 category.categorycode
118 =item item_type
120 itemtypes.itemtype
122 =item notification
124 This can be "CHECKIN" or "CHECKOUT"
126 =back
128 =cut
130 sub create {
131 my ($class, $opts) = @_;
132 $valid->($opts);
133 my $dbh = C4::Context->dbh;
134 my $prefs = $dbh->selectall_arrayref(
135 "SELECT id, branchcode, categorycode, item_type
136 FROM item_circulation_alert_preferences
137 WHERE branchcode = ?
138 AND categorycode = ?
139 AND item_type = ?
140 AND notification = ?",
141 { Slice => {} },
142 $opts->{branchcode},
143 $opts->{categorycode},
144 $opts->{item_type},
145 $opts->{notification},
147 if (@$prefs) {
148 return $class->new($prefs->[0]);
149 } else {
150 my $success = $dbh->do(
151 "INSERT INTO item_circulation_alert_preferences
152 (branchcode, categorycode, item_type, notification) VALUES (?, ?, ?, ?)",
154 $opts->{branchcode},
155 $opts->{categorycode},
156 $opts->{item_type},
157 $opts->{notification},
159 if ($success) {
160 my $self = {
161 id => $dbh->last_insert_id(undef, undef, undef, undef),
162 branchcode => $opts->{branchcode},
163 categorycode => $opts->{categorycode},
164 item_type => $opts->{item_type},
165 notification => $opts->{notification},
167 return $class->new($self);
168 } else {
169 carp $dbh->errstr;
170 return;
178 =head3 C4::ItemCirculationAlertPreference->delete(\%opts)
180 Delete an item circulation alert preference. You can delete by either passing
181 in an B<id> or passing in a B<branchcode>, B<categorycode>, B<item_type>
182 triplet.
184 =cut
186 sub delete {
187 my ($class, $opts) = @_;
188 my $dbh = C4::Context->dbh;
189 if ($opts->{id}) {
190 $dbh->do(
191 "DELETE FROM item_circulation_alert_preferences WHERE id = ?",
193 $opts->{id}
195 } else {
196 $valid->($opts);
197 my $sql =
198 "DELETE FROM item_circulation_alert_preferences
199 WHERE branchcode = ?
200 AND categorycode = ?
201 AND item_type = ?
202 AND notification = ?";
203 $dbh->do(
204 $sql,
206 $opts->{branchcode},
207 $opts->{categorycode},
208 $opts->{item_type},
209 $opts->{notification},
217 =head3 C4::ItemCirculationAlertPreference->is_enabled_for(\%opts)
219 Based on the existing preferences in the C<item_circulation_alert_preferences>
220 table, can an alert be sent for the given B<branchcode>, B<categorycode>, and
221 B<itemtype>?
223 B<Example>:
225 my $alert = 'C4::ItemCirculationAlertPreference';
226 my $conditions = {
227 branchcode => 'CPL',
228 categorycode => 'IL',
229 item_type => 'MU',
232 if ($alert->is_enabled_for($conditions)) {
233 # ...
236 =cut
238 sub is_disabled_for {
239 my ($class, $opts) = @_;
240 $valid->($opts);
241 my $dbh = C4::Context->dbh;
243 # Does a preference exist to block this alert?
244 my $query = qq{
245 SELECT id, branchcode, categorycode, item_type, notification
246 FROM item_circulation_alert_preferences
247 WHERE (branchcode = ? OR branchcode = '*')
248 AND (categorycode = ? OR categorycode = '*')
249 AND (item_type = ? OR item_type = '*')
250 AND (notification = ? OR notification = '*')
253 my $preferences = $dbh->selectall_arrayref(
254 $query,
255 { Slice => {} },
256 $opts->{branchcode},
257 $opts->{categorycode},
258 $opts->{item_type},
259 $opts->{notification},
262 # If any preferences showed up, we are NOT enabled.
263 return @$preferences;
266 sub is_enabled_for {
267 my ($class, $opts) = @_;
268 return not $class->is_disabled_for($opts);
274 =head3 C4::ItemCirculationAlertPreference->find({ branchcode => $bc, notification => $type })
276 This method returns all the item circulation alert preferences for a given
277 branch and notification.
279 B<Example>:
281 my @branch_prefs = C4::ItemCirculationAlertPreference->find({
282 branchcode => 'CPL',
283 notification => 'CHECKIN',
286 =cut
288 sub find {
289 my ($class, $where) = @_;
290 my $dbh = C4::Context->dbh;
291 my $query = qq{
292 SELECT id, branchcode, categorycode, item_type, notification
293 FROM item_circulation_alert_preferences
294 WHERE branchcode = ? AND notification = ?
295 ORDER BY categorycode, item_type
297 return map { $class->new($_) } @{$dbh->selectall_arrayref(
298 $query,
299 { Slice => {} },
300 $where->{branchcode},
301 $where->{notification},
308 =head3 C4::ItemCirculationAlertPreference->grid({ branchcode => $c, notification => $type })
310 Return a 2D arrayref for the grid view in F<admin/item_circulation_alert_preferences.pl>.
311 Each row represents a category (like 'Patron' or 'Young Adult') and
312 each column represents an itemtype (like 'Book' or 'Music').
314 Each cell contains...
316 B<Example>:
318 use Data::Dump 'pp';
319 my $grid = C4::ItemCirculationAlertPreference->grid({
320 branchcode => 'CPL',
321 notification => 'CHECKOUT',
323 warn pp($grid);
325 See F<admin/item_circulation_alerts.pl> to see how this method is used.
327 =cut
329 sub grid {
330 my ($class, $where) = @_;
331 my @branch_prefs = $class->find($where);
332 my @default_prefs = $class->find({ branchcode => '*', notification => $where->{notification} });
333 my @cc = C4::Category->all;
334 my @it = C4::ItemType->all;
335 my $notification = $where->{notification};
336 my %disabled = map {
337 my $key = $_->categorycode . "-" . $_->item_type . "-" . $notification;
338 $key =~ s/\*/_/g;
339 ($key => 1);
340 } @branch_prefs;
341 my %default = map {
342 my $key = $_->categorycode . "-" . $_->item_type . "-" . $notification;
343 $key =~ s/\*/_/g;
344 ($key => 1);
345 } @default_prefs;
346 my @grid;
347 for my $c (@cc) {
348 my $row = { description => $c->description, items => [] };
349 push @grid, $row;
350 for my $i (@it) {
351 my $key = $c->categorycode . "-" . $i->itemtype . "-" . $notification;
352 $key =~ s/\*/_/g;
353 my @classes;
354 my $text = " ";
355 if ($disabled{$key}) {
356 push @classes, 'disabled';
357 $text = "Disabled for $where->{branchcode}";
359 if ($default{$key}) {
360 push @classes, 'default';
361 $text = "Disabled for all";
363 push @{$row->{items}}, {
364 class => join(' ', @classes),
365 id => $key,
366 text => $text,
370 return \@grid;
376 =head2 Object Methods
378 These are read-only accessors for the various attributes of a preference.
380 =head3 $pref->id
382 =cut
384 =head3 $pref->branchcode
386 =cut
388 =head3 $pref->categorycode
390 =cut
392 =head3 $pref->item_type
394 =cut
396 =head3 $pref->notification
398 =cut
400 sub AUTOLOAD {
401 my $self = shift;
402 my $attr = $AUTOLOAD;
403 $attr =~ s/.*://;
404 if (exists $self->{$attr}) {
405 return $self->{$attr};
406 } else {
407 return;
411 sub DESTROY { }
415 =head1 SEE ALSO
417 L<C4::Circulation>, F<admin/item_circulation_alerts.pl>
419 =head1 AUTHOR
421 John Beppu <john.beppu@liblime.com>
423 =cut