Bug 15036: Do not overwrite complete status in basket ops
[koha.git] / Koha / NorwegianPatronDB.pm
blob585dfd21546148cf29ae329778933a5bff73bb17
1 package Koha::NorwegianPatronDB;
3 # Copyright 2014 Oslo Public Library
5 # This file is part of Koha.
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.
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.
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.
20 =head1 NAME
22 Koha::NorwegianPatronDB
24 =head1 SYNOPSIS
26 use Koha::NorwegianPatronDB;
28 =head1 CONDITIONAL LOADING
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:
36 use Koha::NorwegianPatronDB qw(...);
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:
41 use Module::Load;
42 if ( C4::Context->preference('NorwegianPatronDBEnable') && C4::Context->preference('NorwegianPatronDBEnable') == 1 ) {
43 load Koha::NorwegianPatronDB, qw( NLGetSyncDataFromBorrowernumber );
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.)
50 =head1 FUNCTIONS
52 =cut
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;
63 use base 'Exporter';
64 use version; our $VERSION = qv('1.0.0');
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');
81 my $nl_uri = 'http://lanekortet.no';
83 =head2 SOAP::Transport::HTTP::Client::get_basic_credentials
85 This is included to set the username and password used by SOAP::Lite.
87 =cut
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;
102 =head2 NLCheckSysprefs
104 Check that sysprefs relevant to NL are set.
106 =cut
108 sub NLCheckSysprefs {
110 my $response = {
111 'error' => 0,
112 'nlenabled' => 0,
113 'endpoint' => 0,
114 'userpass' => 0,
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;
124 # Check that an endpoint is specified
125 if ( C4::Context->preference("NorwegianPatronDBEndpoint") ne '' ) {
126 $response->{ 'endpoint' } = 1;
127 } else {
128 $response->{ 'error' } = 1;
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;
138 return $response;
142 =head2 NLSearch
144 Search the NL patron database.
146 SOAP call: "hent" (fetch)
148 =cut
150 sub NLSearch {
152 my ( $identifier ) = @_;
154 my $client = SOAP::Lite
155 ->on_action( sub { return '""';})
156 ->uri( $nl_uri )
157 ->proxy( C4::Context->preference("NorwegianPatronDBEndpoint") );
159 my $id = SOAP::Data->type('string');
160 $id->name('identifikator');
161 $id->value( $identifier );
162 my $som = $client->hent( $id );
164 return $som;
168 =head2 NLSync
170 Sync a patron that has been changed or created in Koha "upstream" to NL.
172 Input is a hashref with one of two possible elements, either a patron retrieved
173 from the database:
175 my $result = NLSync({ 'patron' => $borrower_from_dbic });
177 or a plain old borrowernumber:
179 my $result = NLSync({ 'borrowernumber' => $borrowernumber });
181 In the latter case, this function will retrieve the patron record from the
182 database using DBIC.
184 Which part of the API is called depends on the value of the "syncstatus" column:
186 =over 4
188 =item * B<new> = The I<nyPost> ("new record") method is called.
190 =item * B<edited> = The I<endre> ("change/update") method is called.
192 =item * B<delete> = The I<slett> ("delete") method is called.
194 =back
196 Required values for B<new> and B<edited>:
198 =over 4
200 =item * sist_endret (last updated)
202 =item * adresse, postnr eller sted (address, zip or city)
204 =item * fdato (birthdate)
206 =item * fnr_hash (social security number, but not hashed...)
208 =item * kjonn (gender, M/F)
210 =back
212 =cut
214 sub NLSync {
216 my ( $input ) = @_;
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'};
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;
234 my $client = SOAP::Lite
235 ->on_action( sub { return '""';})
236 ->uri( $nl_uri )
237 ->proxy( C4::Context->preference("NorwegianPatronDBEndpoint") );
239 my $cardnumber = SOAP::Data->name( 'lnr' => $patron->cardnumber );
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 );
251 if ( $sync->syncstatus eq 'delete' ) {
252 $response = $client->slett( $cardnumber );
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 } );
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'} } );
266 return $response;
270 =head2 NLGetChanged
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.
277 This is supposed to be executed once per night.
279 SOAP call: soekEndret
281 =cut
283 sub NLGetChanged {
285 my ( $from_arg ) = @_;
287 my $client = SOAP::Lite
288 ->on_action( sub { return '""';})
289 ->uri( $nl_uri )
290 ->proxy( C4::Context->preference("NorwegianPatronDBEndpoint") );
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',
308 $from_string = $from->ymd . "T" . $from->hms;
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
315 # Call the appropriate method based on syncstatus
316 my $som = $client->soekEndret( $timestamp, $max_results, $start_index );
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 );
327 return $result;
331 =head2 NLMarkForDeletion
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.
336 =cut
338 sub NLMarkForDeletion {
340 my ( $borrowernumber ) = @_;
342 my $borrowersync = Koha::Database->new->schema->resultset('BorrowerSync')->find({
343 'synctype' => 'norwegianpatrondb',
344 'borrowernumber' => $borrowernumber,
346 return $borrowersync->update( { 'syncstatus' => 'delete' } );
350 =head2 NLDecodePin
352 Takes a string encoded with AES/ECB/PKCS5PADDING and a 128-bits key, and returns
353 the decoded string as plain text.
355 The key needs to be stored in koha-conf.xml, like so:
357 <yazgfs>
359 <config>
361 <nlkey>xyz</nlkey>
362 </config>
363 </yazgfs>
365 =cut
367 sub NLDecodePin {
369 my ( $hash ) = @_;
370 my $key = C4::Context->config( 'nlkey' );
372 # Convert the hash from Base16
373 my $cb = Convert::BaseN->new( base => 16 );
374 my $decoded_hash = $cb->decode( $hash );
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"
383 $cipher->start( 'decrypting' );
384 $cipher->setkey( $key ); # Must be called after start()
385 my $plaintext = $cipher->decrypt( $decoded_hash );
386 $plaintext .= $cipher->finish;
388 return $plaintext;
392 =head2 NLEncryptPIN
394 Takes a plain text PIN as argument, returns the encrypted PIN, according to the
395 NL specs.
397 my $encrypted_pin = NLEncryptPIN( $plain_text_pin );
399 =cut
401 sub NLEncryptPIN {
403 my ( $pin ) = @_;
404 return _encrypt_pin( $pin );
408 =head2 NLUpdateHashedPIN
410 Takes two arguments:
412 =over 4
414 =item * Borrowernumber
416 =item * Clear text PIN code
418 =back
420 Hashes the password and saves it in borrower_sync.hashed_pin.
422 =cut
424 sub NLUpdateHashedPIN {
426 my ( $borrowernumber, $pin ) = @_;
427 my $borrowersync = Koha::Database->new->schema->resultset('BorrowerSync')->find({
428 'synctype' => 'norwegianpatrondb',
429 'borrowernumber' => $borrowernumber,
431 return $borrowersync->update({ 'hashed_pin', _encrypt_pin( $pin ) });
435 =head2 _encrypt_pin
437 Takes a plain text PIN and returns the encrypted version, according to the NL specs.
439 =cut
441 sub _encrypt_pin {
443 my ( $pin ) = @_;
444 my $key = C4::Context->config( 'nlkey' );
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"
453 $cipher->start( 'encrypting' );
454 $cipher->setkey( $key ); # Must be called after start()
455 my $ciphertext = $cipher->encrypt( $pin );
456 $ciphertext .= $cipher->finish;
458 # Encode as Bas16
459 my $cb = Convert::BaseN->new( base => 16 );
460 my $encoded_ciphertext = $cb->encode( $ciphertext );
462 return $encoded_ciphertext;
466 =head2 NLGetSyncDataFromBorrowernumber
468 Takes a borrowernumber as argument, returns a Koha::Schema::Result::BorrowerSync
469 object.
471 my $syncdata = NLGetSyncDataFromBorrowernumber( $borrowernumber );
473 =cut
475 sub NLGetSyncDataFromBorrowernumber {
477 my ( $borrowernumber ) = @_;
478 my $data = Koha::Database->new->schema->resultset('BorrowerSync')->find({
479 'synctype' => 'norwegianpatrondb',
480 'borrowernumber' => $borrowernumber,
482 return $data;
486 =head2 NLGetFirstname
488 Takes a string like "Surname, Firstname" and returns the "Firstname" part.
490 If there is no comma, the string is returned unaltered.
492 my $firstname = NLGetFirstname( $name );
494 =cut
496 sub NLGetFirstname {
498 my ( $s ) = @_;
499 my ( $surname, $firstname ) = _split_name( $s );
500 if ( $surname eq $s ) {
501 return $s;
502 } else {
503 return $firstname;
508 =head2 NLGetSurname
510 Takes a string like "Surname, Firstname" and returns the "Surname" part.
512 If there is no comma, the string is returned unaltered.
514 my $surname = NLGetSurname( $name );
516 =cut
518 sub NLGetSurname {
520 my ( $s ) = @_;
521 my ( $surname, $firstname ) = _split_name( $s );
522 return $surname;
526 =head2 _split_name
528 Takes a string like "Surname, Firstname" and returns a list of surname and firstname.
530 If there is no comma, the string is returned unaltered.
532 my ( $surname, $firstname ) = _split_name( $name );
534 =cut
536 sub _split_name {
538 my ( $s ) = @_;
540 # Return the string if there is no comma
541 unless ( $s =~ m/,/ ) {
542 return $s;
545 my ( $surname, $firstname ) = split /, /, $s;
547 return ( $surname, $firstname );
551 =head2 _format_soap_error
553 Takes a soap result object as input and returns a formatted string containing SOAP error data.
555 =cut
557 sub _format_soap_error {
559 my ( $result ) = @_;
560 if ( $result ) {
561 return join ', ', $result->faultcode, $result->faultstring, $result->faultdetail;
562 } else {
563 return 'No result';
568 =head2 _soap_to_koha_patron
570 Convert a SOAP object of type "Laaner" into a hash that can be sent to AddMember or ModMember.
572 =cut
574 sub _soap_to_kohapatron {
576 my ( $soap ) = @_;
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' },
611 =head2 _koha_patron_to_soap
613 Convert a patron (in the form of a Koha::Schema::Result::Borrower) into a SOAP
614 object that can be sent to NL.
616 =cut
618 sub _koha_patron_to_soap {
620 my ( $patron ) = @_;
622 # Extract attributes
623 my $patron_attributes = {};
624 foreach my $attribute ( $patron->borrower_attributes ) {
625 $patron_attributes->{ $attribute->code->code } = $attribute->attribute;
628 # There should only be one sync, so we use the first one
629 my @syncs = $patron->borrower_syncs;
630 my $sync = $syncs[0];
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' ),
659 )->type("Laaner");
661 return $soap_patron;
665 =head1 EXPORT
667 None by default.
669 =head1 AUTHOR
671 Magnus Enger <digitalutvikling@gmail.com>
673 =cut
677 __END__