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::Members::Attributes;
  34 use C4::Members::AttributeTypes qw/GetAttributeTypes_hashref/;
  35 use C4::Output;
  36 use List::MoreUtils qw /any uniq/;
  37 use Koha::DateUtils qw( dt_from_string );
  38 use Koha::List::Patron;
  39 use Koha::Libraries;
  40 use Koha::Patron::Categories;
  41 use Koha::Patrons;
  42
  43 my $input = new CGI;
  44 my $op = $input->param('op') || 'show_form';
  45 my ( $template, $loggedinuser, $cookie ) = get_template_and_user(
  46     {   template_name   => "tools/modborrowers.tt",
  47         query           => $input,
  48         type            => "intranet",
  49         authnotrequired => 0,
  50         flagsrequired   => { tools => "edit_patrons" },
  51     }
  52 );
  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     my @contentlist;
  69     if ($filefh) {
  70         while ( my $content = <$filefh> ) {
  71             $content =~ s/[\r\n]*$//g;
  72             push @cardnumbers, $content if $content;
  73         }
  74     } elsif ( $patron_list_id ) {
  75         my ($list) = GetPatronLists( { patron_list_id => $patron_list_id } );
  76
  77         @cardnumbers =
  78           $list->patron_list_patrons()->search_related('borrowernumber')
  79           ->get_column('cardnumber')->all();
  80
  81     } else {
  82         if ( my $list = $input->param('cardnumberlist') ) {
  83             push @cardnumbers, split( /\s\n/, $list );
  84         }
  85     }
  86
  87     my $max_nb_attr = 0;
  88     for my $cardnumber ( @cardnumbers ) {
  89         my $borrower = GetBorrowerInfos( cardnumber => $cardnumber );
  90         if ( $borrower ) {
  91             $max_nb_attr = scalar( @{ $borrower->{patron_attributes} } )
  92                 if scalar( @{ $borrower->{patron_attributes} } ) > $max_nb_attr;
  93             push @borrowers, $borrower;
  94         } else {
  95             push @notfoundcardnumbers, $cardnumber;
  96         }
  97     }
  98
  99     # Just for a correct display
 100     for my $borrower ( @borrowers ) {
 101         my $length = scalar( @{ $borrower->{patron_attributes} } );
 102         push @{ $borrower->{patron_attributes} }, {} for ( $length .. $max_nb_attr - 1);
 103     }
 104
 105     # Construct the patron attributes list
 106     my @patron_attributes_values;
 107     my @patron_attributes_codes;
 108     my $patron_attribute_types = C4::Members::AttributeTypes::GetAttributeTypes_hashref('all');
 109     my @patron_categories = Koha::Patron::Categories->search_limited({}, {order_by => ['description']});
 110     for ( values %$patron_attribute_types ) {
 111         my $attr_type = C4::Members::AttributeTypes->fetch( $_->{code} );
 112         # TODO Repeatable attributes are not correctly managed and can cause data lost.
 113         # This should be implemented.
 114         next if $attr_type->{repeatable};
 115         next if $attr_type->{unique_id}; # Don't display patron attributes that must be unqiue
 116         my $options = $attr_type->authorised_value_category
 117             ? GetAuthorisedValues( $attr_type->authorised_value_category )
 118             : undef;
 119         push @patron_attributes_values,
 120             {
 121                 attribute_code => $_->{code},
 122                 options        => $options,
 123             };
 124
 125         my $category_code = $_->{category_code};
 126         my ( $category_lib ) = map {
 127             ( defined $category_code and $_->categorycode eq $category_code ) ? $_->description : ()
 128         } @patron_categories;
 129         push @patron_attributes_codes,
 130             {
 131                 attribute_code => $_->{code},
 132                 attribute_lib  => $_->{description},
 133                 category_lib   => $category_lib,
 134                 type           => $attr_type->authorised_value_category ? 'select' : 'text',
 135             };
 136     }
 137
 138     my @attributes_header = ();
 139     for ( 1 .. scalar( $max_nb_attr ) ) {
 140         push @attributes_header, { attribute => "Attributes $_" };
 141     }
 142     $template->param( borrowers => \@borrowers );
 143     $template->param( attributes_header => \@attributes_header );
 144     @notfoundcardnumbers = map { { cardnumber => $_ } } @notfoundcardnumbers;
 145     $template->param( notfoundcardnumbers => \@notfoundcardnumbers )
 146         if @notfoundcardnumbers;
 147
 148     # Construct drop-down list values
 149     my $branches = Koha::Libraries->search({}, { order_by => ['branchname'] })->unblessed;
 150     my @branches_option;
 151     push @branches_option, { value => $_->{value}, lib => $_->{branchname} } for @$branches;
 152     unshift @branches_option, { value => "", lib => "" };
 153     my @categories_option;
 154     push @categories_option, { value => $_->categorycode, lib => $_->description } for @patron_categories;
 155     unshift @categories_option, { value => "", lib => "" };
 156     my $bsort1 = GetAuthorisedValues("Bsort1");
 157     my @sort1_option;
 158     push @sort1_option, { value => $_->{authorised_value}, lib => $_->{lib} } for @$bsort1;
 159     unshift @sort1_option, { value => "", lib => "" }
 160         if @sort1_option;
 161     my $bsort2 = GetAuthorisedValues("Bsort2");
 162     my @sort2_option;
 163     push @sort2_option, { value => $_->{authorised_value}, lib => $_->{lib} } for @$bsort2;
 164     unshift @sort2_option, { value => "", lib => "" }
 165         if @sort2_option;
 166
 167     my @mandatoryFields = split( /\|/, C4::Context->preference("BorrowerMandatoryField") );
 168
 169     my @fields = (
 170         {
 171             name => "surname",
 172             type => "text",
 173             mandatory => ( grep /surname/, @mandatoryFields ) ? 1 : 0
 174         }
 175         ,
 176         {
 177             name => "firstname",
 178             type => "text",
 179             mandatory => ( grep /firstname/, @mandatoryFields ) ? 1 : 0,
 180         }
 181         ,
 182         {
 183             name => "branchcode",
 184             type => "select",
 185             option => \@branches_option,
 186             mandatory => ( grep /branchcode/, @mandatoryFields ) ? 1 : 0,
 187         }
 188         ,
 189         {
 190             name => "categorycode",
 191             type => "select",
 192             option => \@categories_option,
 193             mandatory => ( grep /categorycode/, @mandatoryFields ) ? 1 : 0,
 194         }
 195         ,
 196         {
 197             name => "city",
 198             type => "text",
 199             mandatory => ( grep /city/, @mandatoryFields ) ? 1 : 0,
 200         }
 201         ,
 202         {
 203             name => "state",
 204             type => "text",
 205             mandatory => ( grep /state/, @mandatoryFields ) ? 1 : 0,
 206         }
 207         ,
 208         {
 209             name => "zipcode",
 210             type => "text",
 211             mandatory => ( grep /zipcode/, @mandatoryFields ) ? 1 : 0,
 212         }
 213         ,
 214         {
 215             name => "country",
 216             type => "text",
 217             mandatory => ( grep /country/, @mandatoryFields ) ? 1 : 0,
 218         }
 219         ,
 220         {
 221             name => "sort1",
 222             type => @sort1_option ? "select" : "text",
 223             option => \@sort1_option,
 224             mandatory => ( grep /sort1/, @mandatoryFields ) ? 1 : 0,
 225         }
 226         ,
 227         {
 228             name => "sort2",
 229             type => @sort2_option ? "select" : "text",
 230             option => \@sort2_option,
 231             mandatory => ( grep /sort2/, @mandatoryFields ) ? 1 : 0,
 232         }
 233         ,
 234         {
 235             name => "dateenrolled",
 236             type => "date",
 237             mandatory => ( grep /dateenrolled/, @mandatoryFields ) ? 1 : 0,
 238         }
 239         ,
 240         {
 241             name => "dateexpiry",
 242             type => "date",
 243             mandatory => ( grep /dateexpiry/, @mandatoryFields ) ? 1 : 0,
 244         }
 245         ,
 246         {
 247             name => "borrowernotes",
 248             type => "text",
 249             mandatory => ( grep /borrowernotes/, @mandatoryFields ) ? 1 : 0,
 250         }
 251         ,
 252         {
 253             name => "opacnote",
 254             type => "text",
 255             mandatory => ( grep /opacnote/, @mandatoryFields ) ? 1 : 0,
 256         }
 257     );
 258
 259     $template->param('patron_attributes_codes', \@patron_attributes_codes);
 260     $template->param('patron_attributes_values', \@patron_attributes_values);
 261
 262     $template->param( fields => \@fields );
 263 }
 264
 265 # Process modifications
 266 if ( $op eq 'do' ) {
 267
 268     my @disabled = $input->multi_param('disable_input');
 269     my $infos;
 270     for my $field ( qw/surname firstname branchcode categorycode city state zipcode country sort1 sort2 dateenrolled dateexpiry borrowernotes opacnote/ ) {
 271         my $value = $input->param($field);
 272         $infos->{$field} = $value if $value;
 273         $infos->{$field} = "" if grep { /^$field$/ } @disabled;
 274     }
 275
 276     for my $field ( qw( dateenrolled dateexpiry ) ) {
 277         $infos->{$field} = dt_from_string($infos->{$field}) if $infos->{$field};
 278     }
 279
 280     my @attributes = $input->multi_param('patron_attributes');
 281     my @attr_values = $input->multi_param('patron_attributes_value');
 282
 283     my @errors;
 284     my @borrowernumbers = $input->multi_param('borrowernumber');
 285     # For each borrower selected
 286     for my $borrowernumber ( @borrowernumbers ) {
 287         # If at least one field are filled, we want to modify the borrower
 288         if ( defined $infos ) {
 289             $infos->{borrowernumber} = $borrowernumber;
 290             my $success = ModMember(%$infos);
 291             if (!$success) {
 292                 my $borrowerinfo = GetBorrowerInfos( borrowernumber => $borrowernumber );
 293                 $infos->{cardnumber} = $borrowerinfo->{cardnumber} || '';
 294                 push @errors, { error => "can_not_update", borrowernumber => $infos->{borrowernumber}, cardnumber => $infos->{cardnumber} };
 295             }
 296         }
 297
 298         my $borrower_categorycode = Koha::Patrons->find( $borrowernumber )->categorycode;
 299         my $i=0;
 300         for ( @attributes ) {
 301             my $attribute;
 302             $attribute->{code} = $_;
 303             $attribute->{attribute} = $attr_values[$i];
 304             my $attr_type = C4::Members::AttributeTypes->fetch( $_ );
 305             # If this borrower is not in the category of this attribute, we don't want to modify this attribute
 306             ++$i and next if $attr_type->{category_code} and $attr_type->{category_code} ne $borrower_categorycode;
 307             my $valuename = "attr" . $i . "_value";
 308             if ( grep { /^$valuename$/ } @disabled ) {
 309                 # The attribute is disabled, we remove it for this borrower !
 310                 eval {
 311                     C4::Members::Attributes::DeleteBorrowerAttribute( $borrowernumber, $attribute );
 312                 };
 313                 push @errors, { error => $@ } if $@;
 314             } else {
 315                 # Attribute's value is empty, we don't want to modify it
 316                 ++$i and next if not $attribute->{attribute};
 317
 318                 eval {
 319                     C4::Members::Attributes::UpdateBorrowerAttribute( $borrowernumber, $attribute );
 320                 };
 321                 push @errors, { error => $@ } if $@;
 322             }
 323             $i++;
 324         }
 325     }
 326     $op = "show_results"; # We have process modifications, the user want to view its
 327
 328     # Construct the results list
 329     my @borrowers;
 330     my $max_nb_attr = 0;
 331     for my $borrowernumber ( @borrowernumbers ) {
 332         my $borrower = GetBorrowerInfos( borrowernumber => $borrowernumber );
 333         if ( $borrower ) {
 334             $max_nb_attr = scalar( @{ $borrower->{patron_attributes} } )
 335                 if scalar( @{ $borrower->{patron_attributes} } ) > $max_nb_attr;
 336             push @borrowers, $borrower;
 337         }
 338     }
 339     my @patron_attributes_option;
 340     for my $borrower ( @borrowers ) {
 341         push @patron_attributes_option, { value => "$_->{code}", lib => $_->{code} } for @{ $borrower->{patron_attributes} };
 342         my $length = scalar( @{ $borrower->{patron_attributes} } );
 343         push @{ $borrower->{patron_attributes} }, {} for ( $length .. $max_nb_attr - 1);
 344     }
 345
 346     my @attributes_header = ();
 347     for ( 1 .. scalar( $max_nb_attr ) ) {
 348         push @attributes_header, { attribute => "Attributes $_" };
 349     }
 350
 351     $template->param( borrowers => \@borrowers );
 352     $template->param( attributes_header => \@attributes_header );
 353
 354     $template->param( borrowers => \@borrowers );
 355     $template->param( errors => \@errors );
 356 } else {
 357
 358     $template->param( patron_lists => [ GetPatronLists() ] );
 359 }
 360
 361 $template->param(
 362     op => $op,
 363 );
 364 output_html_with_http_headers $input, $cookie, $template->output;
 365 exit;
 366
 367 sub GetBorrowerInfos {
 368     my ( %info ) = @_;
 369     my $borrower = Koha::Patrons->find( \%info );
 370     my $catdesc = $borrower->category->description;
 371     if ( $borrower ) {
 372         $borrower = $borrower->unblessed;
 373         for ( qw(dateenrolled dateexpiry) ) {
 374             my $userdate = $borrower->{$_};
 375             unless ($userdate && $userdate ne "0000-00-00" and $userdate ne "9999-12-31") {
 376                 $borrower->{$_} = '';
 377                 next;
 378             }
 379             $borrower->{$_} = $userdate || '';
 380         }
 381         $borrower->{category_description} = $catdesc;
 382         my $attr_loop = C4::Members::Attributes::GetBorrowerAttributes( $borrower->{borrowernumber} );
 383         $borrower->{patron_attributes} = $attr_loop;
 384     }
 385     return $borrower;
 386 }