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
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.
22 Koha::NorwegianPatronDB
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:
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.)
56 use C4
::Members
::Attributes
qw( UpdateBorrowerAttribute );
59 use Digest
::SHA
qw( sha256_hex );
64 use version
; our $VERSION = qv
('1.0.0');
66 our %EXPORT_TAGS = ( all
=> [qw(
77 NLGetSyncDataFromBorrowernumber
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.
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;
103 =head2 NLCheckSysprefs
105 Check that sysprefs relevant to NL are set.
109 sub NLCheckSysprefs
{
118 # Check that the Norwegian national paron database is enabled
119 if ( C4
::Context
->preference("NorwegianPatronDBEnable") == 1 ) {
120 $response->{ 'nlenabled' } = 1;
122 $response->{ 'error' } = 1;
125 # Check that an endpoint is specified
126 if ( C4
::Context
->preference("NorwegianPatronDBEndpoint") ne '' ) {
127 $response->{ 'endpoint' } = 1;
129 $response->{ 'error' } = 1;
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;
136 $response->{ 'error' } = 1;
145 Search the NL patron database.
147 SOAP call: "hent" (fetch)
153 my ( $identifier ) = @_;
155 my $client = SOAP
::Lite
156 ->on_action( sub { return '""';})
158 ->proxy( C4
::Context
->preference("NorwegianPatronDBEndpoint") );
160 my $id = SOAP
::Data
->type('string');
161 $id->name('identifikator');
162 $id->value( $identifier );
163 my $som = $client->hent( $id );
171 Sync a patron that has been changed or created in Koha "upstream" to NL.
173 Input is a hashref with one of two possible elements, either a patron retrieved
176 my $result = NLSync({ 'patron' => $borrower_from_dbic });
178 or a plain old borrowernumber:
180 my $result = NLSync({ 'borrowernumber' => $borrowernumber });
182 In the latter case, this function will retrieve the patron record from the
185 Which part of the API is called depends on the value of the "syncstatus" column:
189 =item * B<new> = The I<nyPost> ("new record") method is called.
191 =item * B<edited> = The I<endre> ("change/update") method is called.
193 =item * B<delete> = The I<slett> ("delete") method is called.
197 Required values for B<new> and B<edited>:
201 =item * sist_endret (last updated)
203 =item * adresse, postnr eller sted (address, zip or city)
205 =item * fdato (birthdate)
207 =item * fnr_hash (social security number, but not hashed...)
209 =item * kjonn (gender, M/F)
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'};
226 # There should only be one sync, so we use the first one
227 my @syncs = $patron->borrower_syncs;
229 foreach my $this_sync ( @syncs ) {
230 if ( $this_sync->synctype eq 'norwegianpatrondb' ) {
235 my $client = SOAP
::Lite
236 ->on_action( sub { return '""';})
238 ->proxy( C4
::Context
->preference("NorwegianPatronDBEndpoint") );
240 my $cardnumber = SOAP
::Data
->name( 'lnr' => $patron->cardnumber );
242 # Call the appropriate method based on syncstatus
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 );
252 if ( $sync->syncstatus eq 'delete' ) {
253 $response = $client->slett( $cardnumber );
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 } );
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'} } );
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
278 This is supposed to be executed once per night.
280 SOAP call: soekEndret
286 my ( $from_arg ) = @_;
288 my $client = SOAP
::Lite
289 ->on_action( sub { return '""';})
291 ->proxy( C4
::Context
->preference("NorwegianPatronDBEndpoint") );
294 if ( $from_arg && $from_arg ne '' ) {
295 $from_string = $from_arg;
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(
302 month
=> $dt->month(),
307 time_zone
=> 'Europe/Oslo',
309 $from_string = $from->ymd . "T" . $from->hms;
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
316 # Call the appropriate method based on syncstatus
317 my $som = $client->soekEndret( $timestamp, $max_results, $start_index );
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 );
332 =head2 NLMarkForDeletion
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.
339 sub NLMarkForDeletion
{
341 my ( $borrowernumber ) = @_;
343 my $borrowersync = Koha
::Database
->new->schema->resultset('BorrowerSync')->find({
344 'synctype' => 'norwegianpatrondb',
345 'borrowernumber' => $borrowernumber,
347 return $borrowersync->update( { 'syncstatus' => 'delete' } );
353 Takes a string encoded with AES/ECB/PKCS5PADDING and a 128-bits key, and returns
354 the decoded string as plain text.
356 The key needs to be stored in koha-conf.xml, like so:
371 my $key = C4
::Context
->config( 'nlkey' );
373 # Convert the hash from Base16
374 my $cb = Convert
::BaseN
->new( base
=> 16 );
375 my $decoded_hash = $cb->decode( $hash );
378 my $cipher = Crypt
::GCrypt
->new(
382 padding
=> 'standard', # "This is also known as PKCS#5"
384 $cipher->start( 'decrypting' );
385 $cipher->setkey( $key ); # Must be called after start()
386 my $plaintext = $cipher->decrypt( $decoded_hash );
387 $plaintext .= $cipher->finish;
395 Takes a plain text PIN as argument, returns the encrypted PIN, according to the
398 my $encrypted_pin = NLEncryptPIN( $plain_text_pin );
405 return _encrypt_pin
( $pin );
409 =head2 NLUpdateHashedPIN
415 =item * Borrowernumber
417 =item * Clear text PIN code
421 Hashes the password and saves it in borrower_sync.hashed_pin.
425 sub NLUpdateHashedPIN
{
427 my ( $borrowernumber, $pin ) = @_;
428 my $borrowersync = Koha
::Database
->new->schema->resultset('BorrowerSync')->find({
429 'synctype' => 'norwegianpatrondb',
430 'borrowernumber' => $borrowernumber,
432 return $borrowersync->update({ 'hashed_pin', _encrypt_pin
( $pin ) });
438 Takes a plain text PIN and returns the encrypted version, according to the NL specs.
445 my $key = C4
::Context
->config( 'nlkey' );
448 my $cipher = Crypt
::GCrypt
->new(
452 padding
=> 'standard', # "This is also known as PKCS#5"
454 $cipher->start( 'encrypting' );
455 $cipher->setkey( $key ); # Must be called after start()
456 my $ciphertext = $cipher->encrypt( $pin );
457 $ciphertext .= $cipher->finish;
460 my $cb = Convert
::BaseN
->new( base
=> 16 );
461 my $encoded_ciphertext = $cb->encode( $ciphertext );
463 return $encoded_ciphertext;
467 =head2 NLGetSyncDataFromBorrowernumber
469 Takes a borrowernumber as argument, returns a Koha::Schema::Result::BorrowerSync
472 my $syncdata = NLGetSyncDataFromBorrowernumber( $borrowernumber );
476 sub NLGetSyncDataFromBorrowernumber
{
478 my ( $borrowernumber ) = @_;
479 my $data = Koha
::Database
->new->schema->resultset('BorrowerSync')->find({
480 'synctype' => 'norwegianpatrondb',
481 'borrowernumber' => $borrowernumber,
487 =head2 NLGetFirstname
489 Takes a string like "Surname, Firstname" and returns the "Firstname" part.
491 If there is no comma, the string is returned unaltered.
493 my $firstname = NLGetFirstname( $name );
500 my ( $surname, $firstname ) = _split_name
( $s );
501 if ( $surname eq $s ) {
511 Takes a string like "Surname, Firstname" and returns the "Surname" part.
513 If there is no comma, the string is returned unaltered.
515 my $surname = NLGetSurname( $name );
522 my ( $surname, $firstname ) = _split_name
( $s );
529 Takes a string like "Surname, Firstname" and returns a list of surname and firstname.
531 If there is no comma, the string is returned unaltered.
533 my ( $surname, $firstname ) = _split_name( $name );
541 # Return the string if there is no comma
542 unless ( $s =~ m/,/ ) {
546 my ( $surname, $firstname ) = split /, /, $s;
548 return ( $surname, $firstname );
552 =head2 _format_soap_error
554 Takes a soap result object as input and returns a formatted string containing SOAP error data.
558 sub _format_soap_error
{
562 return join ', ', $result->faultcode, $result->faultstring, $result->faultdetail;
569 =head2 _soap_to_koha_patron
571 Convert a SOAP object of type "Laaner" into a hash that can be sent to AddMember or ModMember.
575 sub _soap_to_kohapatron
{
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' },
612 =head2 _koha_patron_to_soap
614 Convert a patron (in the form of a Koha::Schema::Result::Borrower) into a SOAP
615 object that can be sent to NL.
619 sub _koha_patron_to_soap
{
624 my $patron_attributes = {};
625 foreach my $attribute ( $patron->borrower_attributes ) {
626 $patron_attributes->{ $attribute->code->code } = $attribute->attribute;
629 # There should only be one sync, so we use the first one
630 my @syncs = $patron->borrower_syncs;
631 my $sync = $syncs[0];
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' ),
672 Magnus Enger <digitalutvikling@gmail.com>