C4/OAI/Sets.pm

   1 package C4::OAI::Sets;
   2
   3 # Copyright 2011 BibLibre
   4 #
   5 # This file is part of Koha.
   6 #
   7 # Koha is free software; you can redistribute it and/or modify it
   8 # under the terms of the GNU General Public License as published by
   9 # the Free Software Foundation; either version 3 of the License, or
  10 # (at your option) any later version.
  11 #
  12 # Koha is distributed in the hope that it will be useful, but
  13 # WITHOUT ANY WARRANTY; without even the implied warranty of
  14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  15 # GNU General Public License for more details.
  16 #
  17 # You should have received a copy of the GNU General Public License
  18 # along with Koha; if not, see <http://www.gnu.org/licenses>.
  19
  20 =head1 NAME
  21
  22 C4::OAI::Sets - OAI Sets management functions
  23
  24 =head1 DESCRIPTION
  25
  26 C4::OAI::Sets contains functions for managing storage and editing of OAI Sets.
  27
  28 OAI Set description can be found L<here|http://www.openarchives.org/OAI/openarchivesprotocol.html#Set>
  29
  30 =cut
  31
  32 use Modern::Perl;
  33 use C4::Context;
  34 use Koha::Biblio::Metadata;
  35
  36 use vars qw(@ISA @EXPORT);
  37
  38 BEGIN {
  39     require Exporter;
  40     @ISA = qw(Exporter);
  41     @EXPORT = qw(
  42         GetOAISets GetOAISet GetOAISetBySpec ModOAISet DelOAISet AddOAISet
  43         GetOAISetsMappings GetOAISetMappings ModOAISetMappings
  44         GetOAISetsBiblio ModOAISetsBiblios AddOAISetsBiblios
  45         CalcOAISetsBiblio UpdateOAISetsBiblio DelOAISetsBiblio
  46     );
  47 }
  48
  49 =head1 FUNCTIONS
  50
  51 =head2 GetOAISets
  52
  53     $oai_sets = GetOAISets;
  54
  55 GetOAISets return a array reference of hash references describing the sets.
  56 The hash references looks like this:
  57
  58     {
  59         'name'         => 'set name',
  60         'spec'         => 'set spec',
  61         'descriptions' => [
  62             'description 1',
  63             'description 2',
  64             ...
  65         ]
  66     }
  67
  68 =cut
  69
  70 sub GetOAISets {
  71     my $dbh = C4::Context->dbh;
  72     my $query = qq{
  73         SELECT * FROM oai_sets
  74     };
  75     my $sth = $dbh->prepare($query);
  76     $sth->execute;
  77     my $results = $sth->fetchall_arrayref({});
  78
  79     $query = qq{
  80         SELECT description
  81         FROM oai_sets_descriptions
  82         WHERE set_id = ?
  83     };
  84     $sth = $dbh->prepare($query);
  85     foreach my $set (@$results) {
  86         $sth->execute($set->{'id'});
  87         my $desc = $sth->fetchall_arrayref({});
  88         foreach (@$desc) {
  89             push @{$set->{'descriptions'}}, $_->{'description'};
  90         }
  91     }
  92
  93     return $results;
  94 }
  95
  96 =head2 GetOAISet
  97
  98     $set = GetOAISet($set_id);
  99
 100 GetOAISet returns a hash reference describing the set with the given set_id.
 101
 102 See GetOAISets to see what the hash looks like.
 103
 104 =cut
 105
 106 sub GetOAISet {
 107     my ($set_id) = @_;
 108
 109     return unless $set_id;
 110
 111     my $dbh = C4::Context->dbh;
 112     my $query = qq{
 113         SELECT *
 114         FROM oai_sets
 115         WHERE id = ?
 116     };
 117     my $sth = $dbh->prepare($query);
 118     $sth->execute($set_id);
 119     my $set = $sth->fetchrow_hashref;
 120
 121     $query = qq{
 122         SELECT description
 123         FROM oai_sets_descriptions
 124         WHERE set_id = ?
 125     };
 126     $sth = $dbh->prepare($query);
 127     $sth->execute($set->{'id'});
 128     my $desc = $sth->fetchall_arrayref({});
 129     foreach (@$desc) {
 130         push @{$set->{'descriptions'}}, $_->{'description'};
 131     }
 132
 133     return $set;
 134 }
 135
 136 =head2 GetOAISetBySpec
 137
 138     my $set = GetOAISetBySpec($setSpec);
 139
 140 Returns a hash describing the set whose spec is $setSpec
 141
 142 =cut
 143
 144 sub GetOAISetBySpec {
 145     my $setSpec = shift;
 146
 147     return unless defined $setSpec;
 148
 149     my $dbh = C4::Context->dbh;
 150     my $query = qq{
 151         SELECT *
 152         FROM oai_sets
 153         WHERE spec = ?
 154         LIMIT 1
 155     };
 156     my $sth = $dbh->prepare($query);
 157     $sth->execute($setSpec);
 158
 159     return $sth->fetchrow_hashref;
 160 }
 161
 162 =head2 ModOAISet
 163
 164     my $set = {
 165         'id' => $set_id,                 # mandatory
 166         'spec' => $spec,                 # mandatory
 167         'name' => $name,                 # mandatory
 168         'descriptions => \@descriptions, # optional, [] to remove descriptions
 169     };
 170     ModOAISet($set);
 171
 172 ModOAISet modify a set in the database.
 173
 174 =cut
 175
 176 sub ModOAISet {
 177     my ($set) = @_;
 178
 179     return unless($set && $set->{'spec'} && $set->{'name'});
 180
 181     if(!defined $set->{'id'}) {
 182         warn "Set ID not defined, can't modify the set";
 183         return;
 184     }
 185
 186     my $dbh = C4::Context->dbh;
 187     my $query = qq{
 188         UPDATE oai_sets
 189         SET spec = ?,
 190             name = ?
 191         WHERE id = ?
 192     };
 193     my $sth = $dbh->prepare($query);
 194     $sth->execute($set->{'spec'}, $set->{'name'}, $set->{'id'});
 195
 196     if($set->{'descriptions'}) {
 197         $query = qq{
 198             DELETE FROM oai_sets_descriptions
 199             WHERE set_id = ?
 200         };
 201         $sth = $dbh->prepare($query);
 202         $sth->execute($set->{'id'});
 203
 204         if(scalar @{$set->{'descriptions'}} > 0) {
 205             $query = qq{
 206                 INSERT INTO oai_sets_descriptions (set_id, description)
 207                 VALUES (?,?)
 208             };
 209             $sth = $dbh->prepare($query);
 210             foreach (@{ $set->{'descriptions'} }) {
 211                 $sth->execute($set->{'id'}, $_) if $_;
 212             }
 213         }
 214     }
 215 }
 216
 217 =head2 DelOAISet
 218
 219     DelOAISet($set_id);
 220
 221 DelOAISet remove the set with the given set_id
 222
 223 =cut
 224
 225 sub DelOAISet {
 226     my ($set_id) = @_;
 227
 228     return unless $set_id;
 229
 230     my $dbh = C4::Context->dbh;
 231     my $query = qq{
 232         DELETE oai_sets, oai_sets_descriptions, oai_sets_mappings
 233         FROM oai_sets
 234           LEFT JOIN oai_sets_descriptions ON oai_sets_descriptions.set_id = oai_sets.id
 235           LEFT JOIN oai_sets_mappings ON oai_sets_mappings.set_id = oai_sets.id
 236         WHERE oai_sets.id = ?
 237     };
 238     my $sth = $dbh->prepare($query);
 239     $sth->execute($set_id);
 240 }
 241
 242 =head2 AddOAISet
 243
 244     my $set = {
 245         'id' => $set_id,                 # mandatory
 246         'spec' => $spec,                 # mandatory
 247         'name' => $name,                 # mandatory
 248         'descriptions => \@descriptions, # optional
 249     };
 250     my $set_id = AddOAISet($set);
 251
 252 AddOAISet adds a new set and returns its id, or undef if something went wrong.
 253
 254 =cut
 255
 256 sub AddOAISet {
 257     my ($set) = @_;
 258
 259     return unless($set && $set->{'spec'} && $set->{'name'});
 260
 261     my $set_id;
 262     my $dbh = C4::Context->dbh;
 263     my $query = qq{
 264         INSERT INTO oai_sets (spec, name)
 265         VALUES (?,?)
 266     };
 267     my $sth = $dbh->prepare($query);
 268     if( $sth->execute($set->{'spec'}, $set->{'name'}) ) {
 269         $set_id = $dbh->last_insert_id(undef, undef, 'oai_sets', undef);
 270         if($set->{'descriptions'}) {
 271             $query = qq{
 272                 INSERT INTO oai_sets_descriptions (set_id, description)
 273                 VALUES (?,?)
 274             };
 275             $sth = $dbh->prepare($query);
 276             foreach( @{ $set->{'descriptions'} } ) {
 277                 $sth->execute($set_id, $_) if $_;
 278             }
 279         }
 280     } else {
 281         warn "AddOAISet failed";
 282     }
 283
 284     return $set_id;
 285 }
 286
 287 =head2 GetOAISetsMappings
 288
 289     my $mappings = GetOAISetsMappings;
 290
 291 GetOAISetsMappings returns mappings for all OAI Sets.
 292
 293 Mappings define how biblios are categorized in sets.
 294 A mapping is defined by six properties:
 295
 296     {
 297         marcfield => 'XXX',              # the MARC field to check
 298         marcsubfield => 'Y',             # the MARC subfield to check
 299         operator => 'A',                 # the operator 'equal' or 'notequal'; 'equal' if ''
 300         marcvalue => 'zzzz',             # the value to check
 301         rule_operator => 'and|or|undef', # the operator between the rules
 302         rule_order    => 'n'             # the order of the rule for the mapping
 303     }
 304
 305 If defined in a set mapping, a biblio which have at least one 'Y' subfield of
 306 one 'XXX' field equal to 'zzzz' will belong to this set.
 307
 308 GetOAISetsMappings returns a hashref of arrayrefs of hashrefs.
 309 The first hashref keys are the sets IDs, so it looks like this:
 310
 311     $mappings = {
 312         '1' => [
 313             {
 314                 marcfield => 'XXX',
 315                 marcsubfield => 'Y',
 316                 operator => 'A',
 317                 marcvalue => 'zzzz',
 318                 rule_operator => 'and|or|undef',
 319                 rule_order => 'n'
 320             },
 321             {
 322                 ...
 323             },
 324             ...
 325         ],
 326         '2' => [...],
 327         ...
 328     };
 329
 330 =cut
 331
 332 sub GetOAISetsMappings {
 333     my $dbh = C4::Context->dbh;
 334     my $query = qq{
 335         SELECT * FROM oai_sets_mappings ORDER BY set_id, rule_order
 336     };
 337     my $sth = $dbh->prepare($query);
 338     $sth->execute;
 339
 340     my $mappings = {};
 341     while(my $result = $sth->fetchrow_hashref) {
 342         push @{ $mappings->{$result->{'set_id'}} }, {
 343             marcfield => $result->{'marcfield'},
 344             marcsubfield => $result->{'marcsubfield'},
 345             operator => $result->{'operator'},
 346             marcvalue => $result->{'marcvalue'},
 347             rule_operator => $result->{'rule_operator'},
 348             rule_order => $result->{'rule_order'}
 349         };
 350     }
 351
 352     return $mappings;
 353 }
 354
 355 =head2 GetOAISetMappings
 356
 357     my $set_mappings = GetOAISetMappings($set_id);
 358
 359 Return mappings for the set with given set_id. It's an arrayref of hashrefs
 360
 361 =cut
 362
 363 sub GetOAISetMappings {
 364     my ($set_id) = @_;
 365
 366     return unless $set_id;
 367
 368     my $dbh = C4::Context->dbh;
 369     my $query = qq{
 370         SELECT *
 371         FROM oai_sets_mappings
 372         WHERE set_id = ?
 373         ORDER BY rule_order
 374     };
 375     my $sth = $dbh->prepare($query);
 376     $sth->execute($set_id);
 377
 378     my @mappings;
 379     while(my $result = $sth->fetchrow_hashref) {
 380         push @mappings, {
 381             marcfield => $result->{'marcfield'},
 382             marcsubfield => $result->{'marcsubfield'},
 383             operator => $result->{'operator'},
 384             marcvalue => $result->{'marcvalue'},
 385             rule_operator => $result->{'rule_operator'},
 386             rule_order => $result->{'rule_order'}
 387         };
 388     }
 389
 390     return \@mappings;
 391 }
 392
 393 =head2 ModOAISetMappings {
 394
 395     my $mappings = [
 396         {
 397             marcfield => 'XXX',
 398             marcsubfield => 'Y',
 399             operator => 'A',
 400             marcvalue => 'zzzz'
 401         },
 402         ...
 403     ];
 404     ModOAISetMappings($set_id, $mappings);
 405
 406 ModOAISetMappings modifies mappings of a given set.
 407
 408 =cut
 409
 410 sub ModOAISetMappings {
 411     my ($set_id, $mappings) = @_;
 412
 413     return unless $set_id;
 414
 415     my $dbh = C4::Context->dbh;
 416     my $query = qq{
 417         DELETE FROM oai_sets_mappings
 418         WHERE set_id = ?
 419     };
 420     my $sth = $dbh->prepare($query);
 421     $sth->execute($set_id);
 422     if(scalar @$mappings > 0) {
 423         $query = qq{
 424             INSERT INTO oai_sets_mappings (set_id, marcfield, marcsubfield, operator, marcvalue, rule_operator, rule_order)
 425             VALUES (?,?,?,?,?,?,?)
 426         };
 427         $sth = $dbh->prepare($query);
 428         foreach (@$mappings) {
 429             $sth->execute($set_id, $_->{'marcfield'}, $_->{'marcsubfield'}, $_->{'operator'}, $_->{'marcvalue'}, $_->{'rule_operator'}, $_->{'rule_order'});
 430         }
 431     }
 432 }
 433
 434 =head2 GetOAISetsBiblio
 435
 436     $oai_sets = GetOAISetsBiblio($biblionumber);
 437
 438 Return the OAI sets where biblio appears.
 439
 440 Return value is an arrayref of hashref where each element of the array is a set.
 441 Keys of hash are id, spec and name
 442
 443 =cut
 444
 445 sub GetOAISetsBiblio {
 446     my ($biblionumber) = @_;
 447
 448     my $dbh = C4::Context->dbh;
 449     my $query = qq{
 450         SELECT oai_sets.*
 451         FROM oai_sets
 452           LEFT JOIN oai_sets_biblios ON oai_sets_biblios.set_id = oai_sets.id
 453         WHERE biblionumber = ?
 454     };
 455     my $sth = $dbh->prepare($query);
 456
 457     $sth->execute($biblionumber);
 458     return $sth->fetchall_arrayref({});
 459 }
 460
 461 =head2 DelOAISetsBiblio
 462
 463     DelOAISetsBiblio($biblionumber);
 464
 465 Remove a biblio from all sets
 466
 467 =cut
 468
 469 sub DelOAISetsBiblio {
 470     my ($biblionumber) = @_;
 471
 472     return unless $biblionumber;
 473
 474     my $dbh = C4::Context->dbh;
 475     my $query = qq{
 476         DELETE FROM oai_sets_biblios
 477         WHERE biblionumber = ?
 478     };
 479     my $sth = $dbh->prepare($query);
 480     return $sth->execute($biblionumber);
 481 }
 482
 483 =head2 CalcOAISetsBiblio
 484
 485     my @sets = CalcOAISetsBiblio($record, $oai_sets_mappings);
 486
 487 Return a list of set ids the record belongs to. $record must be a MARC::Record
 488 and $oai_sets_mappings (optional) must be a hashref returned by
 489 GetOAISetsMappings
 490
 491 =cut
 492
 493 sub CalcOAISetsBiblio {
 494     my ($record, $oai_sets_mappings) = @_;
 495
 496     return unless $record;
 497
 498     $oai_sets_mappings ||= GetOAISetsMappings;
 499
 500     my @biblio_sets;
 501     foreach my $set_id (keys %$oai_sets_mappings) {
 502
 503         my $rules = [];
 504         foreach my $mapping (@{ $oai_sets_mappings->{$set_id} }) {
 505             next if not $mapping;
 506             my $rule_operator = $mapping->{'rule_operator'};
 507             my $result = _evalRule($record, $mapping);
 508
 509             # First rule or 'or' rule is always pushed
 510             if (!@$rules || $rule_operator eq 'or') {
 511                 push @$rules, [$result];
 512                 next;
 513             }
 514
 515             # 'and' rule is pushed in the last 'or' rule
 516             push @{$rules->[-1]}, $result;
 517         }
 518
 519         my @evaluated_and;
 520         foreach my $ruleset (@$rules) {
 521            if (0 < grep /0/, @{$ruleset}) {
 522                 push @evaluated_and, 0;
 523             } else {
 524                 push @evaluated_and, 1;
 525             }
 526         }
 527
 528         if (grep /1/, @evaluated_and) {
 529             push @biblio_sets, $set_id;
 530         }
 531
 532     }
 533     return @biblio_sets;
 534 }
 535
 536 # Does the record match a given mapping rule?
 537 sub _evalRule {
 538     my $record = shift;
 539     my $mapping = shift;
 540
 541     my $field = $mapping->{'marcfield'};
 542     my $subfield = $mapping->{'marcsubfield'};
 543     my $operator = $mapping->{'operator'};
 544     my $value = $mapping->{'marcvalue'};
 545
 546     my @all_subfield_values;
 547     # Get all the fields with the given tag
 548     my @fields = $record->field($field);
 549     # Iterate over all the fields
 550     foreach my $field ( @fields ) {
 551         # Get the values from all the subfields with the given subfield code
 552         if ( my @subfield_values = $field->subfield($subfield) ) {
 553             push @all_subfield_values, @subfield_values;
 554         }
 555     }
 556
 557     if ($operator eq 'notequal') {
 558         if(0 == grep { $_ eq $value } @all_subfield_values) {
 559             return 1;
 560         }
 561     }
 562     else {
 563         if(0 < grep { $_ eq $value } @all_subfield_values) {
 564             return 1;
 565         }
 566     }
 567     return 0;
 568 }
 569
 570
 571 =head2 ModOAISetsBiblios
 572
 573     my $oai_sets_biblios = {
 574         '1' => [1, 3, 4],   # key is the set_id, and value is an array ref of biblionumbers
 575         '2' => [],
 576         ...
 577     };
 578     ModOAISetsBiblios($oai_sets_biblios);
 579
 580 ModOAISetsBiblios deletes all records from oai_sets_biblios table and calls AddOAISetsBiblios.
 581 This table is then used in opac/oai.pl.
 582
 583 =cut
 584
 585 sub ModOAISetsBiblios {
 586     my $oai_sets_biblios = shift;
 587
 588     return unless ref($oai_sets_biblios) eq "HASH";
 589
 590     my $dbh = C4::Context->dbh;
 591     my $query = qq{
 592         DELETE FROM oai_sets_biblios
 593     };
 594     my $sth = $dbh->prepare($query);
 595     $sth->execute;
 596     AddOAISetsBiblios($oai_sets_biblios);
 597 }
 598
 599 =head2 UpdateOAISetsBiblio
 600
 601     UpdateOAISetsBiblio($biblionumber, $record);
 602
 603 Update OAI sets for one biblio. The two parameters are mandatory.
 604 $record is a MARC::Record.
 605
 606 =cut
 607
 608 sub UpdateOAISetsBiblio {
 609     my ($biblionumber, $record) = @_;
 610
 611     return unless($biblionumber and $record);
 612
 613     $record = $record->clone;
 614     if (C4::Context->preference('OAI-PMH:AutoUpdateSetsEmbedItemData')) {
 615         $record = Koha::Biblio::Metadata->record(
 616             {
 617                 record       => $record,
 618                 embed_items  => 1,
 619                 biblionumber => $biblionumber,
 620             }
 621         );
 622     }
 623
 624     my $sets_biblios;
 625     my @sets = CalcOAISetsBiblio($record);
 626     foreach (@sets) {
 627         push @{ $sets_biblios->{$_} }, $biblionumber;
 628     }
 629     DelOAISetsBiblio($biblionumber);
 630     AddOAISetsBiblios($sets_biblios);
 631 }
 632
 633 =head2 AddOAISetsBiblios
 634
 635     my $oai_sets_biblios = {
 636         '1' => [1, 3, 4],   # key is the set_id, and value is an array ref of biblionumbers
 637         '2' => [],
 638         ...
 639     };
 640     ModOAISetsBiblios($oai_sets_biblios);
 641
 642 AddOAISetsBiblios insert given infos in oai_sets_biblios table.
 643 This table is then used in opac/oai.pl.
 644
 645 =cut
 646
 647 sub AddOAISetsBiblios {
 648     my $oai_sets_biblios = shift;
 649
 650     return unless ref($oai_sets_biblios) eq "HASH";
 651
 652     my $dbh = C4::Context->dbh;
 653     my $query = qq{
 654         INSERT INTO oai_sets_biblios (set_id, biblionumber)
 655         VALUES (?,?)
 656     };
 657     my $sth = $dbh->prepare($query);
 658     foreach my $set_id (keys %$oai_sets_biblios) {
 659         foreach my $biblionumber (@{$oai_sets_biblios->{$set_id}}) {
 660             $sth->execute($set_id, $biblionumber);
 661         }
 662     }
 663 }
 664
 665 1;