t/lib/TestBuilder.pm

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