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