tools/modborrowers.pl

   1 #!/usr/bin/perl
   2
   3 # Copyright 2012 BibLibre
   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 # modborrowers.pl
  21 #
  22 # Batch Edit Patrons
  23 # Modification for patron's fields:
  24 # surname firstname branchcode categorycode city state zipcode country sort1
  25 # sort2 dateenrolled dateexpiry borrowernotes
  26 # And for patron attributes.
  27
  28 use Modern::Perl;
  29 use CGI qw ( -utf8 );
  30 use C4::Auth;
  31 use C4::Koha;
  32 use C4::Members;
  33 use C4::Output;
  34 use List::MoreUtils qw /any uniq/;
  35 use Koha::DateUtils qw( dt_from_string );
  36 use Koha::List::Patron;
  37 use Koha::Libraries;
  38 use Koha::Patron::Categories;
  39 use Koha::Patron::Debarments;
  40 use Koha::Patrons;
  41
  42 my $input = new CGI;
  43 my $op = $input->param('op') || 'show_form';
  44 my ( $template, $loggedinuser, $cookie ) = get_template_and_user(
  45     {   template_name   => "tools/modborrowers.tt",
  46         query           => $input,
  47         type            => "intranet",
  48         flagsrequired   => { tools => "edit_patrons" },
  49     }
  50 );
  51
  52 my $logged_in_user = Koha::Patrons->find( $loggedinuser );
  53
  54 my %cookies   = parse CGI::Cookie($cookie);
  55 my $sessionID = $cookies{'CGISESSID'}->value;
  56 my $dbh       = C4::Context->dbh;
  57
  58 # Show borrower informations
  59 if ( $op eq 'show' ) {
  60     my $filefh         = $input->upload('uploadfile');
  61     my $filecontent    = $input->param('filecontent');
  62     my $patron_list_id = $input->param('patron_list_id');
  63     my @borrowers;
  64     my @cardnumbers;
  65     my @notfoundcardnumbers;
  66
  67     # Get cardnumbers from a file or the input area
  68     if ($filefh) {
  69         while ( my $content = <$filefh> ) {
  70             $content =~ s/[\r\n]*$//g;
  71             push @cardnumbers, $content if $content;
  72         }
  73     } elsif ( $patron_list_id ) {
  74         my ($list) = GetPatronLists( { patron_list_id => $patron_list_id } );
  75
  76         @cardnumbers =
  77           $list->patron_list_patrons()->search_related('borrowernumber')
  78           ->get_column('cardnumber')->all();
  79
  80     } else {
  81         if ( my $list = $input->param('cardnumberlist') ) {
  82             push @cardnumbers, split( /\s\n/, $list );
  83         }
  84     }
  85
  86     my $max_nb_attr = 0;
  87     for my $cardnumber ( @cardnumbers ) {
  88         my $patron = Koha::Patrons->find( { cardnumber => $cardnumber } );
  89         if ( $patron ) {
  90             if ( $logged_in_user->can_see_patron_infos( $patron ) ) {
  91                 my $borrower = $patron->unblessed;
  92                 my $attributes = $patron->extended_attributes;
  93                 $borrower->{patron_attributes} = $attributes->as_list;
  94                 $borrower->{patron_attributes_count} = $attributes->count;
  95                 $max_nb_attr = $borrower->{patron_attributes_count} if $borrower->{patron_attributes_count} > $max_nb_attr;
  96                 push @borrowers, $borrower;
  97             } else {
  98                 push @notfoundcardnumbers, $cardnumber;
  99             }
 100         } else {
 101             push @notfoundcardnumbers, $cardnumber;
 102         }
 103     }
 104
 105     # Just for a correct display
 106     for my $borrower ( @borrowers ) {
 107         my $length = $borrower->{patron_attributes_count};
 108         push @{ $borrower->{patron_attributes} }, {} for ( $length .. $max_nb_attr - 1);
 109     }
 110
 111     # Construct the patron attributes list
 112     my @patron_attributes_values;
 113     my @patron_attributes_codes;
 114     my $library_id = C4::Context->userenv ? C4::Context->userenv->{'branch'} : undef;
 115     my $patron_attribute_types = Koha::Patron::Attribute::Types->search_with_library_limits({}, {}, $library_id);
 116     my @patron_categories = Koha::Patron::Categories->search_limited({}, {order_by => ['description']});
 117     while ( my $attr_type = $patron_attribute_types->next ) {
 118         # TODO Repeatable attributes are not correctly managed and can cause data lost.
 119         # This should be implemented.
 120         next if $attr_type->repeatable;
 121         next if $attr_type->unique_id; # Don't display patron attributes that must be unqiue
 122         my $options = $attr_type->authorised_value_category
 123             ? GetAuthorisedValues( $attr_type->authorised_value_category )
 124             : undef;
 125         push @patron_attributes_values,
 126             {
 127                 attribute_code => $attr_type->code,
 128                 options        => $options,
 129             };
 130
 131         my $category_code = $attr_type->category_code;
 132         my ( $category_lib ) = map {
 133             ( defined $category_code and $attr_type->category_code eq $category_code ) ? $attr_type->description : ()
 134         } @patron_categories;
 135         push @patron_attributes_codes,
 136             {
 137                 attribute_code => $attr_type->code,
 138                 attribute_lib  => $attr_type->description,
 139                 category_lib   => $category_lib,
 140                 type           => $attr_type->authorised_value_category ? 'select' : 'text',
 141             };
 142     }
 143
 144     my @attributes_header = ();
 145     for ( 1 .. scalar( $max_nb_attr ) ) {
 146         push @attributes_header, { attribute => "Attributes $_" };
 147     }
 148     $template->param( borrowers => \@borrowers );
 149     $template->param( attributes_header => \@attributes_header );
 150     @notfoundcardnumbers = map { { cardnumber => $_ } } @notfoundcardnumbers;
 151     $template->param( notfoundcardnumbers => \@notfoundcardnumbers )
 152         if @notfoundcardnumbers;
 153
 154     # Construct drop-down list values
 155     my $branches = Koha::Libraries->search({}, { order_by => ['branchname'] })->unblessed;
 156     my @branches_option;
 157     push @branches_option, { value => $_->{branchcode}, lib => $_->{branchname} } for @$branches;
 158     unshift @branches_option, { value => "", lib => "" };
 159     my @categories_option;
 160     push @categories_option, { value => $_->categorycode, lib => $_->description } for @patron_categories;
 161     unshift @categories_option, { value => "", lib => "" };
 162     my $bsort1 = GetAuthorisedValues("Bsort1");
 163     my @sort1_option;
 164     push @sort1_option, { value => $_->{authorised_value}, lib => $_->{lib} } for @$bsort1;
 165     unshift @sort1_option, { value => "", lib => "" }
 166         if @sort1_option;
 167     my $bsort2 = GetAuthorisedValues("Bsort2");
 168     my @sort2_option;
 169     push @sort2_option, { value => $_->{authorised_value}, lib => $_->{lib} } for @$bsort2;
 170     unshift @sort2_option, { value => "", lib => "" }
 171         if @sort2_option;
 172
 173     my @mandatoryFields = split( /\|/, C4::Context->preference("BorrowerMandatoryField") );
 174
 175     my @fields = (
 176         {
 177             name => "surname",
 178             type => "text",
 179             mandatory => ( grep /surname/, @mandatoryFields ) ? 1 : 0
 180         }
 181         ,
 182         {
 183             name => "firstname",
 184             type => "text",
 185             mandatory => ( grep /firstname/, @mandatoryFields ) ? 1 : 0,
 186         }
 187         ,
 188         {
 189             name => "branchcode",
 190             type => "select",
 191             option => \@branches_option,
 192             mandatory => ( grep /branchcode/, @mandatoryFields ) ? 1 : 0,
 193         }
 194         ,
 195         {
 196             name => "categorycode",
 197             type => "select",
 198             option => \@categories_option,
 199             mandatory => ( grep /categorycode/, @mandatoryFields ) ? 1 : 0,
 200         }
 201         ,
 202         {
 203             name => "streetnumber",
 204             type => "text",
 205             mandatory => ( grep /streetnumber/, @mandatoryFields ) ? 1 : 0,
 206         }
 207         ,
 208         {
 209             name => "address",
 210             type => "text",
 211             mandatory => ( grep /address/, @mandatoryFields ) ? 1 : 0,
 212         }
 213         ,
 214         {
 215             name => "address2",
 216             type => "text",
 217             mandatory => ( grep /address2/, @mandatoryFields ) ? 1 : 0,
 218         }
 219         ,
 220         {
 221             name => "city",
 222             type => "text",
 223             mandatory => ( grep /city/, @mandatoryFields ) ? 1 : 0,
 224         }
 225         ,
 226         {
 227             name => "state",
 228             type => "text",
 229             mandatory => ( grep /state/, @mandatoryFields ) ? 1 : 0,
 230         }
 231         ,
 232         {
 233             name => "zipcode",
 234             type => "text",
 235             mandatory => ( grep /zipcode/, @mandatoryFields ) ? 1 : 0,
 236         }
 237         ,
 238         {
 239             name => "country",
 240             type => "text",
 241             mandatory => ( grep /country/, @mandatoryFields ) ? 1 : 0,
 242         }
 243         ,
 244         {
 245             name => "email",
 246             type => "text",
 247             mandatory => ( grep /email/, @mandatoryFields ) ? 1 : 0,
 248         }
 249         ,
 250         {
 251             name => "phone",
 252             type => "text",
 253             mandatory => ( grep /phone/, @mandatoryFields ) ? 1 : 0,
 254         }
 255         ,
 256         {
 257             name => "mobile",
 258             type => "text",
 259             mandatory => ( grep /mobile/, @mandatoryFields ) ? 1 : 0,
 260         }
 261         ,
 262         {
 263             name => "sort1",
 264             type => @sort1_option ? "select" : "text",
 265             option => \@sort1_option,
 266             mandatory => ( grep /sort1/, @mandatoryFields ) ? 1 : 0,
 267         }
 268         ,
 269         {
 270             name => "sort2",
 271             type => @sort2_option ? "select" : "text",
 272             option => \@sort2_option,
 273             mandatory => ( grep /sort2/, @mandatoryFields ) ? 1 : 0,
 274         }
 275         ,
 276         {
 277             name => "dateenrolled",
 278             type => "date",
 279             mandatory => ( grep /dateenrolled/, @mandatoryFields ) ? 1 : 0,
 280         }
 281         ,
 282         {
 283             name => "dateexpiry",
 284             type => "date",
 285             mandatory => ( grep /dateexpiry/, @mandatoryFields ) ? 1 : 0,
 286         }
 287         ,
 288         {
 289             name => "borrowernotes",
 290             type => "text",
 291             mandatory => ( grep /borrowernotes/, @mandatoryFields ) ? 1 : 0,
 292         }
 293         ,
 294         {
 295             name => "opacnote",
 296             type => "text",
 297             mandatory => ( grep /opacnote/, @mandatoryFields ) ? 1 : 0,
 298         }
 299         ,
 300         {
 301             name => "debarred",
 302             type => "date",
 303             mandatory => ( grep /debarred/, @mandatoryFields ) ? 1 : 0,
 304         }
 305         ,
 306         {
 307             name => "debarredcomment",
 308             type => "text",
 309             mandatory => ( grep /debarredcomment/, @mandatoryFields ) ? 1 : 0,
 310         },
 311     );
 312
 313     $template->param('patron_attributes_codes', \@patron_attributes_codes);
 314     $template->param('patron_attributes_values', \@patron_attributes_values);
 315
 316     $template->param( fields => \@fields );
 317 }
 318
 319 # Process modifications
 320 if ( $op eq 'do' ) {
 321
 322     my @disabled = $input->multi_param('disable_input');
 323     my $infos;
 324         for my $field ( qw/surname firstname branchcode categorycode streetnumber address address2 city state zipcode country email phone mobile sort1 sort2 dateenrolled dateexpiry borrowernotes opacnote/ ) {
 325         my $value = $input->param($field);
 326         $infos->{$field} = $value if $value;
 327         $infos->{$field} = "" if grep { $_ eq $field } @disabled;
 328     }
 329
 330     for my $field ( qw( dateenrolled dateexpiry debarred ) ) {
 331         $infos->{$field} = dt_from_string($infos->{$field}) if $infos->{$field};
 332     }
 333
 334     my @attributes = $input->multi_param('patron_attributes');
 335     my @attr_values = $input->multi_param('patron_attributes_value');
 336
 337     my @errors;
 338     my @borrowernumbers = $input->multi_param('borrowernumber');
 339     # For each borrower selected
 340     for my $borrowernumber ( @borrowernumbers ) {
 341         # If at least one field are filled, we want to modify the borrower
 342         if ( defined $infos ) {
 343             # If a debarred date or debarred comment has been submitted make a new debarment
 344             if ( $infos->{debarred} || $infos->{debarredcomment} ) {
 345                 AddDebarment(
 346                     {
 347                         borrowernumber => $borrowernumber,
 348                         type           => 'MANUAL',
 349                         comment        => $infos->{debarredcomment},
 350                         expiration     => $infos->{debarred},
 351                     });
 352             }
 353
 354             # If debarment date or debarment comment are disabled then remove all debarrments
 355             if ( grep { /debarred/ } @disabled ) {
 356                 eval {
 357                    my $debarrments = GetDebarments( { borrowernumber => $borrowernumber } );
 358                    foreach my $debarment (@$debarrments) {
 359                       DelDebarment( $debarment->{'borrower_debarment_id'} );
 360                    }
 361                 };
 362             }
 363
 364             $infos->{borrowernumber} = $borrowernumber;
 365             eval { Koha::Patrons->find( $borrowernumber )->set($infos)->store; };
 366             if ( $@ ) { # FIXME We could provide better error handling here
 367                 my $patron = Koha::Patrons->find( $borrowernumber );
 368                 $infos->{cardnumber} = $patron ? $patron->cardnumber || '' : '';
 369                 push @errors, { error => "can_not_update", borrowernumber => $infos->{borrowernumber}, cardnumber => $infos->{cardnumber} };
 370             }
 371         }
 372
 373         my $patron = Koha::Patrons->find( $borrowernumber );
 374         my $i=0;
 375         for ( @attributes ) {
 376             next unless $_;
 377             my $attribute;
 378             $attribute->{code} = $_;
 379             $attribute->{attribute} = $attr_values[$i];
 380             my $attr_type = Koha::Patron::Attribute::Types->find($_);
 381             # If this borrower is not in the category of this attribute, we don't want to modify this attribute
 382             ++$i and next if $attr_type->category_code and $attr_type->category_code ne $patron->categorycode;
 383             my $valuename = "attr" . $i . "_value";
 384             if ( grep { $_ eq $valuename } @disabled ) {
 385                 # The attribute is disabled, we remove it for this borrower !
 386                 eval {
 387                     $patron->get_extended_attribute($attribute->{code})->delete;
 388                 };
 389                 push @errors, { error => $@ } if $@;
 390             } else {
 391                 eval {
 392                     # Note:
 393                     # We should not need to filter by branch, but stay on the safe side
 394                     # Repeatable are not supported so we can do that - TODO
 395                     $patron->extended_attributes->search({'me.code' => $attribute->{code}})->filter_by_branch_limitations->delete;
 396                     $patron->add_extended_attribute($attribute);
 397                 };
 398                 push @errors, { error => $@ } if $@;
 399             }
 400             $i++;
 401         }
 402     }
 403     $op = "show_results"; # We have process modifications, the user want to view its
 404
 405     # Construct the results list
 406     my @borrowers;
 407     my $max_nb_attr = 0;
 408     for my $borrowernumber ( @borrowernumbers ) {
 409         my $patron = Koha::Patrons->find( $borrowernumber );
 410         if ( $patron ) {
 411             my $category_description = $patron->category->description;
 412             my $borrower = $patron->unblessed;
 413             $borrower->{category_description} = $category_description;
 414             my $attributes = $patron->extended_attributes;
 415             $borrower->{patron_attributes} = $attributes->as_list;
 416             $max_nb_attr = $attributes->count if $attributes->count > $max_nb_attr;
 417             push @borrowers, $borrower;
 418         }
 419     }
 420     my @patron_attributes_option;
 421     for my $borrower ( @borrowers ) {
 422         push @patron_attributes_option, { value => "$_->{code}", lib => $_->{code} } for @{ $borrower->{patron_attributes} };
 423         my $length = scalar( @{ $borrower->{patron_attributes} } );
 424         push @{ $borrower->{patron_attributes} }, {} for ( $length .. $max_nb_attr - 1);
 425     }
 426
 427     my @attributes_header = ();
 428     for ( 1 .. scalar( $max_nb_attr ) ) {
 429         push @attributes_header, { attribute => "Attributes $_" };
 430     }
 431
 432     $template->param( borrowers => \@borrowers );
 433     $template->param( attributes_header => \@attributes_header );
 434
 435     $template->param( errors => \@errors );
 436 } else {
 437
 438     $template->param( patron_lists => [ GetPatronLists() ] );
 439 }
 440
 441 $template->param(
 442     op => $op,
 443 );
 444 output_html_with_http_headers $input, $cookie, $template->output;
 445 exit;