Koha/Object.pm

   1 package Koha::Object;
   2
   3 # Copyright ByWater Solutions 2014
   4 # Copyright 2016 Koha Development Team
   5 #
   6 # This file is part of Koha.
   7 #
   8 # Koha is free software; you can redistribute it and/or modify it
   9 # under the terms of the GNU General Public License as published by
  10 # the Free Software Foundation; either version 3 of the License, or
  11 # (at your option) any later version.
  12 #
  13 # Koha is distributed in the hope that it will be useful, but
  14 # WITHOUT ANY WARRANTY; without even the implied warranty of
  15 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  16 # GNU General Public License for more details.
  17 #
  18 # You should have received a copy of the GNU General Public License
  19 # along with Koha; if not, see <http://www.gnu.org/licenses>.
  20
  21 use Modern::Perl;
  22
  23 use Carp;
  24 use Mojo::JSON;
  25 use Scalar::Util qw( blessed looks_like_number );
  26 use Try::Tiny;
  27
  28 use Koha::Database;
  29 use Koha::Exceptions::Object;
  30 use Koha::DateUtils;
  31
  32 =head1 NAME
  33
  34 Koha::Object - Koha Object base class
  35
  36 =head1 SYNOPSIS
  37
  38     use Koha::Object;
  39     my $object = Koha::Object->new({ property1 => $property1, property2 => $property2, etc... } );
  40
  41 =head1 DESCRIPTION
  42
  43 This class must always be subclassed.
  44
  45 =head1 API
  46
  47 =head2 Class Methods
  48
  49 =cut
  50
  51 =head3 Koha::Object->new();
  52
  53 my $object = Koha::Object->new();
  54 my $object = Koha::Object->new($attributes);
  55
  56 Note that this cannot be used to retrieve record from the DB.
  57
  58 =cut
  59
  60 sub new {
  61     my ( $class, $attributes ) = @_;
  62     my $self = {};
  63
  64     if ($attributes) {
  65         my $schema = Koha::Database->new->schema;
  66
  67         # Remove the arguments which exist, are not defined but NOT NULL to use the default value
  68         my $columns_info = $schema->resultset( $class->_type )->result_source->columns_info;
  69         for my $column_name ( keys %$attributes ) {
  70             my $c_info = $columns_info->{$column_name};
  71             next if $c_info->{is_nullable};
  72             next if not exists $attributes->{$column_name} or defined $attributes->{$column_name};
  73             delete $attributes->{$column_name};
  74         }
  75
  76         $self->{_result} =
  77           $schema->resultset( $class->_type() )->new($attributes);
  78     }
  79
  80     croak("No _type found! Koha::Object must be subclassed!")
  81       unless $class->_type();
  82
  83     bless( $self, $class );
  84
  85 }
  86
  87 =head3 Koha::Object->_new_from_dbic();
  88
  89 my $object = Koha::Object->_new_from_dbic($dbic_row);
  90
  91 =cut
  92
  93 sub _new_from_dbic {
  94     my ( $class, $dbic_row ) = @_;
  95     my $self = {};
  96
  97     # DBIC result row
  98     $self->{_result} = $dbic_row;
  99
 100     croak("No _type found! Koha::Object must be subclassed!")
 101       unless $class->_type();
 102
 103     croak( "DBIC result _type " . ref( $self->{_result} ) . " isn't of the _type " . $class->_type() )
 104       unless ref( $self->{_result} ) eq "Koha::Schema::Result::" . $class->_type();
 105
 106     bless( $self, $class );
 107
 108 }
 109
 110 =head3 $object->store();
 111
 112 Saves the object in storage.
 113 If the object is new, it will be created.
 114 If the object previously existed, it will be updated.
 115
 116 Returns:
 117     $self  if the store was a success
 118     undef  if the store failed
 119
 120 =cut
 121
 122 sub store {
 123     my ($self) = @_;
 124
 125     my $columns_info = $self->_result->result_source->columns_info;
 126
 127     # Handle not null and default values for integers and dates
 128     foreach my $col ( keys %{$columns_info} ) {
 129         # Integers
 130         if ( _numeric_column_type( $columns_info->{$col}->{data_type} ) ) {
 131             # Has been passed but not a number, usually an empty string
 132             my $value = $self->_result()->get_column($col);
 133             if ( defined $value and not looks_like_number( $value ) ) {
 134                 if ( $columns_info->{$col}->{is_nullable} ) {
 135                     # If nullable, default to null
 136                     $self->_result()->set_column($col => undef);
 137                 } else {
 138                     # If cannot be null, get the default value
 139                     # What if cannot be null and does not have a default value? Possible?
 140                     $self->_result()->set_column($col => $columns_info->{$col}->{default_value});
 141                 }
 142             }
 143         }
 144         elsif ( _date_or_datetime_column_type( $columns_info->{$col}->{data_type} ) ) {
 145             # Set to null if an empty string (or == 0 but should not happen)
 146             my $value = $self->_result()->get_column($col);
 147             if ( defined $value and not $value ) {
 148                 if ( $columns_info->{$col}->{is_nullable} ) {
 149                     $self->_result()->set_column($col => undef);
 150                 } else {
 151                     $self->_result()->set_column($col => $columns_info->{$col}->{default_value});
 152                 }
 153             }
 154             elsif ( not defined $self->$col
 155                   && $columns_info->{$col}->{datetime_undef_if_invalid} )
 156               {
 157                   # timestamp
 158                   $self->_result()->set_column($col => $columns_info->{$col}->{default_value});
 159               }
 160         }
 161     }
 162
 163     try {
 164         return $self->_result()->update_or_insert() ? $self : undef;
 165     }
 166     catch {
 167         # Catch problems and raise relevant exceptions
 168         if (ref($_) eq 'DBIx::Class::Exception') {
 169             warn $_->{msg};
 170             if ( $_->{msg} =~ /Cannot add or update a child row: a foreign key constraint fails/ ) {
 171                 # FK constraints
 172                 # FIXME: MySQL error, if we support more DB engines we should implement this for each
 173                 if ( $_->{msg} =~ /FOREIGN KEY \(`(?<column>.*?)`\)/ ) {
 174                     Koha::Exceptions::Object::FKConstraint->throw(
 175                         error     => 'Broken FK constraint',
 176                         broken_fk => $+{column}
 177                     );
 178                 }
 179             }
 180             elsif( $_->{msg} =~ /Duplicate entry '(.*?)' for key '(?<key>.*?)'/ ) {
 181                 Koha::Exceptions::Object::DuplicateID->throw(
 182                     error => 'Duplicate ID',
 183                     duplicate_id => $+{key}
 184                 );
 185             }
 186             elsif( $_->{msg} =~ /Incorrect (?<type>\w+) value: '(?<value>.*)' for column \W?(?<property>\S+)/ ) { # The optional \W in the regex might be a quote or backtick
 187                 my $type = $+{type};
 188                 my $value = $+{value};
 189                 my $property = $+{property};
 190                 $property =~ s/['`]//g;
 191                 Koha::Exceptions::Object::BadValue->throw(
 192                     type     => $type,
 193                     value    => $value,
 194                     property => $property =~ /(\w+\.\w+)$/ ? $1 : $property, # results in table.column without quotes or backtics
 195                 );
 196             }
 197         }
 198         # Catch-all for foreign key breakages. It will help find other use cases
 199         $_->rethrow();
 200     }
 201 }
 202
 203 =head3 $object->update();
 204
 205 A shortcut for set + store in one call.
 206
 207 =cut
 208
 209 sub update {
 210     my ($self, $values) = @_;
 211     Koha::Exceptions::Object::NotInStorage->throw unless $self->in_storage;
 212     $self->set($values)->store();
 213 }
 214
 215 =head3 $object->delete();
 216
 217 Removes the object from storage.
 218
 219 Returns:
 220     1  if the deletion was a success
 221     0  if the deletion failed
 222     -1 if the object was never in storage
 223
 224 =cut
 225
 226 sub delete {
 227     my ($self) = @_;
 228
 229     my $deleted = $self->_result()->delete;
 230     if ( ref $deleted ) {
 231         my $object_class  = Koha::Object::_get_object_class( $self->_result->result_class );
 232         $deleted = $object_class->_new_from_dbic($deleted);
 233     }
 234     return $deleted;
 235 }
 236
 237 =head3 $object->set( $properties_hashref )
 238
 239 $object->set(
 240     {
 241         property1 => $property1,
 242         property2 => $property2,
 243         property3 => $propery3,
 244     }
 245 );
 246
 247 Enables multiple properties to be set at once
 248
 249 Returns:
 250     1      if all properties were set.
 251     0      if one or more properties do not exist.
 252     undef  if all properties exist but a different error
 253            prevents one or more properties from being set.
 254
 255 If one or more of the properties do not exist,
 256 no properties will be set.
 257
 258 =cut
 259
 260 sub set {
 261     my ( $self, $properties ) = @_;
 262
 263     my @columns = @{$self->_columns()};
 264
 265     foreach my $p ( keys %$properties ) {
 266         unless ( grep { $_ eq $p } @columns ) {
 267             Koha::Exceptions::Object::PropertyNotFound->throw( "No property $p for " . ref($self) );
 268         }
 269     }
 270
 271     return $self->_result()->set_columns($properties) ? $self : undef;
 272 }
 273
 274 =head3 $object->set_or_blank( $properties_hashref )
 275
 276 $object->set_or_blank(
 277     {
 278         property1 => $property1,
 279         property2 => $property2,
 280         property3 => $propery3,
 281     }
 282 );
 283
 284 If not listed in $properties_hashref, the property will be set to the default
 285 value defined at DB level, or nulled.
 286
 287 =cut
 288
 289
 290 sub set_or_blank {
 291     my ( $self, $properties ) = @_;
 292
 293     my $columns_info = $self->_result->result_source->columns_info;
 294
 295     foreach my $col ( keys %{$columns_info} ) {
 296
 297         next if exists $properties->{$col};
 298
 299         if ( $columns_info->{$col}->{is_nullable} ) {
 300             $properties->{$col} = undef;
 301         } else {
 302             $properties->{$col} = $columns_info->{$col}->{default_value};
 303         }
 304     }
 305
 306     return $self->set($properties);
 307 }
 308
 309 =head3 $object->unblessed();
 310
 311 Returns an unblessed representation of object.
 312
 313 =cut
 314
 315 sub unblessed {
 316     my ($self) = @_;
 317
 318     return { $self->_result->get_columns };
 319 }
 320
 321 =head3 $object->get_from_storage;
 322
 323 =cut
 324
 325 sub get_from_storage {
 326     my ( $self, $attrs ) = @_;
 327     my $stored_object = $self->_result->get_from_storage($attrs);
 328     return unless $stored_object;
 329     my $object_class  = Koha::Object::_get_object_class( $self->_result->result_class );
 330     return $object_class->_new_from_dbic($stored_object);
 331 }
 332
 333 =head3 $object->TO_JSON
 334
 335 Returns an unblessed representation of the object, suitable for JSON output.
 336
 337 =cut
 338
 339 sub TO_JSON {
 340
 341     my ($self) = @_;
 342
 343     my $unblessed    = $self->unblessed;
 344     my $columns_info = Koha::Database->new->schema->resultset( $self->_type )
 345         ->result_source->{_columns};
 346
 347     foreach my $col ( keys %{$columns_info} ) {
 348
 349         if ( $columns_info->{$col}->{is_boolean} )
 350         {    # Handle booleans gracefully
 351             $unblessed->{$col}
 352                 = ( $unblessed->{$col} )
 353                 ? Mojo::JSON->true
 354                 : Mojo::JSON->false;
 355         }
 356         elsif ( _numeric_column_type( $columns_info->{$col}->{data_type} )
 357             and looks_like_number( $unblessed->{$col} )
 358         ) {
 359
 360             # TODO: Remove once the solution for
 361             # https://rt.cpan.org/Ticket/Display.html?id=119904
 362             # is ported to whatever distro we support by that time
 363             $unblessed->{$col} += 0;
 364         }
 365         elsif ( _datetime_column_type( $columns_info->{$col}->{data_type} ) ) {
 366             eval {
 367                 return unless $unblessed->{$col};
 368                 $unblessed->{$col} = output_pref({
 369                     dateformat => 'rfc3339',
 370                     dt         => dt_from_string($unblessed->{$col}, 'sql'),
 371                 });
 372             };
 373         }
 374     }
 375     return $unblessed;
 376 }
 377
 378 sub _date_or_datetime_column_type {
 379     my ($column_type) = @_;
 380
 381     my @dt_types = (
 382         'timestamp',
 383         'date',
 384         'datetime'
 385     );
 386
 387     return ( grep { $column_type eq $_ } @dt_types) ? 1 : 0;
 388 }
 389 sub _datetime_column_type {
 390     my ($column_type) = @_;
 391
 392     my @dt_types = (
 393         'timestamp',
 394         'datetime'
 395     );
 396
 397     return ( grep { $column_type eq $_ } @dt_types) ? 1 : 0;
 398 }
 399
 400 sub _numeric_column_type {
 401     # TODO: Remove once the solution for
 402     # https://rt.cpan.org/Ticket/Display.html?id=119904
 403     # is ported to whatever distro we support by that time
 404     my ($column_type) = @_;
 405
 406     my @numeric_types = (
 407         'bigint',
 408         'integer',
 409         'int',
 410         'mediumint',
 411         'smallint',
 412         'tinyint',
 413         'decimal',
 414         'double precision',
 415         'float'
 416     );
 417
 418     return ( grep { $column_type eq $_ } @numeric_types) ? 1 : 0;
 419 }
 420
 421 =head3 prefetch_whitelist
 422
 423     my $whitelist = $object->prefetch_whitelist()
 424
 425 Returns a hash of prefetchable subs and the type they return.
 426
 427 =cut
 428
 429 sub prefetch_whitelist {
 430     my ( $self ) = @_;
 431
 432     my $whitelist = {};
 433     my $relations = $self->_result->result_source->_relationships;
 434
 435     foreach my $key (keys %{$relations}) {
 436         if($self->can($key)) {
 437             my $result_class = $relations->{$key}->{class};
 438             my $obj = $result_class->new;
 439             try {
 440                 $whitelist->{$key} = Koha::Object::_get_object_class( $obj->result_class );
 441             } catch {
 442                 $whitelist->{$key} = undef;
 443             }
 444         }
 445     }
 446
 447     return $whitelist;
 448 }
 449
 450 =head3 to_api
 451
 452     my $object_for_api = $object->to_api(
 453         {
 454           [ embed => {
 455                 items => {
 456                     children => {
 457                         holds => {,
 458                             children => {
 459                               ...
 460                             }
 461                         }
 462                     }
 463                 },
 464                 library => {
 465                     ...
 466                 }
 467             },
 468             ...
 469          ]
 470         }
 471     );
 472
 473 Returns a representation of the object, suitable for API output.
 474
 475 =cut
 476
 477 sub to_api {
 478     my ( $self, $params ) = @_;
 479     my $json_object = $self->TO_JSON;
 480
 481     my $to_api_mapping = $self->to_api_mapping;
 482
 483     # Rename attributes if there's a mapping
 484     if ( $self->can('to_api_mapping') ) {
 485         foreach my $column ( keys %{ $self->to_api_mapping } ) {
 486             my $mapped_column = $self->to_api_mapping->{$column};
 487             if ( exists $json_object->{$column}
 488                 && defined $mapped_column )
 489             {
 490                 # key != undef
 491                 $json_object->{$mapped_column} = delete $json_object->{$column};
 492             }
 493             elsif ( exists $json_object->{$column}
 494                 && !defined $mapped_column )
 495             {
 496                 # key == undef
 497                 delete $json_object->{$column};
 498             }
 499         }
 500     }
 501
 502     my $embeds = $params->{embed};
 503
 504     if ($embeds) {
 505         foreach my $embed ( keys %{$embeds} ) {
 506             if ( $embed =~ m/^(?<relation>.*)_count$/
 507                 and $embeds->{$embed}->{is_count} ) {
 508
 509                 my $relation = $+{relation};
 510                 $json_object->{$embed} = $self->$relation->count;
 511             }
 512             else {
 513                 my $curr = $embed;
 514                 my $next = $embeds->{$curr}->{children};
 515
 516                 my $children = $self->$curr;
 517
 518                 if ( defined $children and ref($children) eq 'ARRAY' ) {
 519                     my @list = map {
 520                         $self->_handle_to_api_child(
 521                             { child => $_, next => $next, curr => $curr } )
 522                     } @{$children};
 523                     $json_object->{$curr} = \@list;
 524                 }
 525                 else {
 526                     $json_object->{$curr} = $self->_handle_to_api_child(
 527                         { child => $children, next => $next, curr => $curr } );
 528                 }
 529             }
 530         }
 531     }
 532
 533
 534
 535     return $json_object;
 536 }
 537
 538 =head3 to_api_mapping
 539
 540     my $mapping = $object->to_api_mapping;
 541
 542 Generic method that returns the attribute name mappings required to
 543 render the object on the API.
 544
 545 Note: this only returns an empty I<hashref>. Each class should have its
 546 own mapping returned.
 547
 548 =cut
 549
 550 sub to_api_mapping {
 551     return {};
 552 }
 553
 554 =head3 from_api_mapping
 555
 556     my $mapping = $object->from_api_mapping;
 557
 558 Generic method that returns the attribute name mappings so the data that
 559 comes from the API is correctly renamed to match what is required for the DB.
 560
 561 =cut
 562
 563 sub from_api_mapping {
 564     my ( $self ) = @_;
 565
 566     my $to_api_mapping = $self->to_api_mapping;
 567
 568     unless ( $self->{_from_api_mapping} ) {
 569         while (my ($key, $value) = each %{ $to_api_mapping } ) {
 570             $self->{_from_api_mapping}->{$value} = $key
 571                 if defined $value;
 572         }
 573     }
 574
 575     return $self->{_from_api_mapping};
 576 }
 577
 578 =head3 new_from_api
 579
 580     my $object = Koha::Object->new_from_api;
 581     my $object = Koha::Object->new_from_api( $attrs );
 582
 583 Creates a new object, mapping the API attribute names to the ones on the DB schema.
 584
 585 =cut
 586
 587 sub new_from_api {
 588     my ( $class, $params ) = @_;
 589
 590     my $self = $class->new;
 591     return $self->set_from_api( $params );
 592 }
 593
 594 =head3 set_from_api
 595
 596     my $object = Koha::Object->new(...);
 597     $object->set_from_api( $attrs )
 598
 599 Sets the object's attributes mapping API attribute names to the ones on the DB schema.
 600
 601 =cut
 602
 603 sub set_from_api {
 604     my ( $self, $from_api_params ) = @_;
 605
 606     return $self->set( $self->attributes_from_api( $from_api_params ) );
 607 }
 608
 609 =head3 attributes_from_api
 610
 611     my $attributes = attributes_from_api( $params );
 612
 613 Returns the passed params, converted from API naming into the model.
 614
 615 =cut
 616
 617 sub attributes_from_api {
 618     my ( $self, $from_api_params ) = @_;
 619
 620     my $from_api_mapping = $self->from_api_mapping;
 621
 622     my $params;
 623     my $columns_info = $self->_result->result_source->columns_info;
 624
 625     while (my ($key, $value) = each %{ $from_api_params } ) {
 626         my $koha_field_name =
 627           exists $from_api_mapping->{$key}
 628           ? $from_api_mapping->{$key}
 629           : $key;
 630
 631         if ( $columns_info->{$koha_field_name}->{is_boolean} ) {
 632             # TODO: Remove when D8 is formally deprecated
 633             # Handle booleans gracefully
 634             $value = ( $value ) ? 1 : 0;
 635         }
 636         elsif ( _date_or_datetime_column_type( $columns_info->{$koha_field_name}->{data_type} ) ) {
 637             try {
 638                 $value = dt_from_string($value, 'rfc3339');
 639             }
 640             catch {
 641                 Koha::Exceptions::BadParameter->throw( parameter => $key );
 642             };
 643         }
 644
 645         $params->{$koha_field_name} = $value;
 646     }
 647
 648     return $params;
 649 }
 650
 651 =head3 $object->unblessed_all_relateds
 652
 653 my $everything_into_one_hashref = $object->unblessed_all_relateds
 654
 655 The unblessed method only retrieves column' values for the column of the object.
 656 In a *few* cases we want to retrieve the information of all the prefetched data.
 657
 658 =cut
 659
 660 sub unblessed_all_relateds {
 661     my ($self) = @_;
 662
 663     my %data;
 664     my $related_resultsets = $self->_result->{related_resultsets} || {};
 665     my $rs = $self->_result;
 666     while ( $related_resultsets and %$related_resultsets ) {
 667         my @relations = keys %{ $related_resultsets };
 668         if ( @relations ) {
 669             my $relation = $relations[0];
 670             $rs = $rs->related_resultset($relation)->get_cache;
 671             $rs = $rs->[0]; # Does it makes sense to have several values here?
 672             my $object_class = Koha::Object::_get_object_class( $rs->result_class );
 673             my $koha_object = $object_class->_new_from_dbic( $rs );
 674             $related_resultsets = $rs->{related_resultsets};
 675             %data = ( %data, %{ $koha_object->unblessed } );
 676         }
 677     }
 678     %data = ( %data, %{ $self->unblessed } );
 679     return \%data;
 680 }
 681
 682 =head3 $object->_result();
 683
 684 Returns the internal DBIC Row object
 685
 686 =cut
 687
 688 sub _result {
 689     my ($self) = @_;
 690
 691     # If we don't have a dbic row at this point, we need to create an empty one
 692     $self->{_result} ||=
 693       Koha::Database->new()->schema()->resultset( $self->_type() )->new({});
 694
 695     return $self->{_result};
 696 }
 697
 698 =head3 $object->_columns();
 699
 700 Returns an arrayref of the table columns
 701
 702 =cut
 703
 704 sub _columns {
 705     my ($self) = @_;
 706
 707     # If we don't have a dbic row at this point, we need to create an empty one
 708     $self->{_columns} ||= [ $self->_result()->result_source()->columns() ];
 709
 710     return $self->{_columns};
 711 }
 712
 713 sub _get_object_class {
 714     my ( $type ) = @_;
 715     return unless $type;
 716
 717     if( $type->can('koha_object_class') ) {
 718         return $type->koha_object_class;
 719     }
 720     $type =~ s|Schema::Result::||;
 721     return ${type};
 722 }
 723
 724 =head3 AUTOLOAD
 725
 726 The autoload method is used only to get and set values for an objects properties.
 727
 728 =cut
 729
 730 sub AUTOLOAD {
 731     my $self = shift;
 732
 733     my $method = our $AUTOLOAD;
 734     $method =~ s/.*://;
 735
 736     my @columns = @{$self->_columns()};
 737     # Using direct setter/getter like $item->barcode() or $item->barcode($barcode);
 738     if ( grep { $_ eq $method } @columns ) {
 739         if ( @_ ) {
 740             $self->_result()->set_column( $method, @_ );
 741             return $self;
 742         } else {
 743             my $value = $self->_result()->get_column( $method );
 744             return $value;
 745         }
 746     }
 747
 748     my @known_methods = qw( is_changed id in_storage get_column discard_changes make_column_dirty );
 749
 750     Koha::Exceptions::Object::MethodNotCoveredByTests->throw(
 751         error      => sprintf("The method %s->%s is not covered by tests!", ref($self), $method),
 752         show_trace => 1
 753     ) unless grep { $_ eq $method } @known_methods;
 754
 755
 756     my $r = eval { $self->_result->$method(@_) };
 757     if ( $@ ) {
 758         Koha::Exceptions::Object->throw( ref($self) . "::$method generated this error: " . $@ );
 759     }
 760     return $r;
 761 }
 762
 763 =head3 _type
 764
 765 This method must be defined in the child class. The value is the name of the DBIC resultset.
 766 For example, for borrowers, the _type method will return "Borrower".
 767
 768 =cut
 769
 770 sub _type { }
 771
 772 =head3 _handle_to_api_child
 773
 774 =cut
 775
 776 sub _handle_to_api_child {
 777     my ($self, $args ) = @_;
 778
 779     my $child = $args->{child};
 780     my $next  = $args->{next};
 781     my $curr  = $args->{curr};
 782
 783     my $res;
 784
 785     if ( defined $child ) {
 786
 787         Koha::Exceptions::Exception->throw( "Asked to embed $curr but its return value doesn't implement to_api" )
 788             if defined $next and blessed $child and !$child->can('to_api');
 789
 790         if ( blessed $child ) {
 791             $res = $child->to_api({ embed => $next });
 792         }
 793         else {
 794             $res = $child;
 795         }
 796     }
 797
 798     return $res;
 799 }
 800
 801 sub DESTROY { }
 802
 803 =head1 AUTHOR
 804
 805 Kyle M Hall <kyle@bywatersolutions.com>
 806
 807 Jonathan Druart <jonathan.druart@bugs.koha-community.org>
 808
 809 =cut
 810
 811 1;