marc_cleanup

   1 #!/usr/bin/perl
   2 require 5.10.0;
   3
   4 use strict;
   5 use warnings;
   6
   7 use Getopt::Long;
   8 use Term::ReadLine;
   9 use Equinox::Migration::SimpleTagList;
  10
  11 my $term = new Term::ReadLine 'yaz-cleanup';
  12 my $OUT = $term->OUT || \*STDOUT;
  13 binmode STDOUT, ":utf8";
  14 binmode $OUT, ":utf8";
  15
  16 $| = 1;
  17
  18 # initialization and setup
  19 my $conf = {};
  20 initialize($conf);
  21
  22 # set up files, since everything appears to be in order
  23 my $marcfile = shift || 'incoming.marc.xml';
  24 open MARC, '<:utf8', $marcfile
  25   or die "Can't open input file $!\n";
  26 open my $NUMARC, '>:utf8', $conf->{output}
  27   or die "Can't open output file $!\n";
  28 open my $OLD2NEW, '>', 'old2new.map'
  29   if ($conf->{'renumber-from'} and $conf->{'original-tag'});
  30 my $EXMARC = 'EX';
  31 print $NUMARC "<collection xmlns=\"http://www.loc.gov/MARC21/slim\">\n";
  32
  33 $conf->{totalrecs} = `grep -c '<record' $marcfile`;
  34 chomp $conf->{totalrecs};
  35 $conf->{percent}   = 0;
  36
  37 my @record;  # current record storage
  38 my %recmeta; # metadata about current record
  39 my $ptr = 0; # record index pointer
  40
  41 # this is the dispatch table which drives command selection in
  42 # edit(), below
  43 my %commands = ( c => \&print_fullcontext,
  44                  n => \&next_line,
  45                  p => \&prev_line,
  46                  '<' => \&widen_window,
  47                  '>' => \&narrow_window,
  48                  d => \&display_lines,
  49                  o => \&insert_original,
  50                  k => \&kill_line,
  51                  y => \&yank_line,
  52                  f => \&flip_line,
  53                  m => \&merge_lines,
  54                  s => \&substitute,
  55                  t => \&commit_edit,
  56                  x => \&dump_record,
  57                  q => \&quit,
  58                  '?' => \&help,
  59                  h   => \&help,
  60                  help => \&help,
  61                );
  62
  63 my @spinner = qw(- \\ | /);
  64 my $sidx = 0;
  65
  66 while ( buildrecord() ) {
  67     unless ($conf->{ricount} % 50) {
  68         $conf->{percent} = int(($conf->{ricount} / $conf->{totalrecs}) * 100);
  69         print "\rWorking (",$conf->{percent},"%) ", $spinner[$sidx];
  70         $sidx = ($sidx == $#spinner) ? 0 : $sidx + 1;
  71     }
  72
  73     my $rc = do_automated_cleanups();
  74     next if $rc;
  75
  76     $ptr = 0;
  77     until ($ptr == $#record) {
  78         # get datafield/tag data if we have it
  79         $rc = stow_record_data() if ($conf->{'renumber-from'} and $conf->{'original-tag'});
  80         return $rc if $rc;
  81
  82         # naked ampersands
  83         if ($record[$ptr] =~ /&/ && $record[$ptr] !~ /&\w+?;/)
  84           { edit("Naked ampersand"); $ptr= 0; next }
  85
  86         if ($record[$ptr] =~ /<datafield tag="(.+?)"/) {
  87             my $match = $1;
  88             # tags must be numeric
  89             if ($match =~ /\D/) {
  90                 edit("Non-numerics in tag") unless $conf->{autoscrub};
  91                 next;
  92             }
  93         }
  94
  95         # subfields can't be non-alphanumeric
  96         if ($record[$ptr] =~ /<subfield code="(.*?)"/) {
  97             if ($1 =~ /\P{IsAlnum}/ or $1 eq '') {
  98                 edit("Junk in subfield code/Null subfield code");
  99                 next;
 100             }
 101         }
 102         # subfields can't be non-alphanumeric
 103         if ($record[$ptr] =~ /<subfield code="(\w{2,})"/) {
 104             edit("Subfield code larger than 1 char");
 105             next;
 106         }
 107
 108         $ptr++;
 109     }
 110     write_record($NUMARC);
 111 }
 112 print $NUMARC "</collection>\n";
 113 print $OUT "\nDone. ",$conf->{ricount}," in; ",$conf->{rocount}," dumped          \n";
 114
 115
 116 #-----------------------------------------------------------------------------------
 117 # cleanup routines
 118 #-----------------------------------------------------------------------------------
 119
 120 sub do_automated_cleanups {
 121     $ptr = 0;
 122     until ($ptr == $#record) {
 123
 124         # catch empty datafield elements
 125         if ($record[$ptr] =~ m/<datafield tag="..."/) {
 126             if ($record[$ptr + 1] =~ m|</datafield>|) {
 127                 my @a = @record[0 .. $ptr - 1];
 128                 my @b = @record[$ptr + 2 .. $#record];
 129                 @record = (@a, @b);
 130                 @a = undef; @b = undef;
 131                 message("Empty datafield scrubbed");
 132                 $ptr = 0;
 133                 next;
 134             }
 135         }
 136         # and quasi-empty subfields
 137         if ($record[$ptr] =~ m|<subfield code="(.*?)">(.*?)</sub|) {
 138             my $code = $1; my $content = $2;
 139             if ($code =~ /\W/ and ($content =~ /\s+/ or $content eq '')) {
 140                 my @a = @record[0 .. $ptr - 1];
 141                 my @b = @record[$ptr + 1 .. $#record];
 142                 @record = (@a, @b);
 143                 @a = undef; @b = undef;
 144                 message("Empty subfield scrubbed");
 145                 $ptr = 0;
 146                 next;
 147             }
 148         }
 149         $ptr++;
 150     }
 151
 152     # single-line fixes
 153     for $ptr (0 .. $#record) {
 154         # pad short leaders
 155         if ($record[$ptr] =~ m|<leader>(.+?)</leader>|) {
 156             my $leader = $1;
 157             if (length $leader < 24) {
 158                 $leader .= ' ' x (20 - length($leader));
 159                 $leader .= "4500";
 160                 $record[$ptr] = "<leader>$leader</leader>\n";
 161                 message("Short leader padded");
 162             }
 163         }
 164         if ($record[$ptr] =~ m|<controlfield tag="008">(.+?)</control|) {
 165             #pad short 008
 166             my $content = $1;
 167             if (length $content < 40) {
 168                 $content .= ' ' x (40 - length($content));
 169                 $record[$ptr] = "<controlfield tag=\"008\">$content</controlfield>\n";
 170                 message("Short 008 padded");
 171             }
 172         }
 173
 174         # clean misplaced dollarsigns
 175         if ($record[$ptr] =~ m|<subfield code="\$">c?\d+\.\d{2}|) {
 176             $record[$ptr] =~ s|"\$">c?(\d+\.\d{2})|"c">\$$1|;
 177             message("Dollar sign corrected");
 178         }
 179
 180         # automatable subfield maladies
 181         $record[$ptr] =~ s/code=" ">c/code="c">/;
 182         $record[$ptr] =~ s/code=" ">\$/code="c">\$/;
 183     }
 184     return 0;
 185 }
 186
 187 sub stow_record_data {
 188     # get tag data if we're looking at it
 189     my $tag = 0;
 190     if ($record[$ptr] =~ m/<(control|data)field tag="(?<TAG>.{3})"/) {
 191         $recmeta{tag} = $+{TAG};
 192         $tag = $recmeta{tag};
 193         $record[$ptr] =~ m/ind1="(?<IND1>.)"/;
 194         $recmeta{ind1} = $+{IND1} || '';
 195         $record[$ptr] =~ m/ind2="(?<IND2>.)"/;
 196         $recmeta{ind2} = $+{IND2} || '';
 197
 198         unless ($tag) {
 199             message("Autokill record: no detectable tag");
 200             dump_record("No detectable tag") ;
 201             return 1;
 202         }
 203
 204         # and since we are looking at a tag, see if it's the original id
 205         if ($tag == $conf->{'original-tag'}) {
 206             my $oid = 0;
 207             if ($tag < 10) {
 208                 # controlfield
 209                 if ($record[$ptr] =~ m|<controlfield tag="$tag">(.+?)</controlfield>|)
 210                       { $oid = $1; print $OLD2NEW "$oid\t", $recmeta{nid}, "\n" }
 211             } elsif ($tag >= 10 and $conf->{'original-subfield'}) {
 212                 # datafield
 213                 my $line = $record[$ptr]; my $lptr = $ptr;
 214                 my $osub = $conf->{'original-subfield'};
 215                 # skim to end of this tag
 216                 until ($line =~ m|</datafield>|) {
 217                     if ($line =~ /<subfield code="$osub">(.+?)</)
 218                       { $oid = $1; print $OLD2NEW "$oid\t", $recmeta{nid}, "\n" }
 219                     $lptr++;
 220                     $line = $record[$lptr];
 221                 }
 222             } else {
 223                 return 0;
 224             }
 225
 226             # didn't find the old id!
 227             unless ($oid) {
 228                 message("Autokill record: no oldid when old2new mapping requested");
 229                 dump_record("No old id found");
 230                 return 1;
 231             }
 232
 233             # got it; write to old->new map file
 234             if ($conf->{'renumber-from'} and $conf->{'original-subfield'}) {
 235             }
 236
 237         }
 238     }
 239     return 0;
 240 }
 241
 242 #-----------------------------------------------------------------------------------
 243 # driver routines
 244 #-----------------------------------------------------------------------------------
 245
 246 =head2 edit
 247
 248 Handles the Term::ReadLine loop
 249
 250 =cut
 251
 252 sub edit {
 253     my ($msg) = @_;
 254
 255     return if $conf->{trash}->has( $recmeta{tag} );
 256     if ( $conf->{fullauto} )
 257     { dump_record($msg); return }
 258
 259     $conf->{editmsg} = $msg;
 260     print_fullcontext();
 261
 262     # stow original problem line
 263     $recmeta{origline} = $record[$ptr];
 264
 265     while (1) {
 266         my $line = $term->readline('marc-cleanup>');
 267         my @chunks = split /\s+/, $line;
 268
 269         # lines with single-character first chunks are commands.
 270         # make sure they exist.
 271         if (length $chunks[0] == 1) {
 272             unless (defined $commands{$chunks[0]}) {
 273                 print $OUT "No such command '", $chunks[0], "'\n";
 274                 next;
 275             }
 276         }
 277
 278         if (defined $commands{$chunks[0]}) {
 279             my $term = $commands{$chunks[0]}->(@chunks[1..$#chunks]);
 280             last if $term;
 281         } else {
 282             $recmeta{prevline} = $record[$ptr];
 283             $record[$ptr] = "$line\n";
 284             print_context();
 285         }
 286     }
 287     # set pointer to top on the way out
 288     $ptr = 0;
 289 }
 290
 291 =head2 buildrecord
 292
 293 Constructs record arrays from the incoming MARC file and returns them
 294 to the driver loop.
 295
 296 =cut
 297
 298 sub buildrecord {
 299     my $l = '';
 300     my $istrash = 0;
 301     my $trash = $conf->{trash};
 302
 303     $l = <MARC> while (defined $l and $l !~ /<record>/);
 304     return $l unless defined $l;
 305     $conf->{ricount}++;
 306
 307     for (keys %recmeta) { $recmeta{$_} = undef }
 308     for (0 .. @record)  { delete $record[$_] }
 309
 310     my $i = 0;
 311     until ($l =~ m|</record>|) {
 312         # clean up tags with spaces in them
 313         $l =~ s/tag="  /tag="00/g;
 314         $l =~ s/tag=" /tag="0/g;
 315         $l =~ s/tag="-/tag="0/g;
 316         $l =~ s/tag="(\d\d) /tag="0$1/g;
 317
 318         # excise unwanted tags
 319         if ($istrash) {
 320             $istrash = 0 if ($l =~ m|</datafield|);
 321             $l = <MARC>;
 322             next;
 323         }
 324         if ($l =~ m/<datafield tag="(.{3})"/) {
 325             if ($trash->has($1) or ($conf->{autoscrub} and $1 =~ /\D/))
 326               { $istrash = 1; next }
 327         }
 328
 329         push @record, $l;
 330         $l = <MARC>;
 331         $i++;
 332     }
 333
 334     # add 903(?) with new record id
 335     if ($conf->{'renumber-from'}) {
 336         $recmeta{nid} = $conf->{'renumber-from'};
 337         push @record, join('', ' <datafield tag="', $conf->{'renumber-tag'},
 338                            '" ind1=" " ind2=" "> <subfield code="',
 339                            $conf->{'renumber-subfield'},
 340                            '">',
 341                            $recmeta{nid},
 342                            "</subfield></datafield>\n");
 343         $conf->{'renumber-from'}++;
 344     }
 345     $i++;
 346
 347     push @record, $l;
 348     return 1;
 349 }
 350
 351 sub write_record {
 352     my ($FH) = @_;
 353
 354     if ($FH eq 'EX') {
 355         $EXMARC = undef;
 356         open $EXMARC, '>:utf8', $conf->{exception}
 357           or die "Can't open exception file $!\n";
 358         $FH = $EXMARC;
 359     }
 360
 361     print $FH '<!-- ', $recmeta{explanation}, " -->\n"
 362       if(defined $recmeta{explanation});
 363
 364     # scrub newlines (unless told not to or writing exception record)
 365     unless ($conf->{nocollapse} or $FH eq $EXMARC)
 366       { s/\n// for (@record) }
 367
 368     # actually write the record
 369     print $FH @record,"\n";
 370
 371     # increment output record count (if not exception)
 372     $conf->{rocount}++ if ($FH eq $EXMARC);
 373
 374     # if we were dumping to exception file, nuke the record and set ptr
 375     # to terminate processing loop
 376     @record = ('a');
 377     $ptr = 0;
 378 }
 379
 380 sub print_fullcontext {
 381     print $OUT "\r", ' ' x 72, "\n";
 382     print $OUT $conf->{editmsg},"\n";
 383     print $OUT "\r    Tag:",$recmeta{tag}, " Ind1:'",
 384       $recmeta{ind1},"' Ind2:'", $recmeta{ind2}, "'";
 385     print $OUT " @ ", $conf->{ricount}, "/", $conf->{totalrecs};
 386     print_context();
 387     return 0;
 388 }
 389
 390 sub print_context {
 391     my $upper = int($conf->{window} / 2) + 1;
 392     my $lower = int($conf->{window} / 2) - 1;
 393     my $start = ($ptr - $upper < 0) ? 0 : $ptr - $upper;
 394     my $stop  = ($ptr + $lower > $#record) ? $#record : $ptr + $lower;
 395     print $OUT "\n";
 396     print $OUT '    |', $record[$_] for ($start .. $ptr - 1);
 397     print $OUT '==> |', $record[$ptr];
 398     print $OUT '    |', $record[$_] for ($ptr + 1 .. $stop);
 399     print $OUT "\n";
 400     return 0;
 401 }
 402
 403 sub message {
 404     my ($msg) = @_;
 405     print $OUT "\r$msg at ",$conf->{ricount},"/",$conf->{totalrecs}, "\n";
 406 }
 407
 408 #-----------------------------------------------------------------------------------
 409 # command routines
 410 #-----------------------------------------------------------------------------------
 411
 412 sub substitute {
 413     my (@chunks) = @_;
 414
 415     my $ofrom = shift @chunks;
 416     if ($ofrom =~ /^'/) {
 417         until ($ofrom =~ /'$/ or !@chunks)
 418           { $ofrom .= join(' ','',shift @chunks) }
 419         $ofrom =~ s/^'//; $ofrom =~ s/'$//;
 420     }
 421     my $to = shift @chunks;
 422     if ($to =~ /^'/) {
 423         until ($to =~ /'$/ or !@chunks)
 424           { $to .= join(' ','',shift @chunks) }
 425         $to =~ s/^'//; $to =~ s/'$//;
 426     }
 427
 428     my $from = '';
 429     for my $char (split(//,$ofrom)) {
 430         $char = "\\" . $char if ($char =~ /\W/);
 431         $from = join('', $from, $char);
 432     }
 433
 434     $recmeta{prevline} = $record[$ptr];
 435     $record[$ptr] =~ s/$from/$to/;
 436     $ofrom = undef; $to = undef; $from = undef;
 437     print_context();
 438     return 0;
 439 }
 440
 441 sub merge_lines {
 442     $recmeta{prevline} = $record[$ptr];
 443     # remove <subfield stuff; extract (probably wrong) subfield code
 444     $record[$ptr] =~ s/^\s*<subfield code="(.*?)">//;
 445     # and move to front of line
 446     $record[$ptr] = join(' ', $1 , $record[$ptr]);
 447     # tear off trailing subfield tag from preceeding line
 448     $record[$ptr - 1] =~ s|</subfield>\n||;
 449     # join current line onto preceeding line
 450     $record[$ptr - 1] = join('', $record[$ptr - 1], $record[$ptr]);
 451     # erase current line
 452     my @a = @record[0 .. $ptr - 1];
 453     my @b = @record[$ptr + 1 .. $#record];
 454     @record = (@a, @b);
 455     # move record pointer to previous line
 456     prev_line();
 457     print_context();
 458     return 0;
 459 }
 460
 461 sub flip_line {
 462     unless ($recmeta{prevline})
 463       { print $OUT "No previously edited line to flip\n"; return }
 464     my $temp = $record[$ptr];
 465     $record[$ptr] = $recmeta{prevline};
 466     $recmeta{prevline} = $temp;
 467     $temp = undef;
 468     print_context();
 469     return 0;
 470 }
 471
 472 sub kill_line {
 473     $recmeta{killline} = $record[$ptr];
 474     my @a = @record[0 .. $ptr - 1];
 475     my @b = @record[$ptr + 1 .. $#record];
 476     @record = (@a, @b);
 477     @a = undef; @b = undef;
 478     print_context();
 479     return 0;
 480 }
 481
 482 sub yank_line {
 483     unless ($recmeta{killline})
 484       { print $OUT "No killed line to yank\n"; return }
 485     my @a = @record[0 .. $ptr - 1];
 486     my @b = @record[$ptr .. $#record];
 487     @record = (@a, $conf->{killline}, @b);
 488     @a = undef; @b = undef;
 489     print_context();
 490     return 0;
 491 }
 492
 493 sub insert_original {
 494     $record[$ptr] = $recmeta{origline};
 495     print_context();
 496     return 0;
 497 }
 498
 499 sub display_lines {
 500     print $OUT "\nOrig. edit line  :", $recmeta{origline};
 501     print $OUT "Current flip line:", $recmeta{prevline} if $recmeta{prevline};
 502     print $OUT "Last killed line :", $recmeta{killline} if $recmeta{killline};
 503     print $OUT "\n";
 504     return 0;
 505 }
 506
 507 sub dump_record {
 508     my (@explanation) = @_;
 509     $recmeta{explanation} = join(' ', 'DUMPING RECORD: Tag', $recmeta{tag}, @explanation);
 510     message( $recmeta{explanation} );
 511     write_record($EXMARC);
 512     return 1;
 513 }
 514
 515 sub next_line {
 516     $ptr++ unless ($ptr == $#record);;
 517     print_context();
 518     return 0;
 519 }
 520
 521 sub prev_line {
 522     $ptr-- unless ($ptr == 0);
 523     print_context();
 524     return 0;
 525 }
 526
 527 sub commit_edit { return 1 }
 528
 529 sub widen_window {
 530     if ($conf->{window} == 15)
 531       { print $OUT "Window can't be bigger than 15 lines\n"; return }
 532     $conf->{window} += 2;
 533     print_context;
 534 }
 535
 536 sub narrow_window {
 537     if ($conf->{window} == 5)
 538       { print $OUT "Window can't be smaller than 5 lines\n"; return }
 539     $conf->{window} -= 2;
 540     print_context;
 541 }
 542
 543 sub help {
 544 print $OUT <<HELP;
 545 Type a replacement for the indicated line, or enter a command.
 546
 547 DISPLAY COMMANDS             | LINE AUTO-EDIT COMMANDS
 548 <  Expand context window     | k  Kill current line
 549 >  Contract context window   | y  Yank last killed line
 550 p  Move pointer to prev line | m  Merge current line into preceding line
 551 n  Move pointer to next line | o  Insert original line
 552 c  Print line context        | f  Flip current line and last edited line
 553 d  Print current saved lines |
 554 -----------------------------+-------------------------------------------
 555 s  Subtitute; replace ARG1 in current line with ARG2. If either ARG
 556    contains spaces, it must be single-quoted
 557 t  Commit changes and resume automated operations
 558 x  Dump record to exception file
 559 q  Quit
 560
 561 HELP
 562 return 0;
 563 }
 564
 565 sub quit { exit }
 566
 567 #-----------------------------------------------------------------------
 568
 569 =head2 initialize
 570
 571 Performs boring script initialization. Handles argument parsing,
 572 mostly.
 573
 574 =cut
 575
 576 sub initialize {
 577     my ($c) = @_;
 578     my @missing = ();
 579
 580     # set mode on existing filehandles
 581     binmode(STDIN, ':utf8');
 582
 583     my $rc = GetOptions( $c,
 584                          'autoscrub|a',
 585                          'fullauto',
 586                          'exception|x=s',
 587                          'output|o=s',
 588                          'prefix|p=s',
 589                          'nocollapse|n',
 590                          'renumber-from|rf=i',
 591                          'renumber-tag|rt=i',
 592                          'renumber-subfield|rs=s',
 593                          'original-tag|ot=i',
 594                          'original-subfield|os=s',
 595                          'script',
 596                          'no-strip9',
 597                          'trashfile|t=s',
 598                          'trashhelp',
 599                          'help|h',
 600                        );
 601     show_help() unless $rc and @ARGV;
 602     show_help() if ($c->{help});
 603     show_trashhelp() if ($c->{trashhelp});
 604
 605     # defaults
 606     my $pfx = $c->{prefix} // "bibs";
 607     $c->{ricount} = 0;
 608     $c->{rocount} = 0;
 609     $c->{output} = join('.',$c->{prefix},'clean','marc','xml');
 610     $c->{exception} = join('.',$c->{prefix},'exception','marc','xml');
 611     $c->{'renumber-tag'} = 903 unless defined $c->{'renumber-tag'};
 612     $c->{'renumber-subfield'} = 'a' unless defined $c->{'renumber-subfield'};
 613     $c->{window} = 9;
 614
 615     if ($c->{trashfile}) {
 616         $c->{trash} = Equinox::Migration::SimpleTagList->new(file => $conf->{trashfile})
 617     } else {
 618         $c->{trash} = Equinox::Migration::SimpleTagList->new;
 619     }
 620     # autotrash 901, 903 unless no strip-nines
 621     unless ($c->{'no-strip9'}) {
 622         $c->{trash}->add_tag(901);
 623         $c->{trash}->add_tag(903);
 624     }
 625     # remove original id sequence tag from trash hash if we know it
 626     $c->{trash}->remove_tag($c->{'original-tag'})
 627       if ( $c->{'original-tag'} and $c->{trash}->has($c->{'original-tag'}) );
 628
 629     my @keys = keys %{$c};
 630     show_help() unless (@ARGV and @keys);
 631 }
 632
 633 sub show_help {
 634     print <<HELP;
 635 Usage is: marc-cleanup [OPTIONS] <filelist>
 636 Options
 637   --output     -o  Cleaned MARCXML output filename
 638   --exception  -x  Exception (dumped records) MARCXML filename
 639        or
 640   --prefix=<PREFIX>>   -p  Shared prefix for output/exception files. Will produce
 641                            PREFIX.clean.marc.xml and PREFIX.exception.marc.xml
 642
 643   --renumber-from     -rf  Begin renumbering id sequence with this number
 644   --renumber-tag      -rt  Tag to use in renumbering (default: 903)
 645   --renumber-subfield -rs  Subfield code to use in renumbering (default: a)
 646   --original-tag      -ot  Original id tag; will be kept in output even if
 647                            it appears in the trash file
 648   --original-subfield -os  Original id subfield code. If this is specified
 649                            and renumbering is in effect, an old-to-new mapping
 650                            file (old2new.map) will be generated.
 651
 652   --autoscrub  -a  Automatically remove non-numeric tags in data
 653   --nocollapse -n  Don't compress records to one line on output
 654   --no-strip9      Don't autoremove 901/903 tags in data
 655   --trashfile  -t  File containing trash tag data (see --trashhelp)
 656
 657   --fullauto       No manual edits. All problematic records dumped to
 658                    exception file.
 659
 660   --script         Store human-initiated ops in scriptfile (.mcscript)
 661                    Not yet implemented
 662 HELP
 663 exit;
 664 }
 665
 666 sub show_trashhelp {
 667     print <<HELP;
 668 See
 669
 670 http://intra.lan.hq.esilibrary.com/dokuwiki/doku.php?id=migration:tag_files
 671
 672 for tag file syntax information.
 673 HELP
 674 exit;
 675 }