our (@ISA,@EXPORT,@EXPORT_OK,$debug);
-use Module::Load::Conditional qw( can_load );
-if ( ! can_load( modules => { 'Koha::NorwegianPatronDB' => undef } ) ) {
- $debug && warn "Unable to load Koha::NorwegianPatronDB";
-}
-
-
BEGIN {
$debug = $ENV{DEBUG} || 0;
require Exporter;
#Modify data
push @EXPORT, qw(
- &ModMember
&changepassword
);
- #Insert data
- push @EXPORT, qw(
- &AddMember
- &AddMember_Auto
- &AddMember_Opac
- );
-
#Check data
push @EXPORT, qw(
&checkuserpassword
- &Generate_Userid
- &fixup_cardnumber
&checkcardnumber
);
}
return ( \%flags );
}
-
-=head2 ModMember
-
- my $success = ModMember(borrowernumber => $borrowernumber,
- [ field => value ]... );
-
-Modify borrower's data. All date fields should ALREADY be in ISO format.
-
-return :
-true on success, or false on failure
-
-=cut
-
-sub ModMember {
- my (%data) = @_;
-
- # trim whitespace from data which has some non-whitespace in it.
- foreach my $field_name (keys(%data)) {
- if ( defined $data{$field_name} && $data{$field_name} =~ /\S/ ) {
- $data{$field_name} =~ s/^\s*|\s*$//g;
- }
- }
-
- # test to know if you must update or not the borrower password
- if (exists $data{password}) {
- if ($data{password} eq '****' or $data{password} eq '') {
- delete $data{password};
- } else {
- if ( C4::Context->preference('NorwegianPatronDBEnable') && C4::Context->preference('NorwegianPatronDBEnable') == 1 ) {
- # Update the hashed PIN in borrower_sync.hashed_pin, before Koha hashes it
- Koha::NorwegianPatronDB::NLUpdateHashedPIN( $data{'borrowernumber'}, $data{password} );
- }
- $data{password} = hash_password($data{password});
- }
- }
-
- my $old_categorycode = Koha::Patrons->find( $data{borrowernumber} )->categorycode;
-
- # get only the columns of a borrower
- my $schema = Koha::Database->new()->schema;
- my @columns = $schema->source('Borrower')->columns;
- my $new_borrower = { map { join(' ', @columns) =~ /$_/ ? ( $_ => $data{$_} ) : () } keys(%data) };
-
- $new_borrower->{dateofbirth} ||= undef if exists $new_borrower->{dateofbirth};
- $new_borrower->{dateenrolled} ||= undef if exists $new_borrower->{dateenrolled};
- $new_borrower->{dateexpiry} ||= undef if exists $new_borrower->{dateexpiry};
- $new_borrower->{debarred} ||= undef if exists $new_borrower->{debarred};
- $new_borrower->{sms_provider_id} ||= undef if exists $new_borrower->{sms_provider_id};
- $new_borrower->{guarantorid} ||= undef if exists $new_borrower->{guarantorid};
-
- my $patron = Koha::Patrons->find( $new_borrower->{borrowernumber} );
-
- my $borrowers_log = C4::Context->preference("BorrowersLog");
- if ( $borrowers_log && $patron->cardnumber ne $new_borrower->{cardnumber} )
- {
- logaction(
- "MEMBERS",
- "MODIFY",
- $data{'borrowernumber'},
- to_json(
- {
- cardnumber_replaced => {
- previous_cardnumber => $patron->cardnumber,
- new_cardnumber => $new_borrower->{cardnumber},
- }
- },
- { utf8 => 1, pretty => 1 }
- )
- );
- }
-
- delete $new_borrower->{userid} if exists $new_borrower->{userid} and not $new_borrower->{userid};
-
- my $execute_success = $patron->store if $patron->set($new_borrower);
-
- if ($execute_success) { # only proceed if the update was a success
- # If the patron changes to a category with enrollment fee, we add a fee
- if ( $data{categorycode} and $data{categorycode} ne $old_categorycode ) {
- if ( C4::Context->preference('FeeOnChangePatronCategory') ) {
- $patron->add_enrolment_fee_if_needed;
- }
- }
-
- # If NorwegianPatronDBEnable is enabled, we set syncstatus to something that a
- # cronjob will use for syncing with NL
- if ( C4::Context->preference('NorwegianPatronDBEnable') && C4::Context->preference('NorwegianPatronDBEnable') == 1 ) {
- my $borrowersync = Koha::Database->new->schema->resultset('BorrowerSync')->find({
- 'synctype' => 'norwegianpatrondb',
- 'borrowernumber' => $data{'borrowernumber'}
- });
- # Do not set to "edited" if syncstatus is "new". We need to sync as new before
- # we can sync as changed. And the "new sync" will pick up all changes since
- # the patron was created anyway.
- if ( $borrowersync->syncstatus ne 'new' && $borrowersync->syncstatus ne 'delete' ) {
- $borrowersync->update( { 'syncstatus' => 'edited' } );
- }
- # Set the value of 'sync'
- $borrowersync->update( { 'sync' => $data{'sync'} } );
- # Try to do the live sync
- Koha::NorwegianPatronDB::NLSync({ 'borrowernumber' => $data{'borrowernumber'} });
- }
-
- logaction("MEMBERS", "MODIFY", $data{'borrowernumber'}, "UPDATE (executed w/ arg: $data{'borrowernumber'})") if $borrowers_log;
- }
- return $execute_success;
-}
-
-=head2 AddMember
-
- $borrowernumber = &AddMember(%borrower);
-
-insert new borrower into table
-
-(%borrower keys are database columns. Database columns could be
-different in different versions. Please look into database for correct
-column names.)
-
-Returns the borrowernumber upon success
-
-Returns as undef upon any db error without further processing
-
-=cut
-
-#'
-sub AddMember {
- my (%data) = @_;
- my $dbh = C4::Context->dbh;
- my $schema = Koha::Database->new()->schema;
-
- my $category = Koha::Patron::Categories->find( $data{categorycode} );
- unless ($category) {
- Koha::Exceptions::BadParameter->throw(
- error => 'Invalid parameter passed',
- parameter => 'categorycode'
- );
- }
-
- # trim whitespace from data which has some non-whitespace in it.
- foreach my $field_name (keys(%data)) {
- if ( defined $data{$field_name} && $data{$field_name} =~ /\S/ ) {
- $data{$field_name} =~ s/^\s*|\s*$//g;
- }
- }
-
- my $p = Koha::Patron->new( { userid => $data{userid}, firstname => $data{firstname}, surname => $data{surname} } );
- # generate a proper login if none provided
- $data{'userid'} = $p->generate_userid
- if ( $data{'userid'} eq '' || ! $p->has_valid_userid );
-
- # add expiration date if it isn't already there
- $data{dateexpiry} ||= $category->get_expiry_date;
-
- # add enrollment date if it isn't already there
- unless ( $data{'dateenrolled'} ) {
- $data{'dateenrolled'} = output_pref( { dt => dt_from_string, dateonly => 1, dateformat => 'iso' } );
- }
-
- if ( C4::Context->preference("autoMemberNum") ) {
- if ( not exists $data{cardnumber} or not defined $data{cardnumber} or $data{cardnumber} eq '' ) {
- $data{cardnumber} = fixup_cardnumber( $data{cardnumber} );
- }
- }
-
- $data{'privacy'} =
- $category->default_privacy() eq 'default' ? 1
- : $category->default_privacy() eq 'never' ? 2
- : $category->default_privacy() eq 'forever' ? 0
- : undef;
-
- $data{'privacy_guarantor_checkouts'} = 0 unless defined( $data{'privacy_guarantor_checkouts'} );
-
- # Make a copy of the plain text password for later use
- my $plain_text_password = $data{'password'};
-
- # create a disabled account if no password provided
- $data{'password'} = ($data{'password'})? hash_password($data{'password'}) : '!';
-
- # we don't want invalid dates in the db (mysql has a bad habit of inserting 0000-00-00
- $data{'dateofbirth'} = undef if ( not $data{'dateofbirth'} );
- $data{'debarred'} = undef if ( not $data{'debarred'} );
- $data{'sms_provider_id'} = undef if ( not $data{'sms_provider_id'} );
- $data{'guarantorid'} = undef if ( not $data{'guarantorid'} );
-
- # get only the columns of Borrower
- # FIXME Do we really need this check?
- my @columns = $schema->source('Borrower')->columns;
- my $new_member = { map { join(' ',@columns) =~ /$_/ ? ( $_ => $data{$_} ) : () } keys(%data) } ;
-
- delete $new_member->{borrowernumber};
-
- my $patron = Koha::Patron->new( $new_member )->store;
- $data{borrowernumber} = $patron->borrowernumber;
-
- # If NorwegianPatronDBEnable is enabled, we set syncstatus to something that a
- # cronjob will use for syncing with NL
- if ( exists $data{'borrowernumber'} && C4::Context->preference('NorwegianPatronDBEnable') && C4::Context->preference('NorwegianPatronDBEnable') == 1 ) {
- Koha::Database->new->schema->resultset('BorrowerSync')->create({
- 'borrowernumber' => $data{'borrowernumber'},
- 'synctype' => 'norwegianpatrondb',
- 'sync' => 1,
- 'syncstatus' => 'new',
- 'hashed_pin' => Koha::NorwegianPatronDB::NLEncryptPIN( $plain_text_password ),
- });
- }
-
- logaction("MEMBERS", "CREATE", $data{'borrowernumber'}, "") if C4::Context->preference("BorrowersLog");
-
- $patron->add_enrolment_fee_if_needed;
-
- return $data{borrowernumber};
-}
-
-=head2 Generate_Userid
-
- my $newuid = Generate_Userid($borrowernumber, $firstname, $surname);
-
- Generate a userid using the $surname and the $firstname (if there is a value in $firstname).
-
- $borrowernumber is optional (i.e. it can contain a blank value). A value is passed when generating a new userid for an existing borrower. When a new userid is created for a new borrower, a blank value is passed to this sub.
-
- return :
- new userid ($firstname.$surname if there is a $firstname, or $surname if there is no value in $firstname) plus offset (0 if the $newuid is unique, or a higher numeric value if not unique).
-
-=cut
-
-sub Generate_Userid {
- my ($borrowernumber, $firstname, $surname) = @_;
- my $newuid;
- my $offset = 0;
- my $patron = Koha::Patron->new;
- #The script will "do" the following code and increment the $offset until the generated userid is unique
- do {
- $firstname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
- $surname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
- $newuid = lc(($firstname)? "$firstname.$surname" : $surname);
- $newuid = unac_string('utf-8',$newuid);
- $newuid .= $offset unless $offset == 0;
- $patron->userid( $newuid );
- $offset++;
- } while (! $patron->has_valid_userid );
-
- return $newuid;
-}
-
-=head2 fixup_cardnumber
-
-Warning: The caller is responsible for locking the members table in write
-mode, to avoid database corruption.
-
-=cut
-
-sub fixup_cardnumber {
- my ($cardnumber) = @_;
- my $autonumber_members = C4::Context->boolean_preference('autoMemberNum') || 0;
-
- # Find out whether member numbers should be generated
- # automatically. Should be either "1" or something else.
- # Defaults to "0", which is interpreted as "no".
-
- ($autonumber_members) or return $cardnumber;
- my $dbh = C4::Context->dbh;
-
- my $sth = $dbh->prepare(
- 'SELECT MAX( CAST( cardnumber AS SIGNED ) ) FROM borrowers WHERE cardnumber REGEXP "^-?[0-9]+$"'
- );
- $sth->execute;
- my ($result) = $sth->fetchrow;
- return $result + 1;
-}
-
=head2 GetAllIssues
$issues = &GetAllIssues($borrowernumber, $sortkey, $limit);
);
}
-=head2 AddMember_Auto
-
-=cut
-
-sub AddMember_Auto {
- my ( %borrower ) = @_;
-
- $borrower{'cardnumber'} ||= fixup_cardnumber();
-
- $borrower{'borrowernumber'} = AddMember(%borrower);
-
- return ( %borrower );
-}
-
-=head2 AddMember_Opac
-
-=cut
-
-sub AddMember_Opac {
- my ( %borrower ) = @_;
-
- $borrower{'categorycode'} //= C4::Context->preference('PatronSelfRegistrationDefaultCategory');
- if (not defined $borrower{'password'}){
- my $sr = new String::Random;
- $sr->{'A'} = [ 'A'..'Z', 'a'..'z' ];
- my $password = $sr->randpattern("AAAAAAAAAA");
- $borrower{'password'} = $password;
- }
-
- %borrower = AddMember_Auto(%borrower);
-
- return ( $borrower{'borrowernumber'}, $borrower{'password'} );
-}
-
=head2 DeleteExpiredOpacRegistrations
Delete accounts that haven't been upgraded from the 'temporary' category
projects / koha.git / blobdiff