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     my $random = String::Random->new( max => $params->{info}->{size} );
 292     return $random->randregex('[A-Za-z]+[A-Za-z0-9_]*');
 293 }
 294
 295 sub _gen_set_enum {
 296     my ($self, $params) = @_;
 297     return $params->{info}->{extra}->{list}->[0];
 298 }
 299
 300 sub _gen_blob {
 301     my ($self, $params) = @_;;
 302     return 'b';
 303 }
 304
 305
 306 sub DESTROY {
 307     my $self = shift;
 308     $self->schema->txn_rollback();
 309 }
 310
 311
 312 =head1 NAME
 313
 314 t::lib::TestBuilder.pm - Koha module to simplify the writing of tests
 315
 316 =head1 SYNOPSIS
 317
 318     use t::lib::TestBuilder;
 319
 320 Koha module to insert the foreign keys automatically for the tests
 321
 322 =head1 DESCRIPTION
 323
 324 This module allows to insert automatically an entry in the database. All the database changes are wrapped in a transaction.
 325 The foreign keys are created according to the DBIx::Class schema.
 326 The taken values are the values by default if it is possible or randomly generated.
 327
 328 =head1 FUNCTIONS
 329
 330 =head2 new
 331
 332     $builder = t::lib::TestBuilder->new()
 333
 334 Constructor - Begins a transaction and returns the object TestBuilder
 335
 336 =head2 schema
 337
 338     $schema = $builder->schema
 339
 340 Getter - Returns the schema of DBIx::Class
 341
 342 =head2 clear
 343
 344     $builder->clear({ source => $source_name })
 345
 346 =over
 347
 348 =item C<$source_name> is the name of the source in the DBIx::Class schema (required)
 349
 350 =back
 351
 352 Clears all the data of this source (database table)
 353
 354 =head2 build
 355
 356     $builder->build({
 357         source  => $source_name,
 358         value   => $value,
 359         only_fk => $only_fk,
 360     })
 361
 362 =over
 363
 364 =item C<$source_name> is the name of the source in the DBIx::Class schema (required)
 365
 366 =item C<$value> is the values for the entry (optional)
 367
 368 =item C<$only_fk> is a boolean to indicate if only the foreign keys are created (optional)
 369
 370 =back
 371
 372 Inserts an entry in the database by instanciating all the foreign keys.
 373 The values can be specified, the values which are not given are default values if they exists or generated randomly.
 374 Returns the values of the entry as a hashref with an extra key : _fk which contains all the values of the generated foreign keys.
 375
 376 =head1 AUTHOR
 377
 378 Yohann Dufour <yohann.dufour@biblibre.com>
 379
 380 =head1 COPYRIGHT
 381
 382 Copyright 2014 - Biblibre SARL
 383
 384 =head1 LICENSE
 385
 386 This file is part of Koha.
 387
 388 Koha is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by
 389 the Free Software Foundation; either version 3 of the License, or (at your option) any later version.
 390
 391 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.
 392
 393 You should have received a copy of the GNU General Public License along with Koha; if not, see <http://www.gnu.org/licenses>.
 394
 395 =cut
 396
 397 1;