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