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