#!/usr/bin/perl -w
use strict;

my $file = '';
$file = shift @ARGV unless $file;
unless ($file) {
    print "Please input a filename: ";
    chomp ($file = <>);
}

my %change = (
    HEAL => 'NOTE Medical:',	
    HIST => 'NOTE Biography:',
    EDUC => 'NOTE Educated:',
    RESI => 'NOTE Resided:',
    OCCU => 'NOTE Occupation:');

open (FILE, "<$file") or die "Unable to open $file: $!";
my @data = <FILE>;
close FILE;

my $change_this = join "|", keys %change;
$change_this = qr/($change_this)/;

my $found_sour = 0;
my $last_line = '';
for (@data) {
    # make the IBM DOS to ASCII substitution
    s/1 CHAR IBM DOS/O CHAR ASCII/; 
    s/$change_this/$change{$1}/g;
    $found_sour = 0 if m/^0/;
    $found_sour = 1 if m/^0.+SOUR\s*$/;
    if ($found_sour == 1) {
        $found_sour++ if s/1 NAME/1 TITL/;
    }
    elsif ($found_sour) {
        s/1 NAME/2 CONT/;
    }
    # fix the name problem
    if ($last_line =~ m/\bINDI\s*$/) {
        if (m/1\s*NAME/) {
            s|([\w.]+)|($1 eq "NAME")? $1 :ucfirst lc $1|eg;
            # the MacDonald fix, the \b (boundary) condition
            # and the quote check should limit appropriately 
            # Names like Mace and Mack are treated as special
            # cases as this is the only way to deal with them
            s               # substitute regex
            /               # opening delimiter for regex
            (?<!["'`])      # look back for *not* a quote char
            \b              # only match at the boundary of a word and non word
            (Mc|Mac)        # match Mc or Mac and capture in $1
            ([\w-]+)        # match the rest of the name in $2
            /               # finish the match part ot this regex

            # this is what we will use to substitute
            # we execute this code to get our result
            # to avoid special cases MacE and MacK
            # but still allow MacEvoy and MacKinley
            # we us a conditional
            ($1.$2 eq 'Mace' or $1.$2 eq 'Mack')
            ?               # if this condition is true
            $1.$2           # we substitute what we just found back in with no change
            :               # else
            $1.ucfirst $2   # we substitute uppercased first letter of second bit
            /egx;           # the /e is for execute 2nd half
                            # the /g is all cases
                            # the /x allows all these comments!
            # here it is on one line, uncomment this and delete
            # the long one if you want
            # s/(?<!["'`])\b(Mc|Mac)([\w-]+)/($1.$2 eq 'Mace' or $1.$2 eq 'Mack') ? $1.$2 : $1.ucfirst $2/egx;

            # uppercase surname if present, we look for pattern 
            # /\w+/ To allow for commas, dots and spaces we
            # use a character class (the bit in the [ ] ) which
            # will match alphanumerics, spaces, commas, and dots
            # and hypens incases like SLEVIN-WINDSOR :-)
            s|(?<=/)([\w\s,.-]+)(?=/)|uc $1|eg;
        }
    }
    $last_line = $_; # remember the last line for INDI
}

# change the filename. if this substitution fails we warn that
# the file name will be $file.new  the /i makes it case insensitive
# which is important for DOS based systems
unless ($file =~ s/.ged$/PAF.ged/i) {
    warn "$file does not end in '.ged', saving as $file.new\n";
    $file .= '.new';
}
# let's add a test to avoid accidentaly overwriting files
if (-e $file) {
    print "$file exists, overwrite (Y/N)? ";
    my $input = <>;
    unless ($input =~ m/y/i) {
        print "Aborting!\n";
      exit;
    }
}
open (FILE, ">$file") or die "Unable to create $file: $!";
print FILE @data;
close FILE;

print "Data written to $file OK!";