Bug 6440: Implement OAI-PMH Sets
[koha.git] / 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 under the
8 # terms of the GNU General Public License as published by the Free Software
9 # Foundation; either version 2 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 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
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 three properties:
294
295     {
296         marcfield => 'XXX',     # the MARC field to check
297         marcsubfield => 'Y',    # the MARC subfield to check
298         marcvalue => 'zzzz',    # the value to check
299     }
300
301 If defined in a set mapping, a biblio which have at least one 'Y' subfield of
302 one 'XXX' field equal to 'zzzz' will belong to this set.
303 If multiple mappings are defined in a set, the biblio will belong to this set
304 if at least one condition is matched.
305
306 GetOAISetsMappings returns a hashref of arrayrefs of hashrefs.
307 The first hashref keys are the sets IDs, so it looks like this:
308
309     $mappings = {
310         '1' => [
311             {
312                 marcfield => 'XXX',
313                 marcsubfield => 'Y',
314                 marcvalue => 'zzzz'
315             },
316             {
317                 ...
318             },
319             ...
320         ],
321         '2' => [...],
322         ...
323     };
324
325 =cut
326
327 sub GetOAISetsMappings {
328     my $dbh = C4::Context->dbh;
329     my $query = qq{
330         SELECT * FROM oai_sets_mappings
331     };
332     my $sth = $dbh->prepare($query);
333     $sth->execute;
334
335     my $mappings = {};
336     while(my $result = $sth->fetchrow_hashref) {
337         push @{ $mappings->{$result->{'set_id'}} }, {
338             marcfield => $result->{'marcfield'},
339             marcsubfield => $result->{'marcsubfield'},
340             marcvalue => $result->{'marcvalue'}
341         };
342     }
343
344     return $mappings;
345 }
346
347 =head2 GetOAISetMappings
348
349     my $set_mappings = GetOAISetMappings($set_id);
350
351 Return mappings for the set with given set_id. It's an arrayref of hashrefs
352
353 =cut
354
355 sub GetOAISetMappings {
356     my ($set_id) = @_;
357
358     return unless $set_id;
359
360     my $dbh = C4::Context->dbh;
361     my $query = qq{
362         SELECT *
363         FROM oai_sets_mappings
364         WHERE set_id = ?
365     };
366     my $sth = $dbh->prepare($query);
367     $sth->execute($set_id);
368
369     my @mappings;
370     while(my $result = $sth->fetchrow_hashref) {
371         push @mappings, {
372             marcfield => $result->{'marcfield'},
373             marcsubfield => $result->{'marcsubfield'},
374             marcvalue => $result->{'marcvalue'}
375         };
376     }
377
378     return \@mappings;
379 }
380
381 =head2 ModOAISetMappings {
382
383     my $mappings = [
384         {
385             marcfield => 'XXX',
386             marcsubfield => 'Y',
387             marcvalue => 'zzzz'
388         },
389         ...
390     ];
391     ModOAISetMappings($set_id, $mappings);
392
393 ModOAISetMappings modifies mappings of a given set.
394
395 =cut
396
397 sub ModOAISetMappings {
398     my ($set_id, $mappings) = @_;
399
400     return unless $set_id;
401
402     my $dbh = C4::Context->dbh;
403     my $query = qq{
404         DELETE FROM oai_sets_mappings
405         WHERE set_id = ?
406     };
407     my $sth = $dbh->prepare($query);
408     $sth->execute($set_id);
409
410     if(scalar @$mappings > 0) {
411         $query = qq{
412             INSERT INTO oai_sets_mappings (set_id, marcfield, marcsubfield, marcvalue)
413             VALUES (?,?,?,?)
414         };
415         $sth = $dbh->prepare($query);
416         foreach (@$mappings) {
417             $sth->execute($set_id, $_->{'marcfield'}, $_->{'marcsubfield'}, $_->{'marcvalue'});
418         }
419     }
420 }
421
422 =head2 GetOAISetsBiblio
423
424     $oai_sets = GetOAISetsBiblio($biblionumber);
425
426 Return the OAI sets where biblio appears.
427
428 Return value is an arrayref of hashref where each element of the array is a set.
429 Keys of hash are id, spec and name
430
431 =cut
432
433 sub GetOAISetsBiblio {
434     my ($biblionumber) = @_;
435
436     my $dbh = C4::Context->dbh;
437     my $query = qq{
438         SELECT oai_sets.*
439         FROM oai_sets
440           LEFT JOIN oai_sets_biblios ON oai_sets_biblios.set_id = oai_sets.id
441         WHERE biblionumber = ?
442     };
443     my $sth = $dbh->prepare($query);
444
445     $sth->execute($biblionumber);
446     return $sth->fetchall_arrayref({});
447 }
448
449 =head2 DelOAISetsBiblio
450
451     DelOAISetsBiblio($biblionumber);
452
453 Remove a biblio from all sets
454
455 =cut
456
457 sub DelOAISetsBiblio {
458     my ($biblionumber) = @_;
459
460     return unless $biblionumber;
461
462     my $dbh = C4::Context->dbh;
463     my $query = qq{
464         DELETE FROM oai_sets_biblios
465         WHERE biblionumber = ?
466     };
467     my $sth = $dbh->prepare($query);
468     return $sth->execute($biblionumber);
469 }
470
471 =head2 CalcOAISetsBiblio
472
473     my @sets = CalcOAISetsBiblio($record, $oai_sets_mappings);
474
475 Return a list of set ids the record belongs to. $record must be a MARC::Record
476 and $oai_sets_mappings (optional) must be a hashref returned by
477 GetOAISetsMappings
478
479 =cut
480
481 sub CalcOAISetsBiblio {
482     my ($record, $oai_sets_mappings) = @_;
483
484     return unless $record;
485
486     $oai_sets_mappings ||= GetOAISetsMappings;
487
488     my @biblio_sets;
489     foreach my $set_id (keys %$oai_sets_mappings) {
490         foreach my $mapping (@{ $oai_sets_mappings->{$set_id} }) {
491             next if not $mapping;
492             my $field = $mapping->{'marcfield'};
493             my $subfield = $mapping->{'marcsubfield'};
494             my $value = $mapping->{'marcvalue'};
495
496             my @subfield_values = $record->subfield($field, $subfield);
497             if(0 < grep /^$value$/, @subfield_values) {
498                 push @biblio_sets, $set_id;
499                 last;
500             }
501         }
502     }
503     return @biblio_sets;
504 }
505
506 =head2 ModOAISetsBiblios
507
508     my $oai_sets_biblios = {
509         '1' => [1, 3, 4],   # key is the set_id, and value is an array ref of biblionumbers
510         '2' => [],
511         ...
512     };
513     ModOAISetsBiblios($oai_sets_biblios);
514
515 ModOAISetsBiblios truncate oai_sets_biblios table and call AddOAISetsBiblios.
516 This table is then used in opac/oai.pl.
517
518 =cut
519
520 sub ModOAISetsBiblios {
521     my $oai_sets_biblios = shift;
522
523     return unless ref($oai_sets_biblios) eq "HASH";
524
525     my $dbh = C4::Context->dbh;
526     my $query = qq{
527         TRUNCATE TABLE oai_sets_biblios
528     };
529     my $sth = $dbh->prepare($query);
530     $sth->execute;
531     AddOAISetsBiblios($oai_sets_biblios);
532 }
533
534 =head2 UpdateOAISetsBiblio
535
536     UpdateOAISetsBiblio($biblionumber, $record);
537
538 Update OAI sets for one biblio. The two parameters are mandatory.
539 $record is a MARC::Record.
540
541 =cut
542
543 sub UpdateOAISetsBiblio {
544     my ($biblionumber, $record) = @_;
545
546     return unless($biblionumber and $record);
547
548     my $sets_biblios;
549     my @sets = CalcOAISetsBiblio($record);
550     foreach (@sets) {
551         push @{ $sets_biblios->{$_} }, $biblionumber;
552     }
553     DelOAISetsBiblio($biblionumber);
554     AddOAISetsBiblios($sets_biblios);
555 }
556
557 =head2 AddOAISetsBiblios
558
559     my $oai_sets_biblios = {
560         '1' => [1, 3, 4],   # key is the set_id, and value is an array ref of biblionumbers
561         '2' => [],
562         ...
563     };
564     ModOAISetsBiblios($oai_sets_biblios);
565
566 AddOAISetsBiblios insert given infos in oai_sets_biblios table.
567 This table is then used in opac/oai.pl.
568
569 =cut
570
571 sub AddOAISetsBiblios {
572     my $oai_sets_biblios = shift;
573
574     return unless ref($oai_sets_biblios) eq "HASH";
575
576     my $dbh = C4::Context->dbh;
577     my $query = qq{
578         INSERT INTO oai_sets_biblios (set_id, biblionumber)
579         VALUES (?,?)
580     };
581     my $sth = $dbh->prepare($query);
582     foreach my $set_id (keys %$oai_sets_biblios) {
583         foreach my $biblionumber (@{$oai_sets_biblios->{$set_id}}) {
584             $sth->execute($set_id, $biblionumber);
585         }
586     }
587 }
588
589 1;