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,
+use Koha::Database qw( schema );
+use C4::Biblio qw( AddBiblio );
+use Koha::Biblios qw( _type );
+use Koha::Items qw( _type );
+use Koha::DateUtils qw( dt_from_string );
- 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,
-};
+use Bytes::Random::Secure;
+use Carp qw( carp );
+use Module::Load qw( load );
+use String::Random;
-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,
- },
+use constant {
+ SIZE_BARCODE => 20, # Not perfect but avoid to fetch the value when creating a new item
};
-$default_value->{UserPermission}->{code} = $default_value->{UserPermission}->{module_bit};
-
sub new {
my ($class) = @_;
bless( $self, $class );
$self->schema( Koha::Database->new()->schema );
- eval {
- $self->schema->txn_begin();
- };
$self->schema->storage->sql_maker->quote_char('`');
+
+ $self->{gen_type} = _gen_type();
+ $self->{default_values} = _gen_default_values();
return $self;
}
return $self->{schema};
}
-sub clear {
- my ($self, $params) = @_;
- my $source = $self->schema->resultset( $params->{source} );
- return $source->delete_all();
+# sub clear has been obsoleted; use delete_all from the schema resultset
+
+sub delete {
+ my ( $self, $params ) = @_;
+ my $source = $params->{source} || return;
+ my @recs = ref( $params->{records} ) eq 'ARRAY'?
+ @{$params->{records}}: ( $params->{records} // () );
+ # tables without PK are not supported
+ my @pk = $self->schema->source( $source )->primary_columns;
+ return if !@pk;
+ my $rv = 0;
+ foreach my $rec ( @recs ) {
+ # delete only works when you supply full primary key values
+ # $cond does not include searches for undef (not allowed in PK)
+ my $cond = { map { defined $rec->{$_}? ($_, $rec->{$_}): (); } @pk };
+ next if keys %$cond < @pk;
+ $self->schema->resultset( $source )->search( $cond )->delete;
+ # we clear the pk columns in the supplied hash
+ # this indirectly signals at least an attempt to delete
+ map { delete $rec->{$_}; } @pk;
+ $rv++;
+ }
+ return $rv;
+}
+
+sub build_object {
+ my ( $self, $params ) = @_;
+
+ my $class = $params->{class};
+ my $value = $params->{value};
+
+ if ( not defined $class ) {
+ carp "Missing class param";
+ return;
+ }
+
+ my @unknowns = grep( !/^(class|value)$/, keys %{ $params });
+ carp "Unknown parameter(s): ", join( ', ', @unknowns ) if scalar @unknowns;
+
+ load $class;
+ my $source = $class->_type;
+
+ my $hashref = $self->build({ source => $source, value => $value });
+ my $object;
+ if ( $class eq 'Koha::Old::Patrons' ) {
+ $object = $class->search({ borrowernumber => $hashref->{borrowernumber} })->next;
+ } elsif ( $class eq 'Koha::Statistics' ) {
+ $object = $class->search({ datetime => $hashref->{datetime} })->next;
+ } else {
+ my @ids;
+ my @pks = $self->schema->source( $class->_type )->primary_columns;
+ foreach my $pk ( @pks ) {
+ push @ids, $hashref->{ $pk };
+ }
+
+ $object = $class->find( @ids );
+ }
+
+ return $object;
}
sub build {
+# build returns a hash of column values for a created record, or undef
+# build does NOT update a record, or pass back values of an existing record
my ($self, $params) = @_;
- my $source = $params->{source} || return;
+ my $source = $params->{source};
+ if( !$source ) {
+ carp "Source parameter not specified!";
+ return;
+ }
my $value = $params->{value};
- my $only_fk = $params->{only_fk} || 0;
+
+ my @unknowns = grep( !/^(source|value)$/, keys %{ $params });
+ carp "Unknown parameter(s): ", join( ', ', @unknowns ) if scalar @unknowns;
my $col_values = $self->_buildColumnValues({
source => $source,
value => $value,
});
+ return if !$col_values; # did not meet unique constraints?
- my $data;
+ # loop thru all fk and create linked records if needed
+ # fills remaining entries in $col_values
my $foreign_keys = $self->_getForeignKeys( { source => $source } );
+ my $col_names = {};
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};
+ # skip when FK points to itself: e.g. borrowers:guarantorid
+ next if $fk->{source} eq $source;
+
+ # If we have more than one FK on the same column, we only generate values for the first one
+ next
+ if scalar @{ $fk->{keys} } == 1
+ && exists $col_names->{ $fk->{keys}->[0]->{col_name} };
+
+ my $keys = $fk->{keys};
+ my $tbl = $fk->{source};
+ my $res = $self->_create_links( $tbl, $keys, $col_values, $value );
+ return if !$res; # failed: no need to go further
+ foreach( keys %$res ) { # save new values
+ $col_values->{$_} = $res->{$_};
}
- elsif( defined( $col_values->{$col_name} ) ) {
- next;
+
+ $col_names->{ $fk->{keys}->[0]->{col_name} } = 1
+ if scalar @{ $fk->{keys} } == 1
+ }
+
+ # store this record and return hashref
+ return $self->_storeColumnValues({
+ source => $source,
+ values => $col_values,
+ });
+}
+
+sub build_sample_biblio {
+ my ( $self, $args ) = @_;
+
+ my $title = $args->{title} || 'Some boring read';
+ my $author = $args->{author} || 'Some boring author';
+ my $frameworkcode = $args->{frameworkcode} || '';
+ my $itemtype = $args->{itemtype}
+ || $self->build_object( { class => 'Koha::ItemTypes' } )->itemtype;
+
+ my $marcflavour = C4::Context->preference('marcflavour');
+
+ my $record = MARC::Record->new();
+ $record->encoding( 'UTF-8' );
+
+ my ( $tag, $subfield ) = $marcflavour eq 'UNIMARC' ? ( 200, 'a' ) : ( 245, 'a' );
+ $record->append_fields(
+ MARC::Field->new( $tag, ' ', ' ', $subfield => $title ),
+ );
+
+ ( $tag, $subfield ) = $marcflavour eq 'UNIMARC' ? ( 200, 'f' ) : ( 100, 'a' );
+ $record->append_fields(
+ MARC::Field->new( $tag, ' ', ' ', $subfield => $author ),
+ );
+
+ ( $tag, $subfield ) = $marcflavour eq 'UNIMARC' ? ( 995, 'r' ) : ( 942, 'c' );
+ $record->append_fields(
+ MARC::Field->new( $tag, ' ', ' ', $subfield => $itemtype )
+ );
+
+ my ($biblio_id) = C4::Biblio::AddBiblio( $record, $frameworkcode );
+ return Koha::Biblios->find($biblio_id);
+}
+
+sub build_sample_item {
+ my ( $self, $args ) = @_;
+
+ my $biblionumber =
+ delete $args->{biblionumber} || $self->build_sample_biblio->biblionumber;
+ my $library = delete $args->{library}
+ || $self->build_object( { class => 'Koha::Libraries' } )->branchcode;
+
+ # If itype is not passed it will be picked from the biblio (see Koha::Item->store)
+
+ my $barcode = delete $args->{barcode}
+ || $self->_gen_text( { info => { size => SIZE_BARCODE } } );
+
+ return Koha::Item->new(
+ {
+ biblionumber => $biblionumber,
+ homebranch => $library,
+ holdingbranch => $library,
+ barcode => $barcode,
+ %$args,
}
+ )->store->get_from_storage;
+}
- my $fk_row = $self->build({
- source => $fk->{source},
- value => $fk_value,
- });
+# ------------------------------------------------------------------------------
+# Internal helper routines
- 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;
+sub _create_links {
+# returns undef for failure to create linked records
+# otherwise returns hashref containing new column values for parent record
+ my ( $self, $linked_tbl, $keys, $col_values, $value ) = @_;
+
+ my $fk_value = {};
+ my ( $cnt_scalar, $cnt_null ) = ( 0, 0 );
+
+ # First, collect all values for creating a linked record (if needed)
+ foreach my $fk ( @$keys ) {
+ my ( $col, $destcol ) = ( $fk->{col_name}, $fk->{col_fk_name} );
+ if( ref( $value->{$col} ) eq 'HASH' ) {
+ # add all keys from the FK hash
+ $fk_value = { %{ $value->{$col} }, %$fk_value };
+ }
+ if( exists $col_values->{$col} ) {
+ # add specific value (this does not necessarily exclude some
+ # values from the hash in the preceding if)
+ $fk_value->{ $destcol } = $col_values->{ $col };
+ $cnt_scalar++;
+ $cnt_null++ if !defined( $col_values->{$col} );
}
}
- my $new_row;
- if( $only_fk ) {
- $new_row = $col_values;
+ # If we saw all FK columns, first run the following checks
+ if( $cnt_scalar == @$keys ) {
+ # if one or more fk cols are null, the FK constraint will not be forced
+ return {} if $cnt_null > 0;
+
+ # does the record exist already?
+ my @pks = $self->schema->source( $linked_tbl )->primary_columns;
+ my %fk_pk_value;
+ for (@pks) {
+ $fk_pk_value{$_} = $fk_value->{$_} if defined $fk_value->{$_};
+ }
+ return {} if !(keys %fk_pk_value);
+ return {} if $self->schema->resultset($linked_tbl)->find( \%fk_pk_value );
}
- else {
- $new_row = $self->_storeColumnValues({
- source => $source,
- values => $col_values,
- });
+ # create record with a recursive build call
+ my $row = $self->build({ source => $linked_tbl, value => $fk_value });
+ return if !$row; # failure
+
+ # Finally, only return the new values
+ my $rv = {};
+ foreach my $fk ( @$keys ) {
+ my ( $col, $destcol ) = ( $fk->{col_name}, $fk->{col_fk_name} );
+ next if exists $col_values->{ $col };
+ $rv->{ $col } = $row->{ $destcol };
}
- $new_row->{_fk} = $data if( defined( $data ) );
- return $new_row;
+ return $rv; # success
}
sub _formatSource {
my ($params) = @_;
- my $source = $params->{source};
+ my $source = $params->{source} || return;
$source =~ s|(\w+)$|$1|;
return $source;
}
sub _buildColumnValues {
my ($self, $params) = @_;
- my $source = _formatSource( { source => $params->{source} } );
+ my $source = _formatSource( $params ) || return;
my $original_value = $params->{value};
- my $col_values;
+ my $col_values = {};
my @columns = $self->schema->source($source)->columns;
my %unique_constraints = $self->schema->source($source)->unique_constraints();
- my $build_value = 1;
+ my $build_value = 5;
+ # we try max $build_value times if there are unique constraints
BUILD_VALUE: while ( $build_value ) {
# generate random values for all columns
for my $col_name( @columns ) {
- my $col_value = $self->_buildColumnValue({
+ my $valref = $self->_buildColumnValue({
source => $source,
column_name => $col_name,
value => $original_value,
});
- $col_values->{$col_name} = $col_value if( defined( $col_value ) );
+ return if !$valref; # failure
+ if( @$valref ) { # could be empty
+ # there will be only one value, but it could be undef
+ $col_values->{$col_name} = $valref->[0];
+ }
}
- $build_value = 0;
-
- # If default values are set, maybe the data exist in the DB
- # But no need to wait for another value
- # FIXME this can be wrong if a default value is defined for a field
- # which is not a constraint and that the generated value for the
- # constraint already exists.
- last BUILD_VALUE if exists( $default_value->{$source} );
- # If there is no original value given and unique constraints exist,
- # check if the generated values do not exist yet.
- if ( not defined $original_value and scalar keys %unique_constraints > 0 ) {
-
- # verify the data would respect each unique constraint
- CONSTRAINTS: foreach my $constraint (keys %unique_constraints) {
+ # verify the data would respect each unique constraint
+ # note that this is INCOMPLETE since not all col_values are filled
+ CONSTRAINTS: 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
+ # if one column does not exist or is undef, skip it
+ # an insert with a null will not trigger the constraint
+ next CONSTRAINTS
+ if !exists $col_values->{ $constraint_column } ||
+ !defined $col_values->{ $constraint_column };
$condition->{ $constraint_column } =
$col_values->{ $constraint_column };
}
-
my $count = $self->schema
->resultset( $source )
->search( $condition )
->count();
if ( $count > 0 ) {
# no point checking more stuff, exit the loop
- $build_value = 1;
- last CONSTRAINTS;
+ $build_value--;
+ next BUILD_VALUE;
}
- }
}
+ last; # you passed all tests
}
- return $col_values;
+ return $col_values if $build_value > 0;
+
+ # if you get here, we have a problem
+ warn "Violation of unique constraint in $source";
+ return;
}
-# Returns [ {
-# rel_name => $rel_name,
-# source => $table_name,
-# keys => [ {
-# col_name => $col_name,
-# col_fk_name => $col_fk_name,
-# }, ... ]
-# }, ... ]
sub _getForeignKeys {
+
+# Returns the following arrayref
+# [ [ source => name, keys => [ col_name => A, col_fk_name => B ] ], ... ]
+# The array gives source name and keys for each FK constraint
+
my ($self, $params) = @_;
my $source = $self->schema->source( $params->{source} );
- my @foreign_keys = ();
+ my ( @foreign_keys, $check_dupl );
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},
- };
+ $rel_info->{source} =~ s/^.*:://g;
+ my $rel = { source => $rel_info->{source} };
- my @keys = ();
+ 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|;
col_fk_name => $col_fk_name,
};
}
+ # check if the combination table and keys is unique
+ # so skip double belongs_to relations (as in Biblioitem)
+ my $tag = $rel->{source}. ':'.
+ join ',', sort map { $_->{col_name} } @keys;
+ next if $check_dupl->{$tag};
+ $check_dupl->{$tag} = 1;
$rel->{keys} = \@keys;
-
push @foreign_keys, $rel;
}
}
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;
+ my $new_row = $self->schema->resultset( $source )->create( $col_values );
+ return $new_row? { $new_row->get_columns }: {};
}
sub _buildColumnValue {
+# returns an arrayref if all goes well
+# an empty arrayref typically means: auto_incr column or fk column
+# undef means failure
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} and 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 ($@);
+ my $retvalue = [];
+ if( $col_info->{is_auto_increment} ) {
+ if( exists $value->{$col_name} ) {
+ warn "Value not allowed for auto_incr $col_name in $source";
+ return;
+ }
+ # otherwise: no need to assign a value
+ } elsif( $col_info->{is_foreign_key} || _should_be_fk($source,$col_name) ) {
+ if( exists $value->{$col_name} ) {
+ if( !defined $value->{$col_name} && !$col_info->{is_nullable} ) {
+ # This explicit undef is not allowed
+ warn "Null value for $col_name in $source not allowed";
+ return;
+ }
+ if( ref( $value->{$col_name} ) ne 'HASH' ) {
+ push @$retvalue, $value->{$col_name};
+ }
+ # sub build will handle a passed hash value later on
+ }
+ } elsif( ref( $value->{$col_name} ) eq 'HASH' ) {
+ # this is not allowed for a column that is not a FK
+ warn "Hash not allowed for $col_name in $source";
+ return;
+ } elsif( exists $value->{$col_name} ) {
+ if( !defined $value->{$col_name} && !$col_info->{is_nullable} ) {
+ # This explicit undef is not allowed
+ warn "Null value for $col_name in $source not allowed";
+ return;
+ }
+ push @$retvalue, $value->{$col_name};
+ } elsif( exists $self->{default_values}{$source}{$col_name} ) {
+ my $v = $self->{default_values}{$source}{$col_name};
+ $v = &$v() if ref($v) eq 'CODE';
+ push @$retvalue, $v;
+ } else {
+ my $data_type = $col_info->{data_type};
+ $data_type =~ s| |_|;
+ if( my $hdlr = $self->{gen_type}->{$data_type} ) {
+ push @$retvalue, &$hdlr( $self, { info => $col_info } );
+ } else {
+ warn "Unknown type $data_type for $col_name in $source";
+ return;
+ }
}
- return $col_value;
+ return $retvalue;
+}
+
+sub _should_be_fk {
+# This sub is only needed for inconsistencies in the schema
+# A column is not marked as FK, but a belongs_to relation is defined
+ my ( $source, $column ) = @_;
+ my $inconsistencies = {
+ 'Item.biblionumber' => 1, #FIXME: Please remove me when I become FK
+ 'CheckoutRenewal.checkout_id' => 1, #FIXME: Please remove when issues and old_issues are merged
+ };
+ return $inconsistencies->{ "$source.$column" };
}
+sub _gen_type {
+ return {
+ tinyint => \&_gen_bool,
+ smallint => \&_gen_int,
+ mediumint => \&_gen_int,
+ integer => \&_gen_int,
+ bigint => \&_gen_int,
+
+ float => \&_gen_real,
+ decimal => \&_gen_real,
+ double_precision => \&_gen_real,
+
+ timestamp => \&_gen_datetime,
+ datetime => \&_gen_datetime,
+ 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,
+ };
+};
+
+sub _gen_bool {
+ my ($self, $params) = @_;
+ return int( rand(2) );
+}
sub _gen_int {
my ($self, $params) = @_;
if( defined( $params->{info}->{size} ) ) {
$max = 10 ** ($params->{info}->{size}->[0] - $params->{info}->{size}->[1]);
}
- return rand($max) + 1;
+ $max = 10 ** 5 if $max > 10 ** 5;
+ return sprintf("%.2f", rand($max-0.1));
}
sub _gen_date {
my ($self, $params) = @_;
- return $self->schema->storage->datetime_parser->format_datetime(DateTime->now());
+ return $self->schema->storage->datetime_parser->format_date(dt_from_string)
+}
+
+sub _gen_datetime {
+ my ($self, $params) = @_;
+ return $self->schema->storage->datetime_parser->format_datetime(dt_from_string);
}
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 );
+ my $size = $params->{info}{size} // 10;
+ $size -= alt_rand(0.5 * $size);
+ my $regex = $size > 1
+ ? '[A-Za-z][A-Za-z0-9_]{'.($size-1).'}'
+ : '[A-Za-z]';
+ my $random = String::Random->new( rand_gen => \&alt_rand );
+ # rand_gen is only supported from 0.27 onward
return $random->randregex($regex);
}
+sub alt_rand { #Alternative randomizer
+ my ($max) = @_;
+ my $random = Bytes::Random::Secure->new( NonBlocking => 1 );
+ my $r = $random->irand / 2**32;
+ return int( $r * $max );
+}
+
sub _gen_set_enum {
my ($self, $params) = @_;
return $params->{info}->{extra}->{list}->[0];
return 'b';
}
-
-sub DESTROY {
- my $self = shift;
- eval {
- $self->schema->txn_rollback();
+sub _gen_default_values {
+ my ($self) = @_;
+ return {
+ BackgroundJob => {
+ context => '{}'
+ },
+ Borrower => {
+ login_attempts => 0,
+ gonenoaddress => undef,
+ lost => undef,
+ debarred => undef,
+ borrowernotes => '',
+ secret => undef,
+ password_expiration_date => undef,
+ },
+ Item => {
+ notforloan => 0,
+ itemlost => 0,
+ withdrawn => 0,
+ restricted => 0,
+ damaged => 0,
+ materials => undef,
+ more_subfields_xml => undef,
+ },
+ Category => {
+ enrolmentfee => 0,
+ reservefee => 0,
+ # Not X, used for statistics
+ category_type => sub { return [ qw( A C S I P ) ]->[int(rand(5))] },
+ min_password_length => undef,
+ require_strong_password => undef,
+ },
+ Branch => {
+ pickup_location => 0,
+ },
+ Reserve => {
+ non_priority => 0,
+ },
+ Itemtype => {
+ rentalcharge => 0,
+ rentalcharge_daily => 0,
+ rentalcharge_hourly => 0,
+ defaultreplacecost => 0,
+ processfee => 0,
+ notforloan => 0,
+ },
+ Aqbookseller => {
+ tax_rate => 0,
+ discount => 0,
+ url => undef,
+ },
+ Aqbudget => {
+ sort1_authcat => undef,
+ sort2_authcat => undef,
+ },
+ AuthHeader => {
+ marcxml => '',
+ },
+ BorrowerAttributeType => {
+ mandatory => 0,
+ },
+ Suggestion => {
+ suggesteddate => dt_from_string()->ymd,
+ STATUS => 'ASKED'
+ },
+ ReturnClaim => {
+ issue_id => undef, # It should be a FK but we removed it
+ # We don't want to generate a random value
+ },
+ ImportItem => {
+ status => 'staged',
+ import_error => undef
+ },
+ SearchFilter => {
+ opac => 1,
+ staff_client => 1
+ },
};
}
-
=head1 NAME
-t::lib::TestBuilder.pm - Koha module to simplify the writing of tests
+t::lib::TestBuilder.pm - Koha module to create test records
=head1 SYNOPSIS
use t::lib::TestBuilder;
-
-Koha module to insert the foreign keys automatically for the tests
+ my $builder = t::lib::TestBuilder->new;
+
+ # The following call creates a patron, linked to branch CPL.
+ # Surname is provided, other columns are randomly generated.
+ # Branch CPL is created if it does not exist.
+ my $patron = $builder->build({
+ source => 'Borrower',
+ value => { surname => 'Jansen', branchcode => 'CPL' },
+ });
=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.
+This module automatically creates database records for you.
+If needed, records for foreign keys are created too.
+Values will be randomly generated if not passed to TestBuilder.
+Note that you should wrap these actions in a transaction yourself.
-=head1 FUNCTIONS
+=head1 METHODS
=head2 new
- $builder = t::lib::TestBuilder->new()
+ my $builder = t::lib::TestBuilder->new;
-Constructor - Begins a transaction and returns the object TestBuilder
+ Constructor - Returns the object TestBuilder
=head2 schema
- $schema = $builder->schema
-
-Getter - Returns the schema of DBIx::Class
-
-=head2 clear
-
- $builder->clear({ source => $source_name })
+ my $schema = $builder->schema;
-=over
+ Getter - Returns the schema of DBIx::Class
-=item C<$source_name> is the name of the source in the DBIx::Class schema (required)
+=head2 delete
-=back
+ $builder->delete({
+ source => $source,
+ records => $patron, # OR: records => [ $patron, ... ],
+ });
-Clears all the data of this source (database table)
+ Delete individual records, created by builder.
+ Returns the number of delete attempts, or undef.
=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)
+ $builder->build({ source => $source_name, value => $value });
+
+ Create a test record in the table, represented by $source_name.
+ The name is required and must conform to the DBIx::Class schema.
+ Values may be specified by the optional $value hashref. Will be
+ randomized otherwise.
+ If needed, TestBuilder creates linked records for foreign keys.
+ Returns the values of the new record as a hashref, or undef if
+ the record could not be created.
+
+ Note that build also supports recursive hash references inside the
+ value hash for foreign key columns, like:
+ value => {
+ column1 => 'some_value',
+ fk_col2 => {
+ columnA => 'another_value',
+ }
+ }
+ The hash for fk_col2 here means: create a linked record with build
+ where columnA has this value. In case of a composite FK the hashes
+ are merged.
-=item C<$value> is the values for the entry (optional)
+ Realize that passing primary key values to build may result in undef
+ if a record with that primary key already exists.
-=item C<$only_fk> is a boolean to indicate if only the foreign keys are created (optional)
+=head2 build_object
-=back
+Given a plural Koha::Object-derived class, it creates a random element, and
+returns the corresponding Koha::Object.
-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.
+ my $patron = $builder->build_object({ class => 'Koha::Patrons' [, value => { ... }] });
=head1 AUTHOR
Yohann Dufour <yohann.dufour@biblibre.com>
+Koha Development Team
+
=head1 COPYRIGHT
Copyright 2014 - Biblibre SARL
projects / srvgit / blobdiff