From 6aa923e331a50574c15df231d259fa22f0f8d14e Mon Sep 17 00:00:00 2001 From: Olli-Antti Kivilahti Date: Mon, 7 Mar 2016 14:00:34 +0200 Subject: [PATCH] Bug 15996 - Bibliographic records diffing tool Currently there is no tool to diff differences or changes between biblios or their different versions. This is most useful for logging who changed and what. This feature introduces a biblio diffing module, which takes an arbitrary amount of MARC::Records and produces a complex data structure about all the identified changes. --- C4/Biblio/Diff.pm | 325 +++++++++++++++++++++ t/db_dependent/Biblio/Diff/diff.t | 217 ++++++++++++++ t/db_dependent/Biblio/Diff/localRecords.pm | 455 +++++++++++++++++++++++++++++ 3 files changed, 997 insertions(+) create mode 100644 C4/Biblio/Diff.pm create mode 100644 t/db_dependent/Biblio/Diff/diff.t create mode 100644 t/db_dependent/Biblio/Diff/localRecords.pm diff --git a/C4/Biblio/Diff.pm b/C4/Biblio/Diff.pm new file mode 100644 index 0000000..5028773 --- /dev/null +++ b/C4/Biblio/Diff.pm @@ -0,0 +1,325 @@ +package C4::Biblio::Diff; + +# Copyright KohaSuomi 2016 +# +# This file is part of Koha. +# +# Koha is free software; you can redistribute it and/or modify it under the +# terms of the GNU General Public License as published by the Free Software +# Foundation; either version 3 of the License, or (at your option) any later +# version. +# +# Koha is distributed in the hope that it will be useful, but WITHOUT ANY +# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR +# A PARTICULAR PURPOSE. See the GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License along +# with Koha; if not, write to the Free Software Foundation, Inc., +# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + +use Modern::Perl; +use Scalar::Util qw(blessed); +use Try::Tiny; + +use Koha::Exception::BadParameter; + +=head SYNOPSIS + + Diff takes any amount of MARC::Records and produces a diff of all the MARC + elements that are different in atleast one of the records. + +=cut + +=head new + + my $diff = C4::Biblio::Diff->new($params, @MARC::Records); + +@PARAM1 HASHRef of options, + 'excludedFields' => ['999', '952', ...] #Which MARC::Fields to exclude from the comparison result +@PARAM2..n MARC::Record-objects to diff +@RETURNS C4::Biblio::Diff-object + +=cut + +sub new { + my ($class, $params, @records) = @_; + my $self = (ref($params) eq 'HASH') ? $params : {}; + bless($self, $class); + + $self->{records} = []; + foreach my $r (@records) { + $self->addRecord($r); + } + if ($self->{excludedFields}) { + $self->setExcludedFields( $self->{excludedFields} ); + } + + return $self; +} + +=head addRecord + + $diff = $diff->addRecord($MARC::Record); + +@PARAM1, MARC::Record-object. +@RETURNS C4::Biblio::Diff to chain commands +@THROWS Koha::Exception::BadParameter + +=cut + +sub addRecord { + my ($self, $record) = @_; + + unless(blessed($record) && $record->isa('MARC::Record')) { + my @cc = caller(0); + Koha::Exception::BadParameter->throw(error => $cc[3]."()> Param \$record '$record' is not a MARC::Record-object"); + } + push(@{$self->{records}}, $record); + return $self; +} + +sub getRecords { + return shift->{records}; +} +sub getExcludedFields { + return shift->{excludedFields}; +} +sub setExcludedFields { + my ($self, $excludedFields) = @_; + unless(ref($excludedFields) eq 'ARRAY') { + my @cc1 = caller(1); + Koha::Exception::BadParameter->throw(error => $cc1[3]." is trying to setExcludedFields, but the param \$excludedFields '$excludedFields' is not an ARRAYref."); + } + $self->{excludedFields} = {}; #Make a easy to search hash + foreach my $f (@$excludedFields) { + $self->{excludedFields}->{$f} = 1; + } + return $self; +} +sub isFieldExcluded { + my ($self, $field) = @_; + my $ef = $self->getExcludedFields(); + if ($ef && $ef->{$field}) { + return 1; + } + return 0; +} + +=head diffRecords + +Generates a multitiered and parallel diff which lists all the changed MARC-(sub)fields +and indicators horizontally between any amount of given MARC::Records. + +@PARAMS List of MARC::Records to be compared between each others for difference. +@RETURNS HASHmonster, depicting all the MARC elements where even one of the given MARC::Records differ from the others: + { + '001' => [ + '3243256', + '10042', + undef, + ], + '003' => [ + 'VAARA', + 'LUMME', + 'KYYTI', + ], + '049' => [ + { + '_i1' => [ + ' ', + 1, + undef, + ], + 'a' => [ + undef, + 'K18', + undef, + ], + 'b' => [ + undef, + 'YLE', + undef, + ], + }, + ], + '245' => [ + { + '_i2' => [ + 3, + undef, + 1, + ], + 'a' => [ + 'Rickshaw /', + 'Rickshaw', + 'Rickshaw', + ], + }, + ], + } + +=cut + +sub diffRecords { + my ($self) = @_; + my $records = $self->getRecords(); + my %availableFields; + my %fieldRepetitions; + my %subfieldRepetitions; + + #collect all found fields and subfields to to a single stack. + #Collect repetiton counts of fields and subfields. + foreach my $r (@$records) { + foreach my $f ($r->fields()) { #iterate fields + next if $self->isFieldExcluded($f->tag()); + if ($f->is_control_field()) { + $availableFields{$f->tag()} = 1; + } + else { + $availableFields{$f->tag()} = {} unless($availableFields{$f->tag()}); + my $sfs = $availableFields{$f->tag()}; + + my @fields = $r->field($f->tag()); + $fieldRepetitions{$f->tag()} = scalar(@fields) if(not($fieldRepetitions{$f->tag()}) || $fieldRepetitions{$f->tag()} < scalar(@fields)); + + foreach my $sf ($f->subfields()) { #Iterate subfields + my @sfs = $f->subfield( $sf->[0] ); + $subfieldRepetitions{ $f->tag().$sf->[0] } = scalar(@sfs) if(not($subfieldRepetitions{ $f->tag().$sf->[0] }) || $subfieldRepetitions{ $f->tag().$sf->[0] } < scalar(@sfs)); + $sfs->{ $sf->[0] } = 1; + } + } + } + } + + my %diff; + ##Iterate all found indicators, fields and subfields and diff between all given records + #Remember that all fields and subfields can be repeated + foreach my $fk (sort(keys(%availableFields))) { #Iterate fields + + if (int($fk) < 10) { #Control fields + my @candidates; + for(my $ri=0 ; $ri[$ri]; + my $field = $r->field($fk); + $candidates[$ri] = ($field) ? $field->data() : undef; + } + if (_valuesDiff(\@candidates)) { + $diff{$fk} = \@candidates; + } + } #EO control field + else { #Data fields + my @fs; + for(my $fi=0 ; $fi<$fieldRepetitions{$fk} ; $fi++) { #Iterate field repetitions + + foreach my $i (1..2) { #Diff indicators + my @candidates; + for(my $ri=0 ; $ri[$ri]; + $fs[$ri] = [$r->field($fk)] unless $fs[$ri]; + + $candidates[$ri] = ($fs[$ri]->[$fi]) ? $fs[$ri]->[$fi]->indicator($i) : undef; + } + if (_valuesDiff(\@candidates)) { + $diff{$fk} = [] unless $diff{$fk}; + $diff{$fk}->[$fi] = {} unless $diff{$fk}->[$fi]; + $diff{$fk}->[$fi]->{"_i$i"} = \@candidates; + } + } #EO indicators + + foreach my $sfk (sort(keys(%{$availableFields{$fk}}))) { #Iterate subfields + my @sfs; + + for(my $sfi=0 ; $sfi<$subfieldRepetitions{$fk.$sfk} ; $sfi++) { #Iterate subfield repetitions + + my @candidates; + for(my $ri=0 ; $ri[$ri]; + $fs[$ri] = [$r->field($fk)] unless $fs[$ri]; + $sfs[$ri] = [$fs[$ri]->[$fi]->subfield($sfk)] if (not($sfs[$ri]) && $fs[$ri]->[$fi]); + + $candidates[$ri] = ($sfs[$ri]) ? $sfs[$ri]->[$sfi] : undef; + } + if (_valuesDiff(\@candidates)) { + $diff{$fk} = [] unless $diff{$fk}; + $diff{$fk}->[$fi] = {} unless $diff{$fk}->[$fi]; + $diff{$fk}->[$fi]->{$sfk} = [] unless $diff{$fk}->[$fi]->{$sfk}; + $diff{$fk}->[$fi]->{$sfk}->[$sfi] = \@candidates; + } + } #EO subfield repetiton iterator + } #EO subfields iterator + } #EO Field repetiton iterator + } #EO Data fields + } #EO fields iterator + +##DEBUG DEBUG Find out why some diffs have a undefined array index and defined array indexes after that? +sub throwUp { + my ($records, $diff, $msg) = @_; + require Data::Dumper::Dumper; + die "\n$msg\n\n@$records\n\n".Data::Dumper::Dumper($diff)."\n\n"; +} +foreach my $fk (sort(keys(%availableFields))) { #Iterate fields + if (int($fk) < 10) { #Control fields + if (exists($diff{$fk}) && not($diff{$fk})) { + throwUp($records, \%diff, "Control field null"); + } + } #EO control field + else { #Data fields + if (exists($diff{$fk}) && not($diff{$fk})) { + throwUp($records, \%diff, "Data field null"); + } + for(my $fi=0 ; $fi<$fieldRepetitions{$fk} ; $fi++) { #Iterate field repetitions + foreach my $i (1..2) { #Diff indicators + if (exists($diff{$fk}->[$fi]) && not($diff{$fk}->[$fi])) { + throwUp($records, \%diff, "Data field repetition null"); + } + } #EO indicators + foreach my $sfk (sort(keys(%{$availableFields{$fk}}))) { #Iterate subfields + if (exists($diff{$fk}->[$fi]->{$sfk}) && not($diff{$fk}->[$fi]->{$sfk})) { + throwUp($records, \%diff, "Subfield null"); + } + for(my $sfi=0 ; $sfi<$subfieldRepetitions{$fk.$sfk} ; $sfi++) { #Iterate subfield repetitions + if (exists($diff{$fk}->[$fi]->{$sfk}->[$sfi]) && not($diff{$fk}->[$fi]->{$sfk}->[$sfi])) { + throwUp($records, \%diff, "Subfield repetition null"); + } + } #EO subfield repetiton iterator + } #EO subfields iterator + } #EO Field repetiton iterator + } #EO Data fields +} #EO fields iterator +##EO DEBUG DEBUG + + $self->{diff} = \%diff; + return $self->{diff}; +} + +=head _valuesDiff + + if ($diff->_valuesDiff($candidates)) { + #Candidates do not match + } + else { + #All candidates match + } + +TODO::This is a good point to change the similarity logic of this diff:ing tool if necessary. + +@PARAM1 ARRAYref of Scalar-values, these are compared for similarity. +@RETURNS Boolean, true if values differ + false if they are the same +=cut + +sub _valuesDiff { + my ($candidates) = @_; + for(my $i=1 ; $i[$i-1]) ? $candidates->[$i-1] : ''; + my $nextValue = defined($candidates->[$i]) ? $candidates->[$i] : ''; + + if ($prevValue ne $nextValue) { + return 1; + } + } + return 0; +} + +1; diff --git a/t/db_dependent/Biblio/Diff/diff.t b/t/db_dependent/Biblio/Diff/diff.t new file mode 100644 index 0000000..20a9502 --- /dev/null +++ b/t/db_dependent/Biblio/Diff/diff.t @@ -0,0 +1,217 @@ +# Copyright 2016 KohaSuomi +# +# This file is part of Koha. +# +# Koha is free software; you can redistribute it and/or modify it under the +# terms of the GNU General Public License as published by the Free Software +# Foundation; either version 3 of the License, or (at your option) any later +# version. +# +# Koha is distributed in the hope that it will be useful, but WITHOUT ANY +# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR +# A PARTICULAR PURPOSE. See the GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License along +# with Koha; if not, write to the Free Software Foundation, Inc., +# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + +use Modern::Perl; +use Test::More; +use Scalar::Util qw(blessed); +use Try::Tiny; + +use C4::Biblio::Diff; + +use t::db_dependent::Biblio::Diff::localRecords; +use t::lib::TestObjects::BiblioFactory; + + +subtest "C4::Biblio::Diff", \&biblioDiff; +sub biblioDiff { + my $testContext = {}; + eval { + my $records = t::db_dependent::Biblio::Diff::localRecords::create($testContext); + my @recKeys = sort(keys(%$records)); + + my $diff = C4::Biblio::Diff->new( + {excludedFields => ['999', '942', '952']}, + $records->{ $recKeys[0] }, + $records->{ $recKeys[1] }, + $records->{ $recKeys[2] }, + ); + my $d = $diff->diffRecords(); + + my $expectedDiff = { + '001' => [ + '300841', + '21937', + '4312727', + ], + '003' => [ + 'KYYTI', + 'OUTI', + undef, + ], + '007' => [ + undef, + undef, + 'ta', + ], + '020' => [ + { + 'a' => [ + [ + '9510108303', + '9510108304', + '9510108305', + ], + ], + 'q' => [ + [ + 'NID.', + 'NID.', + undef, + ], + ], + 'c' => [ + [ + undef, + '7.74 EUR', + undef, + ], + ], + }, + ], + '041' => [ + { + '_i1' => [ + undef, + undef, + '0', + ], + '_i2' => [ + undef, + undef, + ' ' + ], + 'a' => [ + [ + undef, + undef, + 'lat', + ], + [ + undef, + undef, + 'swe', + ], + [ + undef, + undef, + 'eng', + ], + ], + }, + ], + '245' => [ + { + '_i2' => [ + '4', + '0', + '0', + ], + 'a' => [ + [ + 'THE WISHING TREE /', + 'TYRANNIT VOIVAT PAREMMIN :', + 'TYRANNIT VOIVAT PAREMMIN :', + ], + ], + 'b' => [ + [ + undef, + 'RUNOJA /', + 'RUNOJA /', + ], + ], + 'c' => [ + [ + 'USHA BAHL.', + 'AKI LUOSTARINEN.', + 'AKI LUOSTARINEN.', + ], + ], + }, + { + '_i1' => [ + undef, + '0', + undef, + ], + '_i2' => [ + undef, + '0', + undef, + ], + 'a' => [ + [ + undef, + 'TYRANNIT VOIVAT PARHAITEN :', + undef, + ], + ], + }, + ], + }; + + is_deeply($d, $expectedDiff, "Deep diff is as expected"); + + + $diff = C4::Biblio::Diff->new( + {}, + $records->{ $recKeys[1] }, + $records->{ $recKeys[2] }, + $records->{ $recKeys[0] }, + ); + $d = $diff->diffRecords(); + is($d->{'003'}->[0], + 'OUTI', + "Same diff, different order"); + is($d->{'003'}->[1], + undef, + "Same diff, different order"); + is($d->{'003'}->[2], + 'KYYTI', + "Same diff, different order"); + }; + if ($@) { + ok(0, $@); + } + t::lib::TestObjects::ObjectFactory->tearDownTestContext($testContext); +} + +subtest "C4::Biblio::Diff undef indexes", \&biblioDiffUndefIndexes; +sub biblioDiffUndefIndexes { + my $testContext = {}; + eval { + my $records = t::db_dependent::Biblio::Diff::localRecords::create2($testContext); + my @recKeys = sort(keys(%$records)); + + my $diff = C4::Biblio::Diff->new( + {excludedFields => ['999', '942', '952']}, + $records->{ $recKeys[0] }, + $records->{ $recKeys[1] }, + ); + my $d = $diff->diffRecords(); + + my $expectedDiff = {}; + + is_deeply($d, $expectedDiff, "Deep diff is as expected"); + }; + if ($@) { + ok(0, $@); + } + t::lib::TestObjects::ObjectFactory->tearDownTestContext($testContext); +} + +done_testing(); \ No newline at end of file diff --git a/t/db_dependent/Biblio/Diff/localRecords.pm b/t/db_dependent/Biblio/Diff/localRecords.pm new file mode 100644 index 0000000..8818f9d --- /dev/null +++ b/t/db_dependent/Biblio/Diff/localRecords.pm @@ -0,0 +1,455 @@ +package t::db_dependent::Biblio::Diff::localRecords; +# +# Copyright 2016 KohaSuomi +# +# This file is part of Koha. +# +# Koha is free software; you can redistribute it and/or modify it under the +# terms of the GNU General Public License as published by the Free Software +# Foundation; either version 3 of the License, or (at your option) any later +# version. +# +# Koha is distributed in the hope that it will be useful, but WITHOUT ANY +# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR +# A PARTICULAR PURPOSE. See the GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License along +# with Koha; if not, write to the Free Software Foundation, Inc., +# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + +use Modern::Perl; + +use t::lib::TestObjects::BiblioFactory; + +=head IN THIS FILE + +Here we create some fully catalogued records to play with + +=cut + +sub create { +my ($testContext) = @_; +my ($record, @records); + +$record = < + 00510cam a22002054a 4500 + 300841 + KYYTI + + 9510108303 + NID. + + + THE WISHING TREE / + USHA BAHL. + + + BK + 1996-05-01 00:00:00 + + +RECORD +push(@records, {record => $record}); + +$record = < + 00618cam a22002294a 4500 + 21937 + OUTI + + 9510108304 + NID. + 7.74 EUR + + + TYRANNIT VOIVAT PAREMMIN : + RUNOJA / + AKI LUOSTARINEN. + + + TYRANNIT VOIVAT PARHAITEN : + + +RECORD +push(@records, {record => $record}); + +$record = < + 01096cam a22003134i 4500 + 4312727 + ta + + 9510108305 + + + lat + swe + eng + + + TYRANNIT VOIVAT PAREMMIN : + RUNOJA / + AKI LUOSTARINEN. + + + CPL + CPL + + + ykl + BK + 2016-02-15T15:03:05 + + +RECORD +push(@records, {record => $record}); + +return t::lib::TestObjects::BiblioFactory->createTestGroup(\@records, undef, $testContext); +} + +sub create2 { +my ($testContext) = @_; +my ($record, @records); + +$record = < + + 01708cam a2200553zi 4500 + 000035144 + FI-MELINDA + 20160304181804.0 + 820317s1981 fi |||||||||||||||f|fin|| + + fx37918 + skl + + + 9510107417 + 43,80 mk + sid. + + + (FI-MELINDA)000035144 + + + (FI-MELINDA)000035144 + + + FI-NL + + + fin + eng + + + finb + + + 87 + kkaa + + + 820 + -3 + + + 84.5 + + + 84.2 + ykl + + + 84.2 + ykl + + + 84.5 + ykl + + + Doyle, Arthur Conan. + + + The hound of the Baskervilles + + + Baskervillen koira / + Arthur Conan Doyle. + + + 10. p. + + + Porvoo ; + Hki ; + Juva : + WSOY, + 1981 + (Porvoo) + + + 159, [1] s. ; + 21 cm. + + + Teksti + + + ei välittävää laitetta + + + Koulun peruskirjasto; + 22 + + + 9. p. 1972. + + + Korjattu suomennos. + + + Lisäpainokset: 11. p. 1983. + + + Luokkataso: yläkoulu. + + + 9. P. 1972. - KORJATTU SUOMENNOS + + + 11. P. 1983 + + + Holmes, Sherlock, + fikt. + + + Watson, John H., + fikt. + + + kaunokirjallisuus + suomenkielinen kirjallisuus + ysa + + + kriminalfiktion + översättningar + finska + engelska + bella + + + rikoskirjallisuus + käännökset + suomen kieli + englannin kieli + kaunokki + + + salapoliisikirjallisuus + Englanti + 1800-luku + kaunokki + + + aateli + kaunokki + + + maaseutu + kaunokki + + + kummittelu + kaunokki + + + Koulun peruskirjasto; + 22 + + + ykl + BR + + +RECORD +push(@records, {record => $record}); + +$record = < + + 01708cam a2200553zi 4500 + 000035144 + FI-MELINDA + 20160304181804.0 + 820317s1981 fi |||||||||||||||f|fin|| + + fx37918 + skl + + + 9510107418 + 43,80 mk + sid. + + + (FI-MELINDA)000035144 + + + (FI-MELINDA)000035144 + + + FI-NL + + + fin + eng + + + finb + + + 87 + kkaa + + + 820 + -3 + + + 84.5 + + + 84.2 + ykl + + + 84.2 + ykl + + + 84.5 + ykl + + + Doyle, Arthur Conan. + + + The hound of the Baskervilles + + + Baskervillen koira / + Arthur Conan Doyle. + + + 10. p. + + + Porvoo ; + Hki ; + Juva : + WSOY, + 1981 + (Porvoo) + + + 159, [1] s. ; + 21 cm. + + + Teksti + + + ei välittävää laitetta + + + Koulun peruskirjasto; + 22 + + + 9. p. 1972. + + + Korjattu suomennos. + + + Lisäpainokset: 11. p. 1983. + + + Luokkataso: yläkoulu. + + + 9. P. 1972. - KORJATTU SUOMENNOS + + + 11. P. 1983 + + + Holmes, Sherlock, + fikt. + + + Watson, John H., + fikt. + + + kaunokirjallisuus + suomenkielinen kirjallisuus + ysa + + + kriminalfiktion + översättningar + finska + engelska + bella + + + rikoskirjallisuus + käännökset + suomen kieli + englannin kieli + kaunokki + + + salapoliisikirjallisuus + Englanti + 1800-luku + kaunokki + + + aateli + kaunokki + + + maaseutu + kaunokki + + + kummittelu + kaunokki + + + Koulun peruskirjasto; + 22 + + + ykl + BR + + +RECORD +push(@records, {record => $record}); + +return t::lib::TestObjects::BiblioFactory->createTestGroup(\@records, undef, $testContext); +} +1; -- 1.9.1