Bug 29862: Add missing txn begin/rollback in TestBuilder.t
[koha-ffzg.git] / t / db_dependent / TestBuilder.t
old mode 100644 (file)
new mode 100755 (executable)
index 4d93cee..c256fe5
 
 use Modern::Perl;
 
-use Test::More tests => 11;
+use utf8;
+
+use Test::More tests => 15;
 use Test::Warn;
-use Data::Dumper qw(Dumper);
+use File::Basename qw(dirname);
 
 use Koha::Database;
+use Koha::Patrons;
 
 BEGIN {
     use_ok('t::lib::TestBuilder');
 }
 
-my $schema = Koha::Database->new->schema;
-$schema->storage->txn_begin;
-my $builder;
-
+our $schema = Koha::Database->new->schema;
+our $builder;
 
 subtest 'Start with some trivial tests' => sub {
-    plan tests => 6;
+    plan tests => 7;
+
+    $schema->storage->txn_begin;
 
     $builder = t::lib::TestBuilder->new;
     isnt( $builder, undef, 'We got a builder' );
 
-    is( $builder->build, undef, 'build without arguments returns undef' );
+    my $data;
+    warning_like { $data = $builder->build; } qr/.+/, 'Catch a warning';
+    is( $data, undef, 'build without arguments returns undef' );
     is( ref( $builder->schema ), 'Koha::Schema', 'check schema' );
     is( ref( $builder->can('delete') ), 'CODE', 'found delete method' );
 
@@ -57,16 +62,22 @@ subtest 'Start with some trivial tests' => sub {
     warning_like { $builder->build( $param ) }
         qr/Violation of unique constraint/,
         'Catch warn on adding existing record';
+
+    $schema->storage->txn_rollback;
 };
 
 
 subtest 'Build all sources' => sub {
     plan tests => 1;
 
+    $schema->storage->txn_begin;
+
     my @sources = $builder->schema->sources;
     my @source_in_failure;
     for my $source ( @sources ) {
         my $res;
+        # Skip the source if it is a view
+        next if $schema->source($source)->isa('DBIx::Class::ResultSource::View');
         eval { $res = $builder->build( { source => $source } ); };
         push @source_in_failure, $source if $@ || !defined( $res );
     }
@@ -76,11 +87,15 @@ subtest 'Build all sources' => sub {
         diag( "The following sources have not been generated correctly: " .
         join ', ', @source_in_failure );
     }
+
+    $schema->storage->txn_rollback;
 };
 
 
 subtest 'Test length of some generated fields' => sub {
-    plan tests => 2;
+    plan tests => 3;
+
+    $schema->storage->txn_begin;
 
     # Test the length of a returned character field
     my $bookseller = $builder->build({ source  => 'Aqbookseller' });
@@ -89,12 +104,19 @@ subtest 'Test length of some generated fields' => sub {
         'The length for a generated string (phone) should not be zero' );
     is( length( $bookseller->{phone} ) <= $max, 1,
         'Check maximum length for a generated string (phone)' );
+
+    my $item = $builder->build({ source => 'Item' });
+    is( $item->{replacementprice}, sprintf("%.2f", $item->{replacementprice}), "The number of decimals for floats should not be more than 2" );
+
+    $schema->storage->txn_rollback;
 };
 
 
 subtest 'Test FKs in overduerules_transport_type' => sub {
     plan tests => 5;
 
+    $schema->storage->txn_begin;
+
     my $my_overduerules_transport_type = {
         message_transport_type => {
             message_transport_type => 'my msg_t_t',
@@ -134,12 +156,16 @@ subtest 'Test FKs in overduerules_transport_type' => sub {
         undef,
         'build generates values if they are not given'
     );
+
+    $schema->storage->txn_rollback;
 };
 
 
 subtest 'Tests with composite FK in userpermission' => sub {
     plan tests => 9;
 
+    $schema->storage->txn_begin;
+
     my $my_user_permission = default_userpermission();
     my $user_permission = $builder->build({
         source => 'UserPermission',
@@ -197,6 +223,8 @@ subtest 'Tests with composite FK in userpermission' => sub {
         $my_user_permission->{code}->{description},
         'build stored description correctly'
     );
+
+    $schema->storage->txn_rollback;
 };
 
 sub default_userpermission {
@@ -229,6 +257,8 @@ sub default_userpermission {
 subtest 'Test build with NULL values' => sub {
     plan tests => 3;
 
+    $schema->storage->txn_begin;
+
     # PK should not be null
     my $params = { source => 'Branch', value => { branchcode => undef }};
     warning_like { $builder->build( $params ) }
@@ -246,12 +276,16 @@ subtest 'Test build with NULL values' => sub {
     $info = $schema->source( 'Reserve' )->column_info( 'itemnumber' );
     is( $reserve && $info->{is_nullable} && $info->{is_foreign_key} &&
         !defined( $reserve->{itemnumber} ), 1, 'Nullable FK' );
+
+    $schema->storage->txn_rollback;
 };
 
 
 subtest 'Tests for delete method' => sub {
     plan tests => 12;
 
+    $schema->storage->txn_begin;
+
     # Test delete with single and multiple records
     my $basket1 = $builder->build({ source => 'Aqbasket' });
     my $basket2 = $builder->build({ source => 'Aqbasket' });
@@ -269,7 +303,7 @@ subtest 'Tests for delete method' => sub {
     # Test delete in table without primary key (..)
     is( $schema->source('TmpHoldsqueue')->primary_columns, 0,
         'Table without primary key detected' );
-    my $bibno = 123; # just a number
+    my $bibno = $builder->build_sample_biblio->biblionumber;
     my $cnt1 = $schema->resultset('TmpHoldsqueue')->count;
     # Insert a new record in TmpHoldsqueue with that biblionumber
     my $val = { biblionumber => $bibno };
@@ -290,12 +324,15 @@ subtest 'Tests for delete method' => sub {
              code       => undef };
     is( $builder->delete({ source => 'Permission', records => $val }), 0,
         'delete returns zero for an undef search with a composite PK' );
-};
 
+    $schema->storage->txn_rollback;
+};
 
 subtest 'Auto-increment values tests' => sub {
     plan tests => 3;
 
+    $schema->storage->txn_begin;
+
     # Pick a table with AI PK
     my $source  = 'Biblio'; # table
     my $column  = 'biblionumber'; # ai column
@@ -319,28 +356,189 @@ subtest 'Auto-increment values tests' => sub {
             value  => { biblionumber => 123 },
         }) } qr/^Value not allowed for auto_incr/,
         'Build should not overwrite an auto_incr column';
+
+    $schema->storage->txn_rollback;
 };
 
 subtest 'Date handling' => sub {
     plan tests => 2;
 
+    $schema->storage->txn_begin;
+
     $builder = t::lib::TestBuilder->new;
 
     my $patron = $builder->build( { source => 'Borrower' } );
     is( length( $patron->{updated_on} ),  19, 'A timestamp column value should be YYYY-MM-DD HH:MM:SS' );
     is( length( $patron->{dateofbirth} ), 10, 'A date column value should be YYYY-MM-DD' );
 
+    $schema->storage->txn_rollback;
 };
 
 subtest 'Default values' => sub {
-    plan tests => 2;
+    plan tests => 3;
+
+    $schema->storage->txn_begin;
+
     $builder = t::lib::TestBuilder->new;
     my $item = $builder->build( { source => 'Item' } );
-    is( $item->{more_subfields_xml}, undef );
+    is( $item->{more_subfields_xml}, undef, 'This xml field should be undef' );
     $item = $builder->build( { source => 'Item', value => { more_subfields_xml => 'some xml' } } );
-    is( $item->{more_subfields_xml}, 'some xml' );
+    is( $item->{more_subfields_xml}, 'some xml', 'Default should not overwrite assigned value' );
+
+    subtest 'generated dynamically (coderef)' => sub {
+        plan tests => 2;
+        my $patron = $builder->build_object({ class => 'Koha::Patrons' });
+        like( $patron->category->category_type, qr{^(A|C|S|I|P|)$}, );
+
+        my $patron_category_X = $builder->build_object({ class => 'Koha::Patron::Categories', value => { category_type => 'X' } });
+        $patron = $builder->build_object({ class => 'Koha::Patrons', value => {categorycode => $patron_category_X->categorycode} });
+        is( $patron->category->category_type, 'X', );
+    };
+
+    $schema->storage->txn_rollback;
 };
 
-$schema->storage->txn_rollback;
+subtest 'build_object() tests' => sub {
+
+    plan tests => 5;
+
+    $schema->storage->txn_begin;
+
+    $builder = t::lib::TestBuilder->new();
+
+    my $branchcode = $builder->build( { source => 'Branch' } )->{branchcode};
+    my $categorycode = $builder->build( { source => 'Category' } )->{categorycode};
+    my $itemtype = $builder->build( { source => 'Itemtype' } )->{itemtype};
+
+    my $issuing_rule = $builder->build_object(
+        {   class => 'Koha::CirculationRules',
+            value => {
+                branchcode   => $branchcode,
+                categorycode => $categorycode,
+                itemtype     => $itemtype
+            }
+        }
+    );
 
-1;
+    is( ref($issuing_rule), 'Koha::CirculationRule', 'Type is correct' );
+    is( $issuing_rule->categorycode,
+        $categorycode, 'Category code correctly set' );
+    is( $issuing_rule->itemtype, $itemtype, 'Item type correctly set' );
+
+    subtest 'Test all classes' => sub {
+        my $Koha_modules_dir = dirname(__FILE__) . '/../../Koha';
+        my @koha_object_based_modules = `/bin/grep -rl -e '^sub object_class' $Koha_modules_dir`;
+        my @source_in_failure;
+        for my $module_filepath ( @koha_object_based_modules ) {
+            chomp $module_filepath;
+            next unless $module_filepath =~ m|\.pm$|;
+            my $module = $module_filepath;
+            $module =~ s|^.*/(Koha.*)\.pm$|$1|;
+            $module =~ s|/|::|g;
+            next if $module eq 'Koha::Objects';
+            eval "require $module";
+            my $object = $builder->build_object( { class => $module } );
+            is( ref($object), $module->object_class, "Testing $module" );
+            if ( ! grep {$module eq $_ } qw( Koha::Old::Patrons Koha::Statistics ) ) { # FIXME deletedborrowers and statistics do not have a PK
+                eval {$object->get_from_storage};
+                is( $@, '', "Module $module should have koha_object[s]_class method if needed" );
+            }
+
+            # Testing koha_object_class and koha_objects_class
+            my $object_class =  Koha::Object::_get_object_class($object->_result->result_class);
+            eval "require $object_class";
+            is( $@, '', "Module $object_class should be defined");
+            my $objects_class = Koha::Objects::_get_objects_class($object->_result->result_class);
+            eval "require $objects_class";
+            is( $@, '', "Module $objects_class should be defined");
+        }
+    };
+
+    subtest 'test parameters' => sub {
+        plan tests => 3;
+
+        warning_is { $issuing_rule = $builder->build_object( {} ); }
+        { carped => 'Missing class param' },
+            'The class parameter is mandatory, raises a warning if absent';
+        is( $issuing_rule, undef,
+            'If the class parameter is missing, undef is returned' );
+
+        warnings_like {
+            $builder->build_object(
+                { class => 'Koha::Patrons', categorycode => 'foobar' } );
+        } qr{Unknown parameter\(s\): categorycode}, "Unknown parameter detected";
+    };
+
+    $schema->storage->txn_rollback;
+};
+
+subtest '->build parameter' => sub {
+    plan tests => 4;
+
+    $schema->storage->txn_begin;
+
+    # Test to make sure build() warns user of unknown parameters.
+    warnings_are {
+        $builder->build({
+            source => 'Branch',
+            value => {
+                branchcode => 'BRANCH_1'
+            }
+        })
+    } [], "No warnings on correct use";
+
+    warnings_like {
+        $builder->build({
+            source     => 'Branch',
+            branchcode => 'BRANCH_2' # This is wrong!
+        })
+    } qr/unknown param/i, "Carp unknown parameters";
+
+    warnings_like {
+        $builder->build({
+            zource     => 'Branch', # Intentional spelling error
+        })
+    } qr/Source parameter not specified/, "Catch warning on missing source";
+
+    warnings_like {
+        $builder->build(
+            { source => 'Borrower', categorycode => 'foobar' } );
+    } qr{Unknown parameter\(s\): categorycode}, "Unkown parameter detected";
+
+    $schema->storage->txn_rollback;
+};
+
+subtest 'build_sample_biblio() tests' => sub {
+
+    plan tests => 1;
+
+    $schema->storage->txn_begin;
+
+    warnings_are
+        { $builder->build_sample_biblio({ title => 'hell❤️' }); }
+        [],
+        "No encoding warnings!";
+
+    $schema->storage->txn_rollback;
+};
+
+subtest 'Existence of object is only checked using primary keys' => sub {
+
+    plan tests => 1;
+
+    $schema->storage->txn_begin;
+
+    my $biblio = $builder->build_sample_biblio();
+    my $item1 = $builder->build_sample_item({ biblionumber => $biblio->biblionumber });
+    my $item2 = $builder->build_sample_item({ biblionumber => $biblio->biblionumber });
+    warnings_are {
+      $builder->build_object({
+        class => 'Koha::Holds',
+        value  => {
+            biblionumber => $biblio->biblionumber
+        }
+      });
+    } [], "No warning about query returning more than one row";
+
+    $schema->storage->txn_rollback;
+};