adding database-dependent test libs.
These test libs should have been included in the previous patch. Signed-off-by: Galen Charlton <galen.charlton@liblime.com> Signed-off-by: Joshua Ferraro <jmf@liblime.com>
This commit is contained in:
Andrew Moore
Joshua Ferraro
parent
80568463ea
commit
d37e9712eb
|
|
@ -0,0 +1,430 @@
|
|||
package KohaTest;
|
||||
use base qw(Test::Class);
|
||||
|
||||
use Test::More;
|
||||
use Data::Dumper;
|
||||
|
||||
eval "use Test::Class";
|
||||
plan skip_all => "Test::Class required for performing database tests" if $@;
|
||||
# Or, maybe I should just die there.
|
||||
|
||||
if ( $ENV{'USER'} ne 'acm' ) {
|
||||
die 'This test suite rewrites your database, so this is to keep you from accidently doing that.';
|
||||
}
|
||||
|
||||
BEGIN {
|
||||
$ENV{'KOHA_CONF'} = '/home/acm/koha/dev/t/etc/koha-conf.xml';
|
||||
}
|
||||
|
||||
use lib qw(..);
|
||||
use C4::Biblio;
|
||||
use C4::Bookfund;
|
||||
use C4::Bookseller;
|
||||
use C4::Context;
|
||||
use C4::Items;
|
||||
use C4::Members;
|
||||
use C4::Search;
|
||||
|
||||
# Since this is an abstract base class, this prevents these tests from
|
||||
# being run directly unless we're testing a subclass. It just makes
|
||||
# things faster.
|
||||
__PACKAGE__->SKIP_CLASS( 1 );
|
||||
|
||||
|
||||
=head2 startup methods
|
||||
|
||||
these are run once, at the beginning of the whole test suite
|
||||
|
||||
=cut
|
||||
|
||||
=head2 startup_10_prepare_database
|
||||
|
||||
prepare a blank database.
|
||||
|
||||
This ends up getting run once for each test module, so that's several
|
||||
times throughout the test suite. That may be too many times to refresh
|
||||
the database. We may have to tune that.
|
||||
|
||||
=cut
|
||||
|
||||
sub startup_10_prepare_database : Test(startup => 1) {
|
||||
my $self = shift;
|
||||
# this is how I'm refreshing my database for now. I'll think of
|
||||
# something better later. Eventually, I'd like to drop the
|
||||
# database entirely and use the regular install code to rebuild a
|
||||
# base database.
|
||||
my $class = ref $self;
|
||||
|
||||
# like( C4::Context->config( 'database '), qr/test$/, 'using test database: ' . C4::Context->config( 'database' ) )
|
||||
like( C4::Context->database(), qr/test$/, 'using test database: ' . C4::Context->database() )
|
||||
or BAIL_OUT( 'This appears to not be a test database.' );
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
sub startup_15_truncate_tables : Test( startup => 1 ) {
|
||||
my $self = shift;
|
||||
|
||||
# my @truncate_tables = qw( accountlines
|
||||
# accountoffsets
|
||||
# action_logs
|
||||
# alert
|
||||
# aqbasket
|
||||
# aqbookfund
|
||||
# aqbooksellers
|
||||
# aqbudget
|
||||
# aqorderbreakdown
|
||||
# aqorderdelivery
|
||||
# aqorders
|
||||
# auth_header
|
||||
# auth_subfield_structure
|
||||
# auth_tag_structure
|
||||
# auth_types
|
||||
# authorised_values
|
||||
# biblio
|
||||
# biblio_framework
|
||||
# biblioitems
|
||||
# borrowers
|
||||
# branchcategories
|
||||
# branches
|
||||
# branchrelations
|
||||
# branchtransfers
|
||||
# browser
|
||||
# categories
|
||||
# categorytable
|
||||
# cities
|
||||
# class_sort_rules
|
||||
# class_sources
|
||||
# currency
|
||||
# deletedbiblio
|
||||
# deletedbiblioitems
|
||||
# deletedborrowers
|
||||
# deleteditems
|
||||
# ethnicity
|
||||
# import_batches
|
||||
# import_biblios
|
||||
# import_items
|
||||
# import_record_matches
|
||||
# import_records
|
||||
# issues
|
||||
# issuingrules
|
||||
# items
|
||||
# itemtypes
|
||||
# labels
|
||||
# labels_conf
|
||||
# labels_profile
|
||||
# labels_templates
|
||||
# language_descriptions
|
||||
# language_rfc4646_to_iso639
|
||||
# language_script_bidi
|
||||
# language_script_mapping
|
||||
# language_subtag_registry
|
||||
# letter
|
||||
# marc_matchers
|
||||
# marc_subfield_structure
|
||||
# marc_tag_structure
|
||||
# matchchecks
|
||||
# matcher_matchpoints
|
||||
# matchpoint_component_norms
|
||||
# matchpoint_components
|
||||
# matchpoints
|
||||
# mediatypetable
|
||||
# notifys
|
||||
# nozebra
|
||||
# old_issues
|
||||
# old_reserves
|
||||
# opac_news
|
||||
# overduerules
|
||||
# patroncards
|
||||
# patronimage
|
||||
# printers
|
||||
# printers_profile
|
||||
# repeatable_holidays
|
||||
# reports_dictionary
|
||||
# reserveconstraints
|
||||
# reserves
|
||||
# reviews
|
||||
# roadtype
|
||||
# saved_reports
|
||||
# saved_sql
|
||||
# serial
|
||||
# serialitems
|
||||
# services_throttle
|
||||
# sessions
|
||||
# special_holidays
|
||||
# statistics
|
||||
# stopwords
|
||||
# subcategorytable
|
||||
# subscription
|
||||
# subscriptionhistory
|
||||
# subscriptionroutinglist
|
||||
# suggestions
|
||||
# systempreferences
|
||||
# tags
|
||||
# userflags
|
||||
# virtualshelfcontents
|
||||
# virtualshelves
|
||||
# z3950servers
|
||||
# zebraqueue
|
||||
# );
|
||||
|
||||
my @truncate_tables = qw( accountlines
|
||||
accountoffsets
|
||||
alert
|
||||
aqbasket
|
||||
aqbooksellers
|
||||
aqorderbreakdown
|
||||
aqorderdelivery
|
||||
aqorders
|
||||
auth_header
|
||||
branchcategories
|
||||
branchrelations
|
||||
branchtransfers
|
||||
browser
|
||||
categorytable
|
||||
cities
|
||||
deletedbiblio
|
||||
deletedbiblioitems
|
||||
deletedborrowers
|
||||
deleteditems
|
||||
ethnicity
|
||||
import_items
|
||||
import_record_matches
|
||||
issues
|
||||
issuingrules
|
||||
items
|
||||
labels
|
||||
labels_profile
|
||||
matchchecks
|
||||
mediatypetable
|
||||
notifys
|
||||
nozebra
|
||||
old_issues
|
||||
old_reserves
|
||||
overduerules
|
||||
patroncards
|
||||
patronimage
|
||||
printers
|
||||
printers_profile
|
||||
reports_dictionary
|
||||
reserveconstraints
|
||||
reserves
|
||||
reviews
|
||||
roadtype
|
||||
saved_reports
|
||||
saved_sql
|
||||
serial
|
||||
serialitems
|
||||
services_throttle
|
||||
special_holidays
|
||||
statistics
|
||||
subcategorytable
|
||||
subscription
|
||||
subscriptionhistory
|
||||
subscriptionroutinglist
|
||||
suggestions
|
||||
tags
|
||||
virtualshelfcontents
|
||||
);
|
||||
|
||||
my $failed_to_truncate = 0;
|
||||
foreach my $table ( @truncate_tables ) {
|
||||
my $dbh = C4::Context->dbh();
|
||||
$dbh->do( "truncate $table" )
|
||||
or $failed_to_truncate = 1;
|
||||
}
|
||||
is( $failed_to_truncate, 0, 'truncated tables' );
|
||||
|
||||
}
|
||||
|
||||
=head2 startup_20_add_bookseller
|
||||
|
||||
we need a bookseller for many of the tests, so let's insert one. Feel
|
||||
free to use this one, or insert your own.
|
||||
|
||||
=cut
|
||||
|
||||
sub startup_20_add_bookseller : Test(startup => 1) {
|
||||
my $self = shift;
|
||||
|
||||
my $booksellerinfo = { name => 'bookseller ' . $self->random_string(),
|
||||
};
|
||||
|
||||
my $id = AddBookseller( $booksellerinfo );
|
||||
ok( $id, "created bookseller: $id" );
|
||||
$self->{'booksellerid'} = $id;
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
=head2 startup_22_add_bookfund
|
||||
|
||||
we need a bookfund for many of the tests. This currently uses one that
|
||||
is in the skeleton database. free to use this one, or insert your
|
||||
own.
|
||||
|
||||
=cut
|
||||
|
||||
sub startup_22_add_bookfund : Test(startup => 2) {
|
||||
my $self = shift;
|
||||
|
||||
my $bookfundid = 'GEN';
|
||||
my $bookfund = GetBookFund( $bookfundid, undef );
|
||||
# diag( Data::Dumper->Dump( [ $bookfund ], qw( bookfund ) ) );
|
||||
is( $bookfund->{'bookfundid'}, $bookfundid, "found bookfund: '$bookfundid'" );
|
||||
is( $bookfund->{'bookfundname'}, 'General Stacks', "found bookfund: '$bookfundid'" );
|
||||
|
||||
$self->{'bookfundid'} = $bookfundid;
|
||||
return;
|
||||
}
|
||||
|
||||
=head2 startup_24_add_member
|
||||
|
||||
Add a patron/member for the tests to use
|
||||
|
||||
=cut
|
||||
|
||||
sub startup_24_add_member : Test(startup => 1) {
|
||||
my $self = shift;
|
||||
|
||||
my $memberinfo = { surname => 'surname ' . $self->random_string(),
|
||||
firstname => 'firstname' . $self->random_string(),
|
||||
address => 'address' . $self->random_string(),
|
||||
city => 'city' . $self->random_string(),
|
||||
branchcode => 'CPL', # CPL => Centerville
|
||||
categorycode => 'PT', # PT => PaTron
|
||||
};
|
||||
|
||||
my $id = AddMember( %$memberinfo );
|
||||
ok( $id, "created member: $id" );
|
||||
$self->{'memberid'} = $id;
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
=head2 setup methods
|
||||
|
||||
setup methods are run before every test method
|
||||
|
||||
=cut
|
||||
|
||||
=head2 teardown methods
|
||||
|
||||
teardown methods are many time, once at the end of each test method.
|
||||
|
||||
=cut
|
||||
|
||||
=head2 shutdown methods
|
||||
|
||||
shutdown methods are run once, at the end of the test suite
|
||||
|
||||
=cut
|
||||
|
||||
=head2 utility methods
|
||||
|
||||
These are not test methods, but they're handy
|
||||
|
||||
=cut
|
||||
|
||||
=head3 random_string
|
||||
|
||||
Nice for generating names and such. It's not actually random, more
|
||||
like arbitrary.
|
||||
|
||||
=cut
|
||||
|
||||
sub random_string {
|
||||
my $self = shift;
|
||||
|
||||
my $wordsize = 6; # how many letters in your string?
|
||||
|
||||
# leave out these characters: "oOlL10". They're too confusing.
|
||||
my @alphabet = ( 'a'..'k','m','n','p'..'z', 'A'..'K','M','N','P'..'Z', 2..9 );
|
||||
|
||||
my $randomstring;
|
||||
foreach ( 0..$wordsize ) {
|
||||
$randomstring .= $alphabet[ rand( scalar( @alphabet ) ) ];
|
||||
}
|
||||
return $randomstring;
|
||||
|
||||
}
|
||||
|
||||
=head3 add_biblios
|
||||
|
||||
$self->add_biblios( count => 10,
|
||||
add_items => 1, );
|
||||
|
||||
named parameters:
|
||||
count: number of biblios to add
|
||||
add_items: should you add items for each one?
|
||||
|
||||
returns:
|
||||
I don't know yet.
|
||||
|
||||
side effects:
|
||||
adds the biblionumbers to the $self->{'biblios'} listref
|
||||
|
||||
Notes:
|
||||
Should I allow you to pass in biblio information, like title?
|
||||
Since this method is in the KohaTest class, all tests in it will be ignored, unless you call this from your own namespace.
|
||||
This runs 10 tests, plus 4 for each "count", plus 3 more for each item added.
|
||||
|
||||
=cut
|
||||
|
||||
sub add_biblios {
|
||||
my $self = shift;
|
||||
my %param = @_;
|
||||
|
||||
$param{'count'} = 1 unless defined( $param{'count'} );
|
||||
$param{'add_items'} = 0 unless defined( $param{'add_items'} );
|
||||
|
||||
foreach my $counter ( 1..$param{'count'} ) {
|
||||
my $marcrecord = MARC::Record->new();
|
||||
isa_ok( $marcrecord, 'MARC::Record' );
|
||||
my $appendedfieldscount = $marcrecord->append_fields( MARC::Field->new( '100', '1', '0',
|
||||
a => 'Twain, Mark',
|
||||
d => "1835-1910." ),
|
||||
MARC::Field->new( '245', '1', '4',
|
||||
a => sprintf( 'The Adventures of Huckleberry Finn Test %s', $counter ),
|
||||
c => "Mark Twain ; illustrated by E.W. Kemble." )
|
||||
);
|
||||
is( $appendedfieldscount, 2, 'added 2 fields' );
|
||||
|
||||
my $frameworkcode = ''; # XXX I'd like to put something reasonable here.
|
||||
my ( $biblionumber, $biblioitemnumber ) = AddBiblio( $marcrecord, $frameworkcode );
|
||||
ok( $biblionumber, "the biblionumber is $biblionumber" );
|
||||
ok( $biblioitemnumber, "the biblioitemnumber is $biblioitemnumber" );
|
||||
if ( $param{'add_items'} ) {
|
||||
# my @iteminfo = AddItem( {}, $biblionumber );
|
||||
my @iteminfo = AddItemFromMarc( $marcrecord, $biblionumber );
|
||||
is( $iteminfo[0], $biblionumber, "biblionumber is $biblionumber" );
|
||||
is( $iteminfo[1], $biblioitemnumber, "biblioitemnumber is $biblioitemnumber" );
|
||||
ok( $iteminfo[2], "itemnumber is $iteminfo[2]" );
|
||||
}
|
||||
push @{$self->{'biblios'}}, $biblionumber;
|
||||
}
|
||||
|
||||
my $query = 'Finn Test';
|
||||
|
||||
# XXX we're going to repeatedly try to fetch the marc records that
|
||||
# we inserted above. It may take a while before they all show
|
||||
# up. why?
|
||||
my $tries = 30;
|
||||
DELAY: foreach my $trial ( 1..$tries ) {
|
||||
diag "waiting for zebra indexing. Trial: $trial of $tries";
|
||||
my ( $error, $results ) = SimpleSearch( $query );
|
||||
if ( $param{'count'} <= scalar( @$results ) ) {
|
||||
ok( $tries, "found all $param{'count'} titles after $trial tries" );
|
||||
last DELAY;
|
||||
}
|
||||
sleep( 3 );
|
||||
} continue {
|
||||
if ( $trial == $tries ) {
|
||||
fail( "we never found all $param{'count'} titles even after $tries tries." );
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
}
|
||||
|
||||
1;
|
||||
|
|
@ -0,0 +1,147 @@
|
|||
package KohaTest::Acquisition;
|
||||
use base qw( KohaTest );
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use Test::More;
|
||||
|
||||
use C4::Acquisition;
|
||||
use C4::Context;
|
||||
use C4::Members;
|
||||
use Time::localtime;
|
||||
|
||||
sub testing_class { 'C4::Acquisition' };
|
||||
|
||||
|
||||
sub methods : Test( 1 ) {
|
||||
my $self = shift;
|
||||
my @methods = qw( GetBasket
|
||||
NewBasket
|
||||
CloseBasket
|
||||
GetPendingOrders
|
||||
GetOrders
|
||||
GetOrderNumber
|
||||
GetOrder
|
||||
NewOrder
|
||||
ModOrder
|
||||
ModOrderBiblioNumber
|
||||
ModReceiveOrder
|
||||
SearchOrder
|
||||
DelOrder
|
||||
GetParcel
|
||||
GetParcels
|
||||
GetLateOrders
|
||||
GetHistory
|
||||
GetRecentAcqui
|
||||
);
|
||||
|
||||
can_ok( $self->testing_class, @methods );
|
||||
}
|
||||
|
||||
=head3 create_new_basket
|
||||
|
||||
creates a baseket by creating an order with no baseket number.
|
||||
|
||||
named parameters:
|
||||
authorizedby
|
||||
invoice
|
||||
date
|
||||
|
||||
returns: baseket number, order number
|
||||
|
||||
runs 4 tests
|
||||
|
||||
=cut
|
||||
|
||||
sub create_new_basket {
|
||||
my $self = shift;
|
||||
my %param = @_;
|
||||
$param{'authorizedby'} = $self->{'memberid'} unless exists $param{'authorizedby'};
|
||||
$param{'invoice'} = 123 unless exists $param{'invoice'};
|
||||
|
||||
my $today = sprintf( '%04d-%02d-%02d',
|
||||
localtime->year() + 1900,
|
||||
localtime->mon() + 1,
|
||||
localtime->mday() );
|
||||
|
||||
# I actually think that this parameter is unused.
|
||||
$param{'date'} = $today unless exists $param{'date'};
|
||||
|
||||
$self->add_biblios( add_items => 1 );
|
||||
ok( scalar @{$self->{'biblios'}} > 0, 'we have added at least one biblio' );
|
||||
|
||||
my ( $basketno, $ordnum ) = NewOrder( undef, # $basketno,
|
||||
$self->{'biblios'}[0], # $bibnum,
|
||||
undef, # $title,
|
||||
1, # $quantity,
|
||||
undef, # $listprice,
|
||||
$self->{'booksellerid'}, # $booksellerid,
|
||||
$param{'authorizedby'}, # $authorisedby,
|
||||
undef, # $notes,
|
||||
$self->{'bookfundid'}, # $bookfund,
|
||||
undef, # $bibitemnum,
|
||||
1, # $rrp,
|
||||
1, # $ecost,
|
||||
undef, # $gst,
|
||||
undef, # $budget,
|
||||
undef, # $cost,
|
||||
undef, # $sub,
|
||||
$param{'invoice'}, # $invoice,
|
||||
undef, # $sort1,
|
||||
undef, # $sort2,
|
||||
undef, # $purchaseorder
|
||||
);
|
||||
ok( $basketno, "my basket number is $basketno" );
|
||||
ok( $ordnum, "my order number is $ordnum" );
|
||||
|
||||
my $order = GetOrder( $ordnum );
|
||||
is( $order->{'ordernumber'}, $ordnum, 'got the right order' )
|
||||
or diag( Data::Dumper->Dump( [ $order ], [ 'order' ] ) );
|
||||
|
||||
is( $order->{'budgetdate'}, $today, "the budget date is $today" );
|
||||
|
||||
# XXX should I stuff these in $self?
|
||||
return ( $basketno, $ordnum );
|
||||
|
||||
}
|
||||
|
||||
|
||||
sub enable_independant_branches {
|
||||
my $self = shift;
|
||||
|
||||
my $member = GetMember( $self->{'memberid'} );
|
||||
|
||||
C4::Context::set_userenv( 0, # usernum
|
||||
$self->{'memberid'}, # userid
|
||||
undef, # usercnum
|
||||
undef, # userfirstname
|
||||
undef, # usersurname
|
||||
$member->{'branchcode'}, # userbranch
|
||||
undef, # branchname
|
||||
0, # userflags
|
||||
undef, # emailaddress
|
||||
undef, # branchprinter
|
||||
);
|
||||
|
||||
# set a preference. There's surely a method for this, but I can't find it.
|
||||
my $retval = C4::Context->dbh->do( q(update systempreferences set value = '1' where variable = 'IndependantBranches') );
|
||||
ok( $retval, 'set the preference' );
|
||||
|
||||
ok( C4::Context->userenv, 'usernev' );
|
||||
isnt( C4::Context->userenv->{flags}, 1, 'flag != 1' )
|
||||
or diag( Data::Dumper->Dump( [ C4::Context->userenv ], [ 'userenv' ] ) );
|
||||
|
||||
is( C4::Context->userenv->{branch}, $member->{'branchcode'}, 'we have set the right branch in C4::Context: ' . $member->{'branchcode'} );
|
||||
|
||||
}
|
||||
|
||||
sub disable_independant_branches {
|
||||
my $self = shift;
|
||||
|
||||
my $retval = C4::Context->dbh->do( q(update systempreferences set value = '0' where variable = 'IndependantBranches') );
|
||||
ok( $retval, 'set the preference back' );
|
||||
|
||||
|
||||
}
|
||||
1;
|
||||
|
|
@ -0,0 +1,165 @@
|
|||
package KohaTest::Acquisition::GetHistory;
|
||||
use base qw( KohaTest::Acquisition );
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use Test::More;
|
||||
use Time::localtime;
|
||||
|
||||
use C4::Acquisition;
|
||||
use C4::Context;
|
||||
use C4::Members;
|
||||
use C4::Biblio;
|
||||
use C4::Bookseller;
|
||||
|
||||
=head3 no_history
|
||||
|
||||
|
||||
|
||||
=cut
|
||||
|
||||
sub no_history : Test( 4 ) {
|
||||
my $self = shift;
|
||||
|
||||
# my ( $order_loop, $total_qty, $total_price, $total_qtyreceived) = GetHistory( $title, $author, $name, $from_placed_on, $to_placed_on )
|
||||
|
||||
my ( $order_loop, $total_qty, $total_price, $total_qtyreceived) = GetHistory();
|
||||
# diag( Data::Dumper->Dump( [ $order_loop, $total_qty, $total_price, $total_qtyreceived ], [ qw( order_loop total_qty total_price total_qtyreceived ) ] ) );
|
||||
|
||||
is( scalar @$order_loop, 0, 'order_loop is empty' );
|
||||
is( $total_qty, 0, 'total_qty' );
|
||||
is( $total_price, 0, 'total_price' );
|
||||
is( $total_qtyreceived, 0, 'total_qtyreceived' );
|
||||
|
||||
|
||||
}
|
||||
|
||||
=head3 one_order
|
||||
|
||||
=cut
|
||||
|
||||
sub one_order : Test( 50 ) {
|
||||
my $self = shift;
|
||||
|
||||
my ( $basketno, $ordnum ) = $self->create_new_basket();
|
||||
ok( $basketno, "basketno is $basketno" );
|
||||
ok( $ordnum, "ordnum is $ordnum" );
|
||||
|
||||
# No arguments fetches no history.
|
||||
{
|
||||
my ( $order_loop, $total_qty, $total_price, $total_qtyreceived) = GetHistory();
|
||||
# diag( Data::Dumper->Dump( [ $order_loop, $total_qty, $total_price, $total_qtyreceived ], [ qw( order_loop total_qty total_price total_qtyreceived ) ] ) );
|
||||
|
||||
is( scalar @$order_loop, 0, 'order_loop is empty' );
|
||||
is( $total_qty, 0, 'total_qty' );
|
||||
is( $total_price, 0, 'total_price' );
|
||||
is( $total_qtyreceived, 0, 'total_qtyreceived' );
|
||||
}
|
||||
|
||||
my $bibliodata = GetBiblioData( $self->{'biblios'}[0] );
|
||||
ok( $bibliodata->{'title'}, 'the biblio has a title' )
|
||||
or diag( Data::Dumper->Dump( [ $bibliodata ], [ 'bibliodata' ] ) );
|
||||
|
||||
# searching by title should find it.
|
||||
{
|
||||
my ( $order_loop, $total_qty, $total_price, $total_qtyreceived) = GetHistory( $bibliodata->{'title'} );
|
||||
# diag( Data::Dumper->Dump( [ $order_loop, $total_qty, $total_price, $total_qtyreceived ], [ qw( order_loop total_qty total_price total_qtyreceived ) ] ) );
|
||||
|
||||
is( scalar @$order_loop, 1, 'order_loop searched by title' );
|
||||
is( $total_qty, 1, 'total_qty searched by title' );
|
||||
is( $total_price, 1, 'total_price searched by title' );
|
||||
is( $total_qtyreceived, 0, 'total_qtyreceived searched by title' );
|
||||
|
||||
# diag( Data::Dumper->Dump( [ $order_loop ], [ 'order_loop' ] ) );
|
||||
}
|
||||
|
||||
# searching by author
|
||||
{
|
||||
my ( $order_loop, $total_qty, $total_price, $total_qtyreceived) = GetHistory( undef, $bibliodata->{'author'} );
|
||||
# diag( Data::Dumper->Dump( [ $order_loop, $total_qty, $total_price, $total_qtyreceived ], [ qw( order_loop total_qty total_price total_qtyreceived ) ] ) );
|
||||
|
||||
is( scalar @$order_loop, 1, 'order_loop searched by author' );
|
||||
is( $total_qty, 1, 'total_qty searched by author' );
|
||||
is( $total_price, 1, 'total_price searched by author' );
|
||||
is( $total_qtyreceived, 0, 'total_qtyreceived searched by author' );
|
||||
}
|
||||
|
||||
# searching by name
|
||||
{
|
||||
# diag( Data::Dumper->Dump( [ $bibliodata ], [ 'bibliodata' ] ) );
|
||||
|
||||
my $bookseller = GetBookSellerFromId( $self->{'booksellerid'} );
|
||||
ok( $bookseller->{'name'}, 'bookseller name' )
|
||||
or diag( Data::Dumper->Dump( [ $bookseller ], [ 'bookseller' ] ) );
|
||||
|
||||
my ( $order_loop, $total_qty, $total_price, $total_qtyreceived) = GetHistory( undef, undef, $bookseller->{'name'} );
|
||||
# diag( Data::Dumper->Dump( [ $order_loop, $total_qty, $total_price, $total_qtyreceived ], [ qw( order_loop total_qty total_price total_qtyreceived ) ] ) );
|
||||
|
||||
is( scalar @$order_loop, 1, 'order_loop searched by name' );
|
||||
is( $total_qty, 1, 'total_qty searched by name' );
|
||||
is( $total_price, 1, 'total_price searched by name' );
|
||||
is( $total_qtyreceived, 0, 'total_qtyreceived searched by name' );
|
||||
}
|
||||
|
||||
# searching by from_date
|
||||
{
|
||||
my $tomorrowseconds = time + 60*60*24;
|
||||
my $tomorrow = sprintf( '%04d-%02d-%02d',
|
||||
localtime( $tomorrowseconds )->year() + 1900,
|
||||
localtime( $tomorrowseconds )->mon() + 1,
|
||||
localtime( $tomorrowseconds )->mday() );
|
||||
|
||||
my ( $order_loop, $total_qty, $total_price, $total_qtyreceived) = GetHistory( undef, undef, undef, undef, $tomorrow );
|
||||
# diag( Data::Dumper->Dump( [ $order_loop, $total_qty, $total_price, $total_qtyreceived ], [ qw( order_loop total_qty total_price total_qtyreceived ) ] ) );
|
||||
|
||||
is( scalar @$order_loop, 1, 'order_loop searched by to_date' );
|
||||
is( $total_qty, 1, 'total_qty searched by to_date' );
|
||||
is( $total_price, 1, 'total_price searched by to_date' );
|
||||
is( $total_qtyreceived, 0, 'total_qtyreceived searched by to_date' );
|
||||
}
|
||||
|
||||
# searching by from_date
|
||||
{
|
||||
my $yesterdayseconds = time - 60*60*24;
|
||||
my $yesterday = sprintf( '%04d-%02d-%02d',
|
||||
localtime( $yesterdayseconds )->year() + 1900,
|
||||
localtime( $yesterdayseconds )->mon() + 1,
|
||||
localtime( $yesterdayseconds )->mday() );
|
||||
# diag( "yesterday was $yesterday" );
|
||||
|
||||
my ( $order_loop, $total_qty, $total_price, $total_qtyreceived) = GetHistory( undef, undef, undef, $yesterday );
|
||||
# diag( Data::Dumper->Dump( [ $order_loop, $total_qty, $total_price, $total_qtyreceived ], [ qw( order_loop total_qty total_price total_qtyreceived ) ] ) );
|
||||
|
||||
is( scalar @$order_loop, 1, 'order_loop searched by from_date' );
|
||||
is( $total_qty, 1, 'total_qty searched by from_date' );
|
||||
is( $total_price, 1, 'total_price searched by from_date' );
|
||||
is( $total_qtyreceived, 0, 'total_qtyreceived searched by from_date' );
|
||||
}
|
||||
|
||||
# set up some things necessary to make GetHistory use the IndependantBranches
|
||||
$self->enable_independant_branches();
|
||||
|
||||
# just search by title here, we need to search by something.
|
||||
{
|
||||
my ( $order_loop, $total_qty, $total_price, $total_qtyreceived) = GetHistory( $bibliodata->{'title'} );
|
||||
# diag( Data::Dumper->Dump( [ $order_loop, $total_qty, $total_price, $total_qtyreceived ], [ qw( order_loop total_qty total_price total_qtyreceived ) ] ) );
|
||||
|
||||
is( scalar @$order_loop, 1, 'order_loop searched by title' );
|
||||
is( $total_qty, 1, 'total_qty searched by title' );
|
||||
is( $total_price, 1, 'total_price searched by title' );
|
||||
is( $total_qtyreceived, 0, 'total_qtyreceived searched by title' );
|
||||
|
||||
# diag( Data::Dumper->Dump( [ $order_loop ], [ 'order_loop' ] ) );
|
||||
}
|
||||
|
||||
# reset that.
|
||||
$self->disable_independant_branches();
|
||||
|
||||
|
||||
|
||||
|
||||
}
|
||||
|
||||
|
||||
1;
|
||||
|
|
@ -0,0 +1,106 @@
|
|||
package KohaTest::Acquisition::GetLateOrders;
|
||||
use base qw( KohaTest::Acquisition );
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use Test::More;
|
||||
|
||||
use C4::Acquisition;
|
||||
use C4::Context;
|
||||
use C4::Members;
|
||||
|
||||
=head3 no_orders
|
||||
|
||||
=cut
|
||||
|
||||
sub no_orders : Test( 1 ) {
|
||||
my $self = shift;
|
||||
|
||||
my @orders = GetLateOrders( 1 );
|
||||
is( scalar @orders, 0, 'There are no orders, so we found 0.' )
|
||||
or diag( Data::Dumper->Dump( [ \@orders ], [ 'orders' ] ) );
|
||||
|
||||
}
|
||||
|
||||
=head3 one_order
|
||||
|
||||
=cut
|
||||
|
||||
sub one_order : Test( 29 ) {
|
||||
my $self = shift;
|
||||
|
||||
my ( $basketid, $ordernumber ) = $self->create_new_basket();
|
||||
ok( $basketid, 'a new basket was created' );
|
||||
ok( $ordernumber, 'the basket has an order in it.' );
|
||||
# we need this basket to be closed.
|
||||
CloseBasket( $basketid );
|
||||
|
||||
my @orders = GetLateOrders( 0 );
|
||||
|
||||
{
|
||||
my @orders = GetLateOrders( 0 );
|
||||
is( scalar @orders, 1, 'An order closed today is 0 days late.' )
|
||||
or diag( Data::Dumper->Dump( [ \@orders ], [ 'orders' ] ) );
|
||||
}
|
||||
{
|
||||
my @orders = GetLateOrders( 1 );
|
||||
is( scalar @orders, 0, 'An order closed today is not 1 day late.' )
|
||||
or diag( Data::Dumper->Dump( [ \@orders ], [ 'orders' ] ) );
|
||||
}
|
||||
{
|
||||
my @orders = GetLateOrders( -1 );
|
||||
is( scalar @orders, 1, 'an order closed today is -1 day late.' )
|
||||
or diag( Data::Dumper->Dump( [ \@orders ], [ 'orders' ] ) );
|
||||
}
|
||||
|
||||
# provide some vendor information
|
||||
{
|
||||
my @orders = GetLateOrders( 0, $self->{'booksellerid'} );
|
||||
is( scalar @orders, 1, 'We found this late order with the right supplierid.' )
|
||||
or diag( Data::Dumper->Dump( [ \@orders ], [ 'orders' ] ) );
|
||||
}
|
||||
{
|
||||
my @orders = GetLateOrders( 0, $self->{'booksellerid'} + 1 );
|
||||
is( scalar @orders, 0, 'We found no late orders with the wrong supplierid.' )
|
||||
or diag( Data::Dumper->Dump( [ \@orders ], [ 'orders' ] ) );
|
||||
}
|
||||
|
||||
# provide some branch information
|
||||
my $member = GetMember( $self->{'memberid'} );
|
||||
# diag( Data::Dumper->Dump( [ $member ], [ 'member' ] ) );
|
||||
{
|
||||
my @orders = GetLateOrders( 0, $self->{'booksellerid'}, $member->{'branchcode'} );
|
||||
is( scalar @orders, 1, 'We found this late order with the right branchcode.' )
|
||||
or diag( Data::Dumper->Dump( [ \@orders ], [ 'orders' ] ) );
|
||||
}
|
||||
{
|
||||
my @orders = GetLateOrders( 0, $self->{'booksellerid'}, 'This is not the branch' );
|
||||
is( scalar @orders, 0, 'We found no late orders with the wrong branchcode.' )
|
||||
or diag( Data::Dumper->Dump( [ \@orders ], [ 'orders' ] ) );
|
||||
}
|
||||
|
||||
# set up some things necessary to make GetLateOrders use the IndependantBranches
|
||||
$self->enable_independant_branches();
|
||||
|
||||
{
|
||||
my @orders = GetLateOrders( 0, $self->{'booksellerid'}, $member->{'branchcode'} );
|
||||
is( scalar @orders, 1, 'We found this late order with the right branchcode.' )
|
||||
or diag( Data::Dumper->Dump( [ \@orders ], [ 'orders' ] ) );
|
||||
}
|
||||
{
|
||||
my @orders = GetLateOrders( 0, $self->{'booksellerid'}, 'This is not the branch' );
|
||||
is( scalar @orders, 0, 'We found no late orders with the wrong branchcode.' )
|
||||
or diag( Data::Dumper->Dump( [ \@orders ], [ 'orders' ] ) );
|
||||
}
|
||||
|
||||
# reset that.
|
||||
$self->disable_independant_branches();
|
||||
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
1;
|
||||
|
|
@ -0,0 +1,65 @@
|
|||
package KohaTest::Acquisition::GetParcel;
|
||||
use base qw( KohaTest::Acquisition );
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use Test::More;
|
||||
use Time::localtime;
|
||||
|
||||
use C4::Acquisition;
|
||||
|
||||
=head3 no_parcel
|
||||
|
||||
at first, there should be no parcels for our bookseller.
|
||||
|
||||
=cut
|
||||
|
||||
sub no_parcel : Test( 1 ) {
|
||||
my $self = shift;
|
||||
|
||||
my @parcel = GetParcel( $self->{'booksellerid'}, undef, undef );
|
||||
is( scalar @parcel, 0, 'our new bookseller has no parcels' )
|
||||
or diag( Data::Dumper->Dump( [ \@parcel ], [ 'parcel' ] ) );
|
||||
}
|
||||
|
||||
=head3 one_parcel
|
||||
|
||||
we create an order, mark it as received, and then see if we can find
|
||||
it with GetParcel.
|
||||
|
||||
=cut
|
||||
|
||||
sub one_parcel : Test( 17 ) {
|
||||
my $self = shift;
|
||||
|
||||
my $invoice = 123; # XXX what should this be?
|
||||
|
||||
my $today = sprintf( '%04d-%02d-%02d',
|
||||
localtime->year() + 1900,
|
||||
localtime->mon() + 1,
|
||||
localtime->mday() );
|
||||
my ( $basketno, $ordnum ) = $self->create_new_basket();
|
||||
|
||||
ok( $basketno, "my basket number is $basketno" );
|
||||
ok( $ordnum, "my order number is $ordnum" );
|
||||
my $datereceived = ModReceiveOrder( $self->{'biblios'}[0], # biblionumber
|
||||
$ordnum, # $ordnum,
|
||||
undef, # $quantrec,
|
||||
undef, # $user,
|
||||
undef, # $cost,
|
||||
$invoice, # $invoiceno,
|
||||
undef, # $freight,
|
||||
undef, # $rrp,
|
||||
$self->{'bookfundid'}, # $bookfund,
|
||||
$today, # $datereceived
|
||||
);
|
||||
is( $datereceived, $today, "the parcel was received on $datereceived" );
|
||||
|
||||
my @parcel = GetParcel( $self->{'booksellerid'}, $invoice, $today );
|
||||
is( scalar @parcel, 1, 'we found one (1) parcel.' )
|
||||
or diag( Data::Dumper->Dump( [ \@parcel ], [ 'parcel' ] ) );
|
||||
|
||||
}
|
||||
|
||||
1;
|
||||
|
|
@ -0,0 +1,289 @@
|
|||
package KohaTest::Acquisition::GetParcels;
|
||||
use base qw( KohaTest::Acquisition );
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use Test::More;
|
||||
use Time::localtime;
|
||||
|
||||
use C4::Acquisition;
|
||||
|
||||
=head2 NOTE
|
||||
|
||||
Please do not confuse this with the test suite for C4::Acquisition::GetParcel.
|
||||
|
||||
=head3 no_parcels
|
||||
|
||||
at first, there should be no parcels for our bookseller.
|
||||
|
||||
=cut
|
||||
|
||||
sub no_parcels : Test( 1 ) {
|
||||
my $self = shift;
|
||||
|
||||
my @parcels = GetParcels( $self->{'booksellerid'}, # bookseller
|
||||
# order
|
||||
# code ( aqorders.booksellerinvoicenumber )
|
||||
# datefrom
|
||||
# date to
|
||||
);
|
||||
|
||||
is( scalar @parcels, 0, 'our new bookseller has no parcels' )
|
||||
or diag( Data::Dumper->Dump( [ \@parcels ], [ 'parcels' ] ) );
|
||||
}
|
||||
|
||||
=head3 one_parcel
|
||||
|
||||
we create an order, mark it as received, and then see if we can find
|
||||
it with GetParcels.
|
||||
|
||||
=cut
|
||||
|
||||
sub one_parcel : Test( 19 ) {
|
||||
my $self = shift;
|
||||
|
||||
my $invoice = 123; # XXX what should this be?
|
||||
my $today = sprintf( '%04d-%02d-%02d',
|
||||
localtime->year() + 1900,
|
||||
localtime->mon() + 1,
|
||||
localtime->mday() );
|
||||
|
||||
$self->create_order( authorizedby => 1, # XXX what should this be?
|
||||
invoice => $invoice,
|
||||
date => $today );
|
||||
|
||||
my @parcels = GetParcels( $self->{'booksellerid'}, # bookseller
|
||||
# order
|
||||
# code ( aqorders.booksellerinvoicenumber )
|
||||
# datefrom
|
||||
# date to
|
||||
);
|
||||
is( scalar @parcels, 1, 'we found one (1) parcel.' )
|
||||
or diag( Data::Dumper->Dump( [ \@parcels ], [ 'parcels' ] ) );
|
||||
|
||||
my $thisparcel = shift( @parcels );
|
||||
is( scalar ( keys( %$thisparcel ) ), 6, 'my parcel hashref has 6 keys' )
|
||||
or diag( Data::Dumper->Dump( [ $thisparcel ], [ 'thisparcel' ] ) );
|
||||
|
||||
is( $thisparcel->{'datereceived'}, $today, 'datereceived' );
|
||||
is( $thisparcel->{'biblio'}, 1, 'biblio' );
|
||||
is( $thisparcel->{'booksellerinvoicenumber'}, $invoice, 'booksellerinvoicenumber' );
|
||||
|
||||
# diag( Data::Dumper->Dump( [ $thisparcel ], [ 'thisparcel' ] ) );
|
||||
|
||||
}
|
||||
|
||||
=head3 two_parcels
|
||||
|
||||
we create another order, mark it as received, and then see if we can find
|
||||
them all with GetParcels.
|
||||
|
||||
=cut
|
||||
|
||||
sub two_parcels : Test( 31 ) {
|
||||
my $self = shift;
|
||||
|
||||
my $invoice = 1234; # XXX what should this be?
|
||||
my $today = sprintf( '%04d-%02d-%02d',
|
||||
localtime->year() + 1900,
|
||||
localtime->mon() + 1,
|
||||
localtime->mday() );
|
||||
$self->create_order( authorizedby => 1, # XXX what should this be?
|
||||
invoice => $invoice,
|
||||
date => $today );
|
||||
|
||||
{
|
||||
# fetch them all and check that this one is last
|
||||
my @parcels = GetParcels( $self->{'booksellerid'}, # bookseller
|
||||
# order
|
||||
# code ( aqorders.booksellerinvoicenumber )
|
||||
# datefrom
|
||||
# date to
|
||||
);
|
||||
is( scalar @parcels, 2, 'we found two (2) parcels.' )
|
||||
or diag( Data::Dumper->Dump( [ \@parcels ], [ 'parcels' ] ) );
|
||||
|
||||
my $thisparcel = pop( @parcels );
|
||||
is( scalar ( keys( %$thisparcel ) ), 6, 'my parcel hashref has 6 keys' )
|
||||
or diag( Data::Dumper->Dump( [ $thisparcel ], [ 'thisparcel' ] ) );
|
||||
|
||||
is( $thisparcel->{'datereceived'}, $today, 'datereceived' );
|
||||
is( $thisparcel->{'biblio'}, 1, 'biblio' );
|
||||
is( $thisparcel->{'booksellerinvoicenumber'}, $invoice, 'booksellerinvoicenumber' );
|
||||
}
|
||||
|
||||
{
|
||||
# fetch just one, by using the exact code
|
||||
my @parcels = GetParcels( $self->{'booksellerid'}, # bookseller
|
||||
undef, # order
|
||||
$invoice, # code ( aqorders.booksellerinvoicenumber )
|
||||
undef, # datefrom
|
||||
undef, # date to
|
||||
);
|
||||
is( scalar @parcels, 1, 'we found one (1) parcels.' )
|
||||
or diag( Data::Dumper->Dump( [ \@parcels ], [ 'parcels' ] ) );
|
||||
|
||||
my $thisparcel = pop( @parcels );
|
||||
is( scalar ( keys( %$thisparcel ) ), 6, 'my parcel hashref has 6 keys' )
|
||||
or diag( Data::Dumper->Dump( [ $thisparcel ], [ 'thisparcel' ] ) );
|
||||
|
||||
is( $thisparcel->{'datereceived'}, $today, 'datereceived' );
|
||||
is( $thisparcel->{'biblio'}, 1, 'biblio' );
|
||||
is( $thisparcel->{'booksellerinvoicenumber'}, $invoice, 'booksellerinvoicenumber' );
|
||||
}
|
||||
|
||||
{
|
||||
# fetch them both by using code 123, which gets 123 and 1234
|
||||
my @parcels = GetParcels( $self->{'booksellerid'}, # bookseller
|
||||
undef, # order
|
||||
'123', # code ( aqorders.booksellerinvoicenumber )
|
||||
undef, # datefrom
|
||||
undef, # date to
|
||||
);
|
||||
is( scalar @parcels, 2, 'we found 2 parcels.' )
|
||||
or diag( Data::Dumper->Dump( [ \@parcels ], [ 'parcels' ] ) );
|
||||
|
||||
}
|
||||
|
||||
{
|
||||
# fetch them both, and try to order them
|
||||
my @parcels = GetParcels( $self->{'booksellerid'}, # bookseller
|
||||
'aqorders.booksellerinvoicenumber', # order
|
||||
undef, # code ( aqorders.booksellerinvoicenumber )
|
||||
undef, # datefrom
|
||||
undef, # date to
|
||||
);
|
||||
is( scalar @parcels, 2, 'we found 2 parcels.' )
|
||||
or diag( Data::Dumper->Dump( [ \@parcels ], [ 'parcels' ] ) );
|
||||
is( $parcels[0]->{'booksellerinvoicenumber'}, 123 );
|
||||
is( $parcels[1]->{'booksellerinvoicenumber'}, 1234 );
|
||||
|
||||
}
|
||||
|
||||
{
|
||||
# fetch them both, and try to order them, descending
|
||||
my @parcels = GetParcels( $self->{'booksellerid'}, # bookseller
|
||||
'aqorders.booksellerinvoicenumber desc', # order
|
||||
undef, # code ( aqorders.booksellerinvoicenumber )
|
||||
undef, # datefrom
|
||||
undef, # date to
|
||||
);
|
||||
is( scalar @parcels, 2, 'we found 2 parcels.' )
|
||||
or diag( Data::Dumper->Dump( [ \@parcels ], [ 'parcels' ] ) );
|
||||
is( $parcels[0]->{'booksellerinvoicenumber'}, 1234 );
|
||||
is( $parcels[1]->{'booksellerinvoicenumber'}, 123 );
|
||||
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
||||
# diag( Data::Dumper->Dump( [ $thisparcel ], [ 'thisparcel' ] ) );
|
||||
|
||||
}
|
||||
|
||||
|
||||
=head3 z_several_parcels_with_different_dates
|
||||
|
||||
we create an order, mark it as received, and then see if we can find
|
||||
it with GetParcels.
|
||||
|
||||
=cut
|
||||
|
||||
sub z_several_parcels_with_different_dates : Test( 44 ) {
|
||||
my $self = shift;
|
||||
|
||||
my $authorizedby = 1; # XXX what should this be?
|
||||
|
||||
my @inputs = ( { invoice => 10,
|
||||
date => sprintf( '%04d-%02d-%02d',
|
||||
1950,
|
||||
localtime->mon() + 1,
|
||||
10 ), # I'm using the invoice number as the day.
|
||||
},
|
||||
{ invoice => 15,
|
||||
date => sprintf( '%04d-%02d-%02d',
|
||||
1950,
|
||||
localtime->mon() + 1,
|
||||
15 ), # I'm using the invoice number as the day.
|
||||
},
|
||||
{ invoice => 20,
|
||||
date => sprintf( '%04d-%02d-%02d',
|
||||
1950,
|
||||
localtime->mon() + 1,
|
||||
20 ), # I'm using the invoice number as the day.
|
||||
},
|
||||
);
|
||||
|
||||
foreach my $input ( @inputs ) {
|
||||
$self->create_order( authorizedby => $authorizedby,
|
||||
invoice => $input->{'invoice'},
|
||||
date => $input->{'date'},
|
||||
);
|
||||
}
|
||||
|
||||
my @parcels = GetParcels( $self->{'booksellerid'}, # bookseller
|
||||
undef, # order
|
||||
undef, # code ( aqorders.booksellerinvoicenumber )
|
||||
sprintf( '%04d-%02d-%02d',
|
||||
1950,
|
||||
localtime->mon() + 1,
|
||||
10 ), # datefrom
|
||||
sprintf( '%04d-%02d-%02d',
|
||||
1950,
|
||||
localtime->mon() + 1,
|
||||
20 ), # dateto
|
||||
);
|
||||
is( scalar @parcels, scalar @inputs, 'we found all of the parcels.' )
|
||||
or diag( Data::Dumper->Dump( [ \@parcels ], [ 'parcels' ] ) );
|
||||
|
||||
@parcels = GetParcels( $self->{'booksellerid'}, # bookseller
|
||||
undef, # order
|
||||
undef, # code ( aqorders.booksellerinvoicenumber )
|
||||
sprintf( '%04d-%02d-%02d',
|
||||
1950,
|
||||
localtime->mon() + 1,
|
||||
10 ), # datefrom
|
||||
sprintf( '%04d-%02d-%02d',
|
||||
1950,
|
||||
localtime->mon() + 1,
|
||||
16 ), # dateto
|
||||
);
|
||||
is( scalar @parcels, scalar @inputs - 1, 'we found all of the parcels except one' )
|
||||
or diag( Data::Dumper->Dump( [ \@parcels ], [ 'parcels' ] ) );
|
||||
|
||||
|
||||
|
||||
# diag( Data::Dumper->Dump( [ $thisparcel ], [ 'thisparcel' ] ) );
|
||||
|
||||
}
|
||||
|
||||
sub create_order {
|
||||
my $self = shift;
|
||||
my %param = @_;
|
||||
$param{'authorizedby'} = 1 unless exists $param{'authorizedby'};
|
||||
$param{'invoice'} = 1 unless exists $param{'invoice'};
|
||||
$param{'date'} = sprintf( '%04d-%02d-%02d',
|
||||
localtime->year() + 1900,
|
||||
localtime->mon() + 1,
|
||||
localtime->mday() ) unless exists $param{'date'};
|
||||
|
||||
my ( $basketno, $ordnum ) = $self->create_new_basket( %param );
|
||||
|
||||
my $datereceived = ModReceiveOrder( $self->{'biblios'}[0], # biblionumber
|
||||
$ordnum, # $ordnum,
|
||||
undef, # $quantrec,
|
||||
undef, # $user,
|
||||
undef, # $cost,
|
||||
$param{'invoice'}, # $invoiceno,
|
||||
undef, # $freight,
|
||||
undef, # $rrp,
|
||||
$self->{'bookfundid'}, # $bookfund,
|
||||
$param{'date'}, # $datereceived
|
||||
);
|
||||
is( $datereceived, $param{'date'}, "the parcel was received on $datereceived" );
|
||||
|
||||
}
|
||||
|
||||
1;
|
||||
|
|
@ -0,0 +1,82 @@
|
|||
package KohaTest::Acquisition::GetPendingOrders;
|
||||
use base qw( KohaTest::Acquisition );
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use Test::More;
|
||||
|
||||
use C4::Acquisition;
|
||||
|
||||
=head3 no_orders
|
||||
|
||||
at first, there should be no orders for our bookseller.
|
||||
|
||||
=cut
|
||||
|
||||
sub no_orders : Test( 1 ) {
|
||||
my $self = shift;
|
||||
|
||||
my $orders = GetPendingOrders( $self->{'booksellerid'} );
|
||||
is( scalar @$orders, 0, 'our new bookseller has no pending orders' )
|
||||
or diag( Data::Dumper->Dump( [ $orders ], [ 'orders' ] ) );
|
||||
}
|
||||
|
||||
=head3 new_order
|
||||
|
||||
we make an order, then see if it shows up in the pending orders
|
||||
|
||||
=cut
|
||||
|
||||
sub one_new_order : Test( 49 ) {
|
||||
my $self = shift;
|
||||
|
||||
my ( $basketno, $ordnum ) = $self->create_new_basket();
|
||||
|
||||
ok( $basketno, "basketno is $basketno" );
|
||||
ok( $ordnum, "ordnum is $ordnum" );
|
||||
|
||||
my $orders = GetPendingOrders( $self->{'booksellerid'} );
|
||||
is( scalar @$orders, 1, 'we successfully entered one order.' );
|
||||
|
||||
my @expectedfields = qw( basketno
|
||||
biblioitemnumber
|
||||
biblionumber
|
||||
booksellerinvoicenumber
|
||||
budgetdate
|
||||
cancelledby
|
||||
closedate
|
||||
creationdate
|
||||
currency
|
||||
datecancellationprinted
|
||||
datereceived
|
||||
ecost
|
||||
entrydate
|
||||
firstname
|
||||
freight
|
||||
gst
|
||||
listprice
|
||||
notes
|
||||
ordernumber
|
||||
purchaseordernumber
|
||||
quantity
|
||||
quantityreceived
|
||||
rrp
|
||||
serialid
|
||||
sort1
|
||||
sort2
|
||||
subscription
|
||||
supplierreference
|
||||
surname
|
||||
timestamp
|
||||
title
|
||||
totalamount
|
||||
unitprice );
|
||||
my $firstorder = $orders->[0];
|
||||
for my $field ( @expectedfields ) {
|
||||
ok( exists( $firstorder->{ $field } ), "This order has a $field field" );
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
1;
|
||||
|
|
@ -0,0 +1,106 @@
|
|||
package KohaTest::Acquisition::NewOrder;
|
||||
use base qw( KohaTest::Acquisition );
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use Test::More;
|
||||
use Time::localtime;
|
||||
|
||||
use C4::Acquisition;
|
||||
|
||||
=head3 new_order_no_budget
|
||||
|
||||
If we make a new order and don't pass in a budget date, it defaults to
|
||||
today.
|
||||
|
||||
=cut
|
||||
|
||||
sub new_order_no_budget : Test( 4 ) {
|
||||
my $self = shift;
|
||||
|
||||
my $authorizedby = 1; # XXX what should this be?
|
||||
my $invoice = 123; # XXX what should this be?
|
||||
my $today = sprintf( '%04d-%02d-%02d',
|
||||
localtime->year() + 1900,
|
||||
localtime->mon() + 1,
|
||||
localtime->mday() );
|
||||
my ( $basketno, $ordnum ) = NewOrder( undef, # $basketno,
|
||||
1, # $bibnum,
|
||||
undef, # $title,
|
||||
undef, # $quantity,
|
||||
undef, # $listprice,
|
||||
$self->{'booksellerid'}, # $booksellerid,
|
||||
$authorizedby, # $authorisedby,
|
||||
undef, # $notes,
|
||||
$self->{'bookfundid'}, # $bookfund,
|
||||
undef, # $bibitemnum,
|
||||
undef, # $rrp,
|
||||
undef, # $ecost,
|
||||
undef, # $gst,
|
||||
undef, # $budget,
|
||||
undef, # $cost,
|
||||
undef, # $sub,
|
||||
$invoice, # $invoice,
|
||||
undef, # $sort1,
|
||||
undef, # $sort2,
|
||||
undef, # $purchaseorder
|
||||
);
|
||||
ok( $basketno, "my basket number is $basketno" );
|
||||
ok( $ordnum, "my order number is $ordnum" );
|
||||
|
||||
my $order = GetOrder( $ordnum );
|
||||
is( $order->{'ordernumber'}, $ordnum, 'got the right order' )
|
||||
or diag( Data::Dumper->Dump( [ $order ], [ 'order' ] ) );
|
||||
|
||||
is( $order->{'budgetdate'}, $today, "the budget date is $today" );
|
||||
}
|
||||
|
||||
=head3 new_order_set_budget
|
||||
|
||||
Let's set the budget date of this new order. It actually pretty much
|
||||
only pays attention to the current month and year.
|
||||
|
||||
=cut
|
||||
|
||||
sub new_order_set_budget : Test( 4 ) {
|
||||
my $self = shift;
|
||||
|
||||
my $authorizedby = 1; # XXX what should this be?
|
||||
my $invoice = 123; # XXX what should this be?
|
||||
my $today = sprintf( '%04d-%02d-%02d',
|
||||
localtime->year() + 1900,
|
||||
localtime->mon() + 1,
|
||||
localtime->mday() );
|
||||
my ( $basketno, $ordnum ) = NewOrder( undef, # $basketno,
|
||||
1, # $bibnum,
|
||||
undef, # $title,
|
||||
undef, # $quantity,
|
||||
undef, # $listprice,
|
||||
$self->{'booksellerid'}, # $booksellerid,
|
||||
$authorizedby, # $authorisedby,
|
||||
undef, # $notes,
|
||||
$self->{'bookfundid'}, # $bookfund,
|
||||
undef, # $bibitemnum,
|
||||
undef, # $rrp,
|
||||
undef, # $ecost,
|
||||
undef, # $gst,
|
||||
'does not matter, just not undef', # $budget,
|
||||
undef, # $cost,
|
||||
undef, # $sub,
|
||||
$invoice, # $invoice,
|
||||
undef, # $sort1,
|
||||
undef, # $sort2,
|
||||
undef, # $purchaseorder
|
||||
);
|
||||
ok( $basketno, "my basket number is $basketno" );
|
||||
ok( $ordnum, "my order number is $ordnum" );
|
||||
|
||||
my $order = GetOrder( $ordnum );
|
||||
is( $order->{'ordernumber'}, $ordnum, 'got the right order' )
|
||||
or diag( Data::Dumper->Dump( [ $order ], [ 'order' ] ) );
|
||||
|
||||
like( $order->{'budgetdate'}, qr(^2\d\d\d-07-01$), "the budget date ($order->{'budgetdate'}) is a July 1st." );
|
||||
}
|
||||
|
||||
1;
|
||||
|
|
@ -0,0 +1,38 @@
|
|||
package KohaTest::Search;
|
||||
use base qw( KohaTest );
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use Test::More;
|
||||
|
||||
use C4::Search;
|
||||
sub testing_class { 'C4::Search' };
|
||||
|
||||
|
||||
sub methods : Test( 1 ) {
|
||||
my $self = shift;
|
||||
my @methods = qw( findseealso
|
||||
FindDuplicate
|
||||
SimpleSearch
|
||||
getRecords
|
||||
pazGetRecords
|
||||
_remove_stopwords
|
||||
_detect_truncation
|
||||
_build_stemmed_operand
|
||||
_build_weighted_query
|
||||
buildQuery
|
||||
searchResults
|
||||
NZgetRecords
|
||||
NZanalyse
|
||||
NZoperatorAND
|
||||
NZoperatorOR
|
||||
NZoperatorNOT
|
||||
NZorder
|
||||
ModBiblios
|
||||
);
|
||||
|
||||
can_ok( $self->testing_class, @methods );
|
||||
}
|
||||
|
||||
1;
|
||||
|
|
@ -0,0 +1,134 @@
|
|||
package KohaTest::Search::SimpleSearch;
|
||||
use base qw( KohaTest::Search );
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use Test::More;
|
||||
|
||||
use C4::Search;
|
||||
use C4::Biblio;
|
||||
|
||||
=head2 STARTUP METHODS
|
||||
|
||||
These get run once, before the main test methods in this module
|
||||
|
||||
=head3 insert_test_data
|
||||
|
||||
=cut
|
||||
|
||||
sub insert_test_data : Test( startup => 71 ) {
|
||||
my $self = shift;
|
||||
|
||||
# I'm going to add a bunch of biblios so that I can search for them.
|
||||
$self->add_biblios( count => 10,
|
||||
add_items => 1 );
|
||||
|
||||
|
||||
}
|
||||
|
||||
=head2 STARTUP METHODS
|
||||
|
||||
standard test methods
|
||||
|
||||
=head3 basic_test
|
||||
|
||||
basic usage.
|
||||
|
||||
=cut
|
||||
|
||||
sub basic_test : Test( 2 ) {
|
||||
my $self = shift;
|
||||
|
||||
my $query = 'test';
|
||||
|
||||
my ( $error, $results ) = SimpleSearch( $query );
|
||||
ok( ! defined $error, 'no error found during search' );
|
||||
like( $results->[0], qr/$query/i, 'the result seems to match the query' )
|
||||
or diag( Data::Dumper->Dump( [ $results ], [ 'results' ] ) );
|
||||
|
||||
}
|
||||
|
||||
=head3 basic_test_with_server
|
||||
|
||||
Test the usage where we specify no limits, but we do specify a server.
|
||||
|
||||
=cut
|
||||
|
||||
sub basic_test_with_server : Test( 2 ) {
|
||||
my $self = shift;
|
||||
|
||||
my $query = 'test';
|
||||
|
||||
my ( $error, $results ) = SimpleSearch( $query, undef, undef, [ 'biblioserver' ] );
|
||||
ok( ! defined $error, 'no error found during search' );
|
||||
like( $results->[0], qr/$query/i, 'the result seems to match the query' )
|
||||
or diag( Data::Dumper->Dump( [ $results ], [ 'results' ] ) );
|
||||
|
||||
}
|
||||
|
||||
|
||||
=head3 basic_test_no_results
|
||||
|
||||
Make sure we get back an empty listref when there are no results.
|
||||
|
||||
=cut
|
||||
|
||||
sub basic_test_no_results : Test( 3 ) {
|
||||
my $self = shift;
|
||||
|
||||
my $query = 'This string is almost guaranteed to not match anything.';
|
||||
|
||||
my ( $error, $results ) = SimpleSearch( $query );
|
||||
ok( ! defined $error, 'no error found during search' );
|
||||
isa_ok( $results, 'ARRAY' );
|
||||
is( scalar( @$results ), 0, 'an empty list was returned.' )
|
||||
or diag( Data::Dumper->Dump( [ $results ], [ 'results' ] ) );
|
||||
}
|
||||
|
||||
=head3 limits
|
||||
|
||||
check that the SimpleTest method limits the number of results returned.
|
||||
|
||||
=cut
|
||||
|
||||
sub limits : Test( 8 ) {
|
||||
my $self = shift;
|
||||
|
||||
my $query = 'Finn Test';
|
||||
|
||||
{
|
||||
my ( $error, $results ) = SimpleSearch( $query );
|
||||
ok( ! defined $error, 'no error found during search' );
|
||||
is( scalar @$results, 10, 'found all 10 results.' )
|
||||
or diag( Data::Dumper->Dump( [ $results ], [ 'results' ] ) );
|
||||
}
|
||||
|
||||
my $offset = 4;
|
||||
{
|
||||
my ( $error, $results ) = SimpleSearch( $query, $offset );
|
||||
ok( ! defined $error, 'no error found during search' );
|
||||
is( scalar @$results, 6, 'found 6 results.' )
|
||||
or diag( Data::Dumper->Dump( [ $results ], [ 'results' ] ) );
|
||||
}
|
||||
|
||||
my $max_results = 2;
|
||||
{
|
||||
my ( $error, $results ) = SimpleSearch( $query, $offset, $max_results );
|
||||
ok( ! defined $error, 'no error found during search' );
|
||||
is( scalar @$results, $max_results, "found $max_results results." )
|
||||
or diag( Data::Dumper->Dump( [ $results ], [ 'results' ] ) );
|
||||
}
|
||||
|
||||
{
|
||||
my ( $error, $results ) = SimpleSearch( $query, 0, $max_results );
|
||||
ok( ! defined $error, 'no error found during search' );
|
||||
is( scalar @$results, $max_results, "found $max_results results." )
|
||||
or diag( Data::Dumper->Dump( [ $results ], [ 'results' ] ) );
|
||||
}
|
||||
|
||||
|
||||
}
|
||||
|
||||
|
||||
1;
|
||||
Loading…
Reference in New Issue