[Koha-patches] [PATCH] adding database-dependent test libs.
Galen Charlton
galen.charlton at liblime.com
Fri Apr 18 17:58:31 CEST 2008
From: Andrew Moore <andrew.moore at liblime.com>
These test libs should have been included in the previous patch.
Signed-off-by: Galen Charlton <galen.charlton at liblime.com>
---
t/lib/KohaTest.pm | 430 ++++++++++++++++++++++++
t/lib/KohaTest/Acquisition.pm | 147 ++++++++
t/lib/KohaTest/Acquisition/GetHistory.pm | 165 +++++++++
t/lib/KohaTest/Acquisition/GetLateOrders.pm | 106 ++++++
t/lib/KohaTest/Acquisition/GetParcel.pm | 65 ++++
t/lib/KohaTest/Acquisition/GetParcels.pm | 289 ++++++++++++++++
t/lib/KohaTest/Acquisition/GetPendingOrders.pm | 82 +++++
t/lib/KohaTest/Acquisition/NewOrder.pm | 106 ++++++
t/lib/KohaTest/Search.pm | 38 ++
t/lib/KohaTest/Search/SimpleSearch.pm | 134 ++++++++
10 files changed, 1562 insertions(+), 0 deletions(-)
create mode 100644 t/lib/KohaTest.pm
create mode 100644 t/lib/KohaTest/Acquisition.pm
create mode 100644 t/lib/KohaTest/Acquisition/GetHistory.pm
create mode 100644 t/lib/KohaTest/Acquisition/GetLateOrders.pm
create mode 100644 t/lib/KohaTest/Acquisition/GetParcel.pm
create mode 100644 t/lib/KohaTest/Acquisition/GetParcels.pm
create mode 100644 t/lib/KohaTest/Acquisition/GetPendingOrders.pm
create mode 100644 t/lib/KohaTest/Acquisition/NewOrder.pm
create mode 100644 t/lib/KohaTest/Search.pm
create mode 100644 t/lib/KohaTest/Search/SimpleSearch.pm
diff --git a/t/lib/KohaTest.pm b/t/lib/KohaTest.pm
new file mode 100644
index 0000000..9fb416a
--- /dev/null
+++ b/t/lib/KohaTest.pm
@@ -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;
diff --git a/t/lib/KohaTest/Acquisition.pm b/t/lib/KohaTest/Acquisition.pm
new file mode 100644
index 0000000..4685195
--- /dev/null
+++ b/t/lib/KohaTest/Acquisition.pm
@@ -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;
diff --git a/t/lib/KohaTest/Acquisition/GetHistory.pm b/t/lib/KohaTest/Acquisition/GetHistory.pm
new file mode 100644
index 0000000..940d1a9
--- /dev/null
+++ b/t/lib/KohaTest/Acquisition/GetHistory.pm
@@ -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;
diff --git a/t/lib/KohaTest/Acquisition/GetLateOrders.pm b/t/lib/KohaTest/Acquisition/GetLateOrders.pm
new file mode 100644
index 0000000..36f6436
--- /dev/null
+++ b/t/lib/KohaTest/Acquisition/GetLateOrders.pm
@@ -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;
diff --git a/t/lib/KohaTest/Acquisition/GetParcel.pm b/t/lib/KohaTest/Acquisition/GetParcel.pm
new file mode 100644
index 0000000..ec6d87a
--- /dev/null
+++ b/t/lib/KohaTest/Acquisition/GetParcel.pm
@@ -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;
diff --git a/t/lib/KohaTest/Acquisition/GetParcels.pm b/t/lib/KohaTest/Acquisition/GetParcels.pm
new file mode 100644
index 0000000..82b6101
--- /dev/null
+++ b/t/lib/KohaTest/Acquisition/GetParcels.pm
@@ -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;
diff --git a/t/lib/KohaTest/Acquisition/GetPendingOrders.pm b/t/lib/KohaTest/Acquisition/GetPendingOrders.pm
new file mode 100644
index 0000000..d6361ff
--- /dev/null
+++ b/t/lib/KohaTest/Acquisition/GetPendingOrders.pm
@@ -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;
diff --git a/t/lib/KohaTest/Acquisition/NewOrder.pm b/t/lib/KohaTest/Acquisition/NewOrder.pm
new file mode 100644
index 0000000..bf39d2f
--- /dev/null
+++ b/t/lib/KohaTest/Acquisition/NewOrder.pm
@@ -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;
diff --git a/t/lib/KohaTest/Search.pm b/t/lib/KohaTest/Search.pm
new file mode 100644
index 0000000..44d7885
--- /dev/null
+++ b/t/lib/KohaTest/Search.pm
@@ -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;
diff --git a/t/lib/KohaTest/Search/SimpleSearch.pm b/t/lib/KohaTest/Search/SimpleSearch.pm
new file mode 100644
index 0000000..aaf2fa9
--- /dev/null
+++ b/t/lib/KohaTest/Search/SimpleSearch.pm
@@ -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;
--
1.5.5.rc0.16.g02b00
More information about the Koha-patches
mailing list