C4/Installer.pm

   1 package C4::Installer;
   2
   3 # Copyright (C) 2008 LibLime
   4 #
   5 # This file is part of Koha.
   6 #
   7 # Koha is free software; you can redistribute it and/or modify it
   8 # under the terms of the GNU General Public License as published by
   9 # the Free Software Foundation; either version 3 of the License, or
  10 # (at your option) any later version.
  11 #
  12 # Koha is distributed in the hope that it will be useful, but
  13 # WITHOUT ANY WARRANTY; without even the implied warranty of
  14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  15 # GNU General Public License for more details.
  16 #
  17 # You should have received a copy of the GNU General Public License
  18 # along with Koha; if not, see <http://www.gnu.org/licenses>.
  19
  20 use Modern::Perl;
  21
  22 use Encode qw( encode is_utf8 );
  23 use DBIx::RunSQL;
  24 use YAML::Syck qw( LoadFile );
  25 use C4::Context;
  26 use DBI;
  27 use Koha;
  28
  29 use vars qw(@ISA @EXPORT);
  30 BEGIN {
  31     require Exporter;
  32     @ISA = qw( Exporter );
  33     push @EXPORT, qw( foreign_key_exists index_exists column_exists TableExists);
  34 };
  35
  36 =head1 NAME
  37
  38 C4::Installer
  39
  40 =head1 SYNOPSIS
  41
  42  use C4::Installer;
  43  my $installer = C4::Installer->new();
  44  my $all_languages = getAllLanguages();
  45  my $error = $installer->load_db_schema();
  46  my $list;
  47  #fill $list with list of sql files
  48  my ($fwk_language, $error_list) = $installer->load_sql_in_order($all_languages, @$list);
  49  $installer->set_version_syspref();
  50  $installer->set_marcflavour_syspref('MARC21');
  51
  52 =head1 DESCRIPTION
  53
  54 =cut
  55
  56 =head1 METHODS
  57
  58 =head2 new
  59
  60   my $installer = C4::Installer->new();
  61
  62 Creates a new installer.
  63
  64 =cut
  65
  66 sub new {
  67     my $class = shift;
  68
  69     my $self = {};
  70
  71     # get basic information from context
  72     $self->{'dbname'}   = C4::Context->config("database");
  73     $self->{'dbms'}     = C4::Context->config("db_scheme") ? C4::Context->config("db_scheme") : "mysql";
  74     $self->{'hostname'} = C4::Context->config("hostname");
  75     $self->{'port'}     = C4::Context->config("port");
  76     $self->{'user'}     = C4::Context->config("user");
  77     $self->{'password'} = C4::Context->config("pass");
  78     $self->{'tls'} = C4::Context->config("tls");
  79     if( $self->{'tls'} && $self->{'tls'} eq 'yes' ) {
  80         $self->{'ca'} = C4::Context->config('ca');
  81         $self->{'cert'} = C4::Context->config('cert');
  82         $self->{'key'} = C4::Context->config('key');
  83         $self->{'tlsoptions'} = ";mysql_ssl=1;mysql_ssl_client_key=".$self->{key}.";mysql_ssl_client_cert=".$self->{cert}.";mysql_ssl_ca_file=".$self->{ca};
  84         $self->{'tlscmdline'} =  " --ssl-cert ". $self->{cert} . " --ssl-key " . $self->{key} . " --ssl-ca ".$self->{ca}." "
  85     }
  86     $self->{'dbh'} = DBI->connect("DBI:$self->{dbms}:dbname=$self->{dbname};host=$self->{hostname}" .
  87                                   ( $self->{port} ? ";port=$self->{port}" : "" ).
  88                                   ( $self->{tlsoptions} ? $self->{tlsoptions} : ""),
  89                                   $self->{'user'}, $self->{'password'});
  90     $self->{'language'} = undef;
  91     $self->{'marcflavour'} = undef;
  92         $self->{'dbh'}->do('set NAMES "utf8"');
  93     $self->{'dbh'}->{'mysql_enable_utf8'}=1;
  94
  95     bless $self, $class;
  96     return $self;
  97 }
  98
  99 =head2 marc_framework_sql_list
 100
 101   my ($defaulted_to_en, $list) =
 102      $installer->marc_framework_sql_list($lang, $marcflavour);
 103
 104 Returns in C<$list> a structure listing the filename, description, section,
 105 and mandatory/optional status of MARC framework scripts available for C<$lang>
 106 and C<$marcflavour>.
 107
 108 If the C<$defaulted_to_en> return value is true, no scripts are available
 109 for language C<$lang> and the 'en' ones are returned.
 110
 111 =cut
 112
 113 sub marc_framework_sql_list {
 114     my $self = shift;
 115     my $lang = shift;
 116     my $marcflavour = shift;
 117
 118     my $defaulted_to_en = 0;
 119
 120     undef $/;
 121     my $dir = C4::Context->config('intranetdir') . "/installer/data/$self->{dbms}/$lang/marcflavour/".lc($marcflavour);
 122     unless (opendir( MYDIR, $dir )) {
 123         if ($lang eq 'en') {
 124             warn "cannot open MARC frameworks directory $dir";
 125         } else {
 126             # if no translated MARC framework is available,
 127             # default to English
 128             $dir = C4::Context->config('intranetdir') . "/installer/data/$self->{dbms}/en/marcflavour/".lc($marcflavour);
 129             opendir(MYDIR, $dir) or warn "cannot open English MARC frameworks directory $dir";
 130             $defaulted_to_en = 1;
 131         }
 132     }
 133     my @listdir = sort grep { !/^\.|marcflavour/ && -d "$dir/$_" } readdir(MYDIR);
 134     closedir MYDIR;
 135
 136     my @fwklist;
 137     my $request = $self->{'dbh'}->prepare("SELECT value FROM systempreferences WHERE variable='FrameworksLoaded'");
 138     $request->execute;
 139     my ($frameworksloaded) = $request->fetchrow;
 140     $frameworksloaded = '' unless defined $frameworksloaded; # avoid warning
 141     my %frameworksloaded;
 142     foreach ( split( /\|/, $frameworksloaded ) ) {
 143         $frameworksloaded{$_} = 1;
 144     }
 145
 146     foreach my $requirelevel (@listdir) {
 147         opendir( MYDIR, "$dir/$requirelevel" );
 148         my @listname = grep { !/^\./ && -f "$dir/$requirelevel/$_" && $_ =~ m/\.(sql|yml)$/ } readdir(MYDIR);
 149         closedir MYDIR;
 150         my %cell;
 151         my @frameworklist;
 152         map {
 153             my $name = substr( $_, 0, -4 ); # FIXME: restricted to 3 letter extension
 154             open my $fh, "<:encoding(UTF-8)", "$dir/$requirelevel/$name.txt";
 155             my $line = <$fh>;
 156             $line = Encode::encode('UTF-8', $line) unless ( Encode::is_utf8($line) );
 157             my @lines = split /\n/, $line;
 158             my $mandatory = ($requirelevel =~ /(mandatory|requi|oblig|necess)/i);
 159             push @frameworklist,
 160               {
 161                 'fwkname'        => $name,
 162                 'fwkfile'        => "$dir/$requirelevel/$_",
 163                 'fwkdescription' => \@lines,
 164                 'checked'        => ( ( $frameworksloaded{$_} || $mandatory ) ? 1 : 0 ),
 165                 'mandatory'      => $mandatory,
 166               };
 167         } @listname;
 168         my @fwks =
 169           sort { $a->{'fwkname'} cmp $b->{'fwkname'} } @frameworklist;
 170
 171         $cell{"frameworks"} = \@fwks;
 172         $cell{"label"}      = ucfirst($requirelevel);
 173         $cell{"code"}       = lc($requirelevel);
 174         push @fwklist, \%cell;
 175     }
 176
 177     return ($defaulted_to_en, \@fwklist);
 178 }
 179
 180 =head2 sample_data_sql_list
 181
 182   my ($defaulted_to_en, $list) = $installer->sample_data_sql_list($lang);
 183
 184 Returns in C<$list> a structure listing the filename, description, section,
 185 and mandatory/optional status of sample data scripts available for C<$lang>.
 186 If the C<$defaulted_to_en> return value is true, no scripts are available
 187 for language C<$lang> and the 'en' ones are returned.
 188
 189 =cut
 190
 191 sub sample_data_sql_list {
 192     my $self = shift;
 193     my $lang = shift;
 194
 195     my $defaulted_to_en = 0;
 196
 197     undef $/;
 198     my $dir = C4::Context->config('intranetdir') . "/installer/data/$self->{dbms}/$lang";
 199     unless (opendir( MYDIR, $dir )) {
 200         if ($lang eq 'en') {
 201             warn "cannot open sample data directory $dir";
 202         } else {
 203             # if no sample data is available,
 204             # default to English
 205             $dir = C4::Context->config('intranetdir') . "/installer/data/$self->{dbms}/en";
 206             opendir(MYDIR, $dir) or warn "cannot open English sample data directory $dir";
 207             $defaulted_to_en = 1;
 208         }
 209     }
 210     my @listdir = sort grep { !/^\.|marcflavour/ && -d "$dir/$_" } readdir(MYDIR);
 211     closedir MYDIR;
 212
 213     my @levellist;
 214     my $request = $self->{'dbh'}->prepare("SELECT value FROM systempreferences WHERE variable='FrameworksLoaded'");
 215     $request->execute;
 216     my ($frameworksloaded) = $request->fetchrow;
 217     $frameworksloaded = '' unless defined $frameworksloaded; # avoid warning
 218     my %frameworksloaded;
 219     foreach ( split( /\|/, $frameworksloaded ) ) {
 220         $frameworksloaded{$_} = 1;
 221     }
 222
 223     foreach my $requirelevel (@listdir) {
 224         opendir( MYDIR, "$dir/$requirelevel" );
 225         my @listname = grep { !/^\./ && -f "$dir/$requirelevel/$_" && $_ =~ m/\.(sql|yml)$/ } readdir(MYDIR);
 226         closedir MYDIR;
 227         my %cell;
 228         my @frameworklist;
 229         map {
 230             my ( $name, $ext ) = split /\./, $_;
 231             my @lines;
 232             if ( $ext =~ /yml/ ) {
 233                 my $yaml = LoadFile("$dir/$requirelevel/$name\.$ext");
 234                 @lines = @{ $yaml->{'description'} };
 235             } else {
 236                 open my $fh, "<:encoding(UTF-8)", "$dir/$requirelevel/$name.txt";
 237                 my $line = <$fh>;
 238                 $line = Encode::encode('UTF-8', $line) unless ( Encode::is_utf8($line) );
 239                 @lines = split /\n/, $line;
 240             }
 241             my $mandatory = ($requirelevel =~ /(mandatory|requi|oblig|necess)/i);
 242             push @frameworklist,
 243               {
 244                 'fwkname'        => $name,
 245                 'fwkfile'        => "$dir/$requirelevel/$_",
 246                 'fwkdescription' => \@lines,
 247                 'checked'        => ( ( $frameworksloaded{$_} || $mandatory ) ? 1 : 0 ),
 248                 'mandatory'      => $mandatory,
 249               };
 250         } @listname;
 251         my @fwks = sort { $a->{'fwkname'} cmp $b->{'fwkname'} } @frameworklist;
 252
 253         $cell{"frameworks"} = \@fwks;
 254         $cell{"label"}      = ucfirst($requirelevel);
 255         $cell{"code"}       = lc($requirelevel);
 256         push @levellist, \%cell;
 257     }
 258
 259     return ($defaulted_to_en, \@levellist);
 260 }
 261
 262 =head2 load_db_schema
 263
 264   my $error = $installer->load_db_schema();
 265
 266 Loads the SQL script that creates Koha's tables and indexes.  The
 267 return value is a string containing error messages reported by the
 268 load.
 269
 270 =cut
 271
 272 sub load_db_schema {
 273     my $self = shift;
 274
 275     my $datadir = C4::Context->config('intranetdir') . "/installer/data/$self->{dbms}";
 276     my $error = $self->load_sql("$datadir/kohastructure.sql");
 277     return $error;
 278
 279 }
 280
 281 =head2 load_sql_in_order
 282
 283   my ($fwk_language, $list) = $installer->load_sql_in_order($all_languages, @sql_list);
 284
 285 Given a list of SQL scripts supplied in C<@sql_list>, loads each of them
 286 into the database and sets the FrameworksLoaded system preference to names
 287 of the scripts that were loaded.
 288
 289 The SQL files are loaded in alphabetical order by filename (not including
 290 directory path).  This means that dependencies among the scripts are to
 291 be resolved by carefully naming them, keeping in mind that the directory name
 292 does *not* currently count.
 293
 294 B<FIXME:> this is a rather delicate way of dealing with dependencies between
 295 the install scripts.
 296
 297 The return value C<$list> is an arrayref containing a hashref for each
 298 "level" or directory containing SQL scripts; the hashref in turns contains
 299 a list of hashrefs containing a list of each script load and any error
 300 messages associated with the loading of each script.
 301
 302 B<FIXME:> The C<$fwk_language> code probably doesn't belong and needs to be
 303 moved to a different method.
 304
 305 =cut
 306
 307 sub load_sql_in_order {
 308     my $self = shift;
 309     my $all_languages = shift;
 310     my @sql_list = @_;
 311
 312     my $lang;
 313     my %hashlevel;
 314     my @fnames = sort {
 315         my @aa = split /\/|\\/, ($a);
 316         my @bb = split /\/|\\/, ($b);
 317         $aa[-1] cmp $bb[-1]
 318     } @sql_list;
 319     my $request = $self->{'dbh'}->prepare( "SELECT value FROM systempreferences WHERE variable='FrameworksLoaded'" );
 320     $request->execute;
 321     my ($systempreference) = $request->fetchrow;
 322     $systempreference = '' unless defined $systempreference; # avoid warning
 323
 324     my $global_mandatory_dir = C4::Context->config('intranetdir') . "/installer/data/$self->{dbms}/mandatory";
 325
 326     # Make sure some stuffs are loaded first
 327     unshift(@fnames, C4::Context->config('intranetdir') . "/installer/data/$self->{dbms}/sysprefs.sql");
 328     unshift(@fnames,
 329         "$global_mandatory_dir/subtag_registry.sql",
 330         "$global_mandatory_dir/auth_val_cat.sql",
 331         "$global_mandatory_dir/message_transport_types.sql",
 332         "$global_mandatory_dir/sample_notices_message_attributes.sql",
 333         "$global_mandatory_dir/sample_notices_message_transports.sql",
 334         "$global_mandatory_dir/keyboard_shortcuts.sql",
 335     );
 336
 337     push @fnames, C4::Context->config('intranetdir') . "/installer/data/mysql/userflags.sql";
 338     push @fnames, C4::Context->config('intranetdir') . "/installer/data/mysql/userpermissions.sql";
 339     push @fnames, C4::Context->config('intranetdir') . "/installer/data/mysql/audio_alerts.sql";
 340     push @fnames, C4::Context->config('intranetdir') . "/installer/data/mysql/account_offset_types.sql";
 341     push @fnames, C4::Context->config('intranetdir') . "/installer/data/mysql/account_credit_types.sql";
 342     push @fnames, C4::Context->config('intranetdir') . "/installer/data/mysql/account_debit_types.sql";
 343     foreach my $file (@fnames) {
 344         #      warn $file;
 345         undef $/;
 346         my $error = $self->load_sql($file);
 347         my @file = split qr(\/|\\), $file;
 348         $lang = $file[ scalar(@file) - 3 ] unless ($lang);
 349         my $level = $file[ scalar(@file) - 2 ];
 350         unless ($error) {
 351             $systempreference .= "$file[scalar(@file)-1]|"
 352               unless ( index( $systempreference, $file[ scalar(@file) - 1 ] ) >= 0 );
 353         }
 354
 355         #Bulding here a hierarchy to display files by level.
 356         push @{ $hashlevel{$level} },
 357           { "fwkname" => $file[ scalar(@file) - 1 ], "error" => $error };
 358     }
 359
 360     #systempreference contains an ending |
 361     chop $systempreference;
 362     my @list;
 363     map { push @list, { "level" => $_, "fwklist" => $hashlevel{$_} } } keys %hashlevel;
 364     my $fwk_language;
 365     for my $each_language (@$all_languages) {
 366
 367         #       warn "CODE".$each_language->{'language_code'};
 368         #       warn "LANG:".$lang;
 369         if ( $lang eq $each_language->{'language_code'} ) {
 370             $fwk_language = $each_language->{language_locale_name};
 371         }
 372     }
 373     my $updateflag =
 374       $self->{'dbh'}->do(
 375         "UPDATE systempreferences set value=\"$systempreference\" where variable='FrameworksLoaded'"
 376       );
 377
 378     unless ( $updateflag == 1 ) {
 379         my $string =
 380             "INSERT INTO systempreferences (value, variable, explanation, type) VALUES (\"$systempreference\",'FrameworksLoaded','Frameworks loaded through webinstaller','choice')";
 381         my $rq = $self->{'dbh'}->prepare($string);
 382         $rq->execute;
 383     }
 384     return ($fwk_language, \@list);
 385 }
 386
 387 =head2 set_marcflavour_syspref
 388
 389   $installer->set_marcflavour_syspref($marcflavour);
 390
 391 Set the 'marcflavour' system preference.  The incoming
 392 C<$marcflavour> references to a subdirectory of
 393 installer/data/$dbms/$lang/marcflavour, and is
 394 normalized to MARC21, UNIMARC or NORMARC.
 395
 396 FIXME: this method assumes that the MARC flavour will be either
 397 MARC21, UNIMARC or NORMARC.
 398
 399 =cut
 400
 401 sub set_marcflavour_syspref {
 402     my $self = shift;
 403     my $marcflavour = shift;
 404
 405     # we can have some variants of marc flavour, by having different directories, like : unimarc_small and unimarc_full, for small and complete unimarc frameworks.
 406     # marc_cleaned finds the marcflavour, without the variant.
 407     my $marc_cleaned = 'MARC21';
 408     $marc_cleaned = 'UNIMARC' if $marcflavour =~ /unimarc/i;
 409     $marc_cleaned = 'NORMARC' if $marcflavour =~ /normarc/i;
 410     my $request =
 411         $self->{'dbh'}->prepare(
 412           "INSERT IGNORE INTO `systempreferences` (variable,value,explanation,options,type) VALUES('marcflavour','$marc_cleaned','Define global MARC flavor (MARC21, UNIMARC or NORMARC) used for character encoding','MARC21|UNIMARC|NORMARC','Choice');"
 413         );
 414     $request->execute;
 415 }
 416
 417 =head2 set_version_syspref
 418
 419   $installer->set_version_syspref();
 420
 421 Set or update the 'Version' system preference to the current
 422 Koha software version.
 423
 424 =cut
 425
 426 sub set_version_syspref {
 427     my $self = shift;
 428
 429     my $kohaversion = Koha::version();
 430     # remove the 3 last . to have a Perl number
 431     $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
 432     if (C4::Context->preference('Version')) {
 433         warn "UPDATE Version";
 434         my $finish=$self->{'dbh'}->prepare("UPDATE systempreferences SET value=? WHERE variable='Version'");
 435         $finish->execute($kohaversion);
 436     } else {
 437         warn "INSERT Version";
 438         my $finish=$self->{'dbh'}->prepare("INSERT into systempreferences (variable,value,explanation) values ('Version',?,'The Koha database version. WARNING: Do not change this value manually, it is maintained by the webinstaller')");
 439         $finish->execute($kohaversion);
 440     }
 441     C4::Context->clear_syspref_cache();
 442 }
 443
 444 =head2 load_sql
 445
 446   my $error = $installer->load_sql($filename);
 447
 448 Runs the specified input file using a sql loader DBIx::RunSQL, or a yaml loader
 449 Returns any strings sent to STDERR
 450
 451 # FIXME This should be improved: sometimes the caller and load_sql warn the same
 452 error.
 453
 454 =cut
 455
 456 sub load_sql {
 457     my $self = shift;
 458     my $filename = shift;
 459     my $error;
 460
 461     my $dbh = $self->{ dbh };
 462
 463     my $dup_stderr;
 464     do {
 465         local *STDERR;
 466         open STDERR, ">>", \$dup_stderr;
 467
 468         if ( $filename =~ /sql$/ ) {                                                        # SQL files
 469             eval {
 470                 DBIx::RunSQL->run_sql_file(
 471                     dbh     => $dbh,
 472                     sql     => $filename,
 473                 );
 474             };
 475         }
 476         else {                                                                       # YAML files
 477             eval {
 478                 my $yaml         = LoadFile( $filename );                            # Load YAML
 479                 for my $table ( @{ $yaml->{'tables'} } ) {
 480                     my $table_name   = ( keys %$table )[0];                          # table name
 481                     my @rows         = @{ $table->{$table_name}->{rows} };           #
 482                     my @columns      = ( sort keys %{$rows[0]} );                    # column names
 483                     my $fields       = join ",", @columns;                           # idem, joined
 484                     my $placeholders = join ",", map { "?" } @columns;               # '?,..,?' string
 485                     my $query        = "INSERT INTO $table_name ( $fields ) VALUES ( $placeholders )";
 486                     my $sth          = $dbh->prepare($query);
 487                     foreach my $row ( @rows ) {
 488                         my @values = map { $row->{$_} } @columns;
 489                         $sth->execute( @values );
 490                     }
 491                 }
 492             };
 493         }
 494     };
 495     #   errors thrown while loading installer data should be logged
 496     if( $dup_stderr ) {
 497         warn "C4::Installer::load_sql returned the following errors while attempting to load $filename:\n";
 498         $error = $dup_stderr;
 499     }
 500
 501     return $error;
 502 }
 503
 504 =head2 get_file_path_from_name
 505
 506   my $filename = $installer->get_file_path_from_name('script_name');
 507
 508 searches through the set of known SQL scripts and finds the fully
 509 qualified path name for the script that mathches the input.
 510
 511 returns undef if no match was found.
 512
 513
 514 =cut
 515
 516 sub get_file_path_from_name {
 517     my $self = shift;
 518     my $partialname = shift;
 519
 520     my $lang = 'en'; # FIXME: how do I know what language I want?
 521
 522     my ($defaulted_to_en, $list) = $self->sample_data_sql_list($lang);
 523     # warn( Data::Dumper->Dump( [ $list ], [ 'list' ] ) );
 524
 525     my @found;
 526     foreach my $frameworklist ( @$list ) {
 527         push @found, grep { $_->{'fwkfile'} =~ /$partialname$/ } @{$frameworklist->{'frameworks'}};
 528     }
 529
 530     # warn( Data::Dumper->Dump( [ \@found ], [ 'found' ] ) );
 531     if ( 0 == scalar @found ) {
 532         return;
 533     } elsif ( 1 < scalar @found ) {
 534         warn "multiple results found for $partialname";
 535         return;
 536     } else {
 537         return $found[0]->{'fwkfile'};
 538     }
 539
 540 }
 541
 542 sub foreign_key_exists {
 543     my ( $table_name, $constraint_name ) = @_;
 544     my $dbh = C4::Context->dbh;
 545     my (undef, $infos) = $dbh->selectrow_array(qq|SHOW CREATE TABLE $table_name|);
 546     return $infos =~ m|CONSTRAINT `$constraint_name` FOREIGN KEY|;
 547 }
 548
 549 sub index_exists {
 550     my ( $table_name, $key_name ) = @_;
 551     my $dbh = C4::Context->dbh;
 552     my ($exists) = $dbh->selectrow_array(
 553         qq|
 554         SHOW INDEX FROM $table_name
 555         WHERE key_name = ?
 556         |, undef, $key_name
 557     );
 558     return $exists;
 559 }
 560
 561 sub column_exists {
 562     my ( $table_name, $column_name ) = @_;
 563     return unless TableExists($table_name);
 564     my $dbh = C4::Context->dbh;
 565     my ($exists) = $dbh->selectrow_array(
 566         qq|
 567         SHOW COLUMNS FROM $table_name
 568         WHERE Field = ?
 569         |, undef, $column_name
 570     );
 571     return $exists;
 572 }
 573
 574 sub TableExists { # Could be renamed table_exists for consistency
 575     my $table = shift;
 576     eval {
 577                 my $dbh = C4::Context->dbh;
 578                 local $dbh->{PrintError} = 0;
 579                 local $dbh->{RaiseError} = 1;
 580                 $dbh->do(qq{SELECT * FROM $table WHERE 1 = 0 });
 581             };
 582     return 1 unless $@;
 583     return 0;
 584 }
 585
 586
 587 =head1 AUTHOR
 588
 589 C4::Installer is a refactoring of logic originally from installer/installer.pl, which was
 590 originally written by Henri-Damien Laurant.
 591
 592 Koha Development Team <http://koha-community.org/>
 593
 594 Galen Charlton <galen.charlton@liblime.com>
 595
 596 =cut
 597
 598 1;