Koha/NorwegianPatronDB.pm

   1 package Koha::NorwegianPatronDB;
   2
   3 # Copyright 2014 Oslo Public Library
   4 #
   5 # This file is part of Koha.
   6 #
   7 # Koha is free software; you can redistribute it and/or modify it under the
   8 # terms of the GNU General Public License as published by the Free Software
   9 # Foundation; either version 3 of the License, or (at your option) any later
  10 # version.
  11 #
  12 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
  13 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
  14 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
  15 #
  16 # You should have received a copy of the GNU General Public License along
  17 # with Koha; if not, write to the Free Software Foundation, Inc.,
  18 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
  19
  20 =head1 NAME
  21
  22 Koha::NorwegianPatronDB
  23
  24 =head1 SYNOPSIS
  25
  26   use Koha::NorwegianPatronDB;
  27
  28 =head1 CONDITIONAL LOADING
  29
  30 This module depends on some Perl modules that have not been marked as required.
  31 This is because the module only will be of interest to Norwegian libraries, and
  32 it seems polite not to bother the rest of the world with these modules. It is
  33 also good practice to check that the module is actually needed before loading
  34 it. So in a NorwegianPatronDB page or script it will be OK to just do:
  35
  36   use Koha::NorwegianPatronDB qw(...);
  37
  38 But in scripts that are also used by others (like e.g. moremember.pl), it will
  39 be polite to only load the module at runtime, if it is needed:
  40
  41   use Module::Load;
  42   if ( C4::Context->preference('NorwegianPatronDBEnable') && C4::Context->preference('NorwegianPatronDBEnable') == 1 ) {
  43       load Koha::NorwegianPatronDB, qw( NLGetSyncDataFromBorrowernumber );
  44   }
  45
  46 (Module::Load::Conditional is used for this in other parts of Koha, but it does
  47 not seem to allow for a list of subroutines to import, so Module::Load looks
  48 like a better candidate.)
  49
  50 =head1 FUNCTIONS
  51
  52 =cut
  53
  54 use Modern::Perl;
  55 use C4::Context;
  56 use C4::Members::Attributes qw( UpdateBorrowerAttribute );
  57 use SOAP::Lite;
  58 use Crypt::GCrypt;
  59 use Digest::SHA qw( sha256_hex );
  60 use Convert::BaseN;
  61 use DateTime;
  62
  63 use base 'Exporter';
  64
  65 our %EXPORT_TAGS = ( all => [qw(
  66         NLCheckSysprefs
  67         NLSearch
  68         NLSync
  69         NLGetChanged
  70         NLMarkForDeletion
  71         NLDecodePin
  72         NLEncryptPIN
  73         NLUpdateHashedPIN
  74         NLGetFirstname
  75         NLGetSurname
  76         NLGetSyncDataFromBorrowernumber
  77 )] );
  78 Exporter::export_ok_tags('all');
  79
  80 my $nl_uri   = 'http://lanekortet.no';
  81
  82 =head2 SOAP::Transport::HTTP::Client::get_basic_credentials
  83
  84 This is included to set the username and password used by SOAP::Lite.
  85
  86 =cut
  87
  88 sub SOAP::Transport::HTTP::Client::get_basic_credentials {
  89     # Library username and password from Base Bibliotek (stored as system preferences)
  90     my $library_username = C4::Context->preference("NorwegianPatronDBUsername");
  91     my $library_password = C4::Context->preference("NorwegianPatronDBPassword");
  92     # Vendor username and password (stored in koha-conf.xml)
  93     my $vendor_username = C4::Context->config( 'nlvendoruser' );
  94     my $vendor_password = C4::Context->config( 'nlvendorpass' );
  95     # Combine usernames and passwords, and encrypt with SHA256
  96     my $combined_username = "$vendor_username-$library_username";
  97     my $combined_password = sha256_hex( "$library_password-$vendor_password" );
  98     return $combined_username => $combined_password;
  99 }
 100
 101 =head2 NLCheckSysprefs
 102
 103 Check that sysprefs relevant to NL are set.
 104
 105 =cut
 106
 107 sub NLCheckSysprefs {
 108
 109     my $response = {
 110         'error'     => 0,
 111         'nlenabled' => 0,
 112         'endpoint'  => 0,
 113         'userpass'  => 0,
 114     };
 115
 116     # Check that the Norwegian national paron database is enabled
 117     if ( C4::Context->preference("NorwegianPatronDBEnable") == 1 ) {
 118         $response->{ 'nlenabled' } = 1;
 119     } else {
 120         $response->{ 'error' } = 1;
 121     }
 122
 123     # Check that an endpoint is specified
 124     if ( C4::Context->preference("NorwegianPatronDBEndpoint") ne '' ) {
 125         $response->{ 'endpoint' } = 1;
 126     } else {
 127         $response->{ 'error' } = 1;
 128     }
 129
 130     # Check that the username and password for the patron database is set
 131     if ( C4::Context->preference("NorwegianPatronDBUsername") ne '' && C4::Context->preference("NorwegianPatronDBPassword") ne '' ) {
 132         $response->{ 'userpass' } = 1;
 133     } else {
 134         $response->{ 'error' } = 1;
 135     }
 136
 137     return $response;
 138
 139 }
 140
 141 =head2 NLSearch
 142
 143 Search the NL patron database.
 144
 145 SOAP call: "hent" (fetch)
 146
 147 =cut
 148
 149 sub NLSearch {
 150
 151     my ( $identifier ) = @_;
 152
 153     my $client = SOAP::Lite
 154         ->on_action( sub { return '""';})
 155         ->uri( $nl_uri )
 156         ->proxy( C4::Context->preference("NorwegianPatronDBEndpoint") );
 157
 158     my $id = SOAP::Data->type('string');
 159     $id->name('identifikator');
 160     $id->value( $identifier );
 161     my $som = $client->hent( $id );
 162
 163     return $som;
 164
 165 }
 166
 167 =head2 NLSync
 168
 169 Sync a patron that has been changed or created in Koha "upstream" to NL.
 170
 171 Input is a hashref with one of two possible elements, either a patron retrieved
 172 from the database:
 173
 174     my $result = NLSync({ 'patron' => $borrower_from_dbic });
 175
 176 or a plain old borrowernumber:
 177
 178     my $result = NLSync({ 'borrowernumber' => $borrowernumber });
 179
 180 In the latter case, this function will retrieve the patron record from the
 181 database using DBIC.
 182
 183 Which part of the API is called depends on the value of the "syncstatus" column:
 184
 185 =over 4
 186
 187 =item * B<new> = The I<nyPost> ("new record") method is called.
 188
 189 =item * B<edited> = The I<endre> ("change/update") method is called.
 190
 191 =item * B<delete> = The I<slett> ("delete") method is called.
 192
 193 =back
 194
 195 Required values for B<new> and B<edited>:
 196
 197 =over 4
 198
 199 =item * sist_endret (last updated)
 200
 201 =item * adresse, postnr eller sted (address, zip or city)
 202
 203 =item * fdato (birthdate)
 204
 205 =item * fnr_hash (social security number, but not hashed...)
 206
 207 =item * kjonn (gender, M/F)
 208
 209 =back
 210
 211 =cut
 212
 213 sub NLSync {
 214
 215     my ( $input ) = @_;
 216
 217     my $patron;
 218     if ( defined $input->{'borrowernumber'} ) {
 219         $patron = Koha::Database->new->schema->resultset('Borrower')->find( $input->{'borrowernumber'} );
 220     } elsif ( defined $input->{'patron'} ) {
 221         $patron = $input->{'patron'};
 222     }
 223
 224     # There should only be one sync, so we use the first one
 225     my @syncs = $patron->borrower_syncs;
 226     my $sync;
 227     foreach my $this_sync ( @syncs ) {
 228         if ( $this_sync->synctype eq 'norwegianpatrondb' ) {
 229             $sync = $this_sync;
 230         }
 231     }
 232
 233     my $client = SOAP::Lite
 234         ->on_action( sub { return '""';})
 235         ->uri( $nl_uri )
 236         ->proxy( C4::Context->preference("NorwegianPatronDBEndpoint") );
 237
 238     my $cardnumber = SOAP::Data->name( 'lnr' => $patron->cardnumber );
 239
 240     # Call the appropriate method based on syncstatus
 241     my $response;
 242     if ( $sync->syncstatus eq 'edited' || $sync->syncstatus eq 'new' ) {
 243         my $soap_patron = _koha_patron_to_soap( $patron );
 244         if ( $sync->syncstatus eq 'edited' ) {
 245             $response = $client->endre( $cardnumber, $soap_patron );
 246         } elsif ( $sync->syncstatus eq 'new' ) {
 247             $response = $client->nyPost( $soap_patron );
 248         }
 249     }
 250     if ( $sync->syncstatus eq 'delete' ) {
 251         $response = $client->slett( $cardnumber );
 252     }
 253
 254     # Update the sync data according to the results
 255     if ( $response->{'status'} && $response->{'status'} == 1 ) {
 256         if ( $sync->syncstatus eq 'delete' ) {
 257             # Turn off any further syncing
 258             $sync->update( { 'sync' => 0 } );
 259         }
 260         # Update the syncstatus to 'synced'
 261         $sync->update( { 'syncstatus' => 'synced' } );
 262         # Update the 'synclast' attribute with the "server time" ("server_tid") returned by the method
 263         $sync->update( { 'lastsync' => $response->{'server_tid'} } );
 264     }
 265     return $response;
 266
 267 }
 268
 269 =head2 NLGetChanged
 270
 271 Fetches patrons from NL that have been changed since a given timestamp. This includes
 272 patrons that have been changed by the library that runs the sync, so we have to
 273 check which library was the last one to change a patron, before we update patrons
 274 locally.
 275
 276 This is supposed to be executed once per night.
 277
 278 SOAP call: soekEndret
 279
 280 =cut
 281
 282 sub NLGetChanged {
 283
 284     my ( $from_arg ) = @_;
 285
 286     my $client = SOAP::Lite
 287         ->on_action( sub { return '""';})
 288         ->uri( $nl_uri )
 289         ->proxy( C4::Context->preference("NorwegianPatronDBEndpoint") );
 290
 291     my $from_string;
 292     if ( $from_arg && $from_arg ne '' ) {
 293         $from_string = $from_arg;
 294     } else {
 295         # Calculate 1 second past midnight of the day before
 296         my $dt = DateTime->now( time_zone => 'Europe/Oslo' );
 297         $dt->subtract( days => 1 );
 298         my $from = DateTime->new(
 299             year       => $dt->year(),
 300             month      => $dt->month(),
 301             day        => $dt->day(),
 302             hour       => 0,
 303             minute     => 0,
 304             second     => 1,
 305             time_zone  => 'Europe/Oslo',
 306         );
 307         $from_string = $from->ymd . "T" . $from->hms;
 308     }
 309
 310     my $timestamp   = SOAP::Data->name( 'tidspunkt'    => $from_string );
 311     my $max_results = SOAP::Data->name( 'max_antall'   => 0 ); # 0 = no limit
 312     my $start_index = SOAP::Data->name( 'start_indeks' => 0 ); # 1 is the first record
 313
 314     # Call the appropriate method based on syncstatus
 315     my $som = $client->soekEndret( $timestamp, $max_results, $start_index );
 316
 317     # Extract and massage patron data
 318     my $result = $som->result;
 319     foreach my $patron ( @{ $result->{'respons_poster'} } ) {
 320         # Only handle patrons that have lnr (barcode) and fnr_hash (social security number)
 321         # Patrons that lack these two have been deleted from NL
 322         if ( $patron->{'lnr'} && $patron->{'fnr_hash'} ) {
 323             push @{ $result->{'kohapatrons'} }, _soap_to_kohapatron( $patron );
 324         }
 325     }
 326     return $result;
 327
 328 }
 329
 330 =head2 NLMarkForDeletion
 331
 332 Mark a borrower for deletion, but do not do the actual deletion. Deleting the
 333 borrower from NL will be done later by the nl-sync-from-koha.pl script.
 334
 335 =cut
 336
 337 sub NLMarkForDeletion {
 338
 339     my ( $borrowernumber ) = @_;
 340
 341     my $borrowersync = Koha::Database->new->schema->resultset('BorrowerSync')->find({
 342         'synctype'       => 'norwegianpatrondb',
 343         'borrowernumber' => $borrowernumber,
 344     });
 345     return $borrowersync->update( { 'syncstatus' => 'delete' } );
 346
 347 }
 348
 349 =head2 NLDecodePin
 350
 351 Takes a string encoded with AES/ECB/PKCS5PADDING and a 128-bits key, and returns
 352 the decoded string as plain text.
 353
 354 The key needs to be stored in koha-conf.xml, like so:
 355
 356 <yazgfs>
 357   ...
 358   <config>
 359     ...
 360     <nlkey>xyz</nlkey>
 361   </config>
 362 </yazgfs>
 363
 364 =cut
 365
 366 sub NLDecodePin {
 367
 368     my ( $hash ) = @_;
 369     my $key = C4::Context->config( 'nlkey' );
 370
 371     # Convert the hash from Base16
 372     my $cb = Convert::BaseN->new( base => 16 );
 373     my $decoded_hash = $cb->decode( $hash );
 374
 375     # Do the decryption
 376     my $cipher = Crypt::GCrypt->new(
 377         type      => 'cipher',
 378         algorithm => 'aes',
 379         mode      => 'ecb',
 380         padding   => 'standard', # "This is also known as PKCS#5"
 381     );
 382     $cipher->start( 'decrypting' );
 383     $cipher->setkey( $key ); # Must be called after start()
 384     my $plaintext  = $cipher->decrypt( $decoded_hash );
 385     $plaintext .= $cipher->finish;
 386
 387     return $plaintext;
 388
 389 }
 390
 391 =head2 NLEncryptPIN
 392
 393 Takes a plain text PIN as argument, returns the encrypted PIN, according to the
 394 NL specs.
 395
 396     my $encrypted_pin = NLEncryptPIN( $plain_text_pin );
 397
 398 =cut
 399
 400 sub NLEncryptPIN {
 401
 402     my ( $pin ) = @_;
 403     return _encrypt_pin( $pin );
 404
 405 }
 406
 407 =head2 NLUpdateHashedPIN
 408
 409 Takes two arguments:
 410
 411 =over 4
 412
 413 =item * Borrowernumber
 414
 415 =item * Clear text PIN code
 416
 417 =back
 418
 419 Hashes the password and saves it in borrower_sync.hashed_pin.
 420
 421 =cut
 422
 423 sub NLUpdateHashedPIN {
 424
 425     my ( $borrowernumber, $pin ) = @_;
 426     my $borrowersync = Koha::Database->new->schema->resultset('BorrowerSync')->find({
 427         'synctype'       => 'norwegianpatrondb',
 428         'borrowernumber' => $borrowernumber,
 429         });
 430     return $borrowersync->update({ 'hashed_pin', _encrypt_pin( $pin ) });
 431
 432 }
 433
 434 =head2 _encrypt_pin
 435
 436 Takes a plain text PIN and returns the encrypted version, according to the NL specs.
 437
 438 =cut
 439
 440 sub _encrypt_pin {
 441
 442     my ( $pin ) = @_;
 443     my $key = C4::Context->config( 'nlkey' );
 444
 445     # Do the encryption
 446     my $cipher = Crypt::GCrypt->new(
 447         type      => 'cipher',
 448         algorithm => 'aes',
 449         mode      => 'ecb',
 450         padding   => 'standard', # "This is also known as PKCS#5"
 451     );
 452     $cipher->start( 'encrypting' );
 453     $cipher->setkey( $key ); # Must be called after start()
 454     my $ciphertext  = $cipher->encrypt( $pin );
 455     $ciphertext .= $cipher->finish;
 456
 457     # Encode as Bas16
 458     my $cb = Convert::BaseN->new( base => 16 );
 459     my $encoded_ciphertext = $cb->encode( $ciphertext );
 460
 461     return $encoded_ciphertext;
 462
 463 }
 464
 465 =head2 NLGetSyncDataFromBorrowernumber
 466
 467 Takes a borrowernumber as argument, returns a Koha::Schema::Result::BorrowerSync
 468 object.
 469
 470     my $syncdata = NLGetSyncDataFromBorrowernumber( $borrowernumber );
 471
 472 =cut
 473
 474 sub NLGetSyncDataFromBorrowernumber {
 475
 476     my ( $borrowernumber ) = @_;
 477     my $data = Koha::Database->new->schema->resultset('BorrowerSync')->find({
 478         'synctype'       => 'norwegianpatrondb',
 479         'borrowernumber' => $borrowernumber,
 480     });
 481     return $data;
 482
 483 }
 484
 485 =head2 NLGetFirstname
 486
 487 Takes a string like "Surname, Firstname" and returns the "Firstname" part.
 488
 489 If there is no comma, the string is returned unaltered.
 490
 491     my $firstname = NLGetFirstname( $name );
 492
 493 =cut
 494
 495 sub NLGetFirstname {
 496
 497     my ( $s ) = @_;
 498     my ( $surname, $firstname ) = _split_name( $s );
 499     if ( $surname eq $s ) {
 500         return $s;
 501     } else {
 502         return $firstname;
 503     }
 504
 505 }
 506
 507 =head2 NLGetSurname
 508
 509 Takes a string like "Surname, Firstname" and returns the "Surname" part.
 510
 511 If there is no comma, the string is returned unaltered.
 512
 513     my $surname = NLGetSurname( $name );
 514
 515 =cut
 516
 517 sub NLGetSurname {
 518
 519     my ( $s ) = @_;
 520     my ( $surname, $firstname ) = _split_name( $s );
 521     return $surname;
 522
 523 }
 524
 525 =head2 _split_name
 526
 527 Takes a string like "Surname, Firstname" and returns a list of surname and firstname.
 528
 529 If there is no comma, the string is returned unaltered.
 530
 531     my ( $surname, $firstname ) = _split_name( $name );
 532
 533 =cut
 534
 535 sub _split_name {
 536
 537     my ( $s ) = @_;
 538
 539     # Return the string if there is no comma
 540     unless ( $s =~ m/,/ ) {
 541         return $s;
 542     }
 543
 544     my ( $surname, $firstname ) = split /, /, $s;
 545
 546     return ( $surname, $firstname );
 547
 548 }
 549
 550 =head2 _format_soap_error
 551
 552 Takes a soap result object as input and returns a formatted string containing SOAP error data.
 553
 554 =cut
 555
 556 sub _format_soap_error {
 557
 558     my ( $result ) = @_;
 559     if ( $result ) {
 560         return join ', ', $result->faultcode, $result->faultstring, $result->faultdetail;
 561     } else {
 562         return 'No result';
 563     }
 564
 565 }
 566
 567 =head2 _soap_to_koha_patron
 568
 569 Convert a SOAP object of type "Laaner" into a hash that can be sent to AddMember or ModMember.
 570
 571 =cut
 572
 573 sub _soap_to_kohapatron {
 574
 575     my ( $soap ) = @_;
 576
 577     return {
 578         'cardnumber'      => $soap->{ 'lnr' },
 579         'surname'         => NLGetSurname(   $soap->{ 'navn' } ),
 580         'firstname'       => NLGetFirstname( $soap->{ 'navn' } ),
 581         'sex'             => $soap->{ 'kjonn' },
 582         'dateofbirth'     => $soap->{ 'fdato' },
 583         'address'         => $soap->{ 'p_adresse1' },
 584         'address2'        => $soap->{ 'p_adresse2' },
 585         'zipcode'         => $soap->{ 'p_postnr' },
 586         'city'            => $soap->{ 'p_sted' },
 587         'country'         => $soap->{ 'p_land' },
 588         'b_address'       => $soap->{ 'm_adresse1' },
 589         'b_address2'      => $soap->{ 'm_adresse2' },
 590         'b_zipcode'       => $soap->{ 'm_postnr' },
 591         'b_city'          => $soap->{ 'm_sted' },
 592         'b_country'       => $soap->{ 'm_land' },
 593         'password'        => $soap->{ 'pin' },
 594         'dateexpiry'      => $soap->{ 'gyldig_til' },
 595         'email'           => $soap->{ 'epost' },
 596         'mobile'          => $soap->{ 'tlf_mobil' },
 597         'phone'           => $soap->{ 'tlf_hjemme' },
 598         'phonepro'        => $soap->{ 'tlf_jobb' },
 599         '_extra'          => { # Data that should not go in the borrowers table
 600             'socsec'         => $soap->{ 'fnr_hash' },
 601             'created'        => $soap->{ 'opprettet' },
 602             'created_by'     => $soap->{ 'opprettet_av' },
 603             'last_change'    => $soap->{ 'sist_endret' },
 604             'last_change_by' => $soap->{ 'sist_endret_av' },
 605         },
 606     };
 607
 608 }
 609
 610 =head2 _koha_patron_to_soap
 611
 612 Convert a patron (in the form of a Koha::Schema::Result::Borrower) into a SOAP
 613 object that can be sent to NL.
 614
 615 =cut
 616
 617 sub _koha_patron_to_soap {
 618
 619     my ( $patron ) = @_;
 620
 621     # Extract attributes
 622     my $patron_attributes = {};
 623     foreach my $attribute ( $patron->borrower_attributes ) {
 624         $patron_attributes->{ $attribute->code->code } = $attribute->attribute;
 625     }
 626
 627     # There should only be one sync, so we use the first one
 628     my @syncs = $patron->borrower_syncs;
 629     my $sync = $syncs[0];
 630
 631     # Create SOAP::Data object
 632     my $soap_patron = SOAP::Data->name(
 633         'post' => \SOAP::Data->value(
 634             SOAP::Data->name( 'lnr'         => $patron->cardnumber ),
 635             SOAP::Data->name( 'fnr_hash'    => $patron_attributes->{ 'fnr' } )->type( 'string' )->type( 'string' ),
 636             SOAP::Data->name( 'navn'        => $patron->surname . ', ' . $patron->firstname    )->type( 'string' ),
 637             SOAP::Data->name( 'sist_endret' => $sync->lastsync      )->type( 'string' ),
 638             SOAP::Data->name( 'kjonn'       => $patron->sex         )->type( 'string' ),
 639             SOAP::Data->name( 'fdato'       => $patron->dateofbirth )->type( 'string' ),
 640             SOAP::Data->name( 'p_adresse1'  => $patron->address     )->type( 'string' ),
 641             SOAP::Data->name( 'p_adresse2'  => $patron->address2    )->type( 'string' ),
 642             SOAP::Data->name( 'p_postnr'    => $patron->zipcode     )->type( 'string' ),
 643             SOAP::Data->name( 'p_sted'      => $patron->city        )->type( 'string' ),
 644             SOAP::Data->name( 'p_land'      => $patron->country     )->type( 'string' ),
 645             SOAP::Data->name( 'm_adresse1'  => $patron->b_address   )->type( 'string' ),
 646             SOAP::Data->name( 'm_adresse2'  => $patron->b_address2  )->type( 'string' ),
 647             SOAP::Data->name( 'm_postnr'    => $patron->b_zipcode   )->type( 'string' ),
 648             SOAP::Data->name( 'm_sted'      => $patron->b_city      )->type( 'string' ),
 649             SOAP::Data->name( 'm_land'      => $patron->b_country   )->type( 'string' ),
 650             # Do not send the PIN code as it has been hashed by Koha, but use the version hashed according to NL
 651             SOAP::Data->name( 'pin'         => $sync->hashed_pin    )->type( 'string' ),
 652             SOAP::Data->name( 'gyldig_til'  => $patron->dateexpiry  )->type( 'string' ),
 653             SOAP::Data->name( 'epost'       => $patron->email       )->type( 'string' ),
 654             SOAP::Data->name( 'tlf_mobil'   => $patron->mobile      )->type( 'string' ),
 655             SOAP::Data->name( 'tlf_hjemme'  => $patron->phone       )->type( 'string' ),
 656             SOAP::Data->name( 'tlf_jobb'    => $patron->phonepro    )->type( 'string' ),
 657         ),
 658     )->type("Laaner");
 659
 660     return $soap_patron;
 661
 662 }
 663
 664 =head1 EXPORT
 665
 666 None by default.
 667
 668 =head1 AUTHOR
 669
 670 Magnus Enger <digitalutvikling@gmail.com>
 671
 672 =cut
 673
 674 1;
 675
 676 __END__