t/lib/TestBuilder.pm

   1 package t::lib::TestBuilder;
   2
   3 use Modern::Perl;
   4
   5 use Koha::Database qw( schema );
   6 use C4::Biblio qw( AddBiblio );
   7 use Koha::Biblios qw( _type );
   8 use Koha::Items qw( _type );
   9 use Koha::DateUtils qw( dt_from_string );
  10
  11 use Bytes::Random::Secure;
  12 use Carp qw( carp );
  13 use Module::Load qw( load );
  14 use String::Random;
  15
  16 use constant {
  17     SIZE_BARCODE => 20, # Not perfect but avoid to fetch the value when creating a new item
  18 };
  19
  20 sub new {
  21     my ($class) = @_;
  22     my $self = {};
  23     bless( $self, $class );
  24
  25     $self->schema( Koha::Database->new()->schema );
  26     $self->schema->storage->sql_maker->quote_char('`');
  27
  28     $self->{gen_type} = _gen_type();
  29     $self->{default_values} = _gen_default_values();
  30     return $self;
  31 }
  32
  33 sub schema {
  34     my ($self, $schema) = @_;
  35
  36     if( defined( $schema ) ) {
  37         $self->{schema} = $schema;
  38     }
  39     return $self->{schema};
  40 }
  41
  42 # sub clear has been obsoleted; use delete_all from the schema resultset
  43
  44 sub delete {
  45     my ( $self, $params ) = @_;
  46     my $source = $params->{source} || return;
  47     my @recs = ref( $params->{records} ) eq 'ARRAY'?
  48         @{$params->{records}}: ( $params->{records} // () );
  49     # tables without PK are not supported
  50     my @pk = $self->schema->source( $source )->primary_columns;
  51     return if !@pk;
  52     my $rv = 0;
  53     foreach my $rec ( @recs ) {
  54     # delete only works when you supply full primary key values
  55     # $cond does not include searches for undef (not allowed in PK)
  56         my $cond = { map { defined $rec->{$_}? ($_, $rec->{$_}): (); } @pk };
  57         next if keys %$cond < @pk;
  58         $self->schema->resultset( $source )->search( $cond )->delete;
  59         # we clear the pk columns in the supplied hash
  60         # this indirectly signals at least an attempt to delete
  61         map { delete $rec->{$_}; } @pk;
  62         $rv++;
  63     }
  64     return $rv;
  65 }
  66
  67 sub build_object {
  68     my ( $self, $params ) = @_;
  69
  70     my $class = $params->{class};
  71     my $value = $params->{value};
  72
  73     if ( not defined $class ) {
  74         carp "Missing class param";
  75         return;
  76     }
  77
  78     my @unknowns = grep( !/^(class|value)$/, keys %{ $params });
  79     carp "Unknown parameter(s): ", join( ', ', @unknowns ) if scalar @unknowns;
  80
  81     load $class;
  82     my $source = $class->_type;
  83
  84     my $hashref = $self->build({ source => $source, value => $value });
  85     my $object;
  86     if ( $class eq 'Koha::Old::Patrons' ) {
  87         $object = $class->search({ borrowernumber => $hashref->{borrowernumber} })->next;
  88     } elsif ( $class eq 'Koha::Statistics' ) {
  89         $object = $class->search({ datetime => $hashref->{datetime} })->next;
  90     } else {
  91         my @ids;
  92         my @pks = $self->schema->source( $class->_type )->primary_columns;
  93         foreach my $pk ( @pks ) {
  94             push @ids, $hashref->{ $pk };
  95         }
  96
  97         $object = $class->find( @ids );
  98     }
  99
 100     return $object;
 101 }
 102
 103 sub build {
 104 # build returns a hash of column values for a created record, or undef
 105 # build does NOT update a record, or pass back values of an existing record
 106     my ($self, $params) = @_;
 107     my $source  = $params->{source};
 108     if( !$source ) {
 109         carp "Source parameter not specified!";
 110         return;
 111     }
 112     my $value   = $params->{value};
 113
 114     my @unknowns = grep( !/^(source|value)$/, keys %{ $params });
 115     carp "Unknown parameter(s): ", join( ', ', @unknowns ) if scalar @unknowns;
 116
 117     my $col_values = $self->_buildColumnValues({
 118         source  => $source,
 119         value   => $value,
 120     });
 121     return if !$col_values; # did not meet unique constraints?
 122
 123     # loop thru all fk and create linked records if needed
 124     # fills remaining entries in $col_values
 125     my $foreign_keys = $self->_getForeignKeys( { source => $source } );
 126     my $col_names = {};
 127     for my $fk ( @$foreign_keys ) {
 128         # skip when FK points to itself: e.g. borrowers:guarantorid
 129         next if $fk->{source} eq $source;
 130
 131         # If we have more than one FK on the same column, we only generate values for the first one
 132         next
 133           if scalar @{ $fk->{keys} } == 1
 134           && exists $col_names->{ $fk->{keys}->[0]->{col_name} };
 135
 136         my $keys = $fk->{keys};
 137         my $tbl = $fk->{source};
 138         my $res = $self->_create_links( $tbl, $keys, $col_values, $value );
 139         return if !$res; # failed: no need to go further
 140         foreach( keys %$res ) { # save new values
 141             $col_values->{$_} = $res->{$_};
 142         }
 143
 144         $col_names->{ $fk->{keys}->[0]->{col_name} } = 1
 145           if scalar @{ $fk->{keys} } == 1
 146     }
 147
 148     # store this record and return hashref
 149     return $self->_storeColumnValues({
 150         source => $source,
 151         values => $col_values,
 152     });
 153 }
 154
 155 sub build_sample_biblio {
 156     my ( $self, $args ) = @_;
 157
 158     my $title  = $args->{title}  || 'Some boring read';
 159     my $author = $args->{author} || 'Some boring author';
 160     my $frameworkcode = $args->{frameworkcode} || '';
 161     my $itemtype = $args->{itemtype}
 162       || $self->build_object( { class => 'Koha::ItemTypes' } )->itemtype;
 163
 164     my $marcflavour = C4::Context->preference('marcflavour');
 165
 166     my $record = MARC::Record->new();
 167     $record->encoding( 'UTF-8' );
 168
 169     my ( $tag, $subfield ) = $marcflavour eq 'UNIMARC' ? ( 200, 'a' ) : ( 245, 'a' );
 170     $record->append_fields(
 171         MARC::Field->new( $tag, ' ', ' ', $subfield => $title ),
 172     );
 173
 174     ( $tag, $subfield ) = $marcflavour eq 'UNIMARC' ? ( 200, 'f' ) : ( 100, 'a' );
 175     $record->append_fields(
 176         MARC::Field->new( $tag, ' ', ' ', $subfield => $author ),
 177     );
 178
 179     ( $tag, $subfield ) = $marcflavour eq 'UNIMARC' ? ( 995, 'r' ) : ( 942, 'c' );
 180     $record->append_fields(
 181         MARC::Field->new( $tag, ' ', ' ', $subfield => $itemtype )
 182     );
 183
 184     my ($biblio_id) = C4::Biblio::AddBiblio( $record, $frameworkcode );
 185     return Koha::Biblios->find($biblio_id);
 186 }
 187
 188 sub build_sample_item {
 189     my ( $self, $args ) = @_;
 190
 191     my $biblionumber =
 192       delete $args->{biblionumber} || $self->build_sample_biblio->biblionumber;
 193     my $library = delete $args->{library}
 194       || $self->build_object( { class => 'Koha::Libraries' } )->branchcode;
 195
 196     # If itype is not passed it will be picked from the biblio (see Koha::Item->store)
 197
 198     my $barcode = delete $args->{barcode}
 199       || $self->_gen_text( { info => { size => SIZE_BARCODE } } );
 200
 201     return Koha::Item->new(
 202         {
 203             biblionumber  => $biblionumber,
 204             homebranch    => $library,
 205             holdingbranch => $library,
 206             barcode       => $barcode,
 207             %$args,
 208         }
 209     )->store->get_from_storage;
 210 }
 211
 212 # ------------------------------------------------------------------------------
 213 # Internal helper routines
 214
 215 sub _create_links {
 216 # returns undef for failure to create linked records
 217 # otherwise returns hashref containing new column values for parent record
 218     my ( $self, $linked_tbl, $keys, $col_values, $value ) = @_;
 219
 220     my $fk_value = {};
 221     my ( $cnt_scalar, $cnt_null ) = ( 0, 0 );
 222
 223     # First, collect all values for creating a linked record (if needed)
 224     foreach my $fk ( @$keys ) {
 225         my ( $col, $destcol ) = ( $fk->{col_name}, $fk->{col_fk_name} );
 226         if( ref( $value->{$col} ) eq 'HASH' ) {
 227             # add all keys from the FK hash
 228             $fk_value = { %{ $value->{$col} }, %$fk_value };
 229         }
 230         if( exists $col_values->{$col} ) {
 231             # add specific value (this does not necessarily exclude some
 232             # values from the hash in the preceding if)
 233             $fk_value->{ $destcol } = $col_values->{ $col };
 234             $cnt_scalar++;
 235             $cnt_null++ if !defined( $col_values->{$col} );
 236         }
 237     }
 238
 239     # If we saw all FK columns, first run the following checks
 240     if( $cnt_scalar == @$keys ) {
 241         # if one or more fk cols are null, the FK constraint will not be forced
 242         return {} if $cnt_null > 0;
 243
 244         # does the record exist already?
 245         my @pks = $self->schema->source( $linked_tbl )->primary_columns;
 246         my %fk_pk_value;
 247         for (@pks) {
 248             $fk_pk_value{$_} = $fk_value->{$_} if defined $fk_value->{$_};
 249         }
 250         return {} if !(keys %fk_pk_value);
 251         return {} if $self->schema->resultset($linked_tbl)->find( \%fk_pk_value );
 252     }
 253     # create record with a recursive build call
 254     my $row = $self->build({ source => $linked_tbl, value => $fk_value });
 255     return if !$row; # failure
 256
 257     # Finally, only return the new values
 258     my $rv = {};
 259     foreach my $fk ( @$keys ) {
 260         my ( $col, $destcol ) = ( $fk->{col_name}, $fk->{col_fk_name} );
 261         next if exists $col_values->{ $col };
 262         $rv->{ $col } = $row->{ $destcol };
 263     }
 264     return $rv; # success
 265 }
 266
 267 sub _formatSource {
 268     my ($params) = @_;
 269     my $source = $params->{source} || return;
 270     $source =~ s|(\w+)$|$1|;
 271     return $source;
 272 }
 273
 274 sub _buildColumnValues {
 275     my ($self, $params) = @_;
 276     my $source = _formatSource( $params ) || return;
 277     my $original_value = $params->{value};
 278
 279     my $col_values = {};
 280     my @columns = $self->schema->source($source)->columns;
 281     my %unique_constraints = $self->schema->source($source)->unique_constraints();
 282
 283     my $build_value = 5;
 284     # we try max $build_value times if there are unique constraints
 285     BUILD_VALUE: while ( $build_value ) {
 286         # generate random values for all columns
 287         for my $col_name( @columns ) {
 288             my $valref = $self->_buildColumnValue({
 289                 source      => $source,
 290                 column_name => $col_name,
 291                 value       => $original_value,
 292             });
 293             return if !$valref; # failure
 294             if( @$valref ) { # could be empty
 295                 # there will be only one value, but it could be undef
 296                 $col_values->{$col_name} = $valref->[0];
 297             }
 298         }
 299
 300         # verify the data would respect each unique constraint
 301         # note that this is INCOMPLETE since not all col_values are filled
 302         CONSTRAINTS: foreach my $constraint (keys %unique_constraints) {
 303
 304                 my $condition;
 305                 my $constraint_columns = $unique_constraints{$constraint};
 306                 # loop through all constraint columns and build the condition
 307                 foreach my $constraint_column ( @$constraint_columns ) {
 308                     # build the filter
 309                     # if one column does not exist or is undef, skip it
 310                     # an insert with a null will not trigger the constraint
 311                     next CONSTRAINTS
 312                         if !exists $col_values->{ $constraint_column } ||
 313                         !defined $col_values->{ $constraint_column };
 314                     $condition->{ $constraint_column } =
 315                             $col_values->{ $constraint_column };
 316                 }
 317                 my $count = $self->schema
 318                                  ->resultset( $source )
 319                                  ->search( $condition )
 320                                  ->count();
 321                 if ( $count > 0 ) {
 322                     # no point checking more stuff, exit the loop
 323                     $build_value--;
 324                     next BUILD_VALUE;
 325                 }
 326         }
 327         last; # you passed all tests
 328     }
 329     return $col_values if $build_value > 0;
 330
 331     # if you get here, we have a problem
 332     warn "Violation of unique constraint in $source";
 333     return;
 334 }
 335
 336 sub _getForeignKeys {
 337
 338 # Returns the following arrayref
 339 #   [ [ source => name, keys => [ col_name => A, col_fk_name => B ] ], ... ]
 340 # The array gives source name and keys for each FK constraint
 341
 342     my ($self, $params) = @_;
 343     my $source = $self->schema->source( $params->{source} );
 344
 345     my ( @foreign_keys, $check_dupl );
 346     my @relationships = $source->relationships;
 347     for my $rel_name( @relationships ) {
 348         my $rel_info = $source->relationship_info($rel_name);
 349         if( $rel_info->{attrs}->{is_foreign_key_constraint} ) {
 350             $rel_info->{source} =~ s/^.*:://g;
 351             my $rel = { source => $rel_info->{source} };
 352
 353             my @keys;
 354             while( my ($col_fk_name, $col_name) = each(%{$rel_info->{cond}}) ) {
 355                 $col_name    =~ s|self.(\w+)|$1|;
 356                 $col_fk_name =~ s|foreign.(\w+)|$1|;
 357                 push @keys, {
 358                     col_name    => $col_name,
 359                     col_fk_name => $col_fk_name,
 360                 };
 361             }
 362             # check if the combination table and keys is unique
 363             # so skip double belongs_to relations (as in Biblioitem)
 364             my $tag = $rel->{source}. ':'.
 365                 join ',', sort map { $_->{col_name} } @keys;
 366             next if $check_dupl->{$tag};
 367             $check_dupl->{$tag} = 1;
 368             $rel->{keys} = \@keys;
 369             push @foreign_keys, $rel;
 370         }
 371     }
 372     return \@foreign_keys;
 373 }
 374
 375 sub _storeColumnValues {
 376     my ($self, $params) = @_;
 377     my $source      = $params->{source};
 378     my $col_values  = $params->{values};
 379     my $new_row = $self->schema->resultset( $source )->create( $col_values );
 380     return $new_row? { $new_row->get_columns }: {};
 381 }
 382
 383 sub _buildColumnValue {
 384 # returns an arrayref if all goes well
 385 # an empty arrayref typically means: auto_incr column or fk column
 386 # undef means failure
 387     my ($self, $params) = @_;
 388     my $source    = $params->{source};
 389     my $value     = $params->{value};
 390     my $col_name  = $params->{column_name};
 391
 392     my $col_info  = $self->schema->source($source)->column_info($col_name);
 393
 394     my $retvalue = [];
 395     if( $col_info->{is_auto_increment} ) {
 396         if( exists $value->{$col_name} ) {
 397             warn "Value not allowed for auto_incr $col_name in $source";
 398             return;
 399         }
 400         # otherwise: no need to assign a value
 401     } elsif( $col_info->{is_foreign_key} || _should_be_fk($source,$col_name) ) {
 402         if( exists $value->{$col_name} ) {
 403             if( !defined $value->{$col_name} && !$col_info->{is_nullable} ) {
 404                 # This explicit undef is not allowed
 405                 warn "Null value for $col_name in $source not allowed";
 406                 return;
 407             }
 408             if( ref( $value->{$col_name} ) ne 'HASH' ) {
 409                 push @$retvalue, $value->{$col_name};
 410             }
 411             # sub build will handle a passed hash value later on
 412         }
 413     } elsif( ref( $value->{$col_name} ) eq 'HASH' ) {
 414         # this is not allowed for a column that is not a FK
 415         warn "Hash not allowed for $col_name in $source";
 416         return;
 417     } elsif( exists $value->{$col_name} ) {
 418         if( !defined $value->{$col_name} && !$col_info->{is_nullable} ) {
 419             # This explicit undef is not allowed
 420             warn "Null value for $col_name in $source not allowed";
 421             return;
 422         }
 423         push @$retvalue, $value->{$col_name};
 424     } elsif( exists $self->{default_values}{$source}{$col_name} ) {
 425         my $v = $self->{default_values}{$source}{$col_name};
 426         $v = &$v() if ref($v) eq 'CODE';
 427         push @$retvalue, $v;
 428     } else {
 429         my $data_type = $col_info->{data_type};
 430         $data_type =~ s| |_|;
 431         if( my $hdlr = $self->{gen_type}->{$data_type} ) {
 432             push @$retvalue, &$hdlr( $self, { info => $col_info } );
 433         } else {
 434             warn "Unknown type $data_type for $col_name in $source";
 435             return;
 436         }
 437     }
 438     return $retvalue;
 439 }
 440
 441 sub _should_be_fk {
 442 # This sub is only needed for inconsistencies in the schema
 443 # A column is not marked as FK, but a belongs_to relation is defined
 444     my ( $source, $column ) = @_;
 445     my $inconsistencies = {
 446         'Item.biblionumber'           => 1, #FIXME: Please remove me when I become FK
 447         'CheckoutRenewal.checkout_id' => 1, #FIXME: Please remove when issues and old_issues are merged
 448     };
 449     return $inconsistencies->{ "$source.$column" };
 450 }
 451
 452 sub _gen_type {
 453     return {
 454         tinyint   => \&_gen_bool,
 455         smallint  => \&_gen_int,
 456         mediumint => \&_gen_int,
 457         integer   => \&_gen_int,
 458         bigint    => \&_gen_int,
 459
 460         float            => \&_gen_real,
 461         decimal          => \&_gen_real,
 462         double_precision => \&_gen_real,
 463
 464         timestamp => \&_gen_datetime,
 465         datetime  => \&_gen_datetime,
 466         date      => \&_gen_date,
 467
 468         char       => \&_gen_text,
 469         varchar    => \&_gen_text,
 470         tinytext   => \&_gen_text,
 471         text       => \&_gen_text,
 472         mediumtext => \&_gen_text,
 473         longtext   => \&_gen_text,
 474
 475         set  => \&_gen_set_enum,
 476         enum => \&_gen_set_enum,
 477
 478         tinyblob   => \&_gen_blob,
 479         mediumblob => \&_gen_blob,
 480         blob       => \&_gen_blob,
 481         longblob   => \&_gen_blob,
 482     };
 483 };
 484
 485 sub _gen_bool {
 486     my ($self, $params) = @_;
 487     return int( rand(2) );
 488 }
 489
 490 sub _gen_int {
 491     my ($self, $params) = @_;
 492     my $data_type = $params->{info}->{data_type};
 493
 494     my $max = 1;
 495     if( $data_type eq 'tinyint' ) {
 496         $max = 127;
 497     }
 498     elsif( $data_type eq 'smallint' ) {
 499         $max = 32767;
 500     }
 501     elsif( $data_type eq 'mediumint' ) {
 502         $max = 8388607;
 503     }
 504     elsif( $data_type eq 'integer' ) {
 505         $max = 2147483647;
 506     }
 507     elsif( $data_type eq 'bigint' ) {
 508         $max = 9223372036854775807;
 509     }
 510     return int( rand($max+1) );
 511 }
 512
 513 sub _gen_real {
 514     my ($self, $params) = @_;
 515     my $max = 10 ** 38;
 516     if( defined( $params->{info}->{size} ) ) {
 517         $max = 10 ** ($params->{info}->{size}->[0] - $params->{info}->{size}->[1]);
 518     }
 519     $max = 10 ** 5 if $max > 10 ** 5;
 520     return sprintf("%.2f", rand($max-0.1));
 521 }
 522
 523 sub _gen_date {
 524     my ($self, $params) = @_;
 525     return $self->schema->storage->datetime_parser->format_date(dt_from_string)
 526 }
 527
 528 sub _gen_datetime {
 529     my ($self, $params) = @_;
 530     return $self->schema->storage->datetime_parser->format_datetime(dt_from_string);
 531 }
 532
 533 sub _gen_text {
 534     my ($self, $params) = @_;
 535     # From perldoc String::Random
 536     my $size = $params->{info}{size} // 10;
 537     $size -= alt_rand(0.5 * $size);
 538     my $regex = $size > 1
 539         ? '[A-Za-z][A-Za-z0-9_]{'.($size-1).'}'
 540         : '[A-Za-z]';
 541     my $random = String::Random->new( rand_gen => \&alt_rand );
 542     # rand_gen is only supported from 0.27 onward
 543     return $random->randregex($regex);
 544 }
 545
 546 sub alt_rand { #Alternative randomizer
 547     my ($max) = @_;
 548     my $random = Bytes::Random::Secure->new( NonBlocking => 1 );
 549     my $r = $random->irand / 2**32;
 550     return int( $r * $max );
 551 }
 552
 553 sub _gen_set_enum {
 554     my ($self, $params) = @_;
 555     return $params->{info}->{extra}->{list}->[0];
 556 }
 557
 558 sub _gen_blob {
 559     my ($self, $params) = @_;;
 560     return 'b';
 561 }
 562
 563 sub _gen_default_values {
 564     my ($self) = @_;
 565     return {
 566         BackgroundJob => {
 567             context => '{}'
 568         },
 569         Borrower => {
 570             login_attempts => 0,
 571             gonenoaddress  => undef,
 572             lost           => undef,
 573             debarred       => undef,
 574             borrowernotes  => '',
 575             secret         => undef,
 576             password_expiration_date => undef,
 577         },
 578         Item => {
 579             notforloan         => 0,
 580             itemlost           => 0,
 581             withdrawn          => 0,
 582             restricted         => 0,
 583             damaged            => 0,
 584             materials          => undef,
 585             more_subfields_xml => undef,
 586         },
 587         Category => {
 588             enrolmentfee => 0,
 589             reservefee   => 0,
 590             # Not X, used for statistics
 591             category_type => sub { return [ qw( A C S I P ) ]->[int(rand(5))] },
 592             min_password_length => undef,
 593             require_strong_password => undef,
 594         },
 595         Branch => {
 596             pickup_location => 0,
 597         },
 598         Reserve => {
 599             non_priority => 0,
 600         },
 601         Itemtype => {
 602             rentalcharge => 0,
 603             rentalcharge_daily => 0,
 604             rentalcharge_hourly => 0,
 605             defaultreplacecost => 0,
 606             processfee => 0,
 607             notforloan => 0,
 608         },
 609         Aqbookseller => {
 610             tax_rate => 0,
 611             discount => 0,
 612             url  => undef,
 613         },
 614         Aqbudget => {
 615             sort1_authcat => undef,
 616             sort2_authcat => undef,
 617         },
 618         AuthHeader => {
 619             marcxml => '',
 620         },
 621         BorrowerAttributeType => {
 622             mandatory => 0,
 623         },
 624         Suggestion => {
 625             suggesteddate => dt_from_string()->ymd,
 626             STATUS        => 'ASKED'
 627         },
 628         ReturnClaim => {
 629             issue_id => undef, # It should be a FK but we removed it
 630                                # We don't want to generate a random value
 631         },
 632         ImportItem => {
 633             status => 'staged',
 634             import_error => undef
 635         },
 636         SearchFilter => {
 637             opac => 1,
 638             staff_client => 1
 639         },
 640     };
 641 }
 642
 643 =head1 NAME
 644
 645 t::lib::TestBuilder.pm - Koha module to create test records
 646
 647 =head1 SYNOPSIS
 648
 649     use t::lib::TestBuilder;
 650     my $builder = t::lib::TestBuilder->new;
 651
 652     # The following call creates a patron, linked to branch CPL.
 653     # Surname is provided, other columns are randomly generated.
 654     # Branch CPL is created if it does not exist.
 655     my $patron = $builder->build({
 656         source => 'Borrower',
 657         value  => { surname => 'Jansen', branchcode => 'CPL' },
 658     });
 659
 660 =head1 DESCRIPTION
 661
 662 This module automatically creates database records for you.
 663 If needed, records for foreign keys are created too.
 664 Values will be randomly generated if not passed to TestBuilder.
 665 Note that you should wrap these actions in a transaction yourself.
 666
 667 =head1 METHODS
 668
 669 =head2 new
 670
 671     my $builder = t::lib::TestBuilder->new;
 672
 673     Constructor - Returns the object TestBuilder
 674
 675 =head2 schema
 676
 677     my $schema = $builder->schema;
 678
 679     Getter - Returns the schema of DBIx::Class
 680
 681 =head2 delete
 682
 683     $builder->delete({
 684         source => $source,
 685         records => $patron, # OR: records => [ $patron, ... ],
 686     });
 687
 688     Delete individual records, created by builder.
 689     Returns the number of delete attempts, or undef.
 690
 691 =head2 build
 692
 693     $builder->build({ source  => $source_name, value => $value });
 694
 695     Create a test record in the table, represented by $source_name.
 696     The name is required and must conform to the DBIx::Class schema.
 697     Values may be specified by the optional $value hashref. Will be
 698     randomized otherwise.
 699     If needed, TestBuilder creates linked records for foreign keys.
 700     Returns the values of the new record as a hashref, or undef if
 701     the record could not be created.
 702
 703     Note that build also supports recursive hash references inside the
 704     value hash for foreign key columns, like:
 705         value => {
 706             column1 => 'some_value',
 707             fk_col2 => {
 708                 columnA => 'another_value',
 709             }
 710         }
 711     The hash for fk_col2 here means: create a linked record with build
 712     where columnA has this value. In case of a composite FK the hashes
 713     are merged.
 714
 715     Realize that passing primary key values to build may result in undef
 716     if a record with that primary key already exists.
 717
 718 =head2 build_object
 719
 720 Given a plural Koha::Object-derived class, it creates a random element, and
 721 returns the corresponding Koha::Object.
 722
 723     my $patron = $builder->build_object({ class => 'Koha::Patrons' [, value => { ... }] });
 724
 725 =head1 AUTHOR
 726
 727 Yohann Dufour <yohann.dufour@biblibre.com>
 728
 729 Koha Development Team
 730
 731 =head1 COPYRIGHT
 732
 733 Copyright 2014 - Biblibre SARL
 734
 735 =head1 LICENSE
 736
 737 This file is part of Koha.
 738
 739 Koha is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by
 740 the Free Software Foundation; either version 3 of the License, or (at your option) any later version.
 741
 742 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.
 743
 744 You should have received a copy of the GNU General Public License along with Koha; if not, see <http://www.gnu.org/licenses>.
 745
 746 =cut
 747
 748 1;