#!/usr/bin/perl -w # # evergreen.script - Create Evergreen Cemetery "Directory of the Dead" pages # # Author: John Van Essen # # 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" "notes" "military" "section" "lot" "block" #(data) 16729 "*" "12-14-1994" "Van Essen, William Earl" "74 yrs." #(cont'd) "John Van Essen" "" "WW II" "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: Notes (used only if block and lot and section missing) # Field 8: Military Service (War in which veteran served, if any) # Field 9: Burial location within lot (see NOTE below) # SEC N 1/2 means SEC of N 1/2 of lot (8 plots/lot) # Field 10: Burial lot number within block # Field 11: 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"; $FindFiMG = "findamatchmg.txt"; %HighLot = ( 1 => 44, 2 => 70, 3 => 48, 4 => 103, 5 => 124, 6 => 116, 7 => 163, 8 => 32, 9 => 99, 10 => 132, 11 => 74, 12 => 99, 13 => 42, 14 => 147, 15 => 0, 16 => 13, 17 => 39, 18 => 17, 19 => 8, 20 => 12, 21 => 15, 22 => 42, 23 => 46, 24 => 3, 25 => 18, 26 => 26, 27 => 3, 28 => 34, 29 => 27, 30 => 0, 31 => 33, # 34-48 is road 32 => 16, 33 => 6, 34 => 43, # 44-48 is road 35 => 48, 36 => 48, 37 => 44, 38 => 36, 39 => 28, 40 => 20, 41 => 14, 42 => 7, 43 => 3, 44 => 190, 45 => 112, 46 => 34, 47 => 222, 48 => 101, ); @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-Ss", "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_"; $pfxtdbts = "dotd_tidbits"; $pfxmilit = "dotd_military"; $icon_mil = "milservlink.png"; $icon_fag = "findagravelink.png"; $hor_rule = <<"EOR";
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]; $yeartst = 0000; # Cutoff year for ignoring certain "same as" tests $yearckd = 1900; # Cutoff year for requiring data checked = "*" $yearbls = 1940; # Cutoff year for matching just block & lot & section $ddearly = 1900; # Cutoff year for earliest death dates $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, $FindFiMG ) || die "$FindFiMG: $!\n"; while ( ) { chomp; next; $findex = $1, next if ( m/^ *(\d+)/ ); $famatch{$1} = $findex if ( m/^=> +(\d+)/ ); } open( FAF, $FindFile ) || die "$FindFile: $!\n"; while ( ) { 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 ( ) { chomp; s/\r//; # Remove DOS/Windows CR next if ( m/^$/ ); # Skip any blank lines $NumFields = 11; @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, $owner, $note, $mil, $sec, $lot, $blk ) = @data; next if ( $idx eq "ID" or $idx eq "" ); # Skip any header line $name_in = $name; $idx_in = $idx; 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 ); $NoteRows[$idx] = $note || ""; $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 "" ) ); if ( $datackd eq "" ) { if ( $ddate =~ m/before/ ) { $chkdate{$ddate}++; } elsif ( $ddate =~ m/-(\d\d\d\d)/ ) { $chkdate{"$1"}++; } else { $chkdate{$ddate}++; } $chkdates++; } ### Validate date and figure out earliest and latest burials # pwarn( qq{date "$1$ddate" has leading space} ) if ( $ddate =~ s/(^ +)// && $dataok ); pwarn( qq{date "$ddate$1" has trailing space} ) if ( $ddate =~ s/( +$)// && $dataok ); $dateymd = ""; # in case bad date for block earliest sort if ( $ddate =~ m/^(\d\d)-(\d\d)-(\d\d\d\d)$/ ) { 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 $dateymd = "$3-$1-$2"; $datebeg = $dateymd if ( $datebeg gt $dateymd ); $dateend = $dateymd if ( $dateend lt $dateymd ); } else { $dateymd = "$3-$1-$2"; # Year but no month and/or day } push( @earlymd, sprintf( "$dateymd\t%5d|%s|%s|%s|%s|%s|%s", $idx, $ddate, $age, $blk, $lot, $sec, $name ) ) if ( $dateymd && $dateymd lt "1880-00-00" ); # pwarn( qq{data checked column empty for death >= $yearckd} ) $listckd .= sprintf( "|%s\n", $DataRows[$idx] ) if ( $datackd eq "" and $3 >= $yearckd ); } 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 # 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 ); $name =~ s/ +/ /g; # Condense consecutive spaces pwarn( qq{name is missing} ) if ( $name eq "" && $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 " Or " instead of " or "} ) if ( $name =~ m/ Or / && $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 unwanted space before a comma} ) 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 needs a space before "("} ) if ( $name =~ m/[^ ]\(/ && $dataok ); pwarn( qq{name needs a space before first double-quote} ) if ( $name =~ m/[^ ]".*"/i && $dataok ); pwarn( qq{name needs a space after the period} ) if ( $name =~ m/\.[^A-Z'",) ]/ && $dataok ); # Unless F.M. or F.M.'s pwarn( qq{name has "s instead of 's} ) if ( $name =~ m/"s / && $dataok ); pwarn( qq{name has space after first double-quote} ) if ( $name =~ m/" .*"/ && $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 ); # pwarn( qq{name has "word" ending in an upper-case letter} ) # if ( $name =~ m/[A-Za-z][A-Z]\b/ && $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/ +\(.*\)//; # Remove all parenthetical comments $sortname =~ s/ +".*"//; # Remove all nicknames $sortname =~ s/s' /s's /g; # Standardize s-ending possessives $sortname =~ s/( or [^,]+,)/,$1/; # Sort Lname1 or Lname2, as Lname1, $sortname =~ s/[^\w,.]//g; # Keep A-Z a-z 0-9 comma period # Do not keep apostrophe or dash ### Find alphabetical surname group that contains surname $match = ""; 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 military service # pwarn( qq{military service "$1$mil" has a leading space} ) if ( $mil =~ s/(^ +)//i && $dataok ); pwarn( qq{military service "$mil$1" has a trailing space} ) if ( $mil =~ s/( +$)//i && $dataok ); pwarn( qq{military service "$mil" has 2 or more consecutive spaces} ) if ( $mil =~ m/ / && $dataok ); $mil =~ s|( -)* *http://www.findagrave.*||; # Omit ref. to marker ### 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 "$1$age" has leading space} ) if ( $age =~ s/(^ +)// && $dataok ); pwarn( qq{age "$age$1" has trailing space} ) if ( $age =~ s/( +$)// && $dataok ); pwarn( qq{age "$age" has 2 or more consecutive spaces} ) if ( $age =~ m/ / && $dataok ); $age =~ s/ +/ /g; # Condense consecutive spaces 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 "$1$blk" has a leading space} ) if ( $blk =~ s/(^ +)//i && $dataok ); pwarn( qq{block "$blk$1" has a trailing space} ) if ( $blk =~ s/( +$)//i && $dataok ); ### MemGar section block is grave number which can have (comment) $saveblk = $blk; $blk =~ s/ *\(.*\)//g; # Remove comments for tests/sorting $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/ ); $blk = $saveblk; $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. # Some are X/Y (on line between lots). # MG Paradise can have "All" as lot. # pwarn( qq{lot "$1$lot" has a leading space} ) if ( $lot =~ s/(^ +)//i && $dataok ); pwarn( qq{lot "$lot$1" 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" should be "$1/$2"} ) if ( $lot =~ m/^([A-Z]) *[\-\&] *([A-Z])$/ && $dataok ); pwarn( qq{lot "$lot" should be "$1/$2"} ) if ( $lot =~ m/^([0-9]+) *[\-\&] *([0-9+])$/ && $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 ); pwarn( qq{burial in block $blk has no lot number} ) if ( $lot !~ m/[^ ?]/ && ( $blk ne "" && $blk ne "14" ) && $dataok ); $sortlot = uc( $lot ); $sortlot = "0" if ( $lot eq "All" ); # Use zero for full Paradise 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 "$1$sec" has a leading space} ) if ( $sec =~ s/(^ +)// && $dataok ); pwarn( qq{section "$sec$1" has a trailing space} ) if ( $sec =~ s/( +$)// && $dataok ); pwarn( qq{section "$sec" has 2 or more consecutive spaces} ) if ( $sec =~ m/ / && $dataok ); $sec =~ s/ +/ /g; # Condense consecutive spaces pwarn( qq{section "$sec" has a non-alphanumeric after (} ) if ( $sec =~ m/\(\W/ && $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 ); $savesec = $sec; $sec =~ s/ *\(.*\)//g; # Remove parenthetical comments 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 a value but lot is not given} ) if ( $sec =~ m/[^ ?]/ && ( $lot eq "" || $lot eq "?" ) && $dataok ); pwarn( qq{section "$sec" has unmatched double-quote} ) if ( $sec =~ m/\"/ && $sec !~ m/\".*\"/ && $dataok ); pwarn( qq{section "$sec" has a period after a non-alphabetic character} ) if ( $sec =~ m/[^A-Za-z]\./ && $dataok ); pwarn( qq{section "$sec" needs a space after the period} ) if ( $sec =~ m/\.\S/ && $dataok ); pwarn( qq{section "$sec" needs "${1}ument" instead of "$1."} ) if ( $sec =~ m/\b([Mm]on)\./ && $dataok ); pwarn( qq{section "$sec" needs "fr." instead of "$1"} ) if ( $sec =~ m/ (from) /i && $dataok ); pwarn( qq{section "$sec" needs a space before the fraction} ) if ( $sec =~ m/[^ ]1\/[24]/ && $dataok ); pwarn( qq{section "$sec" needs " Frac. $2 of" instead of "$1$2$3"} ) if ( $sec =~ m/( o?f? ?)(North|South|East|West)( Frac\.?)/ && $dataok ); pwarn( qq{section "$sec" needs "Frac." instead of "$1"} ) if ( $sec =~ m/([Ff]rac[^.]|[Ff]rac$|frac\.)/ && $dataok ); pwarn( qq{section "$sec" needs "North" instead of "$1"} ) if ( $sec =~ m/\b(No)\b/i && $dataok ); pwarn( qq{section "$sec" needs "South" instead of "$1"} ) if ( $sec =~ m/\b(So)\b/i && $dataok ); pwarn( qq{section "$sec" needs "North" instead of "$1"} ) if ( $sec =~ m/\b(No*\.)/i && $dataok ); pwarn( qq{section "$sec" needs "South" instead of "$1"} ) if ( $sec =~ m/\b(So*\.)/i && $dataok ); pwarn( qq{section "$sec" needs "East" instead of "$1"} ) if ( $sec =~ m/\b(Ea*\.)/i && $dataok ); pwarn( qq{section "$sec" needs "West" instead of "$1"} ) if ( $sec =~ m/\b(We*\.)/i && $dataok ); # pwarn( qq{section "$sec" needs "$2 $1" instead of "$1 $2"} ) # if ( $sec =~ m/([NSEW]+ 1\/[24]) ([NS][EW]C)/ && $dataok ); pwarn( qq{section "$sec" should be "$2 $1"} ) if ( $sec =~ m/^([NSEW]+ 1\/[24]) (.*)/ && $dataok ); pwarn( qq{section "$sec" needs "$1" instead of "$1$2"} ) if ( $sec =~ m/\b([NSEW])(orth|outh|ast|est) 1\/[24]/ && $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/\Sft\./ && $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" has unwanted space before comma} ) 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" needs parens around "$1"} ) if ( $sec =~ m/ (\d+'* *x *\d+'*)/ && $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 unwanted space inside rank number "$1"} ) if ( $sec =~ m/(\d*1 st|\d*2 nd|\d*3 rd|\d*[0-9] 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 ); pwarn( qq{section "$sec" contains "$1" - misspelled "grave"?} ) if ( $sec =~ m/\d\w\w ([^g]rave)/i && $dataok ); pwarn( qq{section "$sec" contains unwanted transfer reference} ) if ( $sec =~ m/trans/i && $dataok ); $sec = $savesec; $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 $RowGrave{"Blk $sortblk Lot $sortlot"}++ # Count row/grave matrix refs if ( $sortsec =~ m|row.*grave|i ); ### Validate lot owner (free form) # pwarn( qq{lot owner "$1$owner" has a leading space} ) if ( $owner =~ s/(^ +)// && $dataok ); pwarn( qq{lot owner "$owner$1" has a trailing space} ) if ( $owner =~ s/( +$)// && $dataok ); # pwarn( qq{lot owner "$owner" has 2 or more consecutive spaces} ) # if ( $owner =~ m/ / && $dataok ); pwarn( qq{lot owner "$owner" has a comma with no space after} ) if ( $owner =~ m/,\S/ && $dataok ); pwarn( qq{lot owner "$owner" has unwanted space before a comma} ) if ( $owner =~ m/\s,/ && $dataok ); pwarn( qq{lot owner "$owner" has a trailing comma} ) if ( $owner =~ m/,$/ && $dataok ); pwarn( qq{lot owner "$owner" has a comma with " or " after} ) if ( $owner =~ m/, or / && $dataok ); $owner =~ s/ +/ /g; # Condense consecutive spaces # pwarn( qq{lot owner "$owner" begins with a lower-case letter} ) # if ( $owner =~ m/^[a-z]/ && $owner !~ m/^http/ && $dataok ); pwarn( qq{lot owner "$owner" should be Last, First} ) if ( $owner !~ m/,/ && $owner =~ m/^[A-Z][a-z'.]+ \w/ && $dataok && $owner !~ m/Single|Public|Brainerd|Church|Veteran|Tribe|Lodge/ && $owner !~ m/Evergreen|Fellows|Pacific|Locomotive|Foundation/ ); ### Validate note (free form) # pwarn( qq{note "$1$note" has a leading space} ) if ( $sec =~ s/(^ +)// && $dataok ); pwarn( qq{note "$note$1" has a trailing space} ) if ( $sec =~ s/( +$)// && $dataok ); # pwarn( qq{note "$note" has 2 or more consecutive spaces} ) # if ( $note =~ m/ / && $dataok ); $note =~ s/ +/ /g; # Condense consecutive spaces pwarn( qq{note "$note" begins with a lower-case letter} ) if ( $note =~ m/^[a-z]/ && $note !~ m/^http/ && $dataok ); 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 ); $note = "" if ( $note eq "Reclaimed" or $note eq "Reclaimed file" ); $note =~ s/^Reclaimed - //; $note =~ s/^Reclaimed\. *//; $note =~ s/^Reclaimed file - //; $note =~ s/^Reclaimed file\. *//; pwarn( qq{note "$note" contains "$1"} ) if ( $note =~ m/(reclaim)/i && $dataok ); # $note =~ s/(trans)\./$1ferred/i; pwarn( qq{note "$note" implies block "$blk" should be null} ) if ( $note =~ m/trans(\.|ferred)/i && $blk ne "" && $note !~ m/trans(\.|ferred) (from|fr\.|into|to this) /i ); ### 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"; } elsif ( $sec =~ m/(.*)(Cremation Sec\S*)( *)(.*)/i ) { $countec++; # Process Evergreen Cremation entry pwarn( qq{sec "$sec" has unwanted text "$1" in front} ) if ( $1 && $dataok ); pwarn( qq{sec "$sec" should be "Cremation Section"} ) if ( $2 ne "Cremation Section" && $dataok ); $blk = "CS-$blk"; # Prepend "CS-" to CremSec block $sortblk = "CS-$sortblk"; # Prepend "CS-" to CremSec block $blk_ttl = "Cremation Section"; } 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 ); pwarn( qq{lot "$lot" not within 1-$HighLot{$blk} for block $blk} ) if ( $lot =~ m/^(\d+)/ && exists( $HighLot{$blk} ) && $1 > $HighLot{$blk} && $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 => 01st) $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 two-digit distance numbers for sorting so 10 is after 5 $sortsec =~ s/(^|\D)(\d [\d\/ ]*ft)/${1}0$2/ig; # also allow for 7 1/2 ft ### Enforce space between [NSEW] and "1/2", etc. $sortsec =~ s|([NSEW])1/|$1 1/|ig; ### Remove somewhat optional "of" string $sortsec =~ s| of||ig; ### Remove somewhat optional "fr." string $sortsec =~ s| fr\. | |ig; # ### Remove somewhat optional "Frac." string # Hmm - is not optional # $sortsec =~ s|^Frac\. ||i; # $sortsec =~ s| Frac\.||i; ### Make ordering consistent $sortsec =~ s/(center|east|west|north|south) (back|front)/$2 $1/i; ### Adjust section descriptions so they sort consistently going by # which half/quarter 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)\b/$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/; ### NEW DEC 2010 ### Flip {any} N 1/2 to N 1/2 {any} (unless Row X Grave Y) $sortsec =~ s/^(.+?) +([NSEW]+ +1\/\d)$/$2 $1/ unless ( $sortsec =~ m/row.*grave/i ); ### New JUL 2011 ### Put Fractional info up from so they sort together instead of # being intermingled with the normal lot corners, etc. # Prepend with "Z' tp sor to end of normal corners, etc. # Blah Frac. A South[ of] => ZFrac. A South of Blah # Blah Frac. South[ of] => ZFrac. South of Blah # Blah South[ of] => ZSouth of Blah # warn( "Befor: $sortsec\n" ) if ( $idx eq "7358" ); # $sortsec =~ s/^(.*) (FRAC\..*)(NORTH|SOUTH|EAST|WEST)( OF)*$/Z$2$3 OF $1/; $sortsec =~ s/^(.*) (FRAC\..*) (NORTH|SOUTH|EAST|WEST)( OF)*$/Z$3 $2 OF $1/; # $sortsec =~ s/^(?!FRAC)(.*) (NORTH|SOUTH|EAST|WEST)( OF)*$/Z$2 OF $1/; $sortsec =~ s/^(.*) (NORTH|SOUTH|EAST|WEST)( OF)*$/Z$2 OF $1/; # warn( "After: $sortsec\n" ) if ( $idx eq "7358" ); ### Eliminate punctuation $sortsec =~ s|[\.\,\-]||g; ### Eliminate dupe spaces $sortsec =~ s| +| |g; # printf( "%-30s %s\n", $name, $sortsec ) if ( $blk eq "1" && $lot eq "44" ); $fname = lc( "${pfxnames}$match.html" ); $hrefsur = qq{href="$fname#$idx"}; $fnamblk = ( $sortblk =~ m/CS-/ ) ? "cremsec" : $sortblk; $fname = lc( "${pfxblock}$fnamblk.html" ); $thistag = $sortlot; $thistag =~ s/[\/\&\ ].*//; # strip off &,/,SPACE and following $thistag = sprintf( "%03d", $1 ) if ( $blk =~ m/CS-(\d+)/ ); $hreflot = $sortblk eq "000" ? "" : "#$thistag"; $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, $mil ) ); ### Sort into block name bin # $Block{$fnamblk} = [], $Blockttl{$fnamblk} = $blk_ttl unless exists( $Block{$fnamblk} ); push( @{$Block{$fnamblk}}, join( "\n", "$sortblk\t$sortlot\t$sortsec\t$sortname", $hrefsur, $sortlot, $idx, $dataok, $ddate, $name, $age, $sec, $lot, $blk, $note, $mil ) ); ### Add to tidbits page list of most recent entries # push( @recent, join( "\n", "$idx", $hrefsur, $hrefblk, $idx, $dataok, $ddate, $name, $age, $sec, $lot, $blk, $note, $mil ) ); shift( @recent ) if ( @recent > 100 ); ### Add to tidbits page list of earliest death dates # push( @ddearly, join( "\n", "$dateymd", $hrefsur, $hrefblk, $idx, $dataok, $ddate, $name, $age, $sec, $lot, $blk, $note, $mil ) ) if ( $dateymd && $dateymd ne "0000-00-00" && $dateymd lt "$ddearly-00-00" ); ### Add to tidbits page list of missing death dates # push( @ddmiss, join( "\n", "$sortname\t$sortblk\t$sortlot\t$sortsec", $hrefsur, $hrefblk, $idx, $dataok, $ddate, $name, $age, $sec, $lot, $blk, $note, $mil ) ) if ( $ddate eq "00-00-0000" ); ### Add to tidbits page list of before 1879 death dates # push( @ddbefore, join( "\n", "$sortname\t$sortblk\t$sortlot\t$sortsec", $hrefsur, $hrefblk, $idx, $dataok, $ddate, $name, $age, $sec, $lot, $blk, $note, $mil ) ) if ( $ddate eq "before 1879" ); ### Update first (earliest) death/burial per block # if ( $dateymd ) { $First{$fnamblk} = [], $Firstttl{$fnamblk} = $blk_ttl unless exists( $First{$fnamblk} ); ( $dateold, undef, undef ) = @{$First{$fnamblk}}; $First{$fnamblk} = [ $dateymd, $lot, $name ] if ( ! $dateold || $dateold gt $dateymd ); } ### Update highest lot number per block # if ( $lot && $lot =~ m/^(\d+)/ ) { $lotnew = $1; $Highest{$fnamblk} = "", $Highestttl{$fnamblk} = $blk_ttl unless exists( $Highest{$fnamblk} ); $lotold = $Highest{$fnamblk}; $Highest{$fnamblk} = $lotnew if ( ! $lotold || $lotold < $lotnew ); } ### Add to Military Service list # push( @Mil, join( "\n", "$sortname", $hrefsur, $idx, $ddate, $name, $age, $mil ) ) if ( $mil ne "" ); ### 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 : 0; $dmmdd = $ddate; $dmmdd =~ s|\-\d\d\d\d$|-0000| if ( $dmmdd !~ m|^00-00| ); $dmmyy = $ddate; $dmmyy =~ s|\-\d\d\-|-00-|; $testy = $yeartst; $yisok = $tempy >= $testy; $tempage = $age || "?"; # many "?" are babies, so $tempage = "?" if ( $age eq "-0-" ); # make stillbirths "?" $tempage = "?" if ( lc($age) eq "infant" or lc($age) eq "premature" ); $tempage = "?" if ( $age =~ m/min/ ); # and near-stillbirths $tempage = "?" if ( $age =~ m/hr/ ); # and a few hours old $tempage = "?" if ( $age =~ m/^[12] da/ ); # and a few days old $tempage = "7 da." if ( $age eq "1 wk." ); $tempage = "14 da." if ( $age eq "2 wks." ); $tempage = "21 da." if ( $age eq "3 wks." ); $tempage =~ s| 1/2||; # don't be this specific $tempnam = $sortname; $tempnam =~ s/le,/el,/; # replace surname end "le" w/"el" # so transposed endings match $tempnam =~ s/[aeiou]+/_/g; # replace vowel strings w/_ $tempfn = ( $sortname =~ m/,(.*)/ ) ? $1 : ""; # extract lc firstname $tempfn =~ s/$1$//i # remove middle initial if ( $name =~ m| ([A-Z])\.| ); # if present in orig. name $tempfn =~ s/charlie/charles/; # standardize names $tempfn =~ s/mike/michael/; # standardize names $tempfn =~ s/michel/michael/; # standardize names @previous = (); # ### Warn about same date and name # $token = lc( "$ddate $tempnam" ); # $match = $hashdn{$token} || ""; # $hashdn{$token} = $idx unless ( $match ); # if ( $ddate # skip if ddate missing if ( 1 # && $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] ) # check here so match is added to previous and skipped later if ( $name !~ m/ or / ); # tempnam altern. wildcards push( @previous, $match ) if ( $match ); } } # ### Warn about same block, lot, section, name (NEW Jul 2010) # $token = lc( "$blk $sortlot $sortsec $tempnam" ); # $match = $hashblsn{$token} || ""; # $hashblsn{$token} = $idx unless ( $match ); # if ( $tempy # skip if ddate unknown if ( 1 # && $sortsec !~ m|^[NS] 1/2$| # skip if 1/2 but no corner # && $name !~ m/ or / # skip if name alternatives # && $note !~ m/same (grave|casket|urn|person)/i ) { # skip if dual burial ) { $match = $hashblsn{$token} || ""; $hashblsn{$token} = $idx unless ( $match ); # if ( $match && ! grep( /^$match$/, @previous ) if ( $match && ! grep( /^$match$/, @previous ) && $note !~ m/same (grave|casket|urn|person)/i # skip if dual burial && ! ( $match == 1404 && $idx == 1633 ) # skip bogus match && ! ( $match == 1817 && $idx == 1823 ) # skip bogus match && ! ( $match == 2647 && $idx == 2654 ) # skip bogus match && ! ( $match == 2647 && $idx == 2667 ) # skip bogus match && ! ( $match == 293 && $idx == 19077 ) # skip bogus match && ! ( $match == 12775 && $idx == 19348 ) # skip bogus match && ! ( $match == 20090 && $idx == 20368 ) # skip bogus match ## ^^^^^ # sorted on idx value ) { $listblsn .= sprintf( "/%s\n\\%s\n", @DataRows[$match,$idx] ); push( @previous, $match ) if ( $match ); } } # ### Warn about same year, block, lot, name # # $token = lc( "$tempy $blk $sortlot $sortname" ); $token = lc( "$tempy $blk $sortlot $tempnam" ); # $match = $hashybln{$token} || ""; # $hashybln{$token} = $idx unless ( $match ); # if ( $tempy # skip if ddate unknown if ( 1 # && $sortsec !~ m|^[NS] 1/2$| # skip if 1/2 but no corner # && $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 ## ^^^^^ # 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 # # $token = lc( "$tempy $blk $sortsec $sortname" ); $token = lc( "$tempy $blk $sortsec $tempnam" ); # $match = $hashybsn{$token} || ""; # $hashybsn{$token} = $idx unless ( $match ); # if ( $tempy # skip if ddate unknown if ( 1 # && $sortsec !~ m|^[NS] 1/2$| # skip if 1/2 but no corner # && $name !~ m/ or / # skip if name alternatives # && $note !~ m/same (grave|casket|urn|person)/i ) { # skip if dual burial ) { $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 date, age, block, lot and section # # $token = lc( "$ddate $age $blk $sortlot $sortsec" ); $token = lc( "$dmmdd $tempage $blk $sortlot $sortsec" ); # $match = $hashdabls{$token} || ""; # $hashdabls{$token} = $idx unless ( $match ); # if ( $tempy # skip if ddate unknown if ( 1 && $blk # skip if xfer out, etc. # && $sortsec # skip if section unknown # && $note !~ m/same (grave|casket|urn|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 ) ) { if ( $match && ! grep( /^$match$/, @previous ) && $note !~ m/same (grave|casket|urn|person)/i # skip if dual burial ) { $listdabls .= sprintf( "/%s\n\\%s\n", @DataRows[$match,$idx] ) # check here so match is added to previous and skipped later if ( 1 && ! ( $match == 350 && $idx == 3107 ) # skip bogus match && ! ( $match == 12467 && $idx == 12468 ) # skip bogus match && ! ( $match == 19167 && $idx == 19168 ) # skip bogus match && ! ( $match == 3409 && $idx == 19940 ) # skip bogus match && ! ( $match == 1182 && $idx == 20937 ) # skip bogus match ## ^^^^^ # sorted on idx value ); push( @previous, $match ); next; # other tests are subsets } } # ### Warn about same date, block, lot and firstnm (NEW Dec 2010) # $token = lc( "$ddate $blk $sortlot $tempfn" ); # $match = $hashdblf{$token} || ""; # $hashdblf{$token} = $idx unless ( $match ); # if ( $tempy # skip if ddate unknown if ( 1 && $blk # skip if xfer out, etc. # && $sortsec !~ m|^[NS] 1/2$| # skip if 1/2 but no corner # && $name !~ m/ or / # skip if name alternatives && $sortname !~ m/skeleton/ # skip if no date & age # && $note !~ m/same (grave|casket|urn|person)/i ) { # skip if dual burial ) { $match = $hashdblf{$token} || ""; $hashdblf{$token} = $idx unless ( $match ); if ( $match && ! grep( /^$match$/, @previous ) && $note !~ m/same (grave|casket|urn|person)/i # skip if dual burial && ! ( $match == 1358 && $idx == 2151 ) # skip bogus match && ! ( $match == 523 && $idx == 2381 ) # skip bogus match && ! ( $match == 13861 && $idx == 13862 ) # skip bogus match && ! ( $match == 3519 && $idx == 20944 ) # skip bogus match ## ^^^^^ # sorted on idx value ) { $listdblf .= sprintf( "/%s\n\\%s\n", @DataRows[$match,$idx] ); push( @previous, $match ) if ( $match ); } } # ### Warn about same date, block, section and firstnm (NEW Dec 2010) # $token = lc( "$ddate $blk $sortsec $tempfn" ); # $match = $hashdbsf{$token} || ""; # $hashdbsf{$token} = $idx unless ( $match ); # if ( $tempy # skip if ddate unknown if ( 1 && $blk # skip if xfer out, etc. # && $sortsec !~ m|^[NS] 1/2$| # skip if 1/2 but no corner # && $name !~ m/ or / # skip if name alternatives # && $note !~ m/same (grave|casket|urn|person)/i ) { # skip if dual burial ) { $match = $hashdbsf{$token} || ""; $hashdbsf{$token} = $idx unless ( $match ); if ( $match && ! grep( /^$match$/, @previous ) && $note !~ m/same (grave|casket|urn|person)/i # skip if dual burial ## ^^^^^ # sorted on idx value ) { $listdbsf .= sprintf( "/%s\n\\%s\n", @DataRows[$match,$idx] ); push( @previous, $match ) if ( $match ); } } # ### Warn about same age, block, lot and section (after cutoff year) # $token = lc( "$tempage $blk $sortlot $sortsec" ); # use all-babies tempage # $match = $hashabls{$token} || ""; # $hashabls{$token} = $idx unless ( $match ); # if ( $tempy && $yisok # skip if ddate unknown if ( $yisok # skip if before cutoff && $blk # skip if xfer out, etc. && ( $lot || $blk ne "14" ) # skip if lot unknown in block 14 # && $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|urn|person)/i ) { # skip if dual burial ) { $match = $hashabls{$token} || ""; $hashabls{$token} = $idx unless ( $match ); if ( $match && ! grep( /^$match$/, @previous ) && $note !~ m/same (grave|casket|urn|person)/i # skip if dual burial && ! ( $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 == 3373 && $idx == 3374 ) # 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 == 11647 && $idx == 11781 ) # skip bogus match && ! ( $match == 1966 && $idx == 11866 ) # 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 == 293 && $idx == 19077 ) # skip bogus match && ! ( $match == 824 && $idx == 19192 ) # skip bogus match && ! ( $match == 1229 && $idx == 19288 ) # skip bogus match && ! ( $match == 12570 && $idx == 20338 ) # skip bogus match && ! ( $match == 23 && $idx == 20282 ) # skip bogus match && ! ( $match == 11724 && $idx == 20323 ) # skip bogus match && ! ( $match == 925 && $idx == 20571 ) # 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 $sortlot $sortsec" ); $token = lc( "$dmmdd $blk $sortlot $sortsec" ); # $match = $hashdbls{$token} || ""; # $hashdbls{$token} = $idx unless ( $match ); # if ( $tempy && $yisok # skip if ddate unknown if ( $yisok # skip if before cutoff && $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|urn|person)/i ) { # skip if dual burial ) { $match = $hashdbls{$token} || ""; $hashdbls{$token} = $idx unless ( $match ); if ( $match && ! grep( /^$match$/, @previous ) && $note !~ m/same (grave|casket|urn|person)/i # skip if dual burial && ! ( $match == 2594 && $idx == 2595 ) # skip bogus match && ! ( $match == 350 && $idx == 3107 ) # skip bogus match && ! ( $match == 3101 && $idx == 3171 ) # skip bogus match && ! ( $match == 683 && $idx == 3405 ) # skip bogus match && ! ( $match == 17069 && $idx == 17071 ) # skip bogus match && ! ( $match == 19167 && $idx == 19168 ) # skip bogus match && ! ( $match == 19808 && $idx == 19809 ) # skip bogus match && ! ( $match == 3101 && $idx == 19841 ) # skip bogus match && ! ( $match == 3409 && $idx == 19940 ) # skip bogus match && ! ( $match == 19963 && $idx == 19964 ) # skip bogus match && ! ( $match == 20595 && $idx == 20596 ) # skip bogus match && ! ( $match == 209 && $idx == 20698 ) # skip bogus match ## ^^^^^ # sorted on idx value ) { $listdbls .= sprintf( "/%s\n\\%s\n", @DataRows[$match,$idx] ); push( @previous, $match ) if ( $match ); } } # ### Warn about same year, block, lot, section and firstnm (NEW Dec 2010) # $token = lc( "$tempy $blk $sortlot $sortsec $tempfn" ); # print( "$idx: $token\n" ) if ( $idx == 4005 || $idx == 19076 ); # $match = $hashyblsf{$token} || ""; # $hashyblsf{$token} = $idx unless ( $match ); # if ( $tempy # skip if ddate unknown if ( 1 && $blk # skip if xfer out, etc. # && $sortsec !~ m|^[NS] 1/2$| # skip if 1/2 but no corner # && $name !~ m/ or / # skip if name alternatives # && $note !~ m/same (grave|casket|urn|person)/i ) { # skip if dual burial ) { $match = $hashyblsf{$token} || ""; $hashyblsf{$token} = $idx unless ( $match ); if ( $match && ! grep( /^$match$/, @previous ) && $note !~ m/same (grave|casket|urn|person)/i # skip if dual burial ## ^^^^^ # sorted on idx value ) { $listyblsf .= sprintf( "/%s\n\\%s\n", @DataRows[$match,$idx] ); push( @previous, $match ) if ( $match ); } } # ### Warn about same year, block, lot and section if year OK (NEW Dec 2010) # $token = lc( "$tempy $blk $sortlot $sortsec" ); # $match = $hashybls{$token} || ""; # $hashybls{$token} = $idx unless ( $match ); $yearybls = 1900; if ( $tempy # skip if ddate unknown && $blk # skip if xfer out, etc. # && $blk =~ m/Christus|Devotion|4./ # skip if not Chr|Dev|4n # && $blk =~ m/Chris|Devot|Parad|3.|4./ # skip if not M.G.|3n|4n && $tempy >= $yearybls # skip if too early # && $note !~ m/same (grave|casket|urn|person)/i ) { # skip if dual burial ) { $match = $hashybls{$token} || ""; $hashybls{$token} = $idx unless ( $match ); if ( $match && ! grep( /^$match$/, @previous ) && $note !~ m/same (grave|casket|urn|person)/i # skip if dual burial && ! ( $match == 959 && $idx == 960 ) # skip bogus match && ! ( $match == 1792 && $idx == 1794 ) # skip bogus match && ! ( $match == 141 && $idx == 2575 ) # skip bogus match && ! ( $match == 2697 && $idx == 2701 ) # skip bogus match && ! ( $match == 3101 && $idx == 3171 ) # skip bogus match && ! ( $match == 3193 && $idx == 3194 ) # skip bogus match && ! ( $match == 644 && $idx == 3585 ) # skip bogus match && ! ( $match == 4451 && $idx == 4453 ) # skip bogus match && ! ( $match == 10841 && $idx == 10842 ) # skip bogus match && ! ( $match == 10796 && $idx == 10797 ) # skip bogus match && ! ( $match == 10916 && $idx == 10917 ) # skip bogus match && ! ( $match == 11011 && $idx == 11012 ) # skip bogus match && ! ( $match == 11873 && $idx == 11874 ) # skip bogus match && ! ( $match == 11951 && $idx == 11952 ) # skip bogus match && ! ( $match == 3477 && $idx == 11965 ) # skip bogus match && ! ( $match == 12031 && $idx == 12033 ) # skip bogus match && ! ( $match == 12031 && $idx == 12034 ) # skip bogus match && ! ( $match == 12070 && $idx == 12071 ) # skip bogus match && ! ( $match == 12169 && $idx == 12170 ) # skip bogus match && ! ( $match == 12278 && $idx == 12279 ) # skip bogus match && ! ( $match == 12297 && $idx == 12321 ) # skip bogus match && ! ( $match == 12418 && $idx == 12421 ) # skip bogus match && ! ( $match == 12418 && $idx == 12425 ) # skip bogus match && ! ( $match == 12418 && $idx == 12426 ) # skip bogus match && ! ( $match == 12430 && $idx == 12432 ) # skip bogus match && ! ( $match == 12512 && $idx == 12524 ) # skip bogus match && ! ( $match == 12553 && $idx == 12555 ) # skip bogus match && ! ( $match == 12579 && $idx == 12584 ) # skip bogus match && ! ( $match == 12899 && $idx == 12900 ) # skip bogus match && ! ( $match == 12796 && $idx == 13308 ) # skip bogus match && ! ( $match == 12814 && $idx == 13337 ) # skip bogus match && ! ( $match == 12842 && $idx == 13350 ) # skip bogus match && ! ( $match == 13341 && $idx == 13350 ) # skip bogus match && ! ( $match == 13306 && $idx == 16933 ) # skip bogus match && ! ( $match == 16945 && $idx == 16946 ) # skip bogus match && ! ( $match == 12395 && $idx == 16951 ) # skip bogus match && ! ( $match == 12480 && $idx == 16958 ) # skip bogus match && ! ( $match == 12419 && $idx == 16960 ) # skip bogus match && ! ( $match == 11901 && $idx == 16966 ) # skip bogus match && ! ( $match == 3474 && $idx == 16980 ) # skip bogus match && ! ( $match == 12063 && $idx == 17065 ) # skip bogus match && ! ( $match == 17069 && $idx == 17071 ) # skip bogus match && ! ( $match == 12151 && $idx == 17077 ) # skip bogus match && ! ( $match == 112 && $idx == 18951 ) # skip bogus match && ! ( $match == 960 && $idx == 18985 ) # skip bogus match && ! ( $match == 741 && $idx == 19038 ) # skip bogus match && ! ( $match == 3101 && $idx == 19841 ) # skip bogus match && ! ( $match == 16966 && $idx == 20171 ) # skip bogus match && ! ( $match == 12487 && $idx == 20226 ) # skip bogus match && ! ( $match == 20291 && $idx == 20320 ) # skip bogus match && ! ( $match == 12020 && $idx == 20327 ) # skip bogus match && ! ( $match == 12570 && $idx == 20338 ) # skip bogus match && ! ( $match == 12157 && $idx == 20422 ) # skip bogus match && ! ( $match == 12539 && $idx == 20555 ) # skip bogus match && ! ( $match == 20664 && $idx == 20665 ) # skip bogus match # && ! ( $match == && $idx == ) # skip bogus match ) { $listybls .= 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 $sortlot $sortsec" ); # use all-babies tempage $token = lc( "$dmmdd $tempage $sortlot $sortsec" ); # use all-babies tempage # $match = $hashdals{$token} || ""; # $hashdals{$token} = $idx unless ( $match ); # if ( $tempy && $yisok # skip if ddate unknown if ( $yisok # skip if before cutoff && $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|urn|person)/i ) { # skip if dual burial ) { $match = $hashdals{$token} || ""; $hashdals{$token} = $idx unless ( $match ); if ( $match && ! grep( /^$match$/, @previous ) && $note !~ m/same (grave|casket|urn|person)/i # skip if dual burial && ! ( $match == 1006 && $idx == 2757 ) # skip bogus match && ! ( $match == 350 && $idx == 3107 ) # skip bogus match ## ^^^^^ # sorted on idx value ) { $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 # $token = lc( "$dmmdd $tempage $blk $sortsec" ); # use all-babies tempage $token = lc( "$ddate $tempage $blk $sortsec" ); # use all-babies tempage # $match = $hashdabs{$token} || ""; # $hashdabs{$token} = $idx unless ( $match ); # if ( $tempy && $yisok # skip if ddate unknown if ( $yisok # skip if before cutoff && $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|urn|person)/i ) { # skip if dual burial ) { $match = $hashdabs{$token} || ""; $hashdabs{$token} = $idx unless ( $match ); if ( $match && ! grep( /^$match$/, @previous ) && $note !~ m/same (grave|casket|urn|person)/i # skip if dual burial && ! ( $match == 19167 && $idx == 19168 ) # skip bogus match && ! ( $match == 3409 && $idx == 19940 ) # skip bogus match ## ^^^^^ # sorted on idx value ) { $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 $sortlot" ); # use all-babies tempage $fc = substr( $name, 0, 1 ); # $token = lc( "$fc $dmmdd $tempage $blk $sortlot" ); # use all-babies tempage $token = lc( "$fc $dmmyy $tempage $blk $sortlot" ); # use all-babies tempage # print( "$idx: $token\n" ) if ( $idx == 11632 || $idx == 20366 ); # $match = $hashdabl{$token} || ""; # $hashdabl{$token} = $idx unless ( $match ); # if ( $tempy && $yisok # skip if ddate unknown if ( $yisok # skip if before cutoff && $blk # skip if xfer out, etc. # && $age ne "" && $age ne "?" # skip if age unknown # && $age ne "-0-" # skip if stillborn && $sortname !~ m/skeleton/ # skip if no date & age # && $note !~ m/same (grave|casket|urn|person)/i ) { # skip if dual burial ) { $match = $hashdabl{$token} || ""; $hashdabl{$token} = $idx unless ( $match ); if ( $match && ! grep( /^$match$/, @previous ) && $note !~ m/same (grave|casket|urn|person)/i # skip if dual burial && ! ( $match == 214 && $idx == 215 ) # skip bogus match && ! ( $match == 4575 && $idx == 6428 ) # skip bogus match && ! ( $match == 6043 && $idx == 9609 ) # skip bogus match && ! ( $match == 2965 && $idx == 10049 ) # skip bogus match && ! ( $match == 11663 && $idx == 11665 ) # skip bogus match && ! ( $match == 12086 && $idx == 12090 ) # skip bogus match && ! ( $match == 12271 && $idx == 12274 ) # skip bogus match && ! ( $match == 12391 && $idx == 12394 ) # skip bogus match && ! ( $match == 12509 && $idx == 12510 ) # skip bogus match && ! ( $match == 12570 && $idx == 12571 ) # skip bogus match && ! ( $match == 12732 && $idx == 12733 ) # skip bogus match && ! ( $match == 12940 && $idx == 12941 ) # skip bogus match && ! ( $match == 12987 && $idx == 12992 ) # skip bogus match && ! ( $match == 13475 && $idx == 13476 ) # skip bogus match && ! ( $match == 13479 && $idx == 13480 ) # skip bogus match && ! ( $match == 4976 && $idx == 13493 ) # skip bogus match && ! ( $match == 13165 && $idx == 13664 ) # 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 == 13778 && $idx == 13779 ) # skip bogus match && ! ( $match == 13879 && $idx == 13880 ) # skip bogus match && ! ( $match == 16125 && $idx == 16173 ) # skip bogus match && ! ( $match == 12788 && $idx == 16921 ) # skip bogus match && ! ( $match == 11665 && $idx == 17014 ) # skip bogus match && ! ( $match == 11737 && $idx == 17044 ) # skip bogus match && ! ( $match == 12160 && $idx == 17075 ) # skip bogus match && ! ( $match == 12158 && $idx == 17080 ) # skip bogus match && ! ( $match == 18875 && $idx == 18876 ) # skip bogus match && ! ( $match == 19069 && $idx == 19082 ) # skip bogus match && ! ( $match == 19167 && $idx == 19168 ) # skip bogus match && ! ( $match == 3409 && $idx == 19940 ) # skip bogus match && ! ( $match == 12818 && $idx == 20536 ) # skip bogus match && ! ( $match == 20937 && $idx == 20938 ) # skip bogus match ## ^^^^^ # sorted on idx value ) { $listdabl .= sprintf( "/%s\n\\%s\n", @DataRows[$match,$idx] ); push( @previous, $match ) if ( $match ); } } # ### Warn about same year, age, block, lot and firstnm (NEW Dec 2010) # $token = lc( "$tempy $tempage $blk $sortlot $tempfn" ); # use all-babies tempage # print( "$idx: $token\n" ) if ( $idx == 4005 || $idx == 19076 ); # $match = $hashyablf{$token} || ""; # $hashyablf{$token} = $idx unless ( $match ); # if ( $tempy # skip if ddate unknown if ( 1 && $blk # skip if xfer out, etc. # && $sortsec !~ m|^[NS] 1/2$| # skip if 1/2 but no corner # && $name !~ m/ or / # skip if name alternatives && $sortname !~ m/skeleton/ # skip if no date & age # && $note !~ m/same (grave|casket|urn|person)/i ) { # skip if dual burial ) { $match = $hashyablf{$token} || ""; $hashyablf{$token} = $idx unless ( $match ); if ( $match && ! grep( /^$match$/, @previous ) && $note !~ m/same (grave|casket|urn|person)/i # skip if dual burial && ! ( $match == 11345 && $idx == 11354 ) # skip bogus match && ! ( $match == 12948 && $idx == 12949 ) # skip bogus match && ! ( $match == 12945 && $idx == 12952 ) # skip bogus match && ! ( $match == 13322 && $idx == 13323 ) # skip bogus match && ! ( $match == 12948 && $idx == 13444 ) # skip bogus match && ! ( $match == 13565 && $idx == 13566 ) # skip bogus match && ! ( $match == 13565 && $idx == 13567 ) # skip bogus match && ! ( $match == 12779 && $idx == 16933 ) # skip bogus match && ! ( $match == 12920 && $idx == 20169 ) # skip bogus match && ! ( $match == 11126 && $idx == 20383 ) # skip bogus match && ! ( $match == 3519 && $idx == 20944 ) # skip bogus match && ! ( $match == 11445 && $idx == 20944 ) # skip bogus match # && ! ( $match == && $idx == ) # skip bogus match ## ^^^^^ # sorted on idx value ) { $listyablf .= 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 $sortlot $sortsec" ); # $match = $hashbls{$token} || ""; # $hashbls{$token} = $idx unless ( $match ); # if ( $tempy && $yisok # skip if ddate unknown if ( $yisok # skip if before cutoff && $tempy >= $yearbls # skip if before cutoff && $blk # skip if xfer out, etc. # && $blk =~ m/Christus|Devotion|Paradise/ # skip if not Mem Gard # && $blk !~ m/Christus|Devotion|Paradise/ # skip if Mem Gard && $sortsec # skip if section unknown # && $sortsec !~ m|^[NS] 1/2$| # skip if 1/2 but no corner # && $note !~ m/cremation/i # skip if poss. dual burial # && $note !~ m/same (grave|casket|urn|person)/i ) { # skip if dual burial ) { $match = $hashbls{$token} || ""; $hashbls{$token} = $idx unless ( $match ); $oldn = $match ? $DataRows[$match] : ""; $oldn =~ s/.*\|//; # leave only the name $olds = $oldn; $olds =~ s/,.*//; # leave only the surname $surn = $name; $surn =~ s/,.*//; # leave only the surname $noto = $match ? $NoteRows[$match] : ""; if ( $match && ! grep( /^$match$/, @previous ) && $note !~ m/same (grave|casket|urn|person)/i # skip if dual burial && $noto !~ m/same (grave|casket|urn|person)/i # skip if dual burial && $note !~ m/cremation/i # skip if poss. dual burial && $noto !~ m/cremation/i # skip if poss. dual burial && $name !~ m/\b$olds\b/ # skip if has older surname # (i.e. child or spouse) && $oldn !~ m/\b$surn\b/ # skip if has newer surname # (i.e. child or spouse) && ! ( $match == 7361 && $idx == 21058 ) # skip bogus match ## ^^^^^ # sorted on idx value ) { # pwarn( qq{has same block, lot and sec as #$match} ); $listbls .= sprintf( "/%s\n\\%s\n", @DataRows[$match,$idx] ); push( @previous, $match ) if ( $match ); } } # ### Add to earliest births list # if ( $tempy && $age =~ m/(\d+) yrs/ ) { $byear = $tempy - $1; $blist .= sprintf( "#%5d d. %s b. %s %s\n", $idx, $ddate, $byear, $name ) if ( $byear < 1805 ); } # ### Update block/decade matrix # if ( $tempy && $sortblk ne "000" ) { $decade = $tempy - $tempy % 10; $blkkey = $sortblk; $blkkey =~ s/^0//; $blkkey =~ s/CS-.*/999/; # sort Crem Sec at end of Blocks $blkdec{$blkkey} = {} if ( not exists( $blkdec{$blkkey} ) ); $blkdec{$blkkey}{$decade}++; $blkdec{"ZTotals:"} = {} if ( not exists( $blkdec{$blkkey} ) ); $blkdec{"ZTotals:"}{$decade}++; } } ### Dump out warning messages # 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( "block, lot, section and name", $listblsn ); psame( "year, block, section and name", $listybsn ); psame( "year, block, lot and name", $listybln ); psame( "date, age, block, lot and section", $listdabls ); psame( "date, block, lot and firstname", $listdblf ); psame( "date, block, section and firstname",$listdbsf ); psame( "age, block, lot and section", $listabls ); psame( "date, block, lot and section", $listdbls ); psame( "year, block, lot, section and firstname",$listyblsf ); psame( "year, block, lot and section (>=$yearybls)", $listybls ); psame( "date, age, lot and section", $listdals ); psame( "date, age, block and section", $listdabs ); psame( "date, age, block and lot", $listdabl ); psame( "year, age, block, lot and firstname",$listyablf ); psame( "block, lot and section (year >= $yearbls)", $listbls ); print( "\n The following entries have an empty data checked column" . " (year >= $yearckd)\n$listckd" ) if ( $listckd ); ### Dump out counts of years with empty data checked flag # print( "\nEntries with empty checked flags: $chkdates\n" ); foreach $s ( sort( keys( %chkdate ) ) ) { print( "Entries with empty checked flags for death year $s: $chkdate{$s}\n" ) } ### Dump out counts of "Xth row Yth grave" matrix references # print( "\n" ); foreach $s ( sort( keys( %RowGrave ) ) ) { print( "$s row/grave references: $RowGrave{$s}\n" ) } ### Dump out earliest burial/death per block # print( "\n" ) if ( $DEBUG ); foreach $s ( sort( keys( %First ) ) ) { ( $dateymd, $lot, $name ) = @{$First{$s}}; printf( "Block %-4s earliest date is %s in Lot %-3s - %s\n", $Firstttl{$s}, $dateymd, $lot, $name ) if ( $DEBUG ); } ### Dump out earliest birth dates # print( "\nBirth years before 1805\n$blist") if ( $DEBUG ); ### Dump out earliest (non-zero) deaths # print( "\nDeath years before 1880\n" ) if ( $DEBUG ); foreach $s ( sort( @earlymd ) ) { ( $dateymd, $line ) = split( /\t/, $s ); print( "$line\n" ) if ( $DEBUG ); } ### Dump out highest lot number per block # print( "\n" ) if ( $DEBUG ); foreach $s ( sort( keys( %Highest ) ) ) { $lot = $Highest{$s}; next if ( ! $lot ); printf( "Block %-4s highest lot number is %s\n", $Highestttl{$s}, $lot ) if ( $DEBUG ); } ### Construct block/decade matrix # $html = ""; foreach $bi ( "", sort( keys( %blkdec ) ) ) { # next if ( $bi =~ m/^CS/ ); $lbl = $bi; $lbl = "Crem Sec" if ( $lbl eq "999" ); $lbl =~ s/^Z//; $lbl = sprintf( "%8.8s", ( $lbl =~ m/^\d+$/ ) ? "Block $lbl" : $lbl ); $html .= "$lbl"; # for ( $dec = 1870; $dec <= $yearend; $dec += 10 ) { for ( $dec = 1870; $dec <= 2000 ; $dec += 10 ) { $cnt = ( $bi eq "" ) ? $dec : ( $blkdec{$bi}{$dec} || 0 ); $html .= sprintf( "%3d", $cnt ); } $html .= "\n"; } $blkdec = < $html END ### Check if DRY-RUN - stop here before creating files. # if ( $DRY_RUN ) { warn( "DRY RUN specified - no files written.\n" ); exit(0); } ### Create surname index choice list # print( "\n" ) if ( $DEBUG ); $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/X-Z/X-Y-Z/; # $title =~ s/-/\–/g; # Try to avoid breaks on hyphens # # Nuts - ndash is twice the size of "-" $title =~ s/-/\‑/g; # Try to avoid breaks on hyphens $title =~ s/ /\ /g; $indexes .= qq{$title|\n}; } $indexes =~ s/\|\n$//s; $indexes =~ s/\|/  \| /sg; $indexes = "\n" . "" . "Grouped
" . "By
Surname
\n" . "  " . "\n$indexes"; # $ind_tbl = "\n" # . "$indexes\n
\n"; ### Create burial location choice list # print( "\n" ) if ( $DEBUG ); $blidxes = ""; @blikeys = keys( %Block ); # Make Cremation Section sort after None... @blikeys = sort( map( { $_ eq "cremsec" ? "000cremsec" : $_ } @blikeys ) ); @blikeys = map( { $_ eq "000cremsec" ? "cremsec" : $_ } @blikeys ); foreach $s ( @blikeys ) { printf( "Block %-5s has %4d entries\n", $s, scalar( @{$Block{$s}} ) ) if ( $DEBUG ); $fname = lc( "${pfxblock}$s.html" ); $title = $Blockttl{$s}; $title =~ s/ /\ /g; $blidxes .= qq{$title|\n}; } $blidxes =~ s/\|\n$//s; $blidxes =~ s/\|/  \| /sg; $blidxes = "\n" . "" . "Grouped
" . "By
Block
\n" . "  " . "\n$blidxes"; # $bli_tbl = "\n" # . "$blidxes\n
\n"; ### Create note section that appears after the index choice lists # $milcount = @Mil; $indxnote = <<"EOR";
  • Blocks named Christus, Devotion and Paradise are sections of Memorial Gardens.
  • The Cremation Section block is in Evergreen and has its own block numbers denoted by a leading "CS-".
  • In the Grouped by Surname pages, the lot number is linked to its section in the Grouped by Block pages.
  • In the Grouped by Block pages, the name is linked to its entry in the Grouped by Surname pages.
  • The icon is a link to the memorial at Find-A-Grave for the deceased.
  • The icon is a link to our Military Service Page entry for the deceased ($milcount total entries).
EOR $indxnote = "\n" . "" . "Notes:\n" . "  " . "$indxnote"; ### 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";
Evergreen Cemetery Burials
: 
$countec
       
Earliest Death Date :  $datebeg
Memorial Gardens Burials
: 
$countmg
       
 Latest Death Date :  $dateend
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. print( "\n" ) if ( $DEBUG ); foreach $s ( @Surgroups ) { # next if ( $s ne "U-V" ); $fname = lc( "${pfxnames}$s.html" ); open( OUT, ">$fname" ) || die "$fname: $!\n"; print( "Writing $fname...\n" ) if ( $DEBUG ); $cname = "Evergreen and Memorial Gardens cemeteries"; $stemp = $s; $stemp =~ s/X-Z/X-Y-Z/; $headr = "$titledod: Surnames $stemp"; $title = "$titleeca - Burials of Persons with Surnames $stemp"; $descr = " $titleeca $titledod\n" . " for burials of persons with surnames beginning with $stemp\n" . " in $cname, Brainerd, Minnesota."; pout( htmlstart( $title, $descr ) ); pout( "

$headr

\n" ); pout( "$summary\n" ); pout( "\n" ); pout( "\n" ); pout( "$indexes\n" ); pout( "\n" ); pout( "$blidxes\n" ); pout( "\n" ); pout( "$indxnote\n" ); pout( "\n" ); pout( "
 
 
 
 
\n" ); pout( "\n$hor_rule\n" ); pout( "
\n" ); pout( "
\n" ); pout( "\n" ); pout( "\n" ); pout( " \n" ); pout( " \n" ); pout( " \n" ); pout( " \n" ); pout( " \n" ); pout( " \n" ); pout( "
Name of Person\n" ); pout( "    Death Date\n" ); pout( "    Age\n" ); pout( "    Block\n" ); pout( "    Lot\n" ); pout( "    Section/Plot\n" ); foreach $item ( sort( @{$Sect{$s}} ) ) { ( undef, $hrefblk, $idx, $dataok, $ddate, $name, $age, $sec, $lot, $blk, $note, $mil ) = split( /\n/, $item, 12 ); $name =~ s|([^ ])\(|$1 \(|g; # Ensure space before paren $name =~ s| +| |g; # Make spaces non-breaking $name =~ s| \(| \(|g; # except before open paren $name =~ s|\) |\) |g; # except after close paren $name =~ # except after two-name 'or' s|(.+,.+ or) (.+,.+)|$1 $2|; $age =~ s| (1/2)(?![0-9])|\½|g; # Use 1/2 glyph w/no space $age =~ s| +| |g; # Make spaces non-breaking $age =~ s|\. |\. |g; # except after period # $sec = "Note: $note" if ( $note && ! $sec ); $sec = "Note: $note" if ( $note && ! $lot ); # $sec =~ s| 6-11-1879| 6-14-1879|; $news = "news1800s.html#BrdTrib14Jun1879"; $sec =~ s|(Brainerd Tribune 6-14-1879)|$1|; $lot =~ s| or | or
| if ( $blk =~ m| or | ); $lot = "None" if ( ! $lot && $hrefblk =~ m|000| ); # If blk unknown $lot = "$lot" if ( $lot && $hrefblk ); $blk =~ s| or | or
|; # Use nowrap to prevent MSIE from wrapping on "-" $loc = "		$blk$lot$sec"; $loc =~ s| (1/4)(?![0-9])| \¼|g; # Use 1/4 glyph $loc =~ s| (1/2)(?![0-9])| \½|g; # Use 1/2 glyph $loc =~ s| (3/4)(?![0-9])| \¾|g; # Use 3/4 glyph $mil = ( $mil ) ? qq{ } : ""; $fam = exists( $famatch{$idx} ) ? qq{ } : ""; pout( "
$name$mil$fam\n" ); pout( " $ddate$age$loc\n" ); } pout( "
\n" ); pout( "
\n" ); pout( "
\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. # print( "\n" ) if ( $DEBUG ); foreach $s ( sort( keys( %Block ) ) ) { # next if ( $s ne "045" ); $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( "

$headr

\n" ); pout( "$summary\n" ); pout( "\n" ); pout( "\n" ); pout( "$indexes\n" ); pout( "\n" ); pout( "$blidxes\n" ); pout( "\n" ); pout( "$indxnote\n" ); pout( "\n" ); pout( "
 
 
 
 
\n" ); pout( "\n$hor_rule\n" ); pout( "
\n" ); pout( "
\n" ); pout( htmlextra( $s ) ); pout( "\n" ); pout( "\n" ); pout( " \n" ); pout( " \n" ); pout( " \n" ); pout( " \n" ); pout( " \n" ); pout( " \n" ); pout( "
Name of Person\n" ); pout( "    Death Date\n" ); pout( "    Age\n" ); pout( "    Block\n" ); pout( "    Lot\n" ); pout( "    Section/Plot\n" ); $prevtag = ""; foreach $item ( sort( @{$Block{$s}} ) ) { ( undef, $hrefsur, $sortlot, $idx, $dataok, $ddate, $name, $age, $sec, $lot, $blk, $note, $mil ) = split( /\n/, $item, 13 ); $name =~ s|([^ ])\(|$1 \(|g; # Ensure space before paren $name =~ s| +| |g; # Make spaces non-breaking $name =~ s| \(| \(|g; # except before open paren $name =~ s|\) |\) |g; # and after close paren $name =~ # and after two-name 'or' s|(.+,.+ or) (.+,.+)|$1 $2|; $age =~ s| (1/2)(?![0-9])|\½|g; # Use 1/2 glyph w/no space $age =~ s| +| |g; # Make spaces non-breaking $age =~ s|\. |\. |g; # except after period # $sec = "Note: $note" if ( $note && ! $sec ); $sec = "Note: $note" if ( $note && ! $lot ); # $sec =~ s| 6-11-1879| 6-14-1879|; $news = "news1800s.html#BrdTrib14Jun1879"; $sec =~ s|(Brainerd Tribune 6-14-1879)|$1|; $lot =~ s| or | or
| if ( $blk =~ m| or | ); $blk =~ s| or | or
|; # Use nowrap to prevent MSIE from wrapping on "-" $loc = "		$blk$lot$sec"; $loc =~ s| (1/4)(?![0-9])| \¼|g; # Use 1/4 glyph $loc =~ s| (1/2)(?![0-9])| \½|g; # Use 1/2 glyph $loc =~ s| (3/4)(?![0-9])| \¾|g; # Use 3/4 glyph $thistag = $sortlot; $thistag =~ s/[\/\&\ ].*//; # strip off &,/,SPACE and following $thistag = sprintf( "%03d", $1 ) if ( $blk =~ m/CS-(\d+)/ ); $hrefsur = qq{name="$thistag" $hrefsur}, $prevtag = $thistag if ( $prevtag ne $thistag ); $mil = ( $mil ne "" ) ? qq{ } : ""; $fam = exists( $famatch{$idx} ) ? qq{ } : ""; pout( "
$name$mil$fam\n" ); pout( " $ddate$age$loc\n" ); } pout( "
\n" ); pout( "
\n" ); pout( "
\n" ); pout( htmlfinish( $fname ) ); } ### Create tidbits page # # H: Directory of the Dead: Tidbits # T: Evergreen Cemetery Association - Tidbits # D: Evergreen Cemetery Association Directory of the Dead # tidbits page with earliest dates, missing dates, & recent additions # in Evergreen and Memorial Gardens cemeteries, Brainerd, Minnesota. if ( 1 ) { $fname = lc( "${pfxtdbts}.html" ); open( OUT, ">$fname" ) || die "$fname: $!\n"; print( "Writing $fname...\n" ) if ( $DEBUG ); $cname = "Evergreen and Memorial Gardens cemeteries"; $headr = "$titledod: Tidbits"; $title = "$titleeca - Tidbits"; $descr = " $titleeca $titledod\n" . " tidbits page with earliest dates, missing dates, & recent additions\n" . " in $cname, Brainerd, Minnesota."; pout( htmlstart( $title, $descr ) ); pout( "

$headr

\n" ); pout( "$summary\n" ); pout( "\n" ); pout( "\n" ); pout( "$indexes\n" ); pout( "\n" ); pout( "$blidxes\n" ); pout( "\n" ); pout( "$indxnote\n" ); pout( "
 
 
 
\n" ); } $tbmenu = <Most Recent Additions  |  Missing Death Dates  |  Unresolved 1879 Tribune Burials  |  Deaths Dates Before $ddearly END pout( "
\n" ); pout( "
\n" ); pout( "\n" ); foreach $tidbit ( 1, 2, 4, 3 ) { if ( $tidbit == 1 ) { # @Sortlist = reverse( sort( @recent ) ); @Sortlist = sort( @recent ); $tbtitle = "Most recent additions to the database"; $tbaname = "recent"; } if ( $tidbit == 2 ) { @Sortlist = sort( @ddmiss ); $tbtitle = "Burials with missing death dates"; $tbaname = "ddmiss"; } if ( $tidbit == 3 ) { @Sortlist = sort( @ddearly ); $tbtitle = "Burials with earliest death dates (before $ddearly)"; $tbaname = "ddearly"; } if ( $tidbit == 4 ) { @Sortlist = sort( @ddbefore ); $tbtitle = "Unresolved burials in June 1879 Brainerd Tribune"; $tbaname = "ddbefore"; } pout( "\n" ); pout( "\n" ); pout( " \n" ) if ( $tidbit == 1); pout( " \n" ) if ( $tidbit == 1); pout( " \n" ) if ( $tidbit == 1); pout( " \n" ) if ( $tidbit == 1); pout( " \n" ) if ( $tidbit == 1); pout( " \n" ); pout( "
\n" ); pout( "$tbmenu
\n" ) if ( $tidbit == 1); pout( "
\n$hor_rule
\n" ); pout( "" ); pout( "$tbtitle
" ); pout( "
Name of Person\n" ); pout( "    Death Date\n" ); pout( "    Age\n" ); pout( "    Block\n" ); pout( "    Lot\n" ); pout( "    Section/Plot\n" ); foreach $item ( @Sortlist ) { ( undef, $hrefsur, $hrefblk, $idx, $dataok, $ddate, $name, $age, $sec, $lot, $blk, $note, $mil ) = split( /\n/, $item, 13 ); $name =~ s|([^ ])\(|$1 \(|g; # Ensure space before paren $name =~ s| +| |g; # Make spaces non-breaking $name =~ s| \(| \(|g; # except before open paren $name =~ s|\) |\) |g; # except after close paren $name =~ # except after two-name 'or' s|(.+,.+ or) (.+,.+)|$1 $2|; $age =~ s| (1/2)(?![0-9])|\½|g; # Use 1/2 glyph w/no space $age =~ s| +| |g; # Make spaces non-breaking $age =~ s|\. |\. |g; # except after period $note =~ s|Interment listed.*1879.*|| if ( $tidbit == 4 ); # Don't need this in Tribune tidbits # $sec = "Note: $note" if ( $note && ! $sec ); $sec = "Note: $note" if ( $note && ! $lot ); # $sec =~ s| 6-11-1879| 6-14-1879|; $news = "news1800s.html#BrdTrib14Jun1879"; $sec =~ s|(Brainerd Tribune 6-14-1879)|$1|; $lot =~ s| or | or
| if ( $blk =~ m| or | ); $lot = "None" if ( ! $lot && $hrefblk =~ m|000| ); # If blk unknown $lot = "$lot" if ( $lot && $hrefblk ); $blk =~ s| or | or
|; # Use nowrap to prevent MSIE from wrapping on "-" $loc = "		$blk$lot$sec"; $loc =~ s| (1/4)(?![0-9])| \¼|g; # Use 1/4 glyph $loc =~ s| (1/2)(?![0-9])| \½|g; # Use 1/2 glyph $loc =~ s| (3/4)(?![0-9])| \¾|g; # Use 3/4 glyph $mil = ( $mil ) ? qq{ } : ""; $fam = exists( $famatch{$idx} ) ? qq{ } : ""; pout( "
$name$mil$fam\n" ); pout( " $ddate$age$loc\n" ); } pout( "

\n$tbmenu" ); } if ( 1 ) { pout( "
\n" ); pout( "
\n" ); pout( "
\n" ); pout( htmlfinish( $fname ) ); } ### Create Military Service page # if ( @Mil ) { $fname = lc( "${pfxmilit}.html" ); open( OUT, ">$fname" ) || die "$fname: $!\n"; printf( "Writing $fname (%d entries)...\n", scalar( @Mil ) ) if ( $DEBUG ); $cname = "Evergreen and Memorial Gardens cemeteries"; $headr = "$titledod: Military Service Veterans"; $title = "$titleeca - Burials of Military Service Veterans"; $descr = " $titleeca $titledod\n" . " for burials of persons with military service\n" . " in $cname, Brainerd, Minnesota."; pout( htmlstart( $title, $descr ) ); pout( "

$headr

\n" ); pout( "$summary\n" ); pout( "\n" ); pout( "\n" ); pout( "$indexes\n" ); pout( "\n" ); pout( "$blidxes\n" ); pout( "\n" ); pout( "$indxnote\n" ); pout( "\n" ); pout( "
 
 
 
 
\n" ); pout( "\n$hor_rule\n" ); pout( "
\n" ); pout( "
\n" ); pout( "\n" ); pout( "\n" ); pout( " \n" ); pout( " \n" ); pout( " \n" ); pout( " \n" ); pout( "
Name of Veteran\n" ); pout( "    Death Date\n" ); pout( "    Age\n" ); pout( "    Military Service\n" ); foreach $item ( sort( @Mil ) ) { ( undef, $hrefsur, $idx, $ddate, $name, $age, $mil ) = split( /\n/, $item, 7 ); $name =~ s|([^ ])\(|$1 \(|g; # Ensure space before paren $name =~ s| +| |g; # Make spaces non-breaking $name =~ s| \(| \(|g; # except before open paren $name =~ s|\) |\) |g; # except after close paren $name =~ # except after two-name 'or' s|(.+,.+ or) (.+,.+)|$1 $2|; $age =~ s| (1/2)(?![0-9])|\½|g; # Use 1/2 glyph w/no space $age =~ s| +| |g; # Make spaces non-breaking $age =~ s|\. |\. |g; # except after period $fam = exists( $famatch{$idx} ) ? qq{ } : ""; $mil =~ s|\&|&|g; # Escape special characters $mil =~ s|\<|<|g; $mil =~ s|\>|>|g; pout( "
$name$fam\n" ); pout( " $ddate$age$mil\n" ); } pout( "
\n" ); pout( "
\n" ); pout( "
\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" );

$headr

$summary $indexes $blidxes $indxnote
 
 
 
 
$hor_rule
Source Of This Data – How the directory was assembled and published.
Reliability Of This Data – Accuracy and completeness of our records.
Data Columns – Descriptions for each column in the directory.
Cemetery Block Layout Maps – Online cemetery block layout maps.
Burials By Decade Per Block – A table showing the pattern of burials over the years.
Find-A-Grave Memorials – Links to corresponding memorials at Find-A-Grave.
Obtaining Further Information – Where to find more details about a death/burial.
Corrections or Comments – Emailing corrections or comments.

Source Of This Data

The Directory of the Dead 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.

The former 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 Directory of the Dead would not be possible.

The transformation of the Directory of the Dead from data in a Microsoft Access database to web pages on the World Wide Web involves three steps. The database is first exported to a tab-delimited text file. Then it is processed by this Perl script 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.

Reliability Of This Data

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.

This initial database (2008) has not 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 Birth Certificate Index and Death Certificate Index 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.

If you find errors or duplications, please contact us (see the link in the page footer, below).

Data Columns in These Pages

The data are presented in six columns:

  1. Name - Lastname, Firstname of person (if applicable).

    The names are sorted using only alphabetic characters and commas. All other characters, including spaces and periods, are ignored.

    Nicknames are given in double-quotes, like Smith, John "Smitty". Maiden names are in parentheses.

    HYPERLINK NOTE: 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.
    Example: Van Essen family burials by Surname.

  2. Death Date - The date of death of the person in MM-DD-YYYY format.

    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.

  3. Age - Age at death, if known. Age of -0- means stillborn.

  4. Block - Block number within the cemetery where interment took place.

    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.

  5. Lot - Lot number within the block where interment took place.

    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.

    HYPERLINK NOTE: 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.
    Example: Van Essen family burials in Block 45 Lot 100.

  6. Plot - The plot within the lot where the remains are buried.

    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.

    8 plot lot (two halves - North and South)
    NWC of N ½ NEC of N ½
    SWC of N ½ SEC of N ½
    NWC of S ½ NEC of S ½
    SWC of S ½ SEC of S ½
    		10 plot lot (4 or 5 ft. grave width)
    NWC NEC
    4 or 5 ft. NWC 4 or 5 ft. NEC
    West Center East Center
    4 or 5 ft. SWC 4 or 5 ft. SEC
    SWC SEC
    Lots oriented North/South. NWC = North West Corner, SEC = South East Corner, etc.

Cemetery Block Layout Maps

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.

Death Dates By Decade Per Block

And here, for all you information junkies out there, is a table showing the count of death dates for burials, per decade, per block. (If a block number is missing - it was not used for any burials.) You can see when certain areas of the cemetery were opened up for new burials. There are some year outliers where earlier burials were transferred in to a newly purchased family lot (e.g. a 1932 death transferred into block 48).

$blkdec

Find-A-Grave Memorials

The Find-A-Grave website 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 the Evergreen Cemetery section 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 Van Essen, William. (This link to Find-A-Grave feature does not yet exist for Memorial Gardens, but nearly all those burials are already in the Memorial Gardens Cemetery section at Find-A-Grave.)

Obtaining Further Information

A major rationale for putting the Directory of the Dead online is to provide access to this information for genealogists or interested family members. A key feature of this dataset is the "By Block" sorting to show who else is buried in the same lot and block. This can reveal the burial locations of additional family members of interest.

Once you have found a burial of interest, you will notice that the public data about that person on this website is limited.

The Office records will almost always have additional information (which may be in short supply for early burials, say up to 1910 or so). This supplemental information would have been obtained from the mortuary, burial permit, obituary, family members, or gathered by researchers in the 1930s (part of a WPA project) trying to fill in missing information on past burials by examining county death records, coroner's records, newspaper accounts, etc. So please contact the office by phone or email to see what they have. There will be a \$1 per page fee (\$5 minimum) charged for sending additional information.

The Crow Wing County death records are another source of information if and only if that person died in Crow Wing County. Vital Records are handled by the Crow Wing County Treasurer's Office.

Obituaries are often found in the local newspapers (moreso after about 1900). In the early days, there were many weekly newspapers. A list of microfilm resources for all Crow Wing newspapers can be found in the Microfilm section of the Crow Wing County Historical Society Research Library page. Contact them to request an obituary lookup. The Society maintains a card catalog of all the death notices in Crow Wing county newspapers so a lookup is very easy. For more prominent local figures, a separate file may also exist with information about that person and their family.

And finally, the Crow Wing County GenWeb website lists many resources for researching in Crow Wing county.

Corrections or Comments

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 Directory of the Dead is intended to be a faithful reproduction of the cemetery records, including the original spelling in older records.

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" ); $title END } ########################################################################## sub htmlextra { my ( $pagename ) = @_; return( <<"END_002" ) if ( $pagename eq "002" );

Photo showing potter's field area of block 2

In 1887, the county bought the unused lots in block 2 to be used as a "potter's field" for the burial of people who were unidentified or who themselves, or their families, were indigent and unable to pay for a proper burial. Therefore, few of the graves in lots 19-55 and 66-70 have markers. The above photo shows this area. The fringe of the non-county burials in lots 1-18 are to the left.

END_002 return( <<"END_009" ) if ( $pagename eq "009" );

Lots 43-44-45-46 & part of lot 41 were combined into a single mega-lot 45 and burial locations use row/grave notation.

END_009 return( <<"END_019" ) if ( $pagename eq "019" );

Block 19 seems to be single graves - most likely people buried by the county when the family couldn't afford it.
None of the graves have markers.

END_019 return( <<"END_020" ) if ( $pagename eq "020" );

Block 20 seems to be single graves - most likely people buried by the county when the family couldn't afford it.
Only three graves have markers - Frank Hanson, George Hitch and Mary Stuck -
and they have been photographed and put on Find-a-Grave.

END_020 return( <<"END_024" ) if ( $pagename eq "024" );

Group shot of block 24 Civil War monuments
(Click on image for a HiRes version - 3068 x 1023 pixels - 422 KB)
Back: Chas. A. Barr, Rezo Potwine, Chas. Laurel, Henry Ritchie, Lewis Moses
Middle: Hiram Abbott, Alex. Belongy, Wm. F. Gilpatrick, Andreas Wholfarter, Albert Leach, Geo. W. Healey
Front: Walter B. Brown, Salem Aitken (facing west), Eustach Jourdon (facing west)

Salem Aitken and Eustach Jourdon were originally buried in the Catholic Mission Cemetery
at Old Crow Wing. As the village was abandoned after the 1870s, their remains were moved to
Rock Island National Cemetery and their Civil War Veteran monuments were moved to Evergreen.
Andreas Wholfarter(sic) is supposedly buried in Block 14 Lot 83 so his monument may also be a
memorial, only (no burial). French Barnes has no monument and his burial location is uncertain.

END_024 return( "" ); } ########################################################################## sub htmlfinish { my ( $fname ) = @_; return ( <<"END" ); $hor_rule
Copyright ©   Evergreen Cemetery Association  |  Directory of the Dead  |  Contact Us Last Updated: $updated
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_in, $name_in, $_[0] ); }