t/lib/TestBuilder.pm

   1 package t::lib::TestBuilder;
   2
   3 use Modern::Perl;
   4 use Koha::Database;
   5 use String::Random;
   6
   7
   8 my $gen_type = {
   9     tinyint   => \&_gen_int,
  10     smallint  => \&_gen_int,
  11     mediumint => \&_gen_int,
  12     integer   => \&_gen_int,
  13     bigint    => \&_gen_int,
  14
  15     float            => \&_gen_real,
  16     decimal          => \&_gen_real,
  17     double_precision => \&_gen_real,
  18
  19     timestamp => \&_gen_date,
  20     datetime  => \&_gen_date,
  21     date      => \&_gen_date,
  22
  23     char       => \&_gen_text,
  24     varchar    => \&_gen_text,
  25     tinytext   => \&_gen_text,
  26     text       => \&_gen_text,
  27     mediumtext => \&_gen_text,
  28     longtext   => \&_gen_text,
  29
  30     set  => \&_gen_set_enum,
  31     enum => \&_gen_set_enum,
  32
  33     tinyblob   => \&_gen_blob,
  34     mediumblob => \&_gen_blob,
  35     blob       => \&_gen_blob,
  36     longblob   => \&_gen_blob,
  37 };
  38
  39 our $default_value = {
  40     UserPermission => {
  41         borrowernumber => {
  42             surname => 'my surname',
  43             address => 'my adress',
  44             city    => 'my city',
  45             branchcode => {
  46                 branchcode => 'cB',
  47                 branchname => 'my branchname',
  48             },
  49             categorycode => {
  50                 categorycode    => 'cC',
  51                 hidelostitems   => 0,
  52                 category_type   => 'A',
  53                 default_privacy => 'default',
  54             },
  55             privacy => 1,
  56         },
  57         module_bit => {
  58             module_bit => {
  59                 bit => '10',
  60             },
  61             code => 'my code',
  62         },
  63         code => undef,
  64     },
  65 };
  66 $default_value->{UserPermission}->{code} = $default_value->{UserPermission}->{module_bit};
  67
  68
  69 sub new {
  70     my ($class) = @_;
  71     my $self = {};
  72     bless( $self, $class );
  73
  74     $self->schema( Koha::Database->new()->schema );
  75     eval {
  76         $self->schema->txn_begin();
  77     };
  78     $self->schema->storage->sql_maker->quote_char('`');
  79     return $self;
  80 }
  81
  82 sub schema {
  83     my ($self, $schema) = @_;
  84
  85     if( defined( $schema ) ) {
  86         $self->{schema} = $schema;
  87     }
  88     return $self->{schema};
  89 }
  90
  91 sub clear {
  92     my ($self, $params) = @_;
  93     my $source = $self->schema->resultset( $params->{source} );
  94     return $source->delete_all();
  95 }
  96
  97 sub build {
  98     my ($self, $params) = @_;
  99     my $source  = $params->{source} || return;
 100     my $value   = $params->{value};
 101     my $only_fk = $params->{only_fk} || 0;
 102
 103     my $col_values = $self->_buildColumnValues({
 104         source  => $source,
 105         value   => $value,
 106     });
 107
 108     my $data;
 109     my $foreign_keys = $self->_getForeignKeys( { source => $source } );
 110     for my $fk ( @$foreign_keys ) {
 111         my $fk_value;
 112         my $col_name = $fk->{keys}->[0]->{col_name};
 113         if( ref( $col_values->{$col_name} ) eq 'HASH' ) {
 114             $fk_value = $col_values->{$col_name};
 115         }
 116         elsif( defined( $col_values->{$col_name} ) ) {
 117             next;
 118         }
 119
 120         my $fk_row = $self->build({
 121             source => $fk->{source},
 122             value  => $fk_value,
 123         });
 124
 125         my $keys = $fk->{keys};
 126         for my $key( @$keys )  {
 127             $col_values->{ $key->{col_name} } = $fk_row->{ $key->{col_fk_name} };
 128             $data->{ $key->{col_name} } = $fk_row;
 129         }
 130     }
 131
 132     my $new_row;
 133     if( $only_fk ) {
 134         $new_row = $col_values;
 135     }
 136     else {
 137         $new_row = $self->_storeColumnValues({
 138             source => $source,
 139             values => $col_values,
 140         });
 141     }
 142     $new_row->{_fk} = $data if( defined( $data ) );
 143     return $new_row;
 144 }
 145
 146 sub _formatSource {
 147     my ($params) = @_;
 148     my $source = $params->{source};
 149     $source =~ s|(\w+)$|$1|;
 150     return $source;
 151 }
 152
 153 sub _buildColumnValues {
 154     my ($self, $params) = @_;
 155     my $source = _formatSource( { source => $params->{source} } );
 156     my $original_value = $params->{value};
 157
 158     my $col_values;
 159     my @columns = $self->schema->source($source)->columns;
 160     my %unique_constraints = $self->schema->source($source)->unique_constraints();
 161
 162     my $build_value = 1;
 163     BUILD_VALUE: while ( $build_value ) {
 164         # generate random values for all columns
 165         for my $col_name( @columns ) {
 166             my $col_value = $self->_buildColumnValue({
 167                 source      => $source,
 168                 column_name => $col_name,
 169                 value       => $original_value,
 170             });
 171             $col_values->{$col_name} = $col_value if( defined( $col_value ) );
 172         }
 173         $build_value = 0;
 174
 175         # If default values are set, maybe the data exist in the DB
 176         # But no need to wait for another value
 177         # FIXME this can be wrong if a default value is defined for a field
 178         # which is not a constraint and that the generated value for the
 179         # constraint already exists.
 180         last BUILD_VALUE if exists( $default_value->{$source} );
 181
 182         # If there is no original value given and unique constraints exist,
 183         # check if the generated values do not exist yet.
 184         if ( not defined $original_value and scalar keys %unique_constraints > 0 ) {
 185
 186             # verify the data would respect each unique constraint
 187             CONSTRAINTS: foreach my $constraint (keys %unique_constraints) {
 188
 189                 my $condition;
 190                 my $constraint_columns = $unique_constraints{$constraint};
 191                 # loop through all constraint columns and build the condition
 192                 foreach my $constraint_column ( @$constraint_columns ) {
 193                     # build the filter
 194                     $condition->{ $constraint_column } =
 195                             $col_values->{ $constraint_column };
 196                 }
 197
 198                 my $count = $self->schema
 199                                  ->resultset( $source )
 200                                  ->search( $condition )
 201                                  ->count();
 202                 if ( $count > 0 ) {
 203                     # no point checking more stuff, exit the loop
 204                     $build_value = 1;
 205                     last CONSTRAINTS;
 206                 }
 207             }
 208         }
 209     }
 210     return $col_values;
 211 }
 212
 213 # Returns [ {
 214 #   rel_name => $rel_name,
 215 #   source => $table_name,
 216 #   keys => [ {
 217 #       col_name => $col_name,
 218 #       col_fk_name => $col_fk_name,
 219 #   }, ... ]
 220 # }, ... ]
 221 sub _getForeignKeys {
 222     my ($self, $params) = @_;
 223     my $source = $self->schema->source( $params->{source} );
 224
 225     my @foreign_keys = ();
 226     my @relationships = $source->relationships;
 227     for my $rel_name( @relationships ) {
 228         my $rel_info = $source->relationship_info($rel_name);
 229         if( $rel_info->{attrs}->{is_foreign_key_constraint} ) {
 230             my $rel = {
 231                 rel_name => $rel_name,
 232                 source   => $rel_info->{source},
 233             };
 234
 235             my @keys = ();
 236             while( my ($col_fk_name, $col_name) = each(%{$rel_info->{cond}}) ) {
 237                 $col_name    =~ s|self.(\w+)|$1|;
 238                 $col_fk_name =~ s|foreign.(\w+)|$1|;
 239                 push @keys, {
 240                     col_name    => $col_name,
 241                     col_fk_name => $col_fk_name,
 242                 };
 243             }
 244             $rel->{keys} = \@keys;
 245
 246             push @foreign_keys, $rel;
 247         }
 248     }
 249     return \@foreign_keys;
 250 }
 251
 252 sub _storeColumnValues {
 253     my ($self, $params) = @_;
 254     my $source      = $params->{source};
 255     my $col_values  = $params->{values};
 256
 257     my $new_row;
 258     eval {
 259         $new_row = $self->schema->resultset($source)->update_or_create($col_values);
 260     };
 261     die "$source - $@\n" if ($@);
 262
 263     eval {
 264         $new_row = { $new_row->get_columns };
 265     };
 266     warn "$source - $@\n" if ($@);
 267     return $new_row;
 268 }
 269
 270 sub _buildColumnValue {
 271     my ($self, $params) = @_;
 272     my $source    = $params->{source};
 273     my $value     = $params->{value};
 274     my $col_name  = $params->{column_name};
 275     my $col_info  = $self->schema->source($source)->column_info($col_name);
 276
 277     my $col_value;
 278     if( exists( $value->{$col_name} ) ) {
 279         $col_value = $value->{$col_name};
 280     }
 281     elsif( exists $default_value->{$source} and exists $default_value->{$source}->{$col_name} ) {
 282         $col_value = $default_value->{$source}->{$col_name};
 283     }
 284     elsif( not $col_info->{default_value} and not $col_info->{is_auto_increment} and not $col_info->{is_foreign_key} ) {
 285         eval {
 286             my $data_type = $col_info->{data_type};
 287             $data_type =~ s| |_|;
 288             $col_value = $gen_type->{$data_type}->( $self, { info => $col_info } );
 289         };
 290         die "The type $col_info->{data_type} is not defined\n" if ($@);
 291     }
 292     return $col_value;
 293 }
 294
 295
 296 sub _gen_int {
 297     my ($self, $params) = @_;
 298     my $data_type = $params->{info}->{data_type};
 299
 300     my $max = 1;
 301     if( $data_type eq 'tinyint' ) {
 302         $max = 127;
 303     }
 304     elsif( $data_type eq 'smallint' ) {
 305         $max = 32767;
 306     }
 307     elsif( $data_type eq 'mediumint' ) {
 308         $max = 8388607;
 309     }
 310     elsif( $data_type eq 'integer' ) {
 311         $max = 2147483647;
 312     }
 313     elsif( $data_type eq 'bigint' ) {
 314         $max = 9223372036854775807;
 315     }
 316     return int( rand($max+1) );
 317 }
 318
 319 sub _gen_real {
 320     my ($self, $params) = @_;
 321     my $max = 10 ** 38;
 322     if( defined( $params->{info}->{size} ) ) {
 323         $max = 10 ** ($params->{info}->{size}->[0] - $params->{info}->{size}->[1]);
 324     }
 325     return rand($max) + 1;
 326 }
 327
 328 sub _gen_date {
 329     my ($self, $params) = @_;
 330     return $self->schema->storage->datetime_parser->format_datetime(DateTime->now());
 331 }
 332
 333 sub _gen_text {
 334     my ($self, $params) = @_;
 335     # From perldoc String::Random
 336     # max: specify the maximum number of characters to return for * and other
 337     # regular expression patters that don't return a fixed number of characters
 338     my $regex = '[A-Za-z][A-Za-z0-9_]*';
 339     my $size = $params->{info}{size};
 340     if ( defined $size and $size > 1 ) {
 341         $size--;
 342     } elsif ( defined $size and $size == 1 ) {
 343         $regex = '[A-Za-z]';
 344     }
 345     my $random = String::Random->new( max => $size );
 346     return $random->randregex($regex);
 347 }
 348
 349 sub _gen_set_enum {
 350     my ($self, $params) = @_;
 351     return $params->{info}->{extra}->{list}->[0];
 352 }
 353
 354 sub _gen_blob {
 355     my ($self, $params) = @_;;
 356     return 'b';
 357 }
 358
 359
 360 sub DESTROY {
 361     my $self = shift;
 362     eval {
 363         $self->schema->txn_rollback();
 364     };
 365 }
 366
 367
 368 =head1 NAME
 369
 370 t::lib::TestBuilder.pm - Koha module to simplify the writing of tests
 371
 372 =head1 SYNOPSIS
 373
 374     use t::lib::TestBuilder;
 375
 376 Koha module to insert the foreign keys automatically for the tests
 377
 378 =head1 DESCRIPTION
 379
 380 This module allows to insert automatically an entry in the database. All the database changes are wrapped in a transaction.
 381 The foreign keys are created according to the DBIx::Class schema.
 382 The taken values are the values by default if it is possible or randomly generated.
 383
 384 =head1 FUNCTIONS
 385
 386 =head2 new
 387
 388     $builder = t::lib::TestBuilder->new()
 389
 390 Constructor - Begins a transaction and returns the object TestBuilder
 391
 392 =head2 schema
 393
 394     $schema = $builder->schema
 395
 396 Getter - Returns the schema of DBIx::Class
 397
 398 =head2 clear
 399
 400     $builder->clear({ source => $source_name })
 401
 402 =over
 403
 404 =item C<$source_name> is the name of the source in the DBIx::Class schema (required)
 405
 406 =back
 407
 408 Clears all the data of this source (database table)
 409
 410 =head2 build
 411
 412     $builder->build({
 413         source  => $source_name,
 414         value   => $value,
 415         only_fk => $only_fk,
 416     })
 417
 418 =over
 419
 420 =item C<$source_name> is the name of the source in the DBIx::Class schema (required)
 421
 422 =item C<$value> is the values for the entry (optional)
 423
 424 =item C<$only_fk> is a boolean to indicate if only the foreign keys are created (optional)
 425
 426 =back
 427
 428 Inserts an entry in the database by instanciating all the foreign keys.
 429 The values can be specified, the values which are not given are default values if they exists or generated randomly.
 430 Returns the values of the entry as a hashref with an extra key : _fk which contains all the values of the generated foreign keys.
 431
 432 =head1 AUTHOR
 433
 434 Yohann Dufour <yohann.dufour@biblibre.com>
 435
 436 =head1 COPYRIGHT
 437
 438 Copyright 2014 - Biblibre SARL
 439
 440 =head1 LICENSE
 441
 442 This file is part of Koha.
 443
 444 Koha is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by
 445 the Free Software Foundation; either version 3 of the License, or (at your option) any later version.
 446
 447 Koha is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.
 448
 449 You should have received a copy of the GNU General Public License along with Koha; if not, see <http://www.gnu.org/licenses>.
 450
 451 =cut
 452
 453 1;