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
   6 # under the terms of the GNU General Public License as published by
   7 # the Free Software Foundation; either version 3 of the License, or
   8 # (at your option) any later version.
   9 #
  10 # Koha is distributed in the hope that it will be useful, but
  11 # WITHOUT ANY WARRANTY; without even the implied warranty of
  12 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  13 # GNU General Public License for more details.
  14 #
  15 # You should have received a copy of the GNU General Public License
  16 # along with Koha; if not, see <http://www.gnu.org/licenses>.
  17
  18 use Modern::Perl;
  19
  20 use List::MoreUtils qw( any );
  21
  22 use C4::Members::Messaging;
  23
  24 use Koha::Database;
  25 use Koha::DateUtils qw( dt_from_string );
  26
  27 use base qw(Koha::Object Koha::Object::Limit::Library);
  28
  29 =head1 NAME
  30
  31 Koha::Patron;;Category - Koha Patron;;Category Object class
  32
  33 =head1 API
  34
  35 =head2 Class Methods
  36
  37 =cut
  38
  39 =head3 effective_BlockExpiredPatronOpacActions
  40
  41 my $BlockExpiredPatronOpacActions = $category->effective_BlockExpiredPatronOpacActions
  42
  43 Return the effective BlockExpiredPatronOpacActions value.
  44
  45 =cut
  46
  47 sub effective_BlockExpiredPatronOpacActions {
  48     my( $self) = @_;
  49     return C4::Context->preference('BlockExpiredPatronOpacActions') if $self->BlockExpiredPatronOpacActions == -1;
  50     return $self->BlockExpiredPatronOpacActions
  51 }
  52
  53 =head3 store
  54
  55 =cut
  56
  57 sub store {
  58     my ($self) = @_;
  59
  60     $self->dateofbirthrequired(undef)
  61       if not defined $self->dateofbirthrequired
  62       or $self->dateofbirthrequired eq '';
  63
  64     $self->upperagelimit(undef)
  65       if not defined $self->upperagelimit
  66       or $self->upperagelimit eq '';
  67
  68     $self->checkprevcheckout('inherit')
  69       unless defined $self->checkprevcheckout;
  70
  71     return $self->SUPER::store;
  72 }
  73
  74 =head3 default_messaging
  75
  76 my $messaging = $category->default_messaging();
  77
  78 =cut
  79
  80 sub default_messaging {
  81     my ( $self ) = @_;
  82     my $messaging_options = C4::Members::Messaging::GetMessagingOptions();
  83     my @messaging;
  84     foreach my $option (@$messaging_options) {
  85         my $pref = C4::Members::Messaging::GetMessagingPreferences(
  86             {
  87                 categorycode => $self->categorycode,
  88                 message_name => $option->{message_name}
  89             }
  90         );
  91         next unless $pref->{transports};
  92         my $brief_pref = {
  93             message_attribute_id      => $option->{message_attribute_id},
  94             message_name              => $option->{message_name},
  95             $option->{'message_name'} => 1,
  96         };
  97         foreach my $transport ( keys %{ $pref->{transports} } ) {
  98             push @{ $brief_pref->{transports} }, { transport => $transport };
  99         }
 100         push @messaging, $brief_pref;
 101     }
 102     return \@messaging;
 103 }
 104
 105 sub get_expiry_date {
 106     my ($self, $date ) = @_;
 107     if ( $self->enrolmentperiod ) {
 108         $date ||= dt_from_string;
 109         $date = dt_from_string( $date ) unless ref $date;
 110         return $date->add( months => $self->enrolmentperiod, end_of_month => 'limit' );
 111     } else {
 112         return $self->enrolmentperioddate;
 113     }
 114 }
 115
 116 =head3 get_password_expiry_date
 117
 118 Returns date based on password expiry days set for the category. If the value is not set
 119 we return undef, password does not expire
 120
 121 my $expiry_date = $category->get_password_expiry_date();
 122
 123 =cut
 124
 125 sub get_password_expiry_date {
 126     my ($self, $date ) = @_;
 127     if ( $self->password_expiry_days ) {
 128         $date ||= dt_from_string;
 129         $date = dt_from_string( $date ) unless ref $date;
 130         return $date->add( days => $self->password_expiry_days )->ymd;
 131     } else {
 132         return;
 133     }
 134 }
 135
 136 =head3 effective_reset_password
 137
 138 Returns if patrons in this category can reset their password. If set in $self->reset_password
 139 or, if undef, falls back to the OpacResetPassword system preference.
 140
 141 =cut
 142
 143 sub effective_reset_password {
 144     my ($self) = @_;
 145
 146     return $self->reset_password // C4::Context->preference('OpacResetPassword');
 147 }
 148
 149 =head3 effective_change_password
 150
 151 Returns if patrons in this category can change their password. If set in $self->change_password
 152 or, if undef, falls back to the OpacPasswordChange system preference.
 153
 154 =cut
 155
 156 sub effective_change_password {
 157     my ($self) = @_;
 158
 159     return $self->change_password // C4::Context->preference('OpacPasswordChange');
 160 }
 161
 162 =head3 effective_min_password_length
 163
 164     $category->effective_min_password_length()
 165
 166 Retrieve category's password length if set, or minPasswordLength otherwise
 167
 168 =cut
 169
 170 sub effective_min_password_length {
 171     my ($self) = @_;
 172
 173     return $self->min_password_length // C4::Context->preference('minPasswordLength');
 174 }
 175
 176 =head3 effective_require_strong_password
 177
 178     $category->effective_require_strong_password()
 179
 180 Retrieve category's password strength if set, or RequireStrongPassword otherwise
 181
 182 =cut
 183
 184 sub effective_require_strong_password {
 185     my ($self) = @_;
 186
 187     return $self->require_strong_password // C4::Context->preference('RequireStrongPassword');
 188 }
 189
 190 =head3 override_hidden_items
 191
 192     if ( $patron->category->override_hidden_items ) {
 193         ...
 194     }
 195
 196 Returns a boolean that if patrons of this category are exempt from the OPACHiddenItems policies
 197
 198 TODO: Remove on bug 22547
 199
 200 =cut
 201
 202 sub override_hidden_items {
 203     my ($self) = @_;
 204     return any { $_ eq $self->categorycode }
 205     split( ',', C4::Context->preference('OpacHiddenItemsExceptions') );
 206 }
 207
 208 =head3 can_make_suggestions
 209
 210
 211     if ( $patron->category->can_make_suggestions ) {
 212         ...
 213     }
 214
 215 Returns if the OPAC logged-in user is allowed to make OPAC purchase suggestions.
 216
 217 =cut
 218
 219 sub can_make_suggestions {
 220     my ( $self ) = @_;
 221
 222     if ( C4::Context->preference('suggestion') ) {
 223
 224         my @patron_categories = split ',', C4::Context->preference('suggestionPatronCategoryExceptions') // q{};
 225
 226         return !any {$_ eq $self->categorycode } @patron_categories;
 227     }
 228
 229     return 0;
 230 }
 231
 232 =head2 Internal methods
 233
 234 =head3 _library_limits
 235
 236  configure library limits
 237
 238 =cut
 239
 240 sub _library_limits {
 241     return {
 242         class => "CategoriesBranch",
 243         id => "categorycode",
 244         library => "branchcode",
 245     };
 246 }
 247
 248 =head3 type
 249
 250 =cut
 251
 252 sub _type {
 253     return 'Category';
 254 }
 255
 256 1;