Open-ILS/src/support-scripts/authority_control_fields.pl.in

   1 #!/usr/bin/perl
   2 # Copyright (C) 2010-2011 Laurentian University
   3 # Author: Dan Scott <dscott@laurentian.ca>
   4 #
   5 # This program is free software; you can redistribute it and/or
   6 # modify it under the terms of the GNU General Public License
   7 # as published by the Free Software Foundation; either version 2
   8 # of the License, or (at your option) any later version.
   9
  10 # This program is distributed in the hope that it will be useful,
  11 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  12 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  13 # GNU General Public License for more details.
  14 # ---------------------------------------------------------------
  15
  16 use strict;
  17 use warnings;
  18 use DBI;
  19 use Getopt::Long;
  20 use MARC::Record;
  21 use MARC::File::XML (BinaryEncoding => 'UTF-8');
  22 use MARC::Charset;
  23 use OpenSRF::System;
  24 use OpenILS::Utils::Fieldmapper;
  25 use OpenSRF::Utils::SettingsClient;
  26 use OpenSRF::EX qw/:try/;
  27 use Encode;
  28 use Unicode::Normalize;
  29 use OpenILS::Application::AppUtils;
  30 use Data::Dumper;
  31 use Pod::Usage qw/ pod2usage /;
  32
  33 MARC::Charset->assume_unicode(1);
  34
  35 my ($start_id, $end_id, $refresh);
  36 my ($days_back);
  37 my $bootstrap = '@sysconfdir@/opensrf_core.xml';
  38 my @records;
  39 my $idstatement;
  40
  41 my %options;
  42 my $result = GetOptions(
  43     \%options,
  44     'configuration=s' => \$bootstrap,
  45     'record=i' => \@records,
  46     'refresh' => \$refresh,
  47     'all', 'help',
  48     'start_id=i' => \$start_id,
  49     'end_id=i' => \$end_id,
  50     'days_back=i' => \$days_back,
  51 );
  52
  53 if (!$result or $options{help}) {
  54     pod2usage(0);
  55 }
  56
  57 if ($start_id && $days_back) {
  58     print "Can't use both start ID and days back!\n";
  59     exit;
  60 }
  61
  62 OpenSRF::System->bootstrap_client(config_file => $bootstrap);
  63 Fieldmapper->import(IDL => OpenSRF::Utils::SettingsClient->new->config_value("IDL"));
  64
  65 # must be loaded and initialized after the IDL is parsed
  66 use OpenILS::Utils::CStoreEditor;
  67 OpenILS::Utils::CStoreEditor::init();
  68 my $e = OpenILS::Utils::CStoreEditor->new;
  69 my $undeleted;
  70
  71 # Grab DB information from local settings
  72 my $sc = OpenSRF::Utils::SettingsClient->new;
  73 my $db_driver = $sc->config_value( reporter => setup => database => 'driver' );
  74 my $db_host = $sc->config_value( reporter => setup => database => 'host' );
  75 my $db_port = $sc->config_value( reporter => setup => database => 'port' );
  76 my $db_name = $sc->config_value( reporter => setup => database => 'db' );
  77 if (!$db_name) {
  78     $db_name = $sc->config_value( reporter => setup => database => 'name' );
  79     print STDERR "WARN: <database><name> is a deprecated setting for database name. For future compatibility, you should use <database><db> instead." if $db_name;
  80 }
  81 my $db_user = $sc->config_value( reporter => setup => database => 'user' );
  82 my $db_pw = $sc->config_value( reporter => setup => database => 'pw' );
  83 die "Unable to retrieve database connection information from the settings server" unless ($db_driver && $db_host && $db_port && $db_name && $db_user);
  84 my $dsn = "dbi:" . $db_driver . ":dbname=" . $db_name .';host=' . $db_host . ';port=' . $db_port;
  85 my $dbh = DBI->connect($dsn,$db_user,$db_pw, {AutoCommit => 1, pg_enable_utf8 => 1, RaiseError => 1}) or die "database connection error";
  86
  87 if ($options{all}) {
  88     @records=();
  89
  90     # SQL Used to gather a list of ID's
  91     $idstatement = $dbh->prepare("SELECT DISTINCT(id) AS id FROM biblio.record_entry
  92          WHERE deleted IS FALSE ORDER BY ID DESC");
  93
  94     # Load the list of ID's into the records array
  95     $idstatement->execute();
  96     while (my $ref = $idstatement->fetchrow_hashref()) {
  97         my $id_ref = $ref->{"id"};   # the column name in our sql query is "id"
  98         push(@records, $id_ref);
  99     }
 100 }
 101
 102 if ($start_id and $end_id) {
 103     @records = ($start_id .. $end_id);
 104 }
 105
 106 if (defined $days_back) {
 107     @records=();
 108
 109     # SQL Used to gather a list of ID's
 110     $idstatement = $dbh->prepare("SELECT DISTINCT(id) AS id FROM biblio.record_entry
 111          WHERE deleted IS FALSE AND date(edit_date) >= date((NOW() - '$days_back day'::interval))
 112          ORDER BY ID DESC");
 113
 114     # Load the list of ID's into the records array
 115     $idstatement->execute();
 116     while (my $ref = $idstatement->fetchrow_hashref()) {
 117         my $id_ref = $ref->{"id"};   # the column name in our sql query is "id"
 118         push(@records, $id_ref);
 119     }
 120 }
 121
 122 # print Dumper($undeleted, \@records);
 123
 124 # Hash of controlled fields & subfields in bibliographic records, and their
 125 # corresponding controlling fields & subfields in the authority record
 126 #
 127 # So, if the bib 650$a can be controlled by an auth 150$a, that maps to:
 128 # 650 => { a => { 150 => 'a'}}
 129 my %controllees = (
 130     100 => { a => { 100 => 'a' },
 131              b => { 100 => 'b' },
 132              c => { 100 => 'c' },
 133              d => { 100 => 'd' },
 134              f => { 100 => 'f' },
 135              g => { 100 => 'g' },
 136              j => { 100 => 'j' },
 137              k => { 100 => 'k' },
 138              l => { 100 => 'l' },
 139              n => { 100 => 'n' },
 140              p => { 100 => 'p' },
 141              q => { 100 => 'q' },
 142              t => { 100 => 't' },
 143              u => { 100 => 'u' },
 144     },
 145     110 => { a => { 110 => 'a' },
 146              b => { 110 => 'b' },
 147              c => { 110 => 'c' },
 148              d => { 110 => 'd' },
 149              f => { 110 => 'f' },
 150              g => { 110 => 'g' },
 151              k => { 110 => 'k' },
 152              l => { 110 => 'l' },
 153              n => { 110 => 'n' },
 154              p => { 110 => 'p' },
 155              t => { 110 => 't' },
 156              u => { 110 => 'u' },
 157     },
 158     111 => { a => { 111 => 'a' },
 159              c => { 111 => 'c' },
 160              d => { 111 => 'd' },
 161              e => { 111 => 'e' },
 162              f => { 111 => 'f' },
 163              g => { 111 => 'g' },
 164              j => { 111 => 'j' },
 165              k => { 111 => 'k' },
 166              l => { 111 => 'l' },
 167              n => { 111 => 'n' },
 168              p => { 111 => 'p' },
 169              q => { 111 => 'q' },
 170              t => { 111 => 't' },
 171              u => { 111 => 'u' },
 172     },
 173     130 => { a => { 130 => 'a' },
 174              d => { 130 => 'd' },
 175              f => { 130 => 'f' },
 176              g => { 130 => 'g' },
 177              h => { 130 => 'h' },
 178              k => { 130 => 'k' },
 179              l => { 130 => 'l' },
 180              m => { 130 => 'm' },
 181              n => { 130 => 'n' },
 182              o => { 130 => 'o' },
 183              p => { 130 => 'p' },
 184              r => { 130 => 'r' },
 185              s => { 130 => 's' },
 186              t => { 130 => 't' },
 187     },
 188     600 => { a => { 100 => 'a' },
 189              b => { 100 => 'b' },
 190              c => { 100 => 'c' },
 191              d => { 100 => 'd' },
 192              f => { 100 => 'f' },
 193              g => { 100 => 'g' },
 194              h => { 100 => 'h' },
 195              j => { 100 => 'j' },
 196              k => { 100 => 'k' },
 197              l => { 100 => 'l' },
 198              m => { 100 => 'm' },
 199              n => { 100 => 'n' },
 200              o => { 100 => 'o' },
 201              p => { 100 => 'p' },
 202              q => { 100 => 'q' },
 203              r => { 100 => 'r' },
 204              s => { 100 => 's' },
 205              t => { 100 => 't' },
 206              v => { 100 => 'v' },
 207              x => { 100 => 'x' },
 208              y => { 100 => 'y' },
 209              z => { 100 => 'z' },
 210     },
 211     610 => { a => { 110 => 'a' },
 212              b => { 110 => 'b' },
 213              c => { 110 => 'c' },
 214              d => { 110 => 'd' },
 215              f => { 110 => 'f' },
 216              g => { 110 => 'g' },
 217              h => { 110 => 'h' },
 218              k => { 110 => 'k' },
 219              l => { 110 => 'l' },
 220              m => { 110 => 'm' },
 221              n => { 110 => 'n' },
 222              o => { 110 => 'o' },
 223              p => { 110 => 'p' },
 224              r => { 110 => 'r' },
 225              s => { 110 => 's' },
 226              t => { 110 => 't' },
 227              v => { 110 => 'v' },
 228              x => { 110 => 'x' },
 229              y => { 110 => 'y' },
 230              z => { 110 => 'z' },
 231     },
 232     611 => { a => { 111 => 'a' },
 233              c => { 111 => 'c' },
 234              d => { 111 => 'd' },
 235              e => { 111 => 'e' },
 236              f => { 111 => 'f' },
 237              g => { 111 => 'g' },
 238              h => { 111 => 'h' },
 239              j => { 111 => 'j' },
 240              k => { 111 => 'k' },
 241              l => { 111 => 'l' },
 242              n => { 111 => 'n' },
 243              p => { 111 => 'p' },
 244              q => { 111 => 'q' },
 245              s => { 111 => 's' },
 246              t => { 111 => 't' },
 247              v => { 111 => 'v' },
 248              x => { 111 => 'x' },
 249              y => { 111 => 'y' },
 250              z => { 111 => 'z' },
 251     },
 252     630 => { a => { 130 => 'a' },
 253              d => { 130 => 'd' },
 254              f => { 130 => 'f' },
 255              g => { 130 => 'g' },
 256              h => { 130 => 'h' },
 257              k => { 130 => 'k' },
 258              l => { 130 => 'l' },
 259              m => { 130 => 'm' },
 260              n => { 130 => 'n' },
 261              o => { 130 => 'o' },
 262              p => { 130 => 'p' },
 263              r => { 130 => 'r' },
 264              s => { 130 => 's' },
 265              t => { 130 => 't' },
 266              v => { 130 => 'v' },
 267              x => { 130 => 'x' },
 268              y => { 130 => 'y' },
 269              z => { 130 => 'z' },
 270     },
 271     648 => { a => { 148 => 'a' },
 272              v => { 148 => 'v' },
 273              x => { 148 => 'x' },
 274              y => { 148 => 'y' },
 275              z => { 148 => 'z' },
 276     },
 277     650 => { a => { 150 => 'a' },
 278              b => { 150 => 'b' },
 279              v => { 150 => 'v' },
 280              x => { 150 => 'x' },
 281              y => { 150 => 'y' },
 282              z => { 150 => 'z' },
 283     },
 284     651 => { a => { 151 => 'a' },
 285              v => { 151 => 'v' },
 286              x => { 151 => 'x' },
 287              y => { 151 => 'y' },
 288              z => { 151 => 'z' },
 289     },
 290     655 => { a => { 155 => 'a' },
 291              v => { 155 => 'v' },
 292              x => { 155 => 'x' },
 293              y => { 155 => 'y' },
 294              z => { 155 => 'z' },
 295     },
 296     700 => { a => { 100 => 'a' },
 297              b => { 100 => 'b' },
 298              c => { 100 => 'c' },
 299              d => { 100 => 'd' },
 300              f => { 100 => 'f' },
 301              g => { 100 => 'g' },
 302              j => { 100 => 'j' },
 303              k => { 100 => 'k' },
 304              l => { 100 => 'l' },
 305              n => { 100 => 'n' },
 306              p => { 100 => 'p' },
 307              q => { 100 => 'q' },
 308              t => { 100 => 't' },
 309              u => { 100 => 'u' },
 310     },
 311     710 => { a => { 110 => 'a' },
 312              b => { 110 => 'b' },
 313              c => { 110 => 'c' },
 314              d => { 110 => 'd' },
 315              f => { 110 => 'f' },
 316              g => { 110 => 'g' },
 317              k => { 110 => 'k' },
 318              l => { 110 => 'l' },
 319              n => { 110 => 'n' },
 320              p => { 110 => 'p' },
 321              t => { 110 => 't' },
 322              u => { 110 => 'u' },
 323     },
 324     711 => { a => { 111 => 'a' },
 325              c => { 111 => 'c' },
 326              d => { 111 => 'd' },
 327              e => { 111 => 'e' },
 328              f => { 111 => 'f' },
 329              g => { 111 => 'g' },
 330              j => { 111 => 'j' },
 331              k => { 111 => 'k' },
 332              l => { 111 => 'l' },
 333              n => { 111 => 'n' },
 334              p => { 111 => 'p' },
 335              q => { 111 => 'q' },
 336              t => { 111 => 't' },
 337              u => { 111 => 'u' },
 338     },
 339     730 => { a => { 130 => 'a' },
 340              d => { 130 => 'd' },
 341              f => { 130 => 'f' },
 342              g => { 130 => 'g' },
 343              h => { 130 => 'h' },
 344              k => { 130 => 'k' },
 345              l => { 130 => 'l' },
 346              m => { 130 => 'm' },
 347              n => { 130 => 'n' },
 348              o => { 130 => 'o' },
 349              p => { 130 => 'p' },
 350              r => { 130 => 'r' },
 351              s => { 130 => 's' },
 352              t => { 130 => 't' },
 353     },
 354     751 => { a => { 151 => 'a' },
 355              v => { 151 => 'v' },
 356              x => { 151 => 'x' },
 357              y => { 151 => 'y' },
 358              z => { 151 => 'z' },
 359     },
 360     800 => { a => { 100 => 'a' },
 361              b => { 100 => 'b' },
 362              c => { 100 => 'c' },
 363              d => { 100 => 'd' },
 364              e => { 100 => 'e' },
 365              f => { 100 => 'f' },
 366              g => { 100 => 'g' },
 367              j => { 100 => 'j' },
 368              k => { 100 => 'k' },
 369              l => { 100 => 'l' },
 370              n => { 100 => 'n' },
 371              p => { 100 => 'p' },
 372              q => { 100 => 'q' },
 373              t => { 100 => 't' },
 374              u => { 100 => 'u' },
 375              4 => { 100 => '4' },
 376     },
 377     830 => { a => { 130 => 'a' },
 378              d => { 130 => 'd' },
 379              f => { 130 => 'f' },
 380              g => { 130 => 'g' },
 381              h => { 130 => 'h' },
 382              k => { 130 => 'k' },
 383              l => { 130 => 'l' },
 384              m => { 130 => 'm' },
 385              n => { 130 => 'n' },
 386              o => { 130 => 'o' },
 387              p => { 130 => 'p' },
 388              r => { 130 => 'r' },
 389              s => { 130 => 's' },
 390              t => { 130 => 't' },
 391     },
 392 );
 393
 394 my $rec_count = @records;
 395 my $i = 0;
 396 foreach my $rec_id (@records) {
 397     $i++;
 398     #print "record: $rec_id $i of $rec_count\n";
 399
 400     # State variable; was the record changed?
 401     my $changed = 0;
 402
 403     # get the record
 404     my $record = $e->retrieve_biblio_record_entry($rec_id);
 405     next unless $record;
 406     # print Dumper($record);
 407
 408     try {
 409         my $marc = MARC::Record->new_from_xml($record->marc());
 410
 411         # get the list of controlled fields
 412         my @c_fields = keys %controllees;
 413
 414         foreach my $c_tag (@c_fields) {
 415             my @c_subfields = keys %{$controllees{"$c_tag"}};
 416             # print "Field: $field subfields: ";
 417             # foreach (@subfields) { print "$_ "; }
 418
 419             # Get the MARCXML from the record and check for controlled fields/subfields
 420             my @bib_fields = ($marc->field($c_tag));
 421             foreach my $bib_field (@bib_fields) {
 422                 # print $_->as_formatted();
 423
 424                 if ($refresh and defined(scalar($bib_field->subfield('0')))) {
 425                     $bib_field->delete_subfield(code => '0');
 426                     $changed = 1;
 427                 }
 428
 429                 my %match_subfields;
 430                 my $match_tag;
 431                 my @searches;
 432                 foreach my $c_subfield (@c_subfields) {
 433                     my @sf_values = $bib_field->subfield($c_subfield);
 434                     if (@sf_values) {
 435                         # Give me the first element of the list of authority controlling tags for this subfield
 436                         # XXX Will we need to support more than one controlling tag per subfield? Probably. That
 437                         # will suck. Oh well, leave that up to Ole to implement.
 438                         $match_subfields{$c_subfield} = (keys %{$controllees{$c_tag}{$c_subfield}})[0];
 439                         $match_tag = $match_subfields{$c_subfield};
 440                         push @searches, map {{term => $_, subfield => $c_subfield}} @sf_values;
 441                     }
 442                 }
 443                 # print Dumper(\%match_subfields);
 444                 next if !$match_tag;
 445
 446                 my @tags = ($match_tag);
 447
 448                 # print "Controlling tag: $c_tag and match tag $match_tag\n";
 449                 # print Dumper(\@tags, \@searches);
 450
 451                 # Now we've built up a complete set of matching controlled
 452                 # subfields for this particular field; let's check to see if
 453                 # we have a matching authority record
 454                 my $session = OpenSRF::AppSession->create("open-ils.search");
 455                 my $validates = $session->request("open-ils.search.authority.validate.tag.id_list",
 456                     "tags", \@tags, "searches", \@searches
 457                 )->gather();
 458                 $session->disconnect();
 459
 460                 # print Dumper($validates);
 461
 462                 # Protect against failed (error condition) search request
 463                 if (!$validates) {
 464                     print STDERR "Search for matching authority failed; record # $rec_id\n";
 465                     next if (!$changed);
 466                 }
 467
 468                 # Only add linking if one or more was found, but we may have changed
 469                 # the record already if in --refresh mode.
 470                 if (scalar(@$validates) > 0) {
 471
 472                     # Iterate through the returned authority record IDs to delete any
 473                     # matching $0 subfields already in the bib record
 474                     foreach my $auth_zero (@$validates) {
 475                         $bib_field->delete_subfield(code => '0', match => qr/\)$auth_zero$/);
 476                     }
 477
 478                     # Okay, we have a matching authority control; time to
 479                     # add the magical subfield 0. Use the first returned auth
 480                     # record as a match.
 481                     my $auth_id = @$validates[0];
 482                     my $auth_rec = $e->retrieve_authority_record_entry($auth_id);
 483                     my $auth_marc = MARC::Record->new_from_xml($auth_rec->marc());
 484                     my $cni = $auth_marc->field('003')->data();
 485
 486                     $bib_field->add_subfields('0' => "($cni)$auth_id");
 487                     $changed = 1;
 488                 }
 489             }
 490         }
 491         if ($changed) {
 492             my $editor = OpenILS::Utils::CStoreEditor->new(xact=>1);
 493             # print $marc->as_formatted();
 494             my $xml = $marc->as_xml_record();
 495             $xml =~ s/\n//sgo;
 496             $xml =~ s/^<\?xml.+\?\s*>//go;
 497             $xml =~ s/>\s+</></go;
 498             $xml =~ s/\p{Cc}//go;
 499             $xml = OpenILS::Application::AppUtils->entityize($xml);
 500
 501             $record->marc($xml);
 502             $editor->update_biblio_record_entry($record);
 503             $editor->commit();
 504         }
 505     } otherwise {
 506         my $err = shift;
 507         print STDERR "\nRecord # $rec_id : $err\n";
 508         import MARC::File::XML; # reset SAX parser so that one bad record doesn't kill the entire process
 509     }
 510 }
 511
 512 __END__
 513
 514 =head1 NAME
 515
 516 authority_control_fields.pl - Controls fields in bibliographic records with authorities in Evergreen
 517
 518 =head1 SYNOPSIS
 519
 520 C<authority_control_fields.pl> [B<--configuration>=I<opensrf_core.conf>] [B<--refresh>]
 521 [[B<--record>=I<record>[ B<--record>=I<record>]]] | [B<--all>] | [B<--start_id>=I<start-ID> B<--end_id>=I<end-ID>] |
 522 [B<--days_back>=I<number-of-days>]
 523
 524 =head1 DESCRIPTION
 525
 526 For a given set of records:
 527
 528 =over
 529
 530 =item * Iterate through the list of fields that are controlled fields
 531
 532 =item * Iterate through the list of subfields that are controlled for
 533 that given field
 534
 535 =item * Search for a matching authority record for that combination of
 536 field + subfield(s)
 537
 538 =over
 539
 540 =item * If we find a match, then add a $0 subfield to that field identifying
 541 the controlling authority record
 542
 543 =item * If we do not find a match, then insert a row into an "uncontrolled"
 544 table identifying the record ID, field, and subfield(s) that were not controlled
 545
 546 =back
 547
 548 =item * Iterate through the list of floating subdivisions
 549
 550 =over
 551
 552 =item * If we find a match, then add a $0 subfield to that field identifying
 553 the controlling authority record
 554
 555 =item * If we do not find a match, then insert a row into an "uncontrolled"
 556 table identifying the record ID, field, and subfield(s) that were not controlled
 557
 558 =back
 559
 560 =item * If we changed the record, update it in the database
 561
 562 =back
 563
 564 =head1 OPTIONS
 565
 566 =over
 567
 568 =item * B<-c> I<config-file>, B<--configuration>=I<config-file>
 569
 570 Specifies the OpenSRF configuration file used to connect to the OpenSRF router.
 571 Defaults to F<@sysconfdir@/opensrf_core.xml>
 572
 573 =item * B<-r> I<record-ID>, B<--record>=I<record-ID>
 574
 575 Specifies the bibliographic record ID (found in the C<biblio.record_entry.id>
 576 column) of the record to process. This option may be specified more than once
 577 to process multiple records in a single run.
 578
 579 =item * B<-a>, B<--all>
 580
 581 Specifies that all bibliographic records should be processed. For large
 582 databases, this may take an extraordinarily long amount of time.
 583
 584 =item * B<-r>, B<--refresh>
 585
 586 Specifies that all authority links should be removed from the target
 587 bibliographic record(s).  This will effectively rewrite all authority
 588 linking anew.
 589
 590 =item * B<-s> I<start-ID>, B<--start_id>=I<start-ID>
 591
 592 Specifies the starting ID of the range of bibliographic records to process.
 593 This option is ignored unless it is accompanied by the B<-e> or B<--end_id>
 594 option.
 595
 596 =item * B<-e> I<end-ID>, B<--end_id>=I<end-ID>
 597
 598 Specifies the ending ID of the range of bibliographic records to process.
 599 This option is ignored unless it is accompanied by the B<-s> or B<--start_id>
 600 option.
 601
 602 =item * B<--days_back>=I<number-of-days>
 603
 604 Specifies that only bibliographic records that have been created in the
 605 past few days should be processed.  You must specify how many days back
 606 to include.  This option is incompatible with the B<-s> and B<--start_id>
 607 options.
 608
 609 =back
 610
 611 =head1 EXAMPLES
 612
 613     authority_control_fields.pl --start_id 1 --end_id 50000
 614
 615 Processes the bibliographic records with IDs between 1 and 50,000 using the
 616 default OpenSRF configuration file for connection information.
 617
 618 =head1 AUTHOR
 619
 620 Dan Scott <dscott@laurentian.ca>
 621
 622 =head1 COPYRIGHT AND LICENSE
 623
 624 Copyright 2010-2011 by Dan Scott
 625
 626 This program is free software; you can redistribute it and/or
 627 modify it under the terms of the GNU General Public License
 628 as published by the Free Software Foundation; either version 2
 629 of the License, or (at your option) any later version.
 630
 631 This program is distributed in the hope that it will be useful,
 632 but WITHOUT ANY WARRANTY; without even the implied warranty of
 633 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 634 GNU General Public License for more details.
 635
 636 You should have received a copy of the GNU General Public License
 637 along with this program; if not, write to the Free Software
 638 Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
 639
 640 =cut
 641