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     $self->schema->txn_begin();
  76     $self->schema->storage->sql_maker->quote_char('`');
  77     return $self;
  78 }
  79
  80 sub schema {
  81     my ($self, $schema) = @_;
  82
  83     if( defined( $schema ) ) {
  84         $self->{schema} = $schema;
  85     }
  86     return $self->{schema};
  87 }
  88
  89 sub clear {
  90     my ($self, $params) = @_;
  91     my $source = $self->schema->resultset( $params->{source} );
  92     return $source->delete_all();
  93 }
  94
  95 sub build {
  96     my ($self, $params) = @_;
  97     my $source  = $params->{source} || return;
  98     my $value   = $params->{value};
  99     my $only_fk = $params->{only_fk} || 0;
 100
 101     my $col_values = $self->_buildColumnValues({
 102         source  => $source,
 103         value   => $value,
 104     });
 105
 106     my $data;
 107     my $foreign_keys = $self->_getForeignKeys( { source => $source } );
 108     for my $fk ( @$foreign_keys ) {
 109         my $fk_value;
 110         my $col_name = $fk->{keys}->[0]->{col_name};
 111         if( ref( $col_values->{$col_name} ) eq 'HASH' ) {
 112             $fk_value = $col_values->{$col_name};
 113         }
 114         elsif( defined( $col_values->{$col_name} ) ) {
 115             next;
 116         }
 117
 118         my $fk_row = $self->build({
 119             source => $fk->{source},
 120             value  => $fk_value,
 121         });
 122
 123         my $keys = $fk->{keys};
 124         for my $key( @$keys )  {
 125             $col_values->{ $key->{col_name} } = $fk_row->{ $key->{col_fk_name} };
 126             $data->{ $key->{col_name} } = $fk_row;
 127         }
 128     }
 129
 130     my $new_row;
 131     if( $only_fk ) {
 132         $new_row = $col_values;
 133     }
 134     else {
 135         $new_row = $self->_storeColumnValues({
 136             source => $source,
 137             values => $col_values,
 138         });
 139     }
 140     $new_row->{_fk} = $data if( defined( $data ) );
 141     return $new_row;
 142 }
 143
 144 sub _formatSource {
 145     my ($params) = @_;
 146     my $source = $params->{source};
 147     $source =~ s|(\w+)$|$1|;
 148     return $source;
 149 }
 150
 151 sub _buildColumnValues {
 152     my ($self, $params) = @_;
 153     my $source  = _formatSource( { source => $params->{source} } );
 154     my $value   = $params->{value};
 155
 156     my $col_values;
 157     my @columns = $self->schema->source($source)->columns;
 158     for my $col_name( @columns ) {
 159         my $col_value = $self->_buildColumnValue({
 160             source      => $source,
 161             column_name => $col_name,
 162             value       => $value,
 163         });
 164         $col_values->{$col_name} = $col_value if( defined( $col_value ) );
 165     }
 166     return $col_values;
 167 }
 168
 169 # Returns [ {
 170 #   rel_name => $rel_name,
 171 #   source => $table_name,
 172 #   keys => [ {
 173 #       col_name => $col_name,
 174 #       col_fk_name => $col_fk_name,
 175 #   }, ... ]
 176 # }, ... ]
 177 sub _getForeignKeys {
 178     my ($self, $params) = @_;
 179     my $source = $self->schema->source( $params->{source} );
 180
 181     my @foreign_keys = ();
 182     my @relationships = $source->relationships;
 183     for my $rel_name( @relationships ) {
 184         my $rel_info = $source->relationship_info($rel_name);
 185         if( $rel_info->{attrs}->{is_foreign_key_constraint} ) {
 186             my $rel = {
 187                 rel_name => $rel_name,
 188                 source   => $rel_info->{source},
 189             };
 190
 191             my @keys = ();
 192             while( my ($col_fk_name, $col_name) = each(%{$rel_info->{cond}}) ) {
 193                 $col_name    =~ s|self.(\w+)|$1|;
 194                 $col_fk_name =~ s|foreign.(\w+)|$1|;
 195                 push @keys, {
 196                     col_name    => $col_name,
 197                     col_fk_name => $col_fk_name,
 198                 };
 199             }
 200             $rel->{keys} = \@keys;
 201
 202             push @foreign_keys, $rel;
 203         }
 204     }
 205     return \@foreign_keys;
 206 }
 207
 208 sub _storeColumnValues {
 209     my ($self, $params) = @_;
 210     my $source      = $params->{source};
 211     my $col_values  = $params->{values};
 212
 213     my $new_row;
 214     eval {
 215         $new_row = $self->schema->resultset($source)->update_or_create($col_values);
 216     };
 217     die "$source - $@\n" if ($@);
 218
 219     eval {
 220         $new_row = { $new_row->get_columns };
 221     };
 222     warn "$source - $@\n" if ($@);
 223     return $new_row;
 224 }
 225
 226 sub _buildColumnValue {
 227     my ($self, $params) = @_;
 228     my $source    = $params->{source};
 229     my $value     = $params->{value};
 230     my $col_name  = $params->{column_name};
 231     my $col_info  = $self->schema->source($source)->column_info($col_name);
 232
 233     my $col_value;
 234     if( exists( $value->{$col_name} ) ) {
 235         $col_value = $value->{$col_name};
 236     }
 237     elsif( exists( $default_value->{$source}->{$col_name} ) ) {
 238         $col_value = $default_value->{$source}->{$col_name};
 239     }
 240     elsif( not $col_info->{default_value} and not $col_info->{is_auto_increment} and not $col_info->{is_foreign_key} ) {
 241         eval {
 242             my $data_type = $col_info->{data_type};
 243             $data_type =~ s| |_|;
 244             $col_value = $gen_type->{$data_type}->( $self, { info => $col_info } );
 245         };
 246         die "The type $col_info->{data_type} is not defined\n" if ($@);
 247     }
 248     return $col_value;
 249 }
 250
 251
 252 sub _gen_int {
 253     my ($self, $params) = @_;
 254     my $data_type = $params->{info}->{data_type};
 255
 256     my $max = 1;
 257     if( $data_type eq 'tinyint' ) {
 258         $max = 127;
 259     }
 260     elsif( $data_type eq 'smallint' ) {
 261         $max = 32767;
 262     }
 263     elsif( $data_type eq 'mediumint' ) {
 264         $max = 8388607;
 265     }
 266     elsif( $data_type eq 'integer' ) {
 267         $max = 2147483647;
 268     }
 269     elsif( $data_type eq 'bigint' ) {
 270         $max = 9223372036854775807;
 271     }
 272     return int( rand($max+1) );
 273 }
 274
 275 sub _gen_real {
 276     my ($self, $params) = @_;
 277     my $max = 10 ** 38;
 278     if( defined( $params->{info}->{size} ) ) {
 279         $max = 10 ** ($params->{info}->{size}->[0] - $params->{info}->{size}->[1]);
 280     }
 281     return rand($max) + 1;
 282 }
 283
 284 sub _gen_date {
 285     my ($self, $params) = @_;
 286     return $self->schema->storage->datetime_parser->format_datetime(DateTime->now());
 287 }
 288
 289 sub _gen_text {
 290     my ($self, $params) = @_;
 291     # From perldoc String::Random
 292     # max: specify the maximum number of characters to return for * and other
 293     # regular expression patters that don't return a fixed number of characters
 294     my $regex = '[A-Za-z][A-Za-z0-9_]*';
 295     my $size = $params->{info}{size};
 296     if ( defined $size and $size > 1 ) {
 297         $size--;
 298     } elsif ( defined $size and $size == 1 ) {
 299         $regex = '[A-Za-z]';
 300     }
 301     my $random = String::Random->new( max => $size );
 302     return $random->randregex($regex);
 303 }
 304
 305 sub _gen_set_enum {
 306     my ($self, $params) = @_;
 307     return $params->{info}->{extra}->{list}->[0];
 308 }
 309
 310 sub _gen_blob {
 311     my ($self, $params) = @_;;
 312     return 'b';
 313 }
 314
 315
 316 sub DESTROY {
 317     my $self = shift;
 318     $self->schema->txn_rollback();
 319 }
 320
 321
 322 =head1 NAME
 323
 324 t::lib::TestBuilder.pm - Koha module to simplify the writing of tests
 325
 326 =head1 SYNOPSIS
 327
 328     use t::lib::TestBuilder;
 329
 330 Koha module to insert the foreign keys automatically for the tests
 331
 332 =head1 DESCRIPTION
 333
 334 This module allows to insert automatically an entry in the database. All the database changes are wrapped in a transaction.
 335 The foreign keys are created according to the DBIx::Class schema.
 336 The taken values are the values by default if it is possible or randomly generated.
 337
 338 =head1 FUNCTIONS
 339
 340 =head2 new
 341
 342     $builder = t::lib::TestBuilder->new()
 343
 344 Constructor - Begins a transaction and returns the object TestBuilder
 345
 346 =head2 schema
 347
 348     $schema = $builder->schema
 349
 350 Getter - Returns the schema of DBIx::Class
 351
 352 =head2 clear
 353
 354     $builder->clear({ source => $source_name })
 355
 356 =over
 357
 358 =item C<$source_name> is the name of the source in the DBIx::Class schema (required)
 359
 360 =back
 361
 362 Clears all the data of this source (database table)
 363
 364 =head2 build
 365
 366     $builder->build({
 367         source  => $source_name,
 368         value   => $value,
 369         only_fk => $only_fk,
 370     })
 371
 372 =over
 373
 374 =item C<$source_name> is the name of the source in the DBIx::Class schema (required)
 375
 376 =item C<$value> is the values for the entry (optional)
 377
 378 =item C<$only_fk> is a boolean to indicate if only the foreign keys are created (optional)
 379
 380 =back
 381
 382 Inserts an entry in the database by instanciating all the foreign keys.
 383 The values can be specified, the values which are not given are default values if they exists or generated randomly.
 384 Returns the values of the entry as a hashref with an extra key : _fk which contains all the values of the generated foreign keys.
 385
 386 =head1 AUTHOR
 387
 388 Yohann Dufour <yohann.dufour@biblibre.com>
 389
 390 =head1 COPYRIGHT
 391
 392 Copyright 2014 - Biblibre SARL
 393
 394 =head1 LICENSE
 395
 396 This file is part of Koha.
 397
 398 Koha is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by
 399 the Free Software Foundation; either version 3 of the License, or (at your option) any later version.
 400
 401 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.
 402
 403 You should have received a copy of the GNU General Public License along with Koha; if not, see <http://www.gnu.org/licenses>.
 404
 405 =cut
 406
 407 1;