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(); |