|
Line 0
Link Here
|
| 0 |
- |
1 |
#!/usr/bin/perl |
|
|
2 |
# |
| 3 |
# This Koha test module is a stub! |
| 4 |
# Add more tests here!!! |
| 5 |
|
| 6 |
use Modern::Perl; |
| 7 |
use utf8; |
| 8 |
|
| 9 |
use Test::More tests => 3; |
| 10 |
use MARC::Record; |
| 11 |
|
| 12 |
BEGIN { |
| 13 |
use_ok('C4::Record'); |
| 14 |
use_ok('C4::Biblio'); |
| 15 |
} |
| 16 |
|
| 17 |
### Preparing our testing data ### |
| 18 |
my $bibFramework = ''; #Using the default bibliographic framework. |
| 19 |
my $marcxml=qq(<?xml version="1.0" encoding="UTF-8"?> |
| 20 |
<record format="MARC21" type="Bibliographic"> |
| 21 |
<leader>00000cim a22000004a 4500</leader> |
| 22 |
<controlfield tag="001">1001</controlfield> |
| 23 |
<controlfield tag="005">2013-06-03 07:04:07+02</controlfield> |
| 24 |
<controlfield tag="007">ss||||j|||||||</controlfield> |
| 25 |
<controlfield tag="008"> uuuu xxk|||||||||||||||||eng|c</controlfield> |
| 26 |
<datafield tag="020" ind1=" " ind2=" "> |
| 27 |
<subfield code="a">0-00-103147-3</subfield> |
| 28 |
<subfield code="c">14.46 EUR</subfield> |
| 29 |
</datafield> |
| 30 |
<datafield tag="041" ind1="0" ind2=" "> |
| 31 |
<subfield code="d">eng</subfield> |
| 32 |
</datafield> |
| 33 |
<datafield tag="084" ind1=" " ind2=" "> |
| 34 |
<subfield code="a">83.5</subfield> |
| 35 |
<subfield code="2">ykl</subfield> |
| 36 |
</datafield> |
| 37 |
<datafield tag="100" ind1="1" ind2=" "> |
| 38 |
<subfield code="a">SHAKESPEARE, WILLIAM.</subfield> |
| 39 |
</datafield> |
| 40 |
<datafield tag="245" ind1="1" ind2="4"> |
| 41 |
<subfield code="a">THE TAMING OF THE SHREW /</subfield> |
| 42 |
<subfield code="c">WILLIAM SHAKESPEARE</subfield> |
| 43 |
<subfield code="h">[ÄÄNITE].</subfield> |
| 44 |
</datafield> |
| 45 |
<datafield tag="260" ind1=" " ind2=" "> |
| 46 |
<subfield code="a">LONDON :</subfield> |
| 47 |
<subfield code="b">COLLINS.</subfield> |
| 48 |
</datafield> |
| 49 |
<datafield tag="300" ind1=" " ind2=" "> |
| 50 |
<subfield code="a">2 ÄÄNIKASETTIA.</subfield> |
| 51 |
</datafield> |
| 52 |
<datafield tag="852" ind1=" " ind2=" "> |
| 53 |
<subfield code="a">FI-Jm</subfield> |
| 54 |
<subfield code="h">83.5</subfield> |
| 55 |
</datafield> |
| 56 |
<datafield tag="852" ind1=" " ind2=" "> |
| 57 |
<subfield code="a">FI-Konti</subfield> |
| 58 |
<subfield code="h">83.5</subfield> |
| 59 |
</datafield> |
| 60 |
</record> |
| 61 |
); |
| 62 |
|
| 63 |
my $record=marcxml2marc($marcxml); |
| 64 |
|
| 65 |
my ( $biblionumberTagid, $biblionumberSubfieldid ) = |
| 66 |
GetMarcFromKohaField( "biblio.biblionumber", $bibFramework ); |
| 67 |
my ( $biblioitemnumberTagid, $biblioitemnumberSubfieldid ) = |
| 68 |
GetMarcFromKohaField( "biblioitems.biblioitemnumber", $bibFramework ); |
| 69 |
|
| 70 |
# Making sure the Koha to MARC mappings stand correct |
| 71 |
is ($biblionumberTagid, $biblioitemnumberTagid, 'Testing "Koha to MARC mapping" biblionumber and biblioitemnumber source MARC field sameness'); |
| 72 |
if ($biblionumberTagid ne $biblioitemnumberTagid) { |
| 73 |
warn "Koha to MARC mapping values biblio.biblionumber and biblioitems.biblioitemnumber must share the same MARC field!"; |
| 74 |
} |
| 75 |
|
| 76 |
#Moving the 001 to the field configured for legacy id |
| 77 |
my $legacyIdField = $record->field( '001' ); |
| 78 |
my $legacyId = $legacyIdField->data(); |
| 79 |
my $biblionumberField = MARC::Field->new( $biblionumberTagid, '', '', |
| 80 |
$biblionumberSubfieldid => $legacyId, |
| 81 |
$biblioitemnumberSubfieldid => $legacyId, |
| 82 |
); |
| 83 |
$record->append_fields($biblionumberField); |
| 84 |
|
| 85 |
#Convenience method to easily change the legacy id. |
| 86 |
# Is used to test out database id boundary values. |
| 87 |
sub changeLegacyId { |
| 88 |
my ($record, $newId) = @_; |
| 89 |
|
| 90 |
# Because the author of Marc::Record decided it would be nice to replace all subfields with new ones whenever they are updated, |
| 91 |
# old references are lost and need to be found again. |
| 92 |
my $legacyIdField = $record->field( '001' ); |
| 93 |
my $biblionumberField = $record->field( $biblionumberTagid ); |
| 94 |
|
| 95 |
$legacyIdField->update( $newId ); |
| 96 |
$biblionumberField->update( $biblionumberSubfieldid => $newId, |
| 97 |
$biblioitemnumberSubfieldid => $newId); |
| 98 |
$legacyId = $newId; |
| 99 |
|
| 100 |
|
| 101 |
} |
| 102 |
|
| 103 |
############################## |
| 104 |
### Running the main test! ### |
| 105 |
############################## |
| 106 |
|
| 107 |
## INSERT the record to the DB, SELECT the one we got, |
| 108 |
## then find out if the biblionumber and biblioitemnumbers are the original ones. |
| 109 |
|
| 110 |
my $dbh = C4::Context->dbh; |
| 111 |
|
| 112 |
$dbh->{AutoCommit} = 0; #We don't want to save anything in DB as this is just a test run! |
| 113 |
$dbh->{RaiseError} = 1; |
| 114 |
|
| 115 |
##Testing just below the critical threshold in _koha_add_item() primary key validators. |
| 116 |
## Test should run OK. Also this biblionumber hardly is reserved :) |
| 117 |
changeLegacyId($record, 2147483639); |
| 118 |
|
| 119 |
my ( $newBiblionumber, $newBiblioitemnumber ) = AddBiblio( $record, $bibFramework, { defer_marc_save => 1 } ); |
| 120 |
my $selectedBiblio = GetBiblio($legacyId); |
| 121 |
|
| 122 |
is ($legacyId, $newBiblionumber, 'Biblionumber returned by AddBiblio matches'); |
| 123 |
is ($legacyId, $selectedBiblio->{biblionumber}, 'Biblionumber returned by GetBiblio matches the legacy biblionumber'); |
| 124 |
|
| 125 |
|
| 126 |
##Testing primary key exhaustion situation. Validator should prevent biblionumber or biblioitemnumber INSERTion |
| 127 |
## if the value is over the safety threshold 2147483639 == LONG_MAX |
| 128 |
## So both tests should fail. |
| 129 |
changeLegacyId($record, 2147483645); |
| 130 |
|
| 131 |
( $newBiblionumber, $newBiblioitemnumber ) = AddBiblio( $record, $bibFramework, { defer_marc_save => 1 } ); |
| 132 |
$selectedBiblio = GetBiblio($legacyId); |
| 133 |
|
| 134 |
isnt ($legacyId, $newBiblionumber, 'Testing primary key exhaustion prevention.'); |
| 135 |
isnt ($legacyId, $selectedBiblio->{biblionumber}, 'Primary key exhausted biblio matching'); |
| 136 |
|
| 137 |
##Testing bad primary key situation. Validator should prevent biblionumber or biblioitemnumber INSERTion |
| 138 |
## if the value is not a pure integer/long. |
| 139 |
## So both tests should fail. |
| 140 |
changeLegacyId($record, '12134FAN'); |
| 141 |
|
| 142 |
( $newBiblionumber, $newBiblioitemnumber ) = AddBiblio( $record, $bibFramework, { defer_marc_save => 1 } ); |
| 143 |
$selectedBiblio = GetBiblio($legacyId); |
| 144 |
|
| 145 |
isnt ($legacyId, $newBiblionumber, 'Testing primary key not-an-integer prevention.'); |
| 146 |
isnt ($legacyId, $selectedBiblio->{biblionumber}, 'Primary key not-an-integer biblio matching'); |
| 147 |
|
| 148 |
|
| 149 |
$dbh->rollback(); |
| 150 |
$dbh->disconnect(); |