|
Lines 1-12
Link Here
|
| 1 |
#!/usr/bin/perl |
1 |
#!/usr/bin/perl |
| 2 |
|
2 |
|
| 3 |
# |
|
|
| 4 |
# This file is a test script for C4::VirtualShelves.pm |
3 |
# This file is a test script for C4::VirtualShelves.pm |
| 5 |
# Author : Antoine Farnault, antoine@koha-fr.org |
4 |
# Author : Antoine Farnault, antoine@koha-fr.org |
| 6 |
# |
5 |
# Larger modifications by Jonathan Druart and Marcel de Rooy |
| 7 |
|
6 |
|
| 8 |
use Modern::Perl; |
7 |
use Modern::Perl; |
| 9 |
use Test::More tests => 82; |
8 |
use Test::More tests => 81; |
| 10 |
use MARC::Record; |
9 |
use MARC::Record; |
| 11 |
|
10 |
|
| 12 |
use C4::Biblio qw( AddBiblio DelBiblio ); |
11 |
use C4::Biblio qw( AddBiblio DelBiblio ); |
|
Lines 14-29
use C4::Context;
Link Here
|
| 14 |
|
13 |
|
| 15 |
# Getting some borrowers from database. |
14 |
# Getting some borrowers from database. |
| 16 |
my $dbh = C4::Context->dbh; |
15 |
my $dbh = C4::Context->dbh; |
| 17 |
my $query = q{ |
16 |
my $query = q{SELECT borrowernumber FROM borrowers LIMIT 10}; |
| 18 |
SELECT borrowernumber |
17 |
my $borr_ref=$dbh->selectall_arrayref($query); |
| 19 |
FROM borrowers |
18 |
if(@$borr_ref==0) { #no borrowers? should not occur of course |
| 20 |
LIMIT 10 |
19 |
$borr_ref->[0][0]=undef; |
| 21 |
}; |
20 |
#but even then, we can run this robust test :) |
| 22 |
my $sth = $dbh->prepare($query); |
21 |
} |
| 23 |
$sth->execute; |
|
|
| 24 |
my @borrowers; |
22 |
my @borrowers; |
| 25 |
while(my $borrower = $sth->fetchrow){ |
23 |
foreach(1..10) { |
| 26 |
push @borrowers, $borrower; |
24 |
my $t= $_> @$borr_ref ? int(rand()*@$borr_ref): $_-1; #repeat if not enough |
|
|
25 |
push @borrowers, $borr_ref->[$t][0]; |
| 27 |
} |
26 |
} |
| 28 |
|
27 |
|
| 29 |
# Creating some biblios |
28 |
# Creating some biblios |
|
Lines 34-53
foreach(0..9) {
Link Here
|
| 34 |
push @biblionumbers, $biblionumber; |
33 |
push @biblionumbers, $biblionumber; |
| 35 |
} |
34 |
} |
| 36 |
|
35 |
|
| 37 |
# FIXME Why are you deleting my shelves? See bug 10386. |
|
|
| 38 |
my $delete_virtualshelf = q{ |
| 39 |
DELETE FROM virtualshelves WHERE 1 |
| 40 |
}; |
| 41 |
my $delete_virtualshelfcontent = q{ |
| 42 |
DELETE FROM virtualshelfcontents WHERE 1 |
| 43 |
}; |
| 44 |
|
| 45 |
$sth = $dbh->prepare($delete_virtualshelf); |
| 46 |
$sth->execute; |
| 47 |
$sth = $dbh->prepare($delete_virtualshelfcontent); |
| 48 |
$sth->execute; |
| 49 |
# --- |
| 50 |
|
| 51 |
#----------------------------------------------------------------------# |
36 |
#----------------------------------------------------------------------# |
| 52 |
# |
37 |
# |
| 53 |
# TESTS START HERE |
38 |
# TESTS START HERE |
|
Lines 59-91
use_ok('C4::VirtualShelves');
Link Here
|
| 59 |
#-----------------------TEST AddShelf function------------------------# |
44 |
#-----------------------TEST AddShelf function------------------------# |
| 60 |
# usage : $shelfnumber = &AddShelf( $shelfname, $owner, $category); |
45 |
# usage : $shelfnumber = &AddShelf( $shelfname, $owner, $category); |
| 61 |
|
46 |
|
| 62 |
# creating 10 good shelves. |
47 |
# creating shelves (could be <10 when names are not unique) |
| 63 |
my @shelves; |
48 |
my @shelves; |
| 64 |
for(my $i=0; $i<10;$i++){ |
49 |
for(my $i=0; $i<10;$i++) { |
| 65 |
my $ShelfNumber = AddShelf( |
50 |
my $name= randomname(); |
| 66 |
{shelfname=>"Shelf_".$i, category=>int(rand(2))+1 }, $borrowers[$i] ); |
51 |
my $catg= int(rand(2))+1; |
| 67 |
die "test Not ok, remove some shelves before" if ($ShelfNumber == -1); |
52 |
my $ShelfNumber= AddShelf( |
| 68 |
ok($ShelfNumber > -1, "created shelf"); # Shelf creation successful; |
53 |
{ |
| 69 |
push @shelves, $ShelfNumber if $ShelfNumber > -1; |
54 |
shelfname => $name, |
|
|
55 |
category => $catg, |
| 56 |
}, |
| 57 |
$borrowers[$i]); |
| 58 |
|
| 59 |
if($ShelfNumber>-1) { |
| 60 |
ok($ShelfNumber > -1, "created shelf"); # Shelf creation successful; |
| 61 |
} |
| 62 |
else { |
| 63 |
my $t= C4::VirtualShelves::_CheckShelfName( |
| 64 |
$name, $catg, $borrowers[$i], 0); |
| 65 |
ok($t==0, "Name clash expected on shelf creation"); |
| 66 |
} |
| 67 |
push @shelves, { |
| 68 |
number => $ShelfNumber, |
| 69 |
name => $name, |
| 70 |
catg => $catg, |
| 71 |
owner => $borrowers[$i], |
| 72 |
}; #also push the errors |
| 70 |
} |
73 |
} |
| 71 |
|
74 |
|
| 72 |
ok(10 == scalar @shelves, 'created 10 lists'); # 10 shelves in @shelves; |
75 |
# try to create shelves with duplicate names |
| 73 |
|
|
|
| 74 |
# try to create some shelf which already exists. |
| 75 |
for(my $i=0;$i<10;$i++){ |
76 |
for(my $i=0;$i<10;$i++){ |
| 76 |
my @shlf=GetShelf($shelves[$i]); |
77 |
if($shelves[$i]->{number}<0) { |
| 77 |
|
78 |
ok(1, 'skip duplicate test for earlier name clash'); |
| 78 |
# FIXME This test still needs some attention |
79 |
next; |
| 79 |
# A shelf name is not per se unique ! See report 10386 |
80 |
} |
| 80 |
#temporary hack: Original test only for public list |
81 |
my @shlf=GetShelf($shelves[$i]->{number}); #number, name, owner, catg, ... |
| 81 |
if( $shlf[3]==2 ) { |
82 |
|
| 82 |
my $badNumShelf= AddShelf( |
83 |
# A shelf name is not per se unique! |
| 83 |
{shelfname=>"Shelf_".$i, category => 2}, $borrowers[$i]); |
84 |
if( $shlf[3]==2 ) { #public list: try to create with same name |
|
|
85 |
my $badNumShelf= AddShelf( { |
| 86 |
shelfname=> $shelves[$i]->{name}, |
| 87 |
category => 2 |
| 88 |
}, $borrowers[$i]); |
| 84 |
ok(-1==$badNumShelf, 'do not create public lists with duplicate names'); |
89 |
ok(-1==$badNumShelf, 'do not create public lists with duplicate names'); |
| 85 |
#AddShelf returns -1 if name already exist. |
90 |
#AddShelf returns -1 if name already exist. |
|
|
91 |
DelShelf($badNumShelf) if $badNumShelf>-1; #delete if went wrong.. |
| 86 |
} |
92 |
} |
| 87 |
else { |
93 |
else { #private list, try to add another one for SAME user (owner) |
| 88 |
ok(1==1, "This trivial test cannot fail :)"); #leave count intact |
94 |
my $badNumShelf= defined($shlf[2])? AddShelf( |
|
|
95 |
{ |
| 96 |
shelfname=> $shelves[$i]->{name}, |
| 97 |
category => 1, |
| 98 |
}, |
| 99 |
$shlf[2]): -1; |
| 100 |
ok(-1==$badNumShelf, 'do not create private lists with duplicate name for same user'); |
| 101 |
DelShelf($badNumShelf) if $badNumShelf>-1; #delete if went wrong.. |
| 89 |
} |
102 |
} |
| 90 |
} |
103 |
} |
| 91 |
|
104 |
|
|
Lines 97-106
for(my $i=0;$i<10;$i++){
Link Here
|
| 97 |
my %used = (); |
110 |
my %used = (); |
| 98 |
for(my $i=0; $i<10;$i++){ |
111 |
for(my $i=0; $i<10;$i++){ |
| 99 |
my $bib = $biblionumbers[int(rand(9))]; |
112 |
my $bib = $biblionumbers[int(rand(9))]; |
| 100 |
my $shelfnumber = $shelves[int(rand(9))]; |
113 |
my $shelfnumber = $shelves[int(rand(9))]->{number}; |
|
|
114 |
if($shelfnumber<0) { |
| 115 |
ok(1, 'skip add to list-test for shelf -1'); |
| 116 |
ok(1, 'skip counting list entries for shelf -1'); |
| 117 |
next; |
| 118 |
} |
| 101 |
|
119 |
|
| 102 |
my $key = "$bib\t$shelfnumber"; |
120 |
my $key = "$bib\t$shelfnumber"; |
| 103 |
my $should_fail = exists($used{$key}) ? 1 : 0; |
121 |
my $should_fail = exists($used{$key}) ? 1 : 0; |
|
|
122 |
#FIXME We assume here that we have permission to add.. |
| 123 |
#The different permissions could be tested too. |
| 104 |
|
124 |
|
| 105 |
my ($biblistBefore,$countbefore) = GetShelfContents($shelfnumber); |
125 |
my ($biblistBefore,$countbefore) = GetShelfContents($shelfnumber); |
| 106 |
my $status = AddToShelf($bib,$shelfnumber,$borrowers[$i]); |
126 |
my $status = AddToShelf($bib,$shelfnumber,$borrowers[$i]); |
|
Lines 115-125
for(my $i=0; $i<10;$i++){
Link Here
|
| 115 |
if (defined $status) { |
135 |
if (defined $status) { |
| 116 |
ok($countbefore == $countafter - 1, 'added bib to list'); # the bib has been successfuly added. |
136 |
ok($countbefore == $countafter - 1, 'added bib to list'); # the bib has been successfuly added. |
| 117 |
} else { |
137 |
} else { |
| 118 |
ok($countbefore == $countafter, 'did not add duplicate bib to list'); # the bib has been successfuly added. |
138 |
ok($countbefore == $countafter, 'did not add duplicate bib to list'); |
| 119 |
} |
139 |
} |
| 120 |
|
140 |
|
| 121 |
$used{$key}++; |
141 |
$used{$key}++; |
| 122 |
|
|
|
| 123 |
} |
142 |
} |
| 124 |
|
143 |
|
| 125 |
#-----------------------TEST ModShelf & GetShelf functions------------------------# |
144 |
#-----------------------TEST ModShelf & GetShelf functions------------------------# |
|
Lines 128-153
for(my $i=0; $i<10;$i++){
Link Here
|
| 128 |
|
147 |
|
| 129 |
for(my $i=0; $i<10;$i++){ |
148 |
for(my $i=0; $i<10;$i++){ |
| 130 |
my $rand = int(rand(9)); |
149 |
my $rand = int(rand(9)); |
| 131 |
my $numA = $shelves[$rand]; |
150 |
my $numA = $shelves[$rand]->{number}; |
| 132 |
my $shelf = { shelfname => "NewName_".$rand, |
151 |
if($numA<0) { |
| 133 |
category => int(rand(2))+1 }; |
152 |
ok(1, 'Skip ModShelf test for shelf -1'); |
| 134 |
|
153 |
ok(1, 'Skip ModShelf test for shelf -1'); |
| 135 |
ModShelf($numA,$shelf); |
154 |
ok(1, 'Skip ModShelf test for shelf -1'); |
| 136 |
my ($numB,$nameB,$ownerB,$categoryB) = GetShelf($numA); |
155 |
next; |
| 137 |
|
156 |
} |
| 138 |
ok($numA == $numB, 'modified shelf'); |
157 |
my $newname= randomname(); |
| 139 |
ok($shelf->{shelfname} eq $nameB, '... and name change took'); |
158 |
my $shelf = { |
| 140 |
ok($shelf->{category} eq $categoryB, '... and category change took'); |
159 |
shelfname => $newname, |
|
|
160 |
category => 3-$shelves[$rand]->{catg}, # tric: 1->2 and 2->1 |
| 161 |
}; |
| 162 |
#check name change (with category change) |
| 163 |
if(C4::VirtualShelves::_CheckShelfName($newname,$shelf->{category}, |
| 164 |
$shelves[$rand]->{owner}, $numA)) { |
| 165 |
ModShelf($numA,$shelf); |
| 166 |
my ($numB,$nameB,$ownerB,$categoryB) = GetShelf($numA); |
| 167 |
ok($numA == $numB, 'modified shelf'); |
| 168 |
ok($shelf->{shelfname} eq $nameB, '... and name change took'); |
| 169 |
ok($shelf->{category} eq $categoryB, '... and category change took'); |
| 170 |
} |
| 171 |
else { |
| 172 |
ok(1, "No ModShelf for $newname") for 1..3; |
| 173 |
} |
| 141 |
} |
174 |
} |
| 142 |
|
175 |
|
| 143 |
#-----------------------TEST DelShelf & DelFromShelf functions------------------------# |
176 |
#-----------------------TEST DelShelf & DelFromShelf functions------------------------# |
| 144 |
# usage : ($status) = &DelShelf($shelfnumber); |
177 |
# usage : ($status) = &DelShelf($shelfnumber); |
| 145 |
|
178 |
|
| 146 |
for(my $i=0; $i<10;$i++){ |
179 |
for(my $i=0; $i<10;$i++){ |
| 147 |
my $shelfnumber = $shelves[$i]; |
180 |
my $shelfnumber = $shelves[$i]->{number}; |
|
|
181 |
if($shelfnumber<0) { |
| 182 |
ok(1, 'Skip DelShelf for shelf -1'); |
| 183 |
next; |
| 184 |
} |
| 148 |
my $status = DelShelf($shelfnumber); |
185 |
my $status = DelShelf($shelfnumber); |
| 149 |
ok(1 == $status, "deleted shelf $shelfnumber and its contents"); |
186 |
ok(1 == $status, "deleted shelf $shelfnumber and its contents"); |
| 150 |
} |
187 |
} |
| 151 |
|
188 |
|
| 152 |
#----------------------- CLEANUP ----------------------------------------------# |
189 |
#----------------------- CLEANUP ----------------------------------------------# |
|
|
190 |
|
| 153 |
DelBiblio($_) for @biblionumbers; |
191 |
DelBiblio($_) for @biblionumbers; |
| 154 |
- |
192 |
|
|
|
193 |
#----------------------- SOME SUBS --------------------------------------------# |
| 194 |
|
| 195 |
sub randomname { |
| 196 |
my $rv=''; |
| 197 |
for(0..19) { |
| 198 |
$rv.= ('a'..'z','A'..'Z',0..9) [int(rand()*62)]; |
| 199 |
} |
| 200 |
return $rv; |
| 201 |
} |