--- /dev/null
+package t::lib::TestBuilder;
+
+use Modern::Perl;
+use Koha::Database;
+use String::Random;
+
+
+my $gen_type = {
+ tinyint => \&_gen_int,
+ smallint => \&_gen_int,
+ mediumint => \&_gen_int,
+ integer => \&_gen_int,
+ bigint => \&_gen_int,
+
+ float => \&_gen_real,
+ decimal => \&_gen_real,
+ double_precision => \&_gen_real,
+
+ timestamp => \&_gen_date,
+ datetime => \&_gen_date,
+ date => \&_gen_date,
+
+ char => \&_gen_text,
+ varchar => \&_gen_text,
+ tinytext => \&_gen_text,
+ text => \&_gen_text,
+ mediumtext => \&_gen_text,
+ longtext => \&_gen_text,
+
+ set => \&_gen_set_enum,
+ enum => \&_gen_set_enum,
+
+ tinyblob => \&_gen_blob,
+ mediumblob => \&_gen_blob,
+ blob => \&_gen_blob,
+ longblob => \&_gen_blob,
+};
+
+our $default_value = {
+ UserPermission => {
+ borrowernumber => {
+ surname => 'my surname',
+ address => 'my adress',
+ city => 'my city',
+ branchcode => {
+ branchcode => 'cB',
+ branchname => 'my branchname',
+ },
+ categorycode => {
+ categorycode => 'cC',
+ hidelostitems => 0,
+ category_type => 'A',
+ default_privacy => 'default',
+ },
+ privacy => 1,
+ },
+ module_bit => {
+ module_bit => {
+ bit => '10',
+ },
+ code => 'my code',
+ },
+ code => undef,
+ },
+};
+$default_value->{UserPermission}->{code} = $default_value->{UserPermission}->{module_bit};
+
+
+sub new {
+ my ($class) = @_;
+ my $self = {};
+ bless( $self, $class );
+
+ $self->schema( Koha::Database->new()->schema );
+ $self->schema->txn_begin();
+ $self->schema->storage->sql_maker->quote_char('`');
+ return $self;
+}
+
+sub schema {
+ my ($self, $schema) = @_;
+
+ if( defined( $schema ) ) {
+ $self->{schema} = $schema;
+ }
+ return $self->{schema};
+}
+
+sub clear {
+ my ($self, $params) = @_;
+ my $source = $self->schema->resultset( $params->{source} );
+ return $source->delete_all();
+}
+
+sub build {
+ my ($self, $params) = @_;
+ my $source = $params->{source} || return;
+ my $value = $params->{value};
+ my $only_fk = $params->{only_fk} || 0;
+
+ my $col_values = $self->_buildColumnValues({
+ source => $source,
+ value => $value,
+ });
+
+ my $data;
+ my $foreign_keys = $self->_getForeignKeys( { source => $source } );
+ for my $fk ( @$foreign_keys ) {
+ my $fk_value;
+ my $col_name = $fk->{keys}->[0]->{col_name};
+ if( ref( $col_values->{$col_name} ) eq 'HASH' ) {
+ $fk_value = $col_values->{$col_name};
+ }
+ elsif( defined( $col_values->{$col_name} ) ) {
+ next;
+ }
+
+ my $fk_row = $self->build({
+ source => $fk->{source},
+ value => $fk_value,
+ });
+
+ my $keys = $fk->{keys};
+ for my $key( @$keys ) {
+ $col_values->{ $key->{col_name} } = $fk_row->{ $key->{col_fk_name} };
+ $data->{ $key->{col_name} } = $fk_row;
+ }
+ }
+
+ my $new_row;
+ if( $only_fk ) {
+ $new_row = $col_values;
+ }
+ else {
+ $new_row = $self->_storeColumnValues({
+ source => $source,
+ values => $col_values,
+ });
+ }
+ $new_row->{_fk} = $data if( defined( $data ) );
+ return $new_row;
+}
+
+sub _formatSource {
+ my ($params) = @_;
+ my $source = $params->{source};
+ $source =~ s|(\w+)$|$1|;
+ return $source;
+}
+
+sub _buildColumnValues {
+ my ($self, $params) = @_;
+ my $source = _formatSource( { source => $params->{source} } );
+ my $value = $params->{value};
+
+ my $col_values;
+ my @columns = $self->schema->source($source)->columns;
+ my %unique_constraints = $self->schema->source($source)->unique_constraints();
+
+ my $values_ok = 0;
+ my $at_least_one_constraint_failed;
+
+ while ( not $values_ok ) {
+
+ $at_least_one_constraint_failed = 0;
+ # generate random values
+ for my $col_name( @columns ) {
+ my $col_value = $self->_buildColumnValue({
+ source => $source,
+ column_name => $col_name,
+ value => $value,
+ });
+ $col_values->{$col_name} = $col_value if( defined( $col_value ) );
+ }
+
+ # If default values are set, maybe the data exist in the DB
+ # But no need to wait for another value
+ last if exists( $default_value->{$source} );
+
+ if ( scalar keys %unique_constraints > 0 ) {
+
+ # verify the data would respect each unique constraint
+ foreach my $constraint (keys %unique_constraints) {
+
+ my $condition;
+ my @constraint_columns = $unique_constraints{$constraint};
+ # loop through all constraint columns and build the condition
+ foreach my $constraint_column ( @constraint_columns ) {
+ # build the filter
+ $condition->{ $constraint_column } =
+ $col_values->{ $constraint_column };
+ }
+
+ my $count = $self->schema
+ ->resultset( $source )
+ ->search( $condition )
+ ->count();
+ if ( $count > 0 ) {
+ $at_least_one_constraint_failed = 1;
+ # no point checking more stuff, exit the loop
+ last;
+ }
+ }
+
+ if ( $at_least_one_constraint_failed ) {
+ $values_ok = 0;
+ } else {
+ $values_ok = 1;
+ }
+
+ } else {
+ $values_ok = 1;
+ }
+ }
+ return $col_values;
+}
+
+# Returns [ {
+# rel_name => $rel_name,
+# source => $table_name,
+# keys => [ {
+# col_name => $col_name,
+# col_fk_name => $col_fk_name,
+# }, ... ]
+# }, ... ]
+sub _getForeignKeys {
+ my ($self, $params) = @_;
+ my $source = $self->schema->source( $params->{source} );
+
+ my @foreign_keys = ();
+ my @relationships = $source->relationships;
+ for my $rel_name( @relationships ) {
+ my $rel_info = $source->relationship_info($rel_name);
+ if( $rel_info->{attrs}->{is_foreign_key_constraint} ) {
+ my $rel = {
+ rel_name => $rel_name,
+ source => $rel_info->{source},
+ };
+
+ my @keys = ();
+ while( my ($col_fk_name, $col_name) = each(%{$rel_info->{cond}}) ) {
+ $col_name =~ s|self.(\w+)|$1|;
+ $col_fk_name =~ s|foreign.(\w+)|$1|;
+ push @keys, {
+ col_name => $col_name,
+ col_fk_name => $col_fk_name,
+ };
+ }
+ $rel->{keys} = \@keys;
+
+ push @foreign_keys, $rel;
+ }
+ }
+ return \@foreign_keys;
+}
+
+sub _storeColumnValues {
+ my ($self, $params) = @_;
+ my $source = $params->{source};
+ my $col_values = $params->{values};
+
+ my $new_row;
+ eval {
+ $new_row = $self->schema->resultset($source)->update_or_create($col_values);
+ };
+ die "$source - $@\n" if ($@);
+
+ eval {
+ $new_row = { $new_row->get_columns };
+ };
+ warn "$source - $@\n" if ($@);
+ return $new_row;
+}
+
+sub _buildColumnValue {
+ my ($self, $params) = @_;
+ my $source = $params->{source};
+ my $value = $params->{value};
+ my $col_name = $params->{column_name};
+ my $col_info = $self->schema->source($source)->column_info($col_name);
+
+ my $col_value;
+ if( exists( $value->{$col_name} ) ) {
+ $col_value = $value->{$col_name};
+ }
+ elsif( exists( $default_value->{$source}->{$col_name} ) ) {
+ $col_value = $default_value->{$source}->{$col_name};
+ }
+ elsif( not $col_info->{default_value} and not $col_info->{is_auto_increment} and not $col_info->{is_foreign_key} ) {
+ eval {
+ my $data_type = $col_info->{data_type};
+ $data_type =~ s| |_|;
+ $col_value = $gen_type->{$data_type}->( $self, { info => $col_info } );
+ };
+ die "The type $col_info->{data_type} is not defined\n" if ($@);
+ }
+ return $col_value;
+}
+
+
+sub _gen_int {
+ my ($self, $params) = @_;
+ my $data_type = $params->{info}->{data_type};
+
+ my $max = 1;
+ if( $data_type eq 'tinyint' ) {
+ $max = 127;
+ }
+ elsif( $data_type eq 'smallint' ) {
+ $max = 32767;
+ }
+ elsif( $data_type eq 'mediumint' ) {
+ $max = 8388607;
+ }
+ elsif( $data_type eq 'integer' ) {
+ $max = 2147483647;
+ }
+ elsif( $data_type eq 'bigint' ) {
+ $max = 9223372036854775807;
+ }
+ return int( rand($max+1) );
+}
+
+sub _gen_real {
+ my ($self, $params) = @_;
+ my $max = 10 ** 38;
+ if( defined( $params->{info}->{size} ) ) {
+ $max = 10 ** ($params->{info}->{size}->[0] - $params->{info}->{size}->[1]);
+ }
+ return rand($max) + 1;
+}
+
+sub _gen_date {
+ my ($self, $params) = @_;
+ return $self->schema->storage->datetime_parser->format_datetime(DateTime->now());
+}
+
+sub _gen_text {
+ my ($self, $params) = @_;
+ # From perldoc String::Random
+ # max: specify the maximum number of characters to return for * and other
+ # regular expression patters that don't return a fixed number of characters
+ my $regex = '[A-Za-z][A-Za-z0-9_]*';
+ my $size = $params->{info}{size};
+ if ( defined $size and $size > 1 ) {
+ $size--;
+ } elsif ( defined $size and $size == 1 ) {
+ $regex = '[A-Za-z]';
+ }
+ my $random = String::Random->new( max => $size );
+ return $random->randregex($regex);
+}
+
+sub _gen_set_enum {
+ my ($self, $params) = @_;
+ return $params->{info}->{extra}->{list}->[0];
+}
+
+sub _gen_blob {
+ my ($self, $params) = @_;;
+ return 'b';
+}
+
+
+sub DESTROY {
+ my $self = shift;
+ $self->schema->txn_rollback();
+}
+
+
+=head1 NAME
+
+t::lib::TestBuilder.pm - Koha module to simplify the writing of tests
+
+=head1 SYNOPSIS
+
+ use t::lib::TestBuilder;
+
+Koha module to insert the foreign keys automatically for the tests
+
+=head1 DESCRIPTION
+
+This module allows to insert automatically an entry in the database. All the database changes are wrapped in a transaction.
+The foreign keys are created according to the DBIx::Class schema.
+The taken values are the values by default if it is possible or randomly generated.
+
+=head1 FUNCTIONS
+
+=head2 new
+
+ $builder = t::lib::TestBuilder->new()
+
+Constructor - Begins a transaction and returns the object TestBuilder
+
+=head2 schema
+
+ $schema = $builder->schema
+
+Getter - Returns the schema of DBIx::Class
+
+=head2 clear
+
+ $builder->clear({ source => $source_name })
+
+=over
+
+=item C<$source_name> is the name of the source in the DBIx::Class schema (required)
+
+=back
+
+Clears all the data of this source (database table)
+
+=head2 build
+
+ $builder->build({
+ source => $source_name,
+ value => $value,
+ only_fk => $only_fk,
+ })
+
+=over
+
+=item C<$source_name> is the name of the source in the DBIx::Class schema (required)
+
+=item C<$value> is the values for the entry (optional)
+
+=item C<$only_fk> is a boolean to indicate if only the foreign keys are created (optional)
+
+=back
+
+Inserts an entry in the database by instanciating all the foreign keys.
+The values can be specified, the values which are not given are default values if they exists or generated randomly.
+Returns the values of the entry as a hashref with an extra key : _fk which contains all the values of the generated foreign keys.
+
+=head1 AUTHOR
+
+Yohann Dufour <yohann.dufour@biblibre.com>
+
+=head1 COPYRIGHT
+
+Copyright 2014 - Biblibre SARL
+
+=head1 LICENSE
+
+This file is part of Koha.
+
+Koha is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3 of the License, or (at your option) any later version.
+
+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.
+
+You should have received a copy of the GNU General Public License along with Koha; if not, see <http://www.gnu.org/licenses>.
+
+=cut
+
+1;
projects / koha.git / commitdiff