+++ /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