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_int,
 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_int {
 486     my ($self, $params) = @_;
 487     my $data_type = $params->{info}->{data_type};
 488
 489     my $max = 1;
 490     if( $data_type eq 'tinyint' ) {
 491         $max = 127;
 492     }
 493     elsif( $data_type eq 'smallint' ) {
 494         $max = 32767;
 495     }
 496     elsif( $data_type eq 'mediumint' ) {
 497         $max = 8388607;
 498     }
 499     elsif( $data_type eq 'integer' ) {
 500         $max = 2147483647;
 501     }
 502     elsif( $data_type eq 'bigint' ) {
 503         $max = 9223372036854775807;
 504     }
 505     return int( rand($max+1) );
 506 }
 507
 508 sub _gen_real {
 509     my ($self, $params) = @_;
 510     my $max = 10 ** 38;
 511     if( defined( $params->{info}->{size} ) ) {
 512         $max = 10 ** ($params->{info}->{size}->[0] - $params->{info}->{size}->[1]);
 513     }
 514     $max = 10 ** 5 if $max > 10 ** 5;
 515     return sprintf("%.2f", rand($max-0.1));
 516 }
 517
 518 sub _gen_date {
 519     my ($self, $params) = @_;
 520     return $self->schema->storage->datetime_parser->format_date(dt_from_string)
 521 }
 522
 523 sub _gen_datetime {
 524     my ($self, $params) = @_;
 525     return $self->schema->storage->datetime_parser->format_datetime(dt_from_string);
 526 }
 527
 528 sub _gen_text {
 529     my ($self, $params) = @_;
 530     # From perldoc String::Random
 531     my $size = $params->{info}{size} // 10;
 532     $size -= alt_rand(0.5 * $size);
 533     my $regex = $size > 1
 534         ? '[A-Za-z][A-Za-z0-9_]{'.($size-1).'}'
 535         : '[A-Za-z]';
 536     my $random = String::Random->new( rand_gen => \&alt_rand );
 537     # rand_gen is only supported from 0.27 onward
 538     return $random->randregex($regex);
 539 }
 540
 541 sub alt_rand { #Alternative randomizer
 542     my ($max) = @_;
 543     my $random = Bytes::Random::Secure->new( NonBlocking => 1 );
 544     my $r = $random->irand / 2**32;
 545     return int( $r * $max );
 546 }
 547
 548 sub _gen_set_enum {
 549     my ($self, $params) = @_;
 550     return $params->{info}->{extra}->{list}->[0];
 551 }
 552
 553 sub _gen_blob {
 554     my ($self, $params) = @_;;
 555     return 'b';
 556 }
 557
 558 sub _gen_default_values {
 559     my ($self) = @_;
 560     return {
 561         BackgroundJob => {
 562             context => '{}'
 563         },
 564         Borrower => {
 565             login_attempts => 0,
 566             gonenoaddress  => undef,
 567             lost           => undef,
 568             debarred       => undef,
 569             borrowernotes  => '',
 570             secret         => undef,
 571             password_expiration_date => undef,
 572         },
 573         Item => {
 574             notforloan         => 0,
 575             itemlost           => 0,
 576             withdrawn          => 0,
 577             restricted         => 0,
 578             damaged            => 0,
 579             materials          => undef,
 580             more_subfields_xml => undef,
 581         },
 582         Category => {
 583             enrolmentfee => 0,
 584             reservefee   => 0,
 585             # Not X, used for statistics
 586             category_type => sub { return [ qw( A C S I P ) ]->[int(rand(5))] },
 587             min_password_length => undef,
 588             require_strong_password => undef,
 589         },
 590         Branch => {
 591             pickup_location => 0,
 592         },
 593         Reserve => {
 594             non_priority => 0,
 595         },
 596         Itemtype => {
 597             rentalcharge => 0,
 598             rentalcharge_daily => 0,
 599             rentalcharge_hourly => 0,
 600             defaultreplacecost => 0,
 601             processfee => 0,
 602             notforloan => 0,
 603         },
 604         Aqbookseller => {
 605             tax_rate => 0,
 606             discount => 0,
 607             url  => undef,
 608         },
 609         Aqbudget => {
 610             sort1_authcat => undef,
 611             sort2_authcat => undef,
 612         },
 613         AuthHeader => {
 614             marcxml => '',
 615         },
 616         BorrowerAttributeType => {
 617             mandatory => 0,
 618         },
 619         Suggestion => {
 620             suggesteddate => dt_from_string()->ymd,
 621             STATUS        => 'ASKED'
 622         },
 623         ReturnClaim => {
 624             issue_id => undef, # It should be a FK but we removed it
 625                                # We don't want to generate a random value
 626         },
 627         ImportItem => {
 628             status => 'staged',
 629             import_error => undef
 630         },
 631         SearchFilter => {
 632             opac => 1,
 633             staff_client => 1
 634         },
 635     };
 636 }
 637
 638 =head1 NAME
 639
 640 t::lib::TestBuilder.pm - Koha module to create test records
 641
 642 =head1 SYNOPSIS
 643
 644     use t::lib::TestBuilder;
 645     my $builder = t::lib::TestBuilder->new;
 646
 647     # The following call creates a patron, linked to branch CPL.
 648     # Surname is provided, other columns are randomly generated.
 649     # Branch CPL is created if it does not exist.
 650     my $patron = $builder->build({
 651         source => 'Borrower',
 652         value  => { surname => 'Jansen', branchcode => 'CPL' },
 653     });
 654
 655 =head1 DESCRIPTION
 656
 657 This module automatically creates database records for you.
 658 If needed, records for foreign keys are created too.
 659 Values will be randomly generated if not passed to TestBuilder.
 660 Note that you should wrap these actions in a transaction yourself.
 661
 662 =head1 METHODS
 663
 664 =head2 new
 665
 666     my $builder = t::lib::TestBuilder->new;
 667
 668     Constructor - Returns the object TestBuilder
 669
 670 =head2 schema
 671
 672     my $schema = $builder->schema;
 673
 674     Getter - Returns the schema of DBIx::Class
 675
 676 =head2 delete
 677
 678     $builder->delete({
 679         source => $source,
 680         records => $patron, # OR: records => [ $patron, ... ],
 681     });
 682
 683     Delete individual records, created by builder.
 684     Returns the number of delete attempts, or undef.
 685
 686 =head2 build
 687
 688     $builder->build({ source  => $source_name, value => $value });
 689
 690     Create a test record in the table, represented by $source_name.
 691     The name is required and must conform to the DBIx::Class schema.
 692     Values may be specified by the optional $value hashref. Will be
 693     randomized otherwise.
 694     If needed, TestBuilder creates linked records for foreign keys.
 695     Returns the values of the new record as a hashref, or undef if
 696     the record could not be created.
 697
 698     Note that build also supports recursive hash references inside the
 699     value hash for foreign key columns, like:
 700         value => {
 701             column1 => 'some_value',
 702             fk_col2 => {
 703                 columnA => 'another_value',
 704             }
 705         }
 706     The hash for fk_col2 here means: create a linked record with build
 707     where columnA has this value. In case of a composite FK the hashes
 708     are merged.
 709
 710     Realize that passing primary key values to build may result in undef
 711     if a record with that primary key already exists.
 712
 713 =head2 build_object
 714
 715 Given a plural Koha::Object-derived class, it creates a random element, and
 716 returns the corresponding Koha::Object.
 717
 718     my $patron = $builder->build_object({ class => 'Koha::Patrons' [, value => { ... }] });
 719
 720 =head1 AUTHOR
 721
 722 Yohann Dufour <yohann.dufour@biblibre.com>
 723
 724 Koha Development Team
 725
 726 =head1 COPYRIGHT
 727
 728 Copyright 2014 - Biblibre SARL
 729
 730 =head1 LICENSE
 731
 732 This file is part of Koha.
 733
 734 Koha is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by
 735 the Free Software Foundation; either version 3 of the License, or (at your option) any later version.
 736
 737 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.
 738
 739 You should have received a copy of the GNU General Public License along with Koha; if not, see <http://www.gnu.org/licenses>.
 740
 741 =cut
 742
 743 1;