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