#!/usr/bin/perl -w
#
#   evergreen.script - Create Evergreen Cemetery "Directory of the Dead" pages
#
#   Author:   John Van Essen <vanes002@umn.edu>
#
#   Usage:    evergreen.script [-n|--dry-run] [AccessExportFile]
#
#   Example:  sort -n listing*YYYYMMDD.txt | \
#              perl evergreen.script - >|evergreen-YYYYMMDD.out
#
##########################################################################
#
#   This script processes a MicroSoft Access Listing of the Dead file
#   that has been exported to a tab-delimited text file with text fields
#   enclosed in double-quotes and a column title header row. 
#  
#   Example from exported file using TAB-separated fields:
#
#(header) "ID"     "*"      "date of death"  "name"                     "age"
#(cont'd) "lot owner"       "note"           "section"    "lot"    "block"
#(data)   16729    "*"      "12-14-1994"     "Van Essen, William Earl"  "74 yrs."
#(cont'd) "John Van Essen"  ""               "SEC N 1/2"  "100"    "45"
#
#   Field 1 : Unique index number (1 - N)
#   Field 2 : Data OK flag (non-blank if data double-checked)
#   Field 3 : Date of death (or burial if unknown) MM-DD-YYYY
#   Field 4 : Lastname, Firstname of person
#   Field 5 : Age at death (if known)
#   Field 6 : Lot owner (not used here)
#   Field 7 : Note (used only if block and lot and section missing)
#   Field 8 : Burial location within lot (see NOTE below)
#             SEC N 1/2 means SEC of N 1/2 of lot (8 plots/lot)
#   Field 9 : Burial lot number within block
#   Field 10: Burial block number
#
#   NOTE 1: If section is blank, notes describe why burial location not given.
#   NOTE 2: If burial location starts with the following words:
#              Devotion  Christus  Paradise
#           then burial is at Memorial Garden, not Evergreen Cemetery, and
#           block and section are swapped and modified.
#
##########################################################################

    $| = 1;   # Flush output right away

    $DEBUG = 1;         # 1 = display some summary stats
    $DRY_RUN = 0;       # 1 = don't write files - just analyze input

    ### Look for optional argument -n or --dry-run
    #
    if ( $ARGV[0] and ( $ARGV[0] eq "-n" or $ARGV[0] eq "--dry-run" ) ) {
        shift( @ARGV );
        $DRY_RUN = 1;
    }

    $DataFile = $ARGV[0] || "evergreen.txt";
    $FindFile = "findamatch.txt";

    @Surgroups = (
      "Aa-Am", "An-Az", "Ba-Be", "Bf-Bo", "Bp-Bz",
      "Ca-Ch", "Ci-Cz", "D", "E", "F", "Ga-Gn", "Go-Gz",
      "Ha-Hd", "He-Hn", "Ho-Hz", "I-Jn", "Jo-Jz",
      "Ka-Kn", "Ko-Kz", "La-Lh", "Li-Lz",
      "Ma-Mb", "Mc-Mh", "Mi-Mz", "N", "O",
      "Pa-Pe", "Pf-Pz", "Q-Rn", "Ro-Rz",
      "Sa-Sg", "Sh-Sr", "St-Sz", "T", "U-V",
      "Wa-Wh", "Wi-Wz", "X-Z"
    );
    @DataRows = ();

    $titleeca = "Evergreen Cemetery Association";
    $titledod = "Directory of the Dead";
    $homeroot = "dotd";
    $pfxblock = "dotdblock_";
    $pfxnames = "dotdnames_";
    $hor_rule = <<"EOR";
<!-- ================================================================= -->
<img src="hr.gif" alt="" width="100%" height="3" vspace="3"><br>
EOR
    $indxnote = <<"EOR";
<table cellspacing=0 cellpadding=0><tr valign=top><td>NOTES:&nbsp;</td>
<td>Blocks named Christus, Devotion and Paradise
are sections of Memorial Gardens.<br>
The <img align=top src="findagravelink.png" width=18 height=16
 alt="" title="Icon for link to memorial at Find-A-Grave" border=0>
icon is a link to the memorial at Find-A-Grave for the deceased.<br>
In the Grouped by Surname pages, the <u>lot number</u> is hyperlinked
to its section in the Grouped by Block pages.<br>
In the Grouped by Block pages, the <u>name</u> is hyperlinked
to its entry in the Grouped by Surname pages.<br>
</td></tr></table>
EOR
    $countec = 0;       # Count of burials in Evergreen Cemetery
    $countmg = 0;       # Count of burials in Memorial Gardens
    $countno = 0;       # Count of entries with data NOT OK yet
    $datebeg = "9999-00-00";
    $dateend = "0000-00-00";
    $yearbeg = 1871;
    $yearend = 1900 + (localtime())[5];
    $copyyrs = "2008-$yearend";
    $yeartst = 1895;    # Cutoff year for ignoring certain "same as" tests
    $updated = localtime();     # "Mon Mar 23 22:33:44 2009"
    $updated = sprintf( "%s %d, %s", ( split( ' ', $updated ) )[1,2,4] );
               
    $dblquot = undef;

    ### Process Find-A-Grave match report file
    #
    #   File has Find-A-Grave index and name, followed by Evergreen index
    #
    #      45625242  12-14-1994  Van Essen, William Earl
    #   =>    16729  12-14-1994  Van Essen, William Earl
    #
    %famatch = ();
    open( FAF, $FindFile ) || die "$FindFile: $!\n";
    while ( <FAF> ) {
        chomp;
        $findex = $1, next if ( m/^   +(\d+)/ );
        $famatch{$1} = $findex if ( m/^=> +(\d+)/ );
    }

    ### Process MS Access (Tab-delimited Text) Listing of the Dead file
    #
    open( DOD, $DataFile ) || die "$DataFile: $!\n";
    while ( <DOD> ) {
        chomp;
        next if ( m/^$/ );                 # Skip any blank lines
        $joined = undef;
#       $joined = $_, $_ .= <DOD>, chomp
#          unless ( m/("|\t)$/ );
	$NumFields = 10;
        @data = split( /\t/, $_, -1 );
        # Check first line for name text enclosed in quotes and remember it
        if ( !defined( $dblquot ) ) {
            $dblquot = ( $data[3] =~ m/^".*"$/ ) ? 1 : 0;
        }
        # Remove any double-quotes and escaped quotes from quoted strings
        @data = map( { s/^"//; s/"$//; s/""/"/g; $_ } @data )
          if ( $dblquot );
        ( $idx, $datackd, $ddate, $name, $age, undef, $note, $sec, $lot, $blk )
          = @data;
        next if ( $idx eq "ID" or $idx eq "" );  # Skip any header line
        pwarn( qq{being joined to next line: $joined} )
          if ( defined( $joined ) );
        pwarn( qq{Need $NumFields columns - but got } . scalar( @data ) ),
          if ( @data != $NumFields );
        next if ( $idx == 3672 ); # Skip "West, Phoebe R. (Warner)"
        $DataRows[$idx] =                  # Name must be last in this string
#         sprintf( "%5d%s", $idx, "|$ddate|$age|$blk|$lot|$sec|$name" );
          sprintf( "%5d|%s|%s|%s|%s|%s|%s|%s", 
            $idx, $datackd || " ", $ddate, $age, $blk, $lot, $sec, $name );
        $dataok = $datackd eq "*";
        $dataok = 1;                       # CHECK ALL DATA as of 10/15/2007
        $countno++ unless $dataok;         # Count up unchecked entries
#       $dataok = 1 if ( $DRY_RUN );       # Check ALL entries if dry run
# print( "$idx; $ddate; $name; $age; $sec; $lot; $blk\n" );
# $dataok = "1";

        ### Validate data checked column
        #
        pwarn( qq{data checked column "$datackd" should be "*" or empty} )
          if ( not ( $datackd eq "*" or $datackd eq "" ) );

        ### Validate date and figure out earliest and latest burials
        #
        if ( $ddate =~ m/^(\d\d)-(\d\d)-(\d\d\d\d)$/ ) {
            $datenew = "$3-$1-$2";
            if ( $ddate eq "00-00-0000" ) {
#               10/15/2007 : Don't complain about 00-00-0000 anymore
#               pwarn( qq{date "$ddate" needs at least a year} )
#                 if ( $name !~ m/unknown/i && $blk ne "?" && $dataok );
            }
            elsif ( $3 < $yearbeg || $3 > $yearend ) {
                pwarn( qq{date "$ddate" has year < $yearbeg or > $yearend} )
                  if ( $dataok );
            } elsif ( $1 > 12 ) {          # Require valid month
                pwarn( qq{date "$ddate" has month > 12} )
                  if ( $dataok );
            } elsif ( $2 > 31 ) {          # Require valid day
                pwarn( qq{date "$ddate" has day > 31} )
                  if ( $dataok );
            } elsif ( "$1$2" ne "0000" ) { # Require month & day for limits
                $datebeg = $datenew if ( $datebeg gt $datenew );
                $dateend = $datenew if ( $dateend lt $datenew );
            }
            $chkyear = 1970;
            pwarn( qq{data checked column not "*" for death >= $chkyear} )
              if ( $datackd ne "*" and $3 >= $chkyear );
        } elsif ( $ddate =~ m/^before (\d\d\d\d)$/ ) {
            if ( $1 < $yearbeg || $1 > $yearend ) {
                pwarn( qq{date "$ddate" has year < $yearbeg or > $yearend} )
                  if ( $dataok );
            }
        } else {
            pwarn( qq{date "$ddate" is not of the form ##-##-####} )
              if ( $dataok );
        }

        ### Validate name and prepare to sort into surname groups
        #
        $match = "";
        pwarn( qq{name has leading space} )
          if ( $name =~ s/^ +// && $dataok );
        pwarn( qq{name has trailing space} )
          if ( $name =~ s/ +$// && $dataok );
        pwarn( qq{name has 2 or more consecutive spaces} )
          if ( $name =~ m/  / && $dataok );
        pwarn( qq{name is missing} )
          if ( $name eq "" && $dataok );
        pwarn( qq{name still has (...history...) comment} )
          if ( $name =~ m/\(.*history.*\)/i && $dataok );
        pwarn( qq{name has non-capital-letter first character} )
          if ( $name =~ m/^[^A-Z]/ && $dataok );
        pwarn( qq{name has a "0" (number zero) character} )
          if ( $name =~ m/0/ && $dataok );
        pwarn( qq{name has "comment" instead of (comment)} )
          if ( $name =~ m/child"/i && $dataok );
        pwarn( qq{name has a non-alphanumeric after "("} )
          if ( $name =~ m/\(\W/ && $dataok );
        pwarn( qq{name begins with letter and period} )
          if ( $name =~ m/^[A-Z]\./ && $dataok );
        pwarn( qq{name has a comma with no space after} )
          if ( $name =~ m/,\S/ && $dataok );
        pwarn( qq{name has a trailing comma} )
          if ( $name =~ m/,$/ && $dataok );
        pwarn( qq{name has a comma with " or " after} )
          if ( $name =~ m/, or / && $dataok );
        pwarn( qq{name has no comma and is not "Unknown"} )
          if ( $name !~ m/,/ && $name !~ m/^Unknown|Indian/ && $dataok );
        pwarn( qq{name has a non-space before "("} )
          if ( $name =~ m/[^ ]\(/ && $dataok );
        pwarn( qq{name has "s instead of 's} )
          if ( $name =~ m/"s / && $dataok );
        pwarn( qq{name has unmatched double-quote} )
          if ( $name =~ m/\"/ && $name !~ m/\".*\"/ && $dataok );
        pwarn( qq{name has unmatched opening parenthesis} )
          if ( $name =~ m/\(/ && $name !~ m/\(.*\)/ && $dataok );
        pwarn( qq{name has unmatched closing parenthesis} )
          if ( $name =~ m/\)/ && $name !~ m/\(.*\)/ && $dataok );
        pwarn( qq{name has a period after a non-alphabetic character} )
          if ( $name =~ m/[^A-Za-z]\./ && $dataok );
        $temp = $name;                     # Prepare to test for space typos
        $temp =~ s/ +\(.*\)//i;            # Remove all parenthetical comments
        $temp =~ s/ or / /g;
        $temp =~ s/ and / /g;
        $temp =~ s/ of / /g;
        $temp =~ s/ child\S*\b//;
        $temp =~ s/ baby\b//;
        $temp =~ s/ boy\b//;
        $temp =~ s/ girl\b//;
        $temp =~ s/ son\b//;
        $temp =~ s/ daughter\b//;
        $temp =~ s/ twins\b//;
        $temp =~ s/ man\b//;
        $temp =~ s/ woman\b//;
        $temp =~ s/ adult\b//;
        pwarn( qq{name has a space before a lower-case letter} )
          if ( $temp =~ m/ [a-z]/ && $dataok );
        $sortname = ucfirst( lc( $name ) );
        $sortname =~ s/[^\w,']//g;         #Keep only a-z, 0-9, comma, apost.

        ### Find alphabetical surname group that contains surname
        foreach $s ( @Surgroups ) {
            ( $beg, $end ) = ( $s =~ m|(.*)-(.*)| )
                             ? ( $1, $2 ) : ( $s, $s );
            $match = $s, last
              if ( substr( $sortname, 0, length( $beg ) ) ge $beg
                && substr( $sortname, 0, length( $end ) ) le $end );
        }
        pwarn( qq{name unmatched by any Surgroups entries.} ),
          next unless ( $match );

        ### Validate age
        #   Can be null(missing) or "?" or "-0-" or "premature" or "infant" or
        #   N yr[s]. or N mo[s]. or N wk[s]. or N da[y][s]. or N hr[s]. or N min[s].
        #     where N = "few" or 1-119 with optional fraction (e.g. 1/2)
        #
        pwarn( qq{age "$age" has leading space} )
          if ( $age =~ s/^ +// && $dataok );
        pwarn( qq{age "$age" has trailing space} )
          if ( $age =~ s/ +$// && $dataok );
        pwarn( qq{age "$age" has 2 or more consecutive spaces} )
          if ( $age =~ m/  / && $dataok );
        pwarn( qq{age is missing} )
          if ( $age eq "" && $dataok );
        $numre = '[Ff]ew +|\d\d? +(\d\/\d +)?|\d\d?\-\d\d? +|1[01]\d +';
        $agere = 'yrs?\.|mos?\.|wks?\.|das?\.|days?|hrs?\.|mins?\.';
        pwarn( qq{age "$age" is not recognizable} )
          if ( $dataok && not
             ( $age eq "" or $age eq "?" or $age eq "-0-"
               or lc($age) eq "premature" or lc($age) eq "infant"
               or $age =~ m/^($numre)($agere)$/ ) );

        ### Validate block (null, numerical, "?", or "Babyland")
        #
        pwarn( qq{block "$blk" has a leading space} )
          if ( $blk =~ s/^ +//i && $dataok );
        pwarn( qq{block "$blk" has a trailing space} )
          if ( $blk =~ s/ +$//i && $dataok );
        $sortblk = uc( $blk );
        pwarn( qq{block "$blk" has a non-numeric character} ), $sortblk = "0"
          if ( $blk !~ m/^(|\?|\d+|babyland)$/i && $dataok &&
            not ( $blk =~ m/^\d+ +\& +\d+$/ && $sec =~ m/Christus|Devotion/ ) );
#       pwarn( qq{block "$blk" set to "$1" for sorting} ),
#         $sortblk = $1 if ( $blk =~ m/^(\d\d?) *\?/ );
#       pwarn( qq{block "$blk" set to "$1" for sorting} ),
#         $sortblk = $1 if ( $blk =~ m/^(\d\d?) or/ );
        $sortblk = "0" if ( $sortblk eq "?" ); # Use zero for unknown
        $blk_ttl = ucfirst( lc( $sortblk || "None" ) );
        $sortblk =~ s|^|000|;              # Ensure at least three
        $sortblk =~ s|^0*(\d\d\d)|$1|;     #   leading digits

        ### Validate lot (most are numerical, some are number dash alpha)
        #   MG Paradise can have "All" as lot
        #
        pwarn( qq{lot "$lot" has a leading space} )
          if ( $lot =~ s/^ +//i && $dataok );
        pwarn( qq{lot "$lot" has a trailing space} )
          if ( $lot =~ s/ +$//i && $dataok );
        pwarn( qq{lot "$lot" needs a dash between the number and letter} )
          if ( $lot =~ m/[0-9] *[A-Z]/ && $dataok );
        pwarn( qq{lot "$lot" has a non-(A-Z,0-9,-,/,?,&) character} )
          if ( $lot =~ m/[^A-Z0-9\-\/\?\&\ ]/ && $lot ne "All" && $dataok );
        pwarn( qq{lot "$lot" has a value but block is not given} )
          if ( $lot =~ m/[^ ?]/ && ( $blk eq "" || $blk eq "?" ) && $dataok );
        $sortlot = uc( $lot );
        $sortlot = "0" if ( $lot eq "All" );   # Use zero for full lot
        $sortlot = "0" if ( $sortlot eq "?" ); # Use zero for unknown
        $sortlot =~ s|^|000|;              # Ensure at least three
        $sortlot =~ s|^0*(\d\d\d)|$1|;     #   leading digits

        ### Validate section (free form)
        #
        pwarn( qq{section "$sec" has a leading space} )
          if ( $sec =~ s/^ +// && $dataok );
        pwarn( qq{section "$sec" has a trailing space} )
          if ( $sec =~ s/ +$// && $dataok );
        pwarn( qq{section "$sec" has 2 or more consecutive spaces} )
          if ( $sec =~ m/  / && $dataok );
        pwarn( qq{section "$sec" still has (...history...) comment} )
          if ( $sec =~ m/\(.*history.*\)/i && $dataok );
        pwarn( qq{section "$sec" has a non-alphanumeric after (} )
          if ( $sec =~ m/\(\W/ && $dataok );
        pwarn( qq{section "$sec" has a value but block is not given} )
          if ( $sec =~ m/[^ ?]/ && ( $blk eq "" || $blk eq "?" ) && $dataok );
        pwarn( qq{section "$sec" has unmatched double-quote} )
          if ( $sec =~ m/\"/ && $sec !~ m/\".*\"/ && $dataok );
        pwarn( qq{section "$sec" has unmatched opening parenthesis} )
          if ( $sec =~ m/\(/ && $sec !~ m/\(.*\)/ && $dataok );
        pwarn( qq{section "$sec" has unmatched closing parenthesis} )
          if ( $sec =~ m/\)/ && $sec !~ m/\(.*\)/ && $dataok );
        pwarn( qq{section "$sec" needs a space before the fraction} )
          if ( $sec =~ m/[^ ]1\/[24]/ && $dataok );
        pwarn( qq{section "$sec" needs "frac." instead of "$1"} )
          if ( $sec =~ m/(frac[^.])/i && $dataok );
        pwarn( qq{section "$sec" needs "fr." instead of "$1"} )
          if ( $sec =~ m/ (from) /i && $dataok );
        pwarn( qq{section "$sec" needs "North" instead of "N."} )
          if ( $sec =~ m/ N\./ && $dataok );
        pwarn( qq{section "$sec" needs "South" instead of "S."} )
          if ( $sec =~ m/ S\./ && $dataok );
        pwarn( qq{section "$sec" needs "East" instead of "E."} )
          if ( $sec =~ m/ E\./ && $dataok );
        pwarn( qq{section "$sec" needs "West" instead of "W."} )
          if ( $sec =~ m/ W\./ && $dataok );
        pwarn( qq{section "$sec" needs "$1" instead of "$1$2"} )
          if ( $sec =~ m/ ([NSEW])(orth|outh|ast|est) 1\/[24]/ && $dataok );
#       pwarn( qq{section "$sec" has unnecessary "fr." in "$1"} )
#         if ( $sec =~ m/(ft\. *fr\. *[NS][EW]C)/ && $dataok );
        pwarn( qq{section "$sec" needs "ft" instead of "Ft"} )
          if ( $sec =~ m/Ft/ && $dataok );
        pwarn( qq{section "$sec" needs a period after "ft"} )
          if ( $sec =~ m/ft / && $dataok );
        pwarn( qq{section "$sec" needs a space before "ft."} )
          if ( $sec =~ m/[^\s]ft\./ && $dataok );
        pwarn( qq{section "$sec" needs a space after "ft."} )
          if ( $sec =~ m/ft\.[^\s]/ && $dataok );
        pwarn( qq{section "$sec" needs a space after comma in "$1"} )
          if ( $sec =~ m/(,[^\s])/ && $dataok );
        pwarn( qq{section "$sec" needs a space before "-"} )
          if ( $sec =~ m/[^\s]-/ && $dataok );
        pwarn( qq{section "$sec" needs a space after "-"} )
          if ( $sec =~ m/-[^\s]/ && $dataok );
        pwarn( qq{section "$sec" has invalid corner "$1"} )
          if ( $sec =~ m/([\S][\S][\S]C)( |$)/ && $dataok );
        pwarn( qq{section "$sec" has invalid rank number "$2"} )
          if ( $sec =~ m/(^|\D)([2-9]st|[13-9]nd|[124-9]rd|[123]th)/i && $dataok );
        pwarn( qq{section "$sec" has invalid rank number "$1$2"} )
          if ( $sec =~ m/(1)([0-9]st|[0-9]nd|[0-9]rd)/i && $dataok );
        pwarn( qq{section "$sec" has invalid rank number "$1$2"} )
          if ( $sec =~ m/([2-9])([2-9]st|[13-9]nd|[123]th)/i && $dataok );
        pwarn( qq{section "$sec" has an invalid character after "$1"} )
          if ( $sec =~ m/(1st|2nd|3rd|[4-9]th)[^ ]/i && $dataok );
        pwarn( qq{section "$sec" needs a comma after "row"} )
          if ( $sec =~ m/[0-9]+.. row [0-9]+.. grave/i && $dataok );
        pwarn( qq{section "$sec" needs "Ith row, Jth grave" format} )
          if ( $sec =~ m/row.*grave$/i
            && $sec !~ m/[0-9].. row, [0-9]+..( 1\/2)? grave/ && $dataok );
        pwarn( qq{section "$sec" contains "$1" - misspelled "grave"?} )
          if ( $sec =~ m/\d\w\w (gr(?!ave)(?![. ])...\w*)/i && $dataok );
        $sortsec = uc( $sec );
        $sortsec =~ s/\(.*\)//g;           # Remove sec comments for sorting
        $sortsec = ""                      # Sort on name by erasing section
          unless ( $sortblk || $sortlot ); #   if no block or lot

        ### Validate note (free form)
        #
        pwarn( qq{note contains "$1" - misspelled "grave"?} )
          if ( $note =~ m/same (gr(?!ave)...\w*)/i && $dataok );
        pwarn( qq{note contains "$1" - misspelled "casket"?} )
          if ( $note =~ m/same (ca(?!sket)....\w*)/i && $dataok );

        ### Massage block/lot/section to sort into block groups
        #   Memorial Gardens sections start with one of the three area names
        #
        pwarn( qq{section "$sec" has possible misspelled "Christus"} )
          if ( $sec =~ m/^Chr/i && $sec !~ m/^Christus/ && $dataok );
        pwarn( qq{section "$sec" has possible misspelled "Devotion"} )
          if ( $sec =~ m/^Dev/i && $sec !~ m/^Devotion/ && $dataok );
        pwarn( qq{section "$sec" has possible misspelled "Paradise"} )
          if ( $sec =~ m/^Par/i && $sec !~ m/^Paradise/ && $dataok );
        if ( $sec =~ m/(.*)(Christus|Devotion|Paradise)( *)(.*)/ ) {
            $countmg++;                    # Process Memorial Gardens entry
            pwarn( qq{MG sec "$sec" has unwanted text in front} )
                if ( $1 && $dataok );
            pwarn( qq{MG sec "$sec" needs a space after "$2"} )
                if ( $4 ne "" && $3 eq "" && $dataok );
            $mg = $2;
            $sec = $4;
            if ( $mg eq "Paradise" ) { # Old: block=lot#  lot=N|S 1/2  sec=XXC
                pwarn( qq{block "$blk" in $mg is not numeric} )
                    if ( $sortblk ne "000" && $blk !~ m/^\d+$/ && $dataok );
                pwarn( qq{lot "$lot" in $mg is not [NS] 1/2} )
                    if ( $lot ne "All" and $lot !~ m|^[NS] 1/2$| && $dataok );
                $sec = "$sec $lot";        # Move lot (N|S 1/2) to section
                $sortsec = uc( $sec );
                $sortsec =~ s/\(.*\)//g;   # Remove sec comments for sorting
                $lot = $blk;               # Move block (lot#) to lot
                $sortlot = $sortblk;
            } else {  # Christus or Devotion Old: block=plot#  lot=lot sec=sec
                pwarn( qq{block "$blk" in $mg is not 1-4 or Babyland} )
                    if ( $blk !~ m/^[1-4]|babyland$/i && $dataok );
                pwarn( qq{lot "$lot" in $mg is not [1-###]-[A-D]} )
                    if ( $lot ne "196" && $lot !~ m/^\d{1,3}\-[ABCD]$/ && $dataok );
                $sec = " $sec" if ( $sec ne "" );
                $sec = "$blk $sec";        # Move block (plot#) to section
                $sortsec = uc( $sec );
                $sortsec =~ s/\(.*\)//g;   # Remove sec comments for sorting
            }
            $blk = $mg;                    # Move MG name to block
            $sortblk = "$mg";
            $blk_ttl = "MG: $mg";
        } else {
            $countec++;                    # Process Evergreen Cemetery entry
            pwarn( qq{block "$blk" is not 1-48} ), $sortblk = "000"
                if ( $sortblk ne "000" && ( $blk < 1 || $blk > 48 ) && $dataok );
            if ( $sec =~ m|([SN][EW]C [SN])([o.]+\S*) *[13]/|i ) {
                $corner = $1;
                pwarn( qq{section "$sec" should use "$1", not "$1$2")} );
            }
            if ( $sec =~ m|([SN][EW]C [SN])[^EWo.]|i ) {
                $corner = $1;
                pwarn( qq{section "$sec" should have "1/2" after "$corner"} )
                    if ( $sec !~ m|[SN][EW]C [SN] *1/2|i 
                      && $sec !~ m|[SN][EW]C [SN] *3/4|i )
            }
            if ( $sec =~ m|([SN][EW]C [SN][EW])|i ) {
                $corner = $1;
                pwarn( qq{section "$sec" should have "1/4" after "$corner"} )
                    if ( $sec !~ m|[SN][EW]C [SN][EW] *1/4|i )
            }
            ### Disabled - Evergreen lots can have letters, too.
            # pwarn( qq{lot "$lot" has ###-[A-Z] but sec "$sec" not in MG} )
            #     if ( $lot =~ m/\d+-[A-Z]/ && $dataok );
        }

        ### Enforce two-digit ranked numbers for sorting (e.g. 1st, 9th)
        $sortsec =~ s/(^|\D)(1st|2nd|3rd|4th|5th|6th|7th|8th|9th)/${1}0$2/ig;
        ### Enforce space between number and 'ft'
        $sortsec =~ s/(\d)(ft)/$1 $2/ig;
        ### Enforce space between [NSEW] and "1/2", etc.
        $sortsec =~ s|([NSEW])1/|$1 1/|ig;
        ### Remove somewhat optional "fr." string
        $sortsec =~ s| fr\. | |ig;
        ### Remove somewhat optional "Frac." string
        $sortsec =~ s|^Frac. ||i;
        $sortsec =~ s| Frac.||i;
        ### Adjust section descriptions so they sort consistently going by
        #     which fraction of lot, which corner, then additional details
        #     by flipping certain patterns so they sort properly
        ###
        #   Flip SEC N 1/2       to  ESC N 1/2       (also handle NE 1/4)
        #     swap corner orientations (NS with EW) so adjacent side-by-side
        #     graves sort together (NEC & SEC and NWC & SWC are side-by-side)
        $sortsec =~ s/([NS])([EW])(C +[NSEW]+ +1\/\d)/$2$1$3/;
        #   Flip 5ft. NEC        to  NEC 5ft.   (unless Row X Grave Y NEC)
        $sortsec =~ s/^(.+?) *([NSEW][NSEW]C)/$2 $1/
          unless ( $sortsec =~ m/row.*grave/i );
        #   Flip SEC N 1/2       to  N 1/2 SEC       (also handle NE 1/4)
#       # & Flip 5ft. SWC N 1/2  to  N 1/2 SWC 5ft.  (also handle NE 1/4)
        # & Flip SWC 5ft. N 1/2  to  N 1/2 SWC 5ft.  (also handle NE 1/4)
        # & Flip Center N 1/2    to  N 1/2 Center    (also handle NE 1/4)
#       $sortsec =~ s/^(.*?)([NSEW][NSEW]C +|CENTER +)([NSEW]+ +1\/\d)/$3 $2$1/;
        $sortsec =~ s/^(.*?)([NSEW][NSEW]C +.*?|CENTER +)([NSEW]+ +1\/\d)/$3 $2$1/;
        ### Eliminate punctuation
        $sortsec =~ s|[\.\,\-]||g;
        ### Eliminate dupe spaces
        $sortsec =~ s|  +| |g;

        $fname   = lc( "${pfxnames}$match.html" );
        $hrefsur = qq{href="$fname#$idx"};
        $fname   = lc( "${pfxblock}$sortblk.html" );
        $hreflot = $sortblk eq "000" ? "" : "#$sortlot";
        $hrefblk = qq{href="$fname$hreflot"};

        ### Sort into surname bin
        #
        $Sect{$match} = []
          unless exists( $Sect{$match} );
        push( @{$Sect{$match}}, join( "\n",
          "$sortname\t$sortblk\t$sortlot\t$sortsec", $hrefblk,
          $idx, $dataok, $ddate, $name, $age, $sec, $lot, $blk, $note ) );

        ### Sort into block number bin
        #
        $Block{$sortblk} = [], $Blockttl{$sortblk} = $blk_ttl
          unless exists( $Block{$sortblk} );
        push( @{$Block{$sortblk}}, join( "\n",
          "$sortblk\t$sortlot\t$sortsec\t$sortname", $hrefsur, $sortlot,
          $idx, $dataok, $ddate, $name, $age, $sec, $lot, $blk, $note ) );

        ### Check for duplicates and issue warnings
        #   Warn even if $dataok is not set
        #   Avoid multiple warnings for an entry (might be redundant)
        #
        $tempy = ( $ddate =~ m/-(\d\d\d\d)$/ ) ? $1 + 0 : "";
        $testy = $yeartst;
        $yisok = $tempy && $tempy >= $testy;
        $tempage = $age || "?";                    # many "?" are babies, so
        $tempage = "?" if ( $age eq "-0-" );       # make all preemies "?"
        $tempage = "?" if ( lc($age) eq "infant" or lc($age) eq "premature" );
        $tempage = "?" if ( $age =~ m/hr/ );       # and near-stillbirths "?"
        @previous = ();
        #
        ### Warn about same date and name
        #
        $tempn = $sortname;
        $tempn =~ s/[aeiou]+/_/g;                  # replace vowel strings w/_
        $token = lc( "$ddate $tempn" );
#       if ( $ddate ) {                            # skip if ddate missing
        if ( $ddate                                # skip if ddate missing
          && $name !~ m/ or / ) {                  # skip if " or " in name
            $match = $hashdn{$token} || "";
            $hashdn{$token} = $idx unless ( $match );
            if ( $match && ! grep( /^$match$/, @previous ) ) {
                $listdn .= sprintf( "/%s\n\\%s\n", @DataRows[$match,$idx] );
                push( @previous, $match ) if ( $match );
            }
        }
        #
        ### Warn about same year, block, lot, name
        #
        $tempn = $sortname;
        $tempn =~ s/[aeiou]+/_/g;                  # replace vowel strings w/_
        $token = lc( "$tempy $blk $sortlot $tempn" );
#       $token = lc( "$tempy $blk $sortlot $sortname" );
#       if ( $tempy                                # skip if ddate unknown
#         && $sortsec !~ m|^[NS] 1/2$|             # skip if 1/2 but no corner
#       if ( $tempy ) {                            # skip if ddate unknown
        if ( $tempy                                # skip if ddate unknown
          && $name !~ m/ or / ) {                  # skip if name alternatives
            $match = $hashybln{$token} || "";
            $hashybln{$token} = $idx unless ( $match );
            if ( $match && ! grep( /^$match$/, @previous )
              && ! ( $match ==  1713 && $idx ==  1717 ) # skip bogus match
              && ! ( $match == 20142 && $idx == 20143 ) # skip bogus match
# Haaker      && ! ( $match ==  1364 && $idx == 20350 ) # skip bogus match
                                             ## ^^^^^   # sorted on idx value
              ) {
                $listybln .= sprintf( "/%s\n\\%s\n", @DataRows[$match,$idx] );
                push( @previous, $match ) if ( $match );
            }
        }
        #
        ### Warn about same year, block, section, name
        #
        $tempn = $sortname;
        $tempn =~ s/[aeiou]+/_/g;                  # replace vowel strings w/_
        $token = lc( "$tempy $blk $sortlot $tempn" );
#       $token = lc( "$tempy $blk $sortsec $sortname" );
#       if ( $tempy                                # skip if ddate unknown
#         && $sortsec !~ m|^[NS] 1/2$|             # skip if 1/2 but no corner
#       if ( $tempy ) {                            # skip if ddate unknown
        if ( $tempy                                # skip if ddate unknown
          && $name !~ m/ or / ) {                  # skip if name alternatives
            $match = $hashybsn{$token} || "";
            $hashybsn{$token} = $idx unless ( $match );
            if ( $match && ! grep( /^$match$/, @previous )
              && ! ( $match ==  1713 && $idx ==  1717 ) # skip bogus match
              && ! ( $match == 20142 && $idx == 20143 ) # skip bogus match
                                             ## ^^^^^   # sorted on idx value
              ) {
                $listybsn .= sprintf( "/%s\n\\%s\n", @DataRows[$match,$idx] );
                push( @previous, $match ) if ( $match );
            }
        }
        #
        ### Warn about same year, block, lot and section if Chr|Dev|40-49
        #
        $token = lc( "$tempy $blk $lot $sortsec" );
        if ( $tempy                                # skip if ddate unknown
          && $blk =~ m/Christus|Devotion|4./       # skip if not Chr|Dev|4n
          && $note !~ m/same (grave|casket|person)/i ) { # skip if dual burial
            $match = $hashybls{$token} || "";
            $hashybls{$token} = $idx unless ( $match );
            if ( $match && ! grep( /^$match$/, @previous ) ) {
                $listybls .= sprintf( "/%s\n\\%s\n", @DataRows[$match,$idx] );
                push( @previous, $match ) if ( $match );
            }
        }
        #
        ### Warn about same date, age, block, lot and section
        #
        $token = lc( "$ddate $age $blk $lot $sortsec" );
        if ( $tempy                                # skip if ddate unknown
#       if ( $ddate                                # skip if ddate missing
          && $blk                                  # skip if xfer out, etc.
#         && $sortsec                              # skip if section unknown
          && $note !~ m/same (grave|casket|person)/i ) { # skip if dual burial
            $match = $hashdabls{$token} || "";
            $hashdabls{$token} = $idx unless ( $match );
            ### Special check for intentionally duplicated entries with
            #     "Lastname1 or Lastname2, Firstname" and vice-versa
            $tempn = $match ? $DataRows[$match] : "";
            $tempn =~ s/.*\|//;                    # leave only the name
            if ( $tempn =~ s/([^,]+) or ([^,]+),/$2 or $1,/  # A or B -> B or A
              && $tempn eq $name ) {               # if swapped names match
                next;                              #   alternate names OK
            }
            ### Special check for intentionally duplicated entries with
            #     "Last1, First1 or Last2, First2" and vice-versa
            $tempn = $match ? $DataRows[$match] : "";
            $tempn =~ s/.*\|//;                    # leave only the name field
# print( "name='$name' tempn='$tempn'\n" ) if ( $idx == 12268 or $idx == 16907 );
# $tempn =~ s/infant/Infant/ if ( $idx == 16907 );
            if ( $tempn =~ s/(.+,.+) or (.+,.+)/$2 or $1/  # A or B -> B or A
              && $tempn eq $name ) {               # if swapped names match
                next;                              #   alternate names OK
            }
            if ( $match && ! grep( /^$match$/, @previous ) ) {
                $listdabls .= sprintf( "/%s\n\\%s\n", @DataRows[$match,$idx] )
                  # check here so match is added to previous and skipped later
                  if( ! ( $match == 12467 && $idx == 12468 )
                   && ! ( $match == 19167 && $idx == 19168 ) );
                                                  ## ^^^^^   # sorted on idx value
                push( @previous, $match );
                next;                              # other tests are subsets
            }
        }
        #
        ### Warn about same age, block, lot and section (after cutoff year)
        #
        $token = lc( "$tempage $blk $lot $sortsec" ); # use all-babies tempage
        if ( $tempy && $yisok                      # skip if ddate unknown
          && $blk                                  # skip if xfer out, etc.
#         && $sortsec                              # skip if section unknown
          && $sortsec !~ m|^[NS] 1/2$|             # skip if 1/2 but no corner
#         && $age ne "" && $age ne "?"             # skip if age unknown
          && $note !~ m/same (grave|casket|person)/i ) { # skip if dual burial
            $match = $hashabls{$token} || "";
            $hashabls{$token} = $idx unless ( $match );
            if ( $match && ! grep( /^$match$/, @previous )
              && ! ( $match ==   313 && $idx ==   340 ) # skip bogus match
              && ! ( $match ==   727 && $idx ==  1253 ) # skip bogus match
              && ! ( $match ==   408 && $idx ==  1736 ) # skip bogus match
              && ! ( $match ==   141 && $idx ==  2575 ) # skip bogus match
              && ! ( $match ==   350 && $idx ==  3107 ) # skip bogus match
              && ! ( $match ==  5493 && $idx ==  5552 ) # skip bogus match
              && ! ( $match ==  2722 && $idx ==  5896 ) # skip bogus match
              && ! ( $match ==   677 && $idx ==  7327 ) # skip bogus match
              && ! ( $match == 10964 && $idx == 10969 ) # skip bogus match
              && ! ( $match ==  1910 && $idx == 12248 ) # skip bogus match
              && ! ( $match == 12212 && $idx == 12258 ) # skip bogus match
              && ! ( $match == 12360 && $idx == 12370 ) # skip bogus match
              && ! ( $match == 12425 && $idx == 12426 ) # skip bogus match
              && ! ( $match == 12467 && $idx == 12468 ) # skip bogus match
              && ! ( $match == 12245 && $idx == 12557 ) # skip bogus match
              && ! ( $match == 12773 && $idx == 12774 ) # skip bogus match
              && ! ( $match == 12896 && $idx == 13383 ) # skip bogus match
              && ! ( $match == 12760 && $idx == 13385 ) # skip bogus match
              && ! ( $match == 12783 && $idx == 16923 ) # skip bogus match
              && ! ( $match == 12419 && $idx == 16960 ) # skip bogus match
              && ! ( $match ==   824 && $idx == 19192 ) # skip bogus match
              && ! ( $match == 12570 && $idx == 20338 ) # skip bogus match
                                             ## ^^^^^   # sorted on idx value
              ) {
                $listabls .= sprintf( "/%s\n\\%s\n", @DataRows[$match,$idx] );
                push( @previous, $match ) if ( $match );
            }
        }
        #
        ### Warn about same date, block, lot and section (after cutoff year)
        #
        $token = lc( "$ddate $blk $lot $sortsec" );
        if ( $tempy && $yisok                      # skip if ddate unknown
          && $blk                                  # skip if xfer out, etc.
#         && $sortsec                              # skip if section unknown
#         && $sortsec !~ m|^[NS] 1/2$|             # skip if 1/2 but no corner
          && $note !~ m/same (grave|casket|person)/i ) { # skip if dual burial
            $match = $hashdbls{$token} || "";
            $hashdbls{$token} = $idx unless ( $match );
            if ( $match && ! grep( /^$match$/, @previous )
              && ! ( $match ==  3101 && $idx ==  3171 ) # skip bogus match
              && ! ( $match == 17069 && $idx == 17071 ) # skip bogus match
              && ! ( $match ==  3101 && $idx == 19841 ) # skip bogus match
                                             ## ^^^^^   # sorted on idx value
              ) {
                $listdbls .= sprintf( "/%s\n\\%s\n", @DataRows[$match,$idx] );
                push( @previous, $match ) if ( $match );
            }
        }
        #
        ### Warn about same date, age, lot and section (after cutoff year)
        #
        $token = lc( "$ddate $tempage $lot $sortsec" ); # use all-babies tempage
        if ( $tempy && $yisok                      # skip if ddate unknown
          && $blk                                  # skip if xfer out, etc.
#         && $sortsec                              # skip if section unknown
#         && $sortsec !~ m|^[NS] 1/2$|             # skip if 1/2 but no corner
#         && $age ne "" && $age ne "?"             # skip if age unknown
#         && $age ne "-0-"                         # skip if stillborn
          && $note !~ m/same (grave|casket|person)/i ) { # skip if dual burial
            $match = $hashdals{$token} || "";
            $hashdals{$token} = $idx unless ( $match );
            if ( $match && ! grep( /^$match$/, @previous ) ) {
                $listdals .= sprintf( "/%s\n\\%s\n", @DataRows[$match,$idx] );
                push( @previous, $match ) if ( $match );
            }
        }
        #
        ### Warn about same date, age, block and section (after cutoff year)
        #
        $token = lc( "$ddate $tempage $blk $sortsec" ); # use all-babies tempage
        if ( $tempy && $yisok                      # skip if ddate unknown
          && $blk                                  # skip if xfer out, etc.
#         && $age ne "" && $age ne "?"             # skip if age unknown
#         && $age ne "-0-"                         # skip if stillborn
          && $note !~ m/same (grave|casket|person)/i ) { # skip if dual burial
            $match = $hashdabs{$token} || "";
            $hashdabs{$token} = $idx unless ( $match );
            if ( $match && ! grep( /^$match$/, @previous ) ) {
                $listdabs .= sprintf( "/%s\n\\%s\n", @DataRows[$match,$idx] );
                push( @previous, $match ) if ( $match );
            }
        }
        #
        ### Warn about same date, age, block and lot (after cutoff year)
        #
#       $token = lc( "$ddate $tempage $blk $lot" ); # use all-babies tempage
        $tdate = $ddate;
        $tdate =~ s|-\d\d\d\d$|-0000|;
        $fc = substr( $name, 0, 1 );
        $token = lc( "$fc $tdate $tempage $blk $lot" ); # use all-babies tempage
        if ( $tempy && $yisok                      # skip if ddate unknown
          && $blk                                  # skip if xfer out, etc.
#         && $age ne "" && $age ne "?"             # skip if age unknown
#         && $age ne "-0-"                         # skip if stillborn
          && $note !~ m/same (grave|casket|person)/i ) { # skip if dual burial
            $match = $hashdabl{$token} || "";
            $hashdabl{$token} = $idx unless ( $match );
            if ( $match && ! grep( /^$match$/, @previous ) 
#             && ! ( $match ==  && $idx ==  ) # skip bogus match
              && ! ( $match ==  4575 && $idx ==  6428 ) # skip bogus match
              && ! ( $match ==  6043 && $idx ==  9609 ) # skip bogus match
              && ! ( $match == 12086 && $idx == 12090 ) # skip bogus match
              && ! ( $match == 12271 && $idx == 12274 ) # skip bogus match
              && ! ( $match == 12987 && $idx == 12992 ) # skip bogus match
              && ! ( $match == 13479 && $idx == 13480 ) # skip bogus match
              && ! ( $match == 13726 && $idx == 13739 ) # skip bogus match
              && ! ( $match == 13221 && $idx == 13751 ) # skip bogus match
              && ! ( $match == 13762 && $idx == 13768 ) # skip bogus match
              && ! ( $match == 13879 && $idx == 13880 ) # skip bogus match
              && ! ( $match == 16125 && $idx == 16173 ) # skip bogus match
              && ! ( $match == 11737 && $idx == 17044 ) # skip bogus match
              && ! ( $match == 12160 && $idx == 17075 ) # skip bogus match
                                             ## ^^^^^   # sorted on idx value
              ) {
                $listdabl .= sprintf( "/%s\n\\%s\n", @DataRows[$match,$idx] );
                push( @previous, $match ) if ( $match );
            }
        }
        #
        ### Warn about same block, lot and section (after cutoff year)
        #
        $token = lc( "$blk $lot $sortsec" );
        if ( $tempy && $yisok                      # skip if ddate unknown
          && $blk                                  # skip if xfer out, etc.
#         && $sortsec                              # skip if section unknown
          && $sortsec !~ m|^[NS] 1/2$|             # skip if 1/2 but no corner
          && $note !~ m/same (grave|casket|person)/i ) { # skip if dual burial
            $match = $hashbls{$token} || "";
            $hashbls{$token} = $idx unless ( $match );
            if ( $match && ! grep( /^$match$/, @previous ) ) {
#               pwarn( qq{has same block, lot and sec as #$match} );
#               $listbls .= sprintf( "/%s\n\\%s\n", @DataRows[$match,$idx] );
#               push( @previous, $match ) if ( $match );
            }
        }
    }

    print( "\n" );
    print( " ==== In the sections that follow are pairs of entries.\n" );
    print( " ==== For each entry, the index number, date, age, block, lot,\n" );
    print( " ==== section and name are shown delimited by vertical bars (|).\n" );
    psame( "date and name",                     $listdn    );
    psame( "year, block, lot and name",         $listybln  );
    psame( "year, block, section and name",     $listybsn  );
    psame( "year, block, lot and section",      $listybls  );
    psame( "date, age, block, lot and section", $listdabls );
    psame( "age, block, lot and section",       $listabls  );
    psame( "date, block, lot and section",      $listdbls  );
    psame( "date, age, lot and section",        $listdals  );
    psame( "date, age, block and section",      $listdabs  );
    psame( "date, age, block and lot",          $listdabl  );
#   psame( "block, lot and section",            $listbls   );

    if ( $DRY_RUN ) {
        warn( "DRY RUN specified - no files written.\n" );
        exit(0);
    }

    ### Create surname index choice list
    #
    $indexes = "";
    foreach $s ( @Surgroups ) {
        printf( "Surname group %-5s has %4d entries\n",
          $s, scalar( @{$Sect{$s}} ) ) if ( $DEBUG );
        $fname = lc( "${pfxnames}$s.html" );
        $title = $s;
        $title =~ s/ /\&nbsp;/g;
        $indexes .= qq{<a href="$fname">$title</a>|\n};
    }
    $indexes =~ s/\|\n$//s;
    $indexes =~ s/\|/&nbsp;&nbsp;\|&nbsp;/sg;
    $indexes = "<tr valign=top>\n"
      . "<td align=center nowrap>"
      . "<b>Grouped<br>"
      . "By<br><u>Surname</u></b><br></td>\n"
      . "<td>&nbsp;&nbsp;</td>"
      . "<td>$indexes</td></tr>";
#   $ind_tbl = "<table cellspacing=0 cellpadding=0 border=0>\n"
#            . "$indexes\n</table>\n";

    ### Create burial location choice list
    #
    $blidxes = "";
    foreach $s ( sort( keys( %Block ) ) ) {
        printf( "Block %-5s has %4d entries\n",
          $s, scalar( @{$Block{$s}} ) ) if ( $DEBUG );
        $fname = lc( "${pfxblock}$s.html" );
        $title = $Blockttl{$s};
        $title =~ s/ /\&nbsp;/g;
        $blidxes .= qq{<a href="$fname">$title</a>|\n};
    }
    $blidxes =~ s/\|\n$//s;
    $blidxes =~ s/\|/&nbsp;&nbsp;\|&nbsp;/sg;
    $blidxes = "<tr valign=top>\n"
      . "<td align=center nowrap>"
      . "<b>Grouped<br>"
      . "By<br><u>Block</u></b><br></td>\n"
      . "<td>&nbsp;&nbsp;</td>"
      . "<td>$blidxes</td></tr>";
#   $bli_tbl = "<table cellspacing=0 cellpadding=0 border=0>\n"
#            . "$blidxes\n</table>\n";

    ### Create statistics summary
    #
    $countec =~ s/(\d\d\d)$/,$1/;
    $countmg =~ s/(\d\d\d)$/,$1/;
    $datebeg =~ s/(\d\d\d\d)-(\d\d)-(\d\d)/$2-$3-$1/;
    $dateend =~ s/(\d\d\d\d)-(\d\d)-(\d\d)/$2-$3-$1/;
    $summary = <<"END";
<table border=0 align=center>
<tr>
 <td align=right><big><b>Evergreen Cemetery Burials</b></big><br>
 <td align=right><big><b>:&nbsp;</b></big><br>
 <td align=right><big><b>$countec</b></big><br>
 <td align=right><big><b>&nbsp; &nbsp; &nbsp; &nbsp;</b></big><br>
 <td align=right><big><b>Earliest Death Date :&nbsp; $datebeg</b></big><br>
<tr>
 <td align=right><big><b>  Memorial Gardens Burials</b></big><br>
 <td align=right><big><b>:&nbsp;</b></big><br>
 <td align=right><big><b>$countmg</b></big><br>
 <td align=right><big><b>&nbsp; &nbsp; &nbsp; &nbsp;</b></big><br>
 <td align=right><big><b>  Latest Death Date :&nbsp; $dateend</b></big><br>
</table>
END

    ### Create surname index pages
    #
    #  H: Directory of the Dead: Surname X-Z
    #  T: Evergreen Cemetery Association - Burials of Persons with Surnames X-Z
    #  D: Evergreen Cemetery Association Directory of the Dead
    #     for burials of persons with surnames beginning with X-Z
    #     in Evergreen and Memorial Gardens cemeteries, Brainerd, Minnesota.

    foreach $s ( @Surgroups ) {
        $fname = lc( "${pfxnames}$s.html" );
        open( OUT, ">$fname" ) || die "$fname: $!\n";
        print( "Writing $fname...\n" ) if ( $DEBUG );
        $cname = "Evergreen and Memorial Gardens cemeteries";
        $headr = "$titledod: Surnames $s";
        $title = "$titleeca - Burials of Persons with Surnames $s";
        $descr = "    $titleeca $titledod\n"
               . "    for burials of persons with surnames beginning with $s\n"
               . "    in $cname, Brainerd, Minnesota.";
        pout( htmlstart( $title, $descr ) );
        pout( "<h2 align=center>$headr</h2>\n" );
        pout( "$summary\n" );
        pout( "<table cellspacing=0 cellpadding=0 border=0>\n" );
        pout( "<tr><td colspan=3><small>&nbsp;</small></td>\n" );
        pout( "$indexes\n" );
        pout( "<tr><td colspan=3><small>&nbsp;</small></td>\n" );
        pout( "$blidxes\n" );
        pout( "<tr><td colspan=3><small>&nbsp;</small></td>\n" );
        pout( "<tr><td></td><td></td><td>$indxnote</td>\n" );
        pout( "<tr><td colspan=3><small>&nbsp;</small></td>\n" );
        pout( "</table>\n" );
        pout( "\n$hor_rule\n" );
        pout( "<dl><dd>\n" );
        pout( "<table cellpadding=0 cellspacing=0 border=0>\n" );
        pout( "<tr valign=top>\n" );
        pout( "  <td><b><u>Name&nbsp;of&nbsp;Person</u></b>\n" );
        pout( "  <td rowspan=9999>&nbsp;&nbsp;&nbsp;</td>\n" );
        pout( "  <td><b><u>Death&nbsp;Date</u></b>\n" );
        pout( "  <td rowspan=9999>&nbsp;&nbsp;&nbsp;</td>\n" );
        pout( "  <td><b><u>Age</u></b>\n" );
        pout( "  <td rowspan=9999>&nbsp;&nbsp;&nbsp;</td>\n" );
        pout( "  <td><b><u>Block</u></b>\n" );
        pout( "  <td rowspan=9999>&nbsp;&nbsp;&nbsp;</td>\n" );
        pout( "  <td><b><u>Lot</u></b>\n" );
        pout( "  <td rowspan=9999>&nbsp;&nbsp;&nbsp;</td>\n" );
        pout( "  <td><b><u>Section/Plot</u></b>\n" );
        foreach $item ( sort( @{$Sect{$s}} ) ) {
           ( undef, $hrefblk,
             $idx, $dataok, $ddate, $name, $age, $sec, $lot, $blk, $note ) = 
             split( /\n/, $item, 11 );
           $name =~ s|([^ ])\(|$1 \(|g;   # Ensure space before paren
           $name =~ s| +|&nbsp;|g;        # Make spaces non-breaking
           $name =~ s|&nbsp;\(| \(|g;     #   except before open paren
           $name =~ s|\)&nbsp;|\) |g;     #   except after close paren
           $name =~                       #   except after two-name 'or'
                    s|(.+,.+&nbsp;or)&nbsp;(.+,.+)|$1 $2|;
           $age  =~ s| +|&nbsp;|g;        # Make spaces non-breaking
           $age  =~ s|\.&nbsp;|\. |g;     #   except after period
           $sec  = "Note: $note" if ( $note && ! $sec );
           $lot  = "None" if ( ! $lot && $hrefblk =~ m|000| ); # If blk unknown
           $lot  = "<a $hrefblk>$lot</a>" if ( $lot && $hrefblk );
           # Use nowrap to prevent MSIE from wrapping on "-"
           $loc  = "<td>$blk<td nowrap>$lot<td>$sec";
           $fam  = exists( $famatch{$idx} ) ? qq{&nbsp;<a target="_blank"\n}
                 . qq{  href="http://www.findagrave.com/cgi-bin/}
                 . qq{fg.cgi?page=gr&amp;GRid=$famatch{$idx}"><img align=top\n}
                 . qq{  src="findagravelink.png" width=18 height=16 alt=""\n}
                 . qq{  title="Memorial at Find-A-Grave" border=0></a>} : "";
           pout( "<tr valign=top>\n" );
           pout( "  <td><a name=$idx>$name</a>$fam\n" );
           pout( "  <td nowrap>$ddate<td>$age$loc\n" );
        }
        pout( "</table>\n" );
        pout( "</dl>\n" );
        pout( htmlfinish( $fname ) );
    }

    ### Create Burial Block Number index pages with lot groupings
    #
    #   H: Directory of the Dead: Evergreen Block NN
    #   T: Ev. Cem. Ass'n - Burials in Block NN in Evergreen Cemetery
    #   D: Evergreen Cemetery Association Directory of the Dead
    #        for burials in Block 44
    #        in Evergreen Cemetery, Brainerd, Minnesota.
    #
    #   H: Directory of the Dead: Evergreen No Block Number
    #   T: Ev. Cem. Ass'n - Burials with No Block Number in Evergreen Cemetery
    #   D: Evergreen Cemetery Association Directory of the Dead
    #        for burials with No Block Number
    #        in Evergreen Cemetery, Brainerd, Minnesota.
    #
    #   H: Directory of the Dead: Memorial Gardens Christus
    #   T: Ev. Cem. Ass'n - Burials in the Christus section in Memorial Gardens
    #   D: Evergreen Cemetery Association Directory of the Dead
    #        for burials in the Christus section
    #        in Memorial Gardens Cemetery, Brainerd, Minnesota.
    #
    foreach $s ( sort( keys( %Block ) ) ) {
        $fname = lc( "${pfxblock}$s.html" );
        open( OUT, ">$fname" ) || die "$fname: $!\n";
        print( "Writing $fname...\n" ) if ( $DEBUG );
        $block = "$Blockttl{$s}";     # number, "None", or "MG: {section}"
        $block = "Block $block" if ( $block =~ m|^\d+$| );
        $block = "No Block Number" if ( $block eq "None" );
        $cname = ( $block =~ s/MG: // ) ? "Memorial Gardens" : "Evergreen";
        $headr = "$titledod: $cname $block";
        $block = "in $block" if ( $block =~ m|^Block| );
        $block = "with $block" if ( $block =~ m|^No Block| );
        $block = "in the $block section" if ( $cname =~ m|^Memorial| );
        $cname = "$cname Cemetery";
        $title = "$titleeca - Burials $block in $cname";
        $descr = "    $titleeca $titledod\n"
               . "    for burials in $block\n"
               . "    in $cname, Brainerd, Minnesota.";
        pout( htmlstart( $title, $descr ) );
        pout( "<h2 align=center>$headr</h2>\n" );
        pout( "$summary\n" );
        pout( "<table cellspacing=0 cellpadding=0 border=0>\n" );
        pout( "<tr><td colspan=3><small>&nbsp;</small></td>\n" );
        pout( "$indexes\n" );
        pout( "<tr><td colspan=3><small>&nbsp;</small></td>\n" );
        pout( "$blidxes\n" );
        pout( "<tr><td colspan=3><small>&nbsp;</small></td>\n" );
        pout( "<tr><td></td><td></td><td>$indxnote</td>\n" );
        pout( "<tr><td colspan=3><small>&nbsp;</small></td>\n" );
        pout( "</table>\n" );
        pout( "\n$hor_rule\n" );
        pout( "<dl><dd>\n" );
        pout( "<table cellpadding=0 cellspacing=0 border=0>\n" );
        pout( "<tr valign=top>\n" );
        pout( "  <td><b><u>Name&nbsp;of&nbsp;Person</u></b>\n" );
        pout( "  <td rowspan=9999>&nbsp;&nbsp;&nbsp;</td>\n" );
        pout( "  <td><b><u>Death&nbsp;Date</u></b>\n" );
        pout( "  <td rowspan=9999>&nbsp;&nbsp;&nbsp;</td>\n" );
        pout( "  <td><b><u>Age</u></b>\n" );
        pout( "  <td rowspan=9999>&nbsp;&nbsp;&nbsp;</td>\n" );
        pout( "  <td><b><u>Block</u></b>\n" );
        pout( "  <td rowspan=9999>&nbsp;&nbsp;&nbsp;</td>\n" );
        pout( "  <td><b><u>Lot</u></b>\n" );
        pout( "  <td rowspan=9999>&nbsp;&nbsp;&nbsp;</td>\n" );
        pout( "  <td><b><u>Section/Plot</u></b>\n" );
        $prevlot = "";
        foreach $item ( sort( @{$Block{$s}} ) ) {
           ( undef, $hrefsur, $sortlot,
             $idx, $dataok, $ddate, $name, $age, $sec, $lot, $blk, $note ) = 
             split( /\n/, $item, 12 );
           $name =~ s|([^ ])\(|$1 \(|g;   # Ensure space before paren
           $name =~ s| +|&nbsp;|g;        # Make spaces non-breaking
           $name =~ s|&nbsp;\(| \(|g;     #   except before open paren
           $name =~ s|\)&nbsp;|\) |g;     #      and after close paren
           $name =~                       #   and after two-name 'or'
                    s|(.+,.+&nbsp;or)&nbsp;(.+,.+)|$1 $2|;
           $age  =~ s| +|&nbsp;|g;        # Make spaces non-breaking
           $age  =~ s|\.&nbsp;|\. |g;     #   except after period
           $sec  = "Note: $note" if ( $note && ! $sec );
           # Use nowrap to prevent MSIE from wrapping on "-"
           $loc  = "<td>$blk<td nowrap>$lot<td>$sec";
           $hrefsur = qq{name="$sortlot" $hrefsur}, $prevlot = $sortlot
             if ( $prevlot ne $sortlot );
           $fam  = exists( $famatch{$idx} ) ? qq{&nbsp;<a target="_blank"\n}
                 . qq{  href="http://www.findagrave.com/cgi-bin/}
                 . qq{fg.cgi?page=gr&amp;GRid=$famatch{$idx}"><img align=top\n}
                 . qq{  src="findagravelink.png" width=18 height=16 alt=""\n}
                 . qq{  title="Memorial at Find-A-Grave" border=0></a>} : "";
           pout( "<tr valign=top>\n" );
           pout( "  <td><a $hrefsur>$name</a>$fam\n" );
           pout( "  <td nowrap>$ddate<td>$age$loc\n" );
        }
        pout( "</table>\n" );
        pout( "</dl>\n" );
        pout( htmlfinish( $fname ) );
    }

    ### Create Directory of the Dead Home Page
    #
    #   H: Evergreen Cemetery Association Directory of the Dead
    #   T: Evergreen Cemetery Association - Directory of the Dead
    #   D: Evergreen Cemetery Association Directory of the Dead
    #      for Burials
    #      in Evergreen and Memorial Gardens cemeteries, Brainerd, Minnesota.
    $fname = "$homeroot.html";
    open( OUT, ">$fname" ) || die "$fname: $!\n";
    print( "Writing $fname...\n" ) if ( $DEBUG );
    $cname = "Evergreen and Memorial Gardens cemeteries";
    $headr = "$titleeca $titledod";
    $title = "$titleeca - $titledod";
    $descr = "    $titleeca $titledod\n"
           . "    for burials\n"
           . "    in $cname, Brainerd, Minnesota.";
    pout( htmlstart( $title, $descr ) );
    pout( <<"END_OF_BODY" );
<h2 align=center>$headr</h2>
$summary
<table cellspacing=0 cellpadding=0 border=0>
<tr><td colspan=3><small>&nbsp;</small></td>
$indexes
<tr><td colspan=3><small>&nbsp;</small></td>
$blidxes
<tr><td colspan=3><small>&nbsp;</small></td>
<tr><td></td><td></td><td>$indxnote</td>
<tr><td colspan=3><small>&nbsp;</small></td>
</table>

$hor_rule

<dl><dd>

<p>
<img src="newyel.gif" alt="New!" width="31" height="12" align="top">
Added new <a href="#maps">Maps section</a>, below, explaining where
to find online cemetery block layout maps
<img src="newyel.gif" alt="New!" width="31" height="12" align="top">
</p>

<h2 align=left>Source of this data</h2>
<p>
The <i><b>Directory of the Dead</b></i> is the index of burials for
Evergreen Cemetery in northeast Brainerd and for Evergreen Memorial
Gardens Cemetery, located just north of Brainerd.  Both cemeteries are
managed by the Evergreen Cemetery Association of Brainerd, Minnesota.

<p>
The Association Secretary, Barbara Gavin, spent countless hours
entering this data into a Microsoft Access database.  She consulted
various index books and interment records to assemble an index that
is as complete and accurate as possible.  Without her efforts, this
online <i><b>Directory of the Dead</b></i> would not be possible.</p>

<h2 align=left>Data reliability</h2>
<p>
The source of data for the Association records varies.  Information
for burials before the 1930's was somewhat sparse.  But in the 1930's
the W.P.A. allocated money to local organizations to augment their
local history society activity.  One of the projects was to update
the cemetery records with information from the county records and
from newspaper obituaries.  After that, information was gathered
from the families and mortuaries and kept on file.</p>

<p>
This initial database (2008) has <b>not</b> yet been completely
double-checked.  Typos need to be found and fixed.  Entries for
the same burial were sometimes made in more than one record book and
duplicates created during data entry need to be found and merged.
The Minnesota Historical Society online searchable
<a href="http://people.mnhs.org/bci/">Birth Certificate Index</a> and 
<a href="http://people.mnhs.org/dci/">Death Certificate Index</a>
need to be checked to resolve discrepancies.
But since that whole process may take some time, this initial version,
warts and all, is being made available to the public.</p>

<p>
The data have been checked for $yeartst and later.  If you find errors
or duplications for burials in that range, please contact us (see the
link in the page footer, below).</p>

<h2 align=left>Data contained in these pages</h2>
<p>
The data are presented in six columns:</p>

<ol>
<li><b><u>Name</u></b> -
    Lastname, Firstname of person (if applicable).<br>
    <br>
    The names are sorted using only alphabetic characters and commas.
    All other characters, including spaces and periods, are ignored.<br>
    <br>
    Nicknames are given in double-quotes, like Smith, John "Smitty".
    Maiden names are in parentheses.<br>
    <br>
    <u>HYPERLINK NOTE:</u> In the "Grouped By Block" lists, the name is
    hyperlinked to its location in the appropriate "Grouped By Surname"
    page so you can see who else with that surname is buried here.<br>
    <u>Example</u>: Van Essen family burials by
    <a href="${pfxnames}u-v.html#16699">Surname</a>.<br>
    <br>
<li><b><u>Death Date</u></b> -
    The date of death of the person in MM-DD-YYYY format.<br>
    <br>
    Sometimes only the year and possibly the month is known (or is
    estimated).  In the rare case that a date of death is not known,
    the date of burial is used.  In the case of transfers into the
    cemetery, if the date of death or original burial is not known,
    the date of transfer is used.  There is nothing in this data to
    indicate that a date does not refer to the date of death.<br>
    <br>
<li><b><u>Age</u></b> -
    Age at death, if known.  Age of -0- means stillborn.<br>
    <br>
<li><b><u>Block</u></b> -
    Block number within the cemetery where interment took place.<br>
    <br>
    If the block is "Christus", "Devotion", or "Paradise", it is the
    superblock by that name in Memorial Gardens.  Otherwise it is the
    number of the block within Evergreen Cemetery.<br>
    <br>
<li><b><u>Lot</u></b> -
    Lot number within the block where interment took place.<br>
    <br>
    If there is no lot number, the record is usually from the 1800's and
    the precise location is not known.  This is especially true for the
    "Public Grounds" burials that occured in what is now block 14 before
    the Cemetery Association was formally created in 1878.<br>
    <br>
    <u>HYPERLINK NOTE:</u> In the "Grouped By Surname" list, the lot
    number is hyperlinked to the beginning of that lot section in the
    appropriate "Grouped By Block" page so you can see who else is
    buried in that lot.  Most lots were not owned entirely by the
    same family so this feature is not always useful.<br>
    <u>Example</u>: Van Essen family burials in
    <a href="${pfxblock}045.html#100">Block 45 Lot 100</a>.<br>
    <br>
<li><b><u>Plot</u></b> -
    The plot within the lot where the remains are buried.<br>
    <br>
    This field may also contain additional comments about the burial.
    If there was a transfer out, there will be no block and lot number
    and the plot info is a comment regarding the transfer.<br>
    <br>
    <table><tr valign=top align=center>
    <td>8 plot lot (two halves - North and South)<br>
    <table cellpadding=5 cellspacing=3 bgcolor="#000000" border=0>
    <tr align=center>
      <td bgcolor="#eeeeee" width=120>NWC of N&frac12;</td>
      <td bgcolor="#eeeeee" width=120>NEC of N&frac12;</td>
    <tr align=center>
      <td bgcolor="#eeeeee" width=120>SWC of N&frac12;</td>
      <td bgcolor="#eeeeee" width=120>SEC of N&frac12;</td>
    <tr align=center>
      <td bgcolor="#dddddd" width=120>NWC of S&frac12;</td>
      <td bgcolor="#dddddd" width=120>NEC of S&frac12;</td>
    <tr align=center>
      <td bgcolor="#dddddd" width=120>SWC of S&frac12;</td>
      <td bgcolor="#dddddd" width=120>SEC of S&frac12;</td>
    </table></td>
    <td>10 plot lot (4 or 5 ft. grave width)<br>
    <table cellpadding=5 cellspacing=3 bgcolor="#000000" border=0>
    <tr align=center>
      <td bgcolor="#eeeeee" width=120>NWC</td>
      <td bgcolor="#eeeeee" width=120>NEC</td>
    <tr align=center>
      <td bgcolor="#eeeeee" width=120>4 or 5 ft. NWC</td>
      <td bgcolor="#eeeeee" width=120>4 or 5 ft. NEC</td>
    <tr align=center>
      <td bgcolor="#e6e6e6" width=120>West Center</td>
      <td bgcolor="#e6e6e6" width=120>East Center</td>
    <tr align=center>
      <td bgcolor="#dddddd" width=120>4 or 5 ft. SWC</td>
      <td bgcolor="#dddddd" width=120>4 or 5 ft. SEC</td>
    <tr align=center>
      <td bgcolor="#dddddd" width=120>SWC</td>
      <td bgcolor="#dddddd" width=120>SEC</td>
    </table></td>
    </tr>
    <tr>
      <td align=center colspan=9>
      Lots oriented North/South.
      NWC = North West Corner, SEC = South East Corner, etc.</td>
    </tr>
    </table>
</ol>

<h2 align=left>How these pages were created</h2>
<p>
The database is exported to tab-delimited text file, then processed
by <a href="evergreen.script">this Perl script</a> to create several
dozen web pages grouped as shown at the top of this page.
Those pages are then uploaded to the Evergreen Cemetery web site.
</p>

<h2 align=left><a name=findagrave></a>Links to memorials at Find-A-Grave</h2>
<p>
The <a target="_blank" href="http://www.findagrave.com">Find-A-Grave website</a>
is a place where people can create a memorial to a deceased individual that
includes photos (of the person or the grave marker), a biography or obituary,
"virtual" flowers, and more.  Since we do not have this capability on our
website, we will link to the corresponding memorials in <a target="_blank"
  href="http://www.findagrave.com/cgi-bin/fg.cgi?page=cr&amp;CRid=82259"> the
Evergreen Cemetery section</a> at Find-A-Grave that people set up for
burials in Evergreen Cemetery.  The links will be updated (usually once
per month) when the web pages are updated from the cemetery database.
To see an example, click on the icon for <a
  href="dotdnames_u-v.html#16729">Van Essen, William</a>.
(This link to Find-A-Grave feature does not yet exist for Memorial Gardens,
but nearly all those burials are already in <a target="_blank"
  href="http://www.findagrave.com/cgi-bin/fg.cgi?page=cr&amp;CRid=201997"> the
Memorial Gardens Cemetery section</a> at Find-A-Grave.)
</p>

<h2 align=left><a name=maps></a>Maps showing layout of blocks</h2>
<p>
When the cemeteries were originally platted (and when they were later
expanded), documents were filed with the county surveyor's office.
They have made those documents available online. The original 1879
Evergreen map covers the southernmost portion.  The later ones cover
the middle and the northernmost portions.  For the Memorial Gardens maps,
Christus has the statue in the middle and is centered on the west gate.
Devotion is to the south and Paradise is to the north.
</p>

<ul>
<li><a href="http://www.co.crow-wing.mn.us/surveyor/docs/EVERGREEN_CEMETERY_BRAINERD.PDF"
     target="_blank"><b>1879 Evergreen Cemetery Original Plat Map</b></a> for blocks 1 - 14 (PDF).
<li><a href="http://www.co.crow-wing.mn.us/surveyor/docs/2ND_ADDITION_TO_EVERGREEN_CEMETERY.PDF"
     target="_blank"><b>1948 Evergreen Cemetery 2nd Add'n Plat Map</b></a> for blocks 15 - 45 (PDF).
<li><a href="http://www.co.crow-wing.mn.us/surveyor/docs/THE_3RD_ADDITION_TO_EVERGREEN_CEMETERY.PDF"
     target="_blank"><b>1954 Evergreen Cemetery 3rd Add'n Plat Map</b></a> for block 46 (PDF).
<li><a href="http://www.co.crow-wing.mn.us/surveyor/docs/GARDEN_OF_THE_CHRISTUS.PDF"
     target="_blank"><b>1953 Garden of the Christus Plat Map</b></a> for Memorial Gardens (PDF).
<li><a href="http://www.co.crow-wing.mn.us/surveyor/docs/GARDEN_OF_DEVOTION.PDF"
     target="_blank"><b>1953 Garden of Devotion Plat Map</b></a> for Memorial Gardens (PDF).<br>
     The lot numbers on this preliminary map are reversed from the lot numbers in actual use.<br>
     Lot number 1 is at the lower right (not lower left) and 194 is at the upper left (not upper right).
<li><a href="http://www.co.crow-wing.mn.us/surveyor/docs/GARDEN_OF_PARADISE.PDF"
     target="_blank"><b>1996 Garden of Paradise Plat Map</b></a> for Memorial Gardens (PDF).
     <br><small><small>&nbsp;<br></small></small>
</ul>

<h2 align=left><a name="Contact"></a>Corrections or Comments</h2>
<p>
Please use the "Contact Us" link in the page footer for information
on how to contact the website maintainer or the Association.
Be aware that this <i><b>Directory of the Dead</b></i>
is intended to be a faithful reproduction of the cemetery records,
including the original spelling in older records.</p>

</dl>

<p>

END_OF_BODY
    pout( htmlfinish( $fname ) );

    exit(0);


##########################################################################

sub htmlstart {
    my ( $title, $descr ) = @_;
    warn( qq{htmlstart( "$title" ) called wo/descr argument.} ) if ( ! $descr );
    return ( <<"END" );
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
<html>
<head>
<meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1">
<meta name=description content="
$descr">
<title>$title</title>
<link rel="shortcut icon" href="favicon.ico" type="image/x-icon">
<link rel="stylesheet" type="text/css" href="default.css">
</head>

<body bgcolor=white background="bg_frost.jpg">

END
}


##########################################################################

sub htmlfinish {
    my ( $fname ) = @_;
    return ( <<"END" );

$hor_rule
<dl><dd>

<table cellpadding=0 cellspacing=0 border=0 width="100%">
<tr valign=top><td class=footer>
Copyright &copy;
$copyyrs&nbsp;
<a href="./"><b>Evergreen Cemetery Association</b></a> &nbsp;|&nbsp;
<a href="dotd.html"><b>Directory of the Dead</b></a> &nbsp;|&nbsp;
<a href="contact.html"><b>Contact Us</b></a></td>
<td class=footer align=right>Last Updated:
$updated</td>
</tr></table>

</dl>

</body>

</html>
END
}


##########################################################################

sub psame {
    print( "\n The following pairs of entries have the same $_[0]\n$_[1]" )
      if ( $_[1] );
}

sub pout {
    print OUT ( @_ );
}

sub pwarn {
    printf( qq{#%5d "%s" %s\n}, $idx, $name, $_[0] );
}