C4/Members/AttributeTypes.pm

   1 package C4::Members::AttributeTypes;
   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
   8 # under the terms of the GNU General Public License as published by
   9 # the Free Software Foundation; either version 3 of the License, or
  10 # (at your option) any later version.
  11 #
  12 # Koha is distributed in the hope that it will be useful, but
  13 # WITHOUT ANY WARRANTY; without even the implied warranty of
  14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  15 # GNU General Public License for more details.
  16 #
  17 # You should have received a copy of the GNU General Public License
  18 # along with Koha; if not, see <http://www.gnu.org/licenses>.
  19
  20 use strict;
  21 #use warnings; FIXME - Bug 2505
  22 use C4::Context;
  23
  24
  25
  26 =head1 NAME
  27
  28 C4::Members::AttributeTypes - mananage extended patron attribute types
  29
  30 =head1 SYNOPSIS
  31
  32   my @attribute_types = C4::Members::AttributeTypes::GetAttributeTypes();
  33
  34   my $attr_type = C4::Members::AttributeTypes->new($code, $description);
  35   $attr_type->code($code);
  36   $attr_type->description($description);
  37   $attr_type->repeatable($repeatable);
  38   $attr_type->unique_id($unique_id);
  39   $attr_type->opac_display($opac_display);
  40   $attr_type->password_allowed($password_allowed);
  41   $attr_type->staff_searchable($staff_searchable);
  42   $attr_type->authorised_value_category($authorised_value_category);
  43   $attr_type->store();
  44   $attr_type->delete();
  45
  46   my $attr_type = C4::Members::AttributeTypes->fetch($code);
  47   $attr_type = C4::Members::AttributeTypes->delete($code);
  48
  49 =head1 FUNCTIONS
  50
  51 =head2 GetAttributeTypes
  52
  53   my @attribute_types = C4::Members::AttributeTypes::GetAttributeTypes($all_fields);
  54
  55 Returns an array of hashrefs of each attribute type defined
  56 in the database.  The array is sorted by code.  Each hashref contains
  57 at least the following fields:
  58
  59  - code
  60  - description
  61
  62 If $all_fields is true, then each hashref also contains the other fields from borrower_attribute_types.
  63
  64 =cut
  65
  66 sub GetAttributeTypes {
  67     my $all    = @_   ? shift : 0;
  68     my $no_branch_limit = @_ ? shift : 0;
  69     my $branch_limit = $no_branch_limit
  70         ? 0
  71         : C4::Context->userenv ? C4::Context->userenv->{"branch"} : 0;
  72     my $select = $all ? '*'   : 'DISTINCT(code), description, class';
  73
  74     my $dbh = C4::Context->dbh;
  75     my $query = "SELECT $select FROM borrower_attribute_types";
  76     $query .= qq{
  77         LEFT JOIN borrower_attribute_types_branches ON bat_code = code
  78         WHERE b_branchcode = ? OR b_branchcode IS NULL
  79     } if $branch_limit;
  80     $query .= " ORDER BY code";
  81     my $sth    = $dbh->prepare($query);
  82     $sth->execute( $branch_limit ? $branch_limit : () );
  83     my $results = $sth->fetchall_arrayref({});
  84     $sth->finish;
  85     return @$results;
  86 }
  87
  88 sub GetAttributeTypes_hashref {
  89     my %hash = map {$_->{code} => $_} GetAttributeTypes(@_);
  90     return \%hash;
  91 }
  92
  93 =head2 AttributeTypeExists
  94
  95   my $have_attr_xyz = C4::Members::AttributeTypes::AttributeTypeExists($code)
  96
  97 Returns true if we have attribute type C<$code>
  98 in the database.
  99
 100 =cut
 101
 102 sub AttributeTypeExists {
 103     my ($code) = @_;
 104     my $dbh = C4::Context->dbh;
 105     my $exists = $dbh->selectrow_array("SELECT code FROM borrower_attribute_types WHERE code = ?", undef, $code);
 106     return $exists;
 107 }
 108
 109 =head1 METHODS
 110
 111   my $attr_type = C4::Members::AttributeTypes->new($code, $description);
 112
 113 Create a new attribute type.
 114
 115 =cut
 116
 117 sub new {
 118     my $class = shift;
 119     my $self = {};
 120
 121     $self->{'code'} = shift;
 122     $self->{'description'} = shift;
 123     $self->{'repeatable'} = 0;
 124     $self->{'unique_id'} = 0;
 125     $self->{'opac_display'} = 0;
 126     $self->{'password_allowed'} = 0;
 127     $self->{'staff_searchable'} = 0;
 128     $self->{'display_checkout'} = 0;
 129     $self->{'authorised_value_category'} = '';
 130     $self->{'category_code'} = '';
 131     $self->{'category_description'} = '';
 132     $self->{'class'} = '';
 133
 134     bless $self, $class;
 135     return $self;
 136 }
 137
 138 =head2 fetch
 139
 140   my $attr_type = C4::Members::AttributeTypes->fetch($code);
 141
 142 Fetches an attribute type from the database.  If no
 143 type with the given C<$code> exists, returns undef.
 144
 145 =cut
 146
 147 sub fetch {
 148     my $class = shift;
 149     my $code = shift;
 150     my $self = {};
 151     my $dbh = C4::Context->dbh();
 152
 153     my $sth = $dbh->prepare_cached("
 154         SELECT borrower_attribute_types.*, categories.description AS category_description
 155         FROM borrower_attribute_types
 156         LEFT JOIN categories ON borrower_attribute_types.category_code=categories.categorycode
 157         WHERE code =?");
 158     $sth->execute($code);
 159     my $row = $sth->fetchrow_hashref;
 160     $sth->finish();
 161     return unless defined $row;
 162
 163     $self->{'code'}                      = $row->{'code'};
 164     $self->{'description'}               = $row->{'description'};
 165     $self->{'repeatable'}                = $row->{'repeatable'};
 166     $self->{'unique_id'}                 = $row->{'unique_id'};
 167     $self->{'opac_display'}              = $row->{'opac_display'};
 168     $self->{'password_allowed'}          = $row->{'password_allowed'};
 169     $self->{'staff_searchable'}          = $row->{'staff_searchable'};
 170     $self->{'display_checkout'}          = $row->{'display_checkout'};
 171     $self->{'authorised_value_category'} = $row->{'authorised_value_category'};
 172     $self->{'category_code'}             = $row->{'category_code'};
 173     $self->{'category_description'}      = $row->{'category_description'};
 174     $self->{'class'}                     = $row->{'class'};
 175
 176     $sth = $dbh->prepare("SELECT branchcode, branchname FROM borrower_attribute_types_branches, branches WHERE b_branchcode = branchcode AND bat_code = ?;");
 177     $sth->execute( $code );
 178     while ( my $data = $sth->fetchrow_hashref ) {
 179         push @{ $self->{branches} }, $data;
 180     }
 181     $sth->finish();
 182
 183     bless $self, $class;
 184     return $self;
 185 }
 186
 187 =head2 store
 188
 189   $attr_type->store();
 190
 191 Stores attribute type in the database.  If the type
 192 previously retrieved from the database via the fetch()
 193 method, the DB representation of the type is replaced.
 194
 195 =cut
 196
 197 sub store {
 198     my $self = shift;
 199
 200     my $dbh = C4::Context->dbh;
 201     my $sth;
 202     my $existing = __PACKAGE__->fetch($self->{'code'});
 203     if (defined $existing) {
 204         $sth = $dbh->prepare_cached("UPDATE borrower_attribute_types
 205                                      SET description = ?,
 206                                          repeatable = ?,
 207                                          unique_id = ?,
 208                                          opac_display = ?,
 209                                          password_allowed = ?,
 210                                          staff_searchable = ?,
 211                                          authorised_value_category = ?,
 212                                          display_checkout = ?,
 213                                          category_code = ?,
 214                                          class = ?
 215                                      WHERE code = ?");
 216     } else {
 217         $sth = $dbh->prepare_cached("INSERT INTO borrower_attribute_types
 218                                         (description, repeatable, unique_id, opac_display, password_allowed,
 219                                          staff_searchable, authorised_value_category, display_checkout, category_code, class, code)
 220                                         VALUES (?, ?, ?, ?, ?,
 221                                                 ?, ?, ?, ?, ?, ?)");
 222     }
 223     $sth->bind_param(1, $self->{'description'});
 224     $sth->bind_param(2, $self->{'repeatable'});
 225     $sth->bind_param(3, $self->{'unique_id'});
 226     $sth->bind_param(4, $self->{'opac_display'});
 227     $sth->bind_param(5, $self->{'password_allowed'});
 228     $sth->bind_param(6, $self->{'staff_searchable'});
 229     $sth->bind_param(7, $self->{'authorised_value_category'});
 230     $sth->bind_param(8, $self->{'display_checkout'});
 231     $sth->bind_param(9, $self->{'category_code'} || undef);
 232     $sth->bind_param(10, $self->{'class'});
 233     $sth->bind_param(11, $self->{'code'});
 234     $sth->execute;
 235
 236     if ( defined $$self{branches} ) {
 237         $sth = $dbh->prepare("DELETE FROM borrower_attribute_types_branches WHERE bat_code = ?");
 238         $sth->execute( $$self{code} );
 239         $sth = $dbh->prepare(
 240             "INSERT INTO borrower_attribute_types_branches
 241                         ( bat_code, b_branchcode )
 242                         VALUES ( ?, ? )"
 243         );
 244         for my $branchcode ( @{$$self{branches}} ) {
 245             next if not $branchcode;
 246             $sth->bind_param( 1, $$self{code} );
 247             $sth->bind_param( 2, $branchcode );
 248             $sth->execute;
 249         }
 250     }
 251     $sth->finish;
 252 }
 253
 254 =head2 code
 255
 256   my $code = $attr_type->code();
 257   $attr_type->code($code);
 258
 259 Accessor.  Note that the code is immutable once
 260 a type is created or fetched from the database.
 261
 262 =cut
 263
 264 sub code {
 265     my $self = shift;
 266     return $self->{'code'};
 267 }
 268
 269 =head2 description
 270
 271   my $description = $attr_type->description();
 272   $attr_type->description($description);
 273
 274 Accessor.
 275
 276 =cut
 277
 278 sub description {
 279     my $self = shift;
 280     @_ ? $self->{'description'} = shift : $self->{'description'};
 281 }
 282
 283 =head2 branches
 284
 285 my $branches = $attr_type->branches();
 286 $attr_type->branches($branches);
 287
 288 Accessor.
 289
 290 =cut
 291
 292 sub branches {
 293     my $self = shift;
 294     @_ ? $self->{branches} = shift : $self->{branches};
 295 }
 296
 297 =head2 repeatable
 298
 299   my $repeatable = $attr_type->repeatable();
 300   $attr_type->repeatable($repeatable);
 301
 302 Accessor.  The C<$repeatable> argument
 303 is interpreted as a Perl boolean.
 304
 305 =cut
 306
 307 sub repeatable {
 308     my $self = shift;
 309     @_ ? $self->{'repeatable'} = ((shift) ? 1 : 0) : $self->{'repeatable'};
 310 }
 311
 312 =head2 unique_id
 313
 314   my $unique_id = $attr_type->unique_id();
 315   $attr_type->unique_id($unique_id);
 316
 317 Accessor.  The C<$unique_id> argument
 318 is interpreted as a Perl boolean.
 319
 320 =cut
 321
 322 sub unique_id {
 323     my $self = shift;
 324     @_ ? $self->{'unique_id'} = ((shift) ? 1 : 0) : $self->{'unique_id'};
 325 }
 326 =head2 opac_display
 327
 328   my $opac_display = $attr_type->opac_display();
 329   $attr_type->opac_display($opac_display);
 330
 331 Accessor.  The C<$opac_display> argument
 332 is interpreted as a Perl boolean.
 333
 334 =cut
 335
 336 sub opac_display {
 337     my $self = shift;
 338     @_ ? $self->{'opac_display'} = ((shift) ? 1 : 0) : $self->{'opac_display'};
 339 }
 340 =head2 password_allowed
 341
 342   my $password_allowed = $attr_type->password_allowed();
 343   $attr_type->password_allowed($password_allowed);
 344
 345 Accessor.  The C<$password_allowed> argument
 346 is interpreted as a Perl boolean.
 347
 348 =cut
 349
 350 sub password_allowed {
 351     my $self = shift;
 352     @_ ? $self->{'password_allowed'} = ((shift) ? 1 : 0) : $self->{'password_allowed'};
 353 }
 354 =head2 staff_searchable
 355
 356   my $staff_searchable = $attr_type->staff_searchable();
 357   $attr_type->staff_searchable($staff_searchable);
 358
 359 Accessor.  The C<$staff_searchable> argument
 360 is interpreted as a Perl boolean.
 361
 362 =cut
 363
 364 sub staff_searchable {
 365     my $self = shift;
 366     @_ ? $self->{'staff_searchable'} = ((shift) ? 1 : 0) : $self->{'staff_searchable'};
 367 }
 368
 369 =head2 display_checkout
 370
 371 my $display_checkout = $attr_type->display_checkout();
 372 $attr_type->display_checkout($display_checkout);
 373
 374 Accessor.  The C<$display_checkout> argument
 375 is interpreted as a Perl boolean.
 376
 377 =cut
 378
 379 sub display_checkout {
 380     my $self = shift;
 381     @_ ? $self->{'display_checkout'} = ((shift) ? 1 : 0) : $self->{'display_checkout'};
 382 }
 383
 384 =head2 authorised_value_category
 385
 386   my $authorised_value_category = $attr_type->authorised_value_category();
 387   $attr_type->authorised_value_category($authorised_value_category);
 388
 389 Accessor.
 390
 391 =cut
 392
 393 sub authorised_value_category {
 394     my $self = shift;
 395     @_ ? $self->{'authorised_value_category'} = shift : $self->{'authorised_value_category'};
 396 }
 397
 398 =head2 category_code
 399
 400 my $category_code = $attr_type->category_code();
 401 $attr_type->category_code($category_code);
 402
 403 Accessor.
 404
 405 =cut
 406
 407 sub category_code {
 408     my $self = shift;
 409     @_ ? $self->{'category_code'} = shift : $self->{'category_code'};
 410 }
 411
 412 =head2 category_description
 413
 414 my $category_description = $attr_type->category_description();
 415 $attr_type->category_description($category_description);
 416
 417 Accessor.
 418
 419 =cut
 420
 421 sub category_description {
 422     my $self = shift;
 423     @_ ? $self->{'category_description'} = shift : $self->{'category_description'};
 424 }
 425
 426 =head2 class
 427
 428 my $class = $attr_type->class();
 429 $attr_type->class($class);
 430
 431 Accessor.
 432
 433 =cut
 434
 435 sub class {
 436     my $self = shift;
 437     @_ ? $self->{'class'} = shift : $self->{'class'};
 438 }
 439
 440
 441 =head2 delete
 442
 443   $attr_type->delete();
 444   C4::Members::AttributeTypes->delete($code);
 445
 446 Delete an attribute type from the database.  The attribute
 447 type may be specified either by an object or by a code.
 448
 449 =cut
 450
 451 sub delete {
 452     my $arg = shift;
 453     my $code;
 454     if (ref($arg) eq __PACKAGE__) {
 455         $code = $arg->{'code'};
 456     } else {
 457         $code = shift;
 458     }
 459
 460     my $dbh = C4::Context->dbh;
 461     my $sth = $dbh->prepare_cached("DELETE FROM borrower_attribute_types WHERE code = ?");
 462     $sth->execute($code);
 463     $sth->finish;
 464 }
 465
 466 =head2 num_patrons
 467
 468   my $count = $attr_type->num_patrons();
 469
 470 Returns the number of patron records that use
 471 this attribute type.
 472
 473 =cut
 474
 475 sub num_patrons {
 476     my $self = shift;
 477
 478     my $dbh = C4::Context->dbh;
 479     my $sth = $dbh->prepare_cached("SELECT COUNT(DISTINCT borrowernumber)
 480                                     FROM borrower_attributes
 481                                     WHERE code = ?");
 482     $sth->execute($self->{code});
 483     my ($count) = $sth->fetchrow_array;
 484     $sth->finish;
 485     return $count;
 486 }
 487
 488 =head2 get_patrons
 489
 490   my @borrowernumbers = $attr_type->get_patrons($attribute);
 491
 492 Returns the borrowernumber of the patron records that
 493 have an attribute with the specifie value.
 494
 495 =cut
 496
 497 sub get_patrons {
 498     my $self = shift;
 499     my $value = shift;
 500
 501     my $dbh = C4::Context->dbh;
 502     my $sth = $dbh->prepare_cached("SELECT DISTINCT borrowernumber
 503                                     FROM borrower_attributes
 504                                     WHERE code = ?
 505                                     AND   attribute = ?");
 506     $sth->execute($self->{code}, $value);
 507     my @results;
 508     while (my ($borrowernumber) = $sth->fetchrow_array) {
 509         push @results, $borrowernumber;
 510     }
 511     return @results;
 512 }
 513
 514 =head1 AUTHOR
 515
 516 Koha Development Team <http://koha-community.org/>
 517
 518 Galen Charlton <galen.charlton@liblime.com>
 519
 520 =cut
 521
 522 1;