Koha/Patron/Category.pm

   1 package Koha::Patron::Category;
   2
   3 # This file is part of Koha.
   4 #
   5 # Koha is free software; you can redistribute it and/or modify it under the
   6 # terms of the GNU General Public License as published by the Free Software
   7 # Foundation; either version 3 of the License, or (at your option) any later
   8 # version.
   9 #
  10 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
  11 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
  12 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
  13 #
  14 # You should have received a copy of the GNU General Public License along
  15 # with Koha; if not, write to the Free Software Foundation, Inc.,
  16 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
  17
  18 use Modern::Perl;
  19
  20 use Carp;
  21 use List::MoreUtils qw(any);
  22
  23 use C4::Members::Messaging;
  24
  25 use Koha::Database;
  26 use Koha::DateUtils;
  27
  28 use base qw(Koha::Object);
  29
  30 =head1 NAME
  31
  32 Koha::Patron;;Category - Koha Patron;;Category Object class
  33
  34 =head1 API
  35
  36 =head2 Class Methods
  37
  38 =cut
  39
  40 =head3 effective_BlockExpiredPatronOpacActions
  41
  42 my $BlockExpiredPatronOpacActions = $category->effective_BlockExpiredPatronOpacActions
  43
  44 Return the effective BlockExpiredPatronOpacActions value.
  45
  46 =cut
  47
  48 sub effective_BlockExpiredPatronOpacActions {
  49     my( $self) = @_;
  50     return C4::Context->preference('BlockExpiredPatronOpacActions') if $self->BlockExpiredPatronOpacActions == -1;
  51     return $self->BlockExpiredPatronOpacActions
  52 }
  53
  54 =head3 store
  55
  56 =cut
  57
  58 sub store {
  59     my ($self) = @_;
  60
  61     $self->dateofbirthrequired(undef)
  62       if not defined $self->dateofbirthrequired
  63       or $self->dateofbirthrequired eq '';
  64
  65     $self->upperagelimit(undef)
  66       if not defined $self->upperagelimit
  67       or $self->upperagelimit eq '';
  68
  69     $self->checkprevcheckout('inherit')
  70       unless defined $self->checkprevcheckout;
  71
  72     return $self->SUPER::store;
  73 }
  74
  75 =head3 default_messaging
  76
  77 my $messaging = $category->default_messaging();
  78
  79 =cut
  80
  81 sub default_messaging {
  82     my ( $self ) = @_;
  83     my $messaging_options = C4::Members::Messaging::GetMessagingOptions();
  84     my @messaging;
  85     foreach my $option (@$messaging_options) {
  86         my $pref = C4::Members::Messaging::GetMessagingPreferences(
  87             {
  88                 categorycode => $self->categorycode,
  89                 message_name => $option->{message_name}
  90             }
  91         );
  92         next unless $pref->{transports};
  93         my $brief_pref = {
  94             message_attribute_id      => $option->{message_attribute_id},
  95             message_name              => $option->{message_name},
  96             $option->{'message_name'} => 1,
  97         };
  98         foreach my $transport ( keys %{ $pref->{transports} } ) {
  99             push @{ $brief_pref->{transports} }, { transport => $transport };
 100         }
 101         push @messaging, $brief_pref;
 102     }
 103     return \@messaging;
 104 }
 105
 106 =head3 branch_limitations
 107
 108 my $limitations = $category->branch_limitations();
 109
 110 $category->branch_limitations( \@branchcodes );
 111
 112 =cut
 113
 114 sub branch_limitations {
 115     my ( $self, $branchcodes ) = @_;
 116
 117     if ($branchcodes) {
 118         return $self->replace_branch_limitations($branchcodes);
 119     }
 120     else {
 121         return $self->get_branch_limitations();
 122     }
 123
 124 }
 125
 126 =head3 get_branch_limitations
 127
 128 my $limitations = $category->get_branch_limitations();
 129
 130 =cut
 131
 132 sub get_branch_limitations {
 133     my ($self) = @_;
 134
 135     my @branchcodes =
 136       $self->_catb_resultset->search( { categorycode => $self->categorycode } )
 137       ->get_column('branchcode')->all();
 138
 139     return \@branchcodes;
 140 }
 141
 142 =head3 add_branch_limitation
 143
 144 $category->add_branch_limitation( $branchcode );
 145
 146 =cut
 147
 148 sub add_branch_limitation {
 149     my ( $self, $branchcode ) = @_;
 150
 151     croak("No branchcode passed in!") unless $branchcode;
 152
 153     my $limitation = $self->_catb_resultset->update_or_create(
 154         { categorycode => $self->categorycode, branchcode => $branchcode } );
 155
 156     return $limitation ? 1 : undef;
 157 }
 158
 159 =head3 del_branch_limitation
 160
 161 $category->del_branch_limitation( $branchcode );
 162
 163 =cut
 164
 165 sub del_branch_limitation {
 166     my ( $self, $branchcode ) = @_;
 167
 168     croak("No branchcode passed in!") unless $branchcode;
 169
 170     my $limitation =
 171       $self->_catb_resultset->find(
 172         { categorycode => $self->categorycode, branchcode => $branchcode } );
 173
 174     unless ($limitation) {
 175         my $categorycode = $self->categorycode;
 176         carp(
 177 "No branch limit for branch $branchcode found for categorycode $categorycode to delete!"
 178         );
 179         return;
 180     }
 181
 182     return $limitation->delete();
 183 }
 184
 185 =head3 replace_branch_limitations
 186
 187 $category->replace_branch_limitations( \@branchcodes );
 188
 189 =cut
 190
 191 sub replace_branch_limitations {
 192     my ( $self, $branchcodes ) = @_;
 193
 194     $self->_catb_resultset->search( { categorycode => $self->categorycode } )->delete;
 195
 196     my @return_values =
 197       map { $self->add_branch_limitation($_) } @$branchcodes;
 198
 199     return \@return_values;
 200 }
 201
 202 =head3 Koha::Objects->_catb_resultset
 203
 204 Returns the internal resultset or creates it if undefined
 205
 206 =cut
 207
 208 sub _catb_resultset {
 209     my ($self) = @_;
 210
 211     $self->{_catb_resultset} ||=
 212       Koha::Database->new->schema->resultset('CategoriesBranch');
 213
 214     return $self->{_catb_resultset};
 215 }
 216
 217 sub get_expiry_date {
 218     my ($self, $date ) = @_;
 219     if ( $self->enrolmentperiod ) {
 220         $date ||= dt_from_string;
 221         $date = dt_from_string( $date ) unless ref $date;
 222         return $date->add( months => $self->enrolmentperiod, end_of_month => 'limit' );
 223     } else {
 224         return $self->enrolmentperioddate;
 225     }
 226 }
 227
 228 =head3 effective_reset_password
 229
 230 Returns if patrons in this category can reset their password. If set in $self->reset_password
 231 or, if undef, falls back to the OpacResetPassword system preference.
 232
 233 =cut
 234
 235 sub effective_reset_password {
 236     my ($self) = @_;
 237
 238     return ( defined $self->reset_password )
 239         ? $self->reset_password
 240         : C4::Context->preference('OpacResetPassword');
 241 }
 242
 243 =head3 effective_change_password
 244
 245 Returns if patrons in this category can change their password. If set in $self->change_password
 246 or, if undef, falls back to the OpacPasswordChange system preference.
 247
 248 =cut
 249
 250 sub effective_change_password {
 251     my ($self) = @_;
 252
 253     return ( defined $self->change_password )
 254         ? $self->change_password
 255         : C4::Context->preference('OpacPasswordChange');
 256 }
 257
 258 =head3 override_hidden_items
 259
 260     if ( $patron->category->override_hidden_items ) {
 261         ...
 262     }
 263
 264 Returns a boolean that if patrons of this category are exempt from the OPACHiddenItems policies
 265
 266 TODO: Remove on bug 22547
 267
 268 =cut
 269
 270 sub override_hidden_items {
 271     my ($self) = @_;
 272     return any { $_ eq $self->categorycode }
 273     split( /\|/, C4::Context->preference('OpacHiddenItemsExceptions') );
 274 }
 275
 276 =head2 Internal methods
 277
 278 =head3 type
 279
 280 =cut
 281
 282 sub _type {
 283     return 'Category';
 284 }
 285
 286 1;