This file is indexed.

/usr/share/perl5/Lingua/EN/NameParse.pm is in liblingua-en-nameparse-perl 1.32-1.

This file is owned by root:root, with mode 0o644.

The actual contents of the file can be viewed below.

   1
   2
   3
   4
   5
   6
   7
   8
   9
  10
  11
  12
  13
  14
  15
  16
  17
  18
  19
  20
  21
  22
  23
  24
  25
  26
  27
  28
  29
  30
  31
  32
  33
  34
  35
  36
  37
  38
  39
  40
  41
  42
  43
  44
  45
  46
  47
  48
  49
  50
  51
  52
  53
  54
  55
  56
  57
  58
  59
  60
  61
  62
  63
  64
  65
  66
  67
  68
  69
  70
  71
  72
  73
  74
  75
  76
  77
  78
  79
  80
  81
  82
  83
  84
  85
  86
  87
  88
  89
  90
  91
  92
  93
  94
  95
  96
  97
  98
  99
 100
 101
 102
 103
 104
 105
 106
 107
 108
 109
 110
 111
 112
 113
 114
 115
 116
 117
 118
 119
 120
 121
 122
 123
 124
 125
 126
 127
 128
 129
 130
 131
 132
 133
 134
 135
 136
 137
 138
 139
 140
 141
 142
 143
 144
 145
 146
 147
 148
 149
 150
 151
 152
 153
 154
 155
 156
 157
 158
 159
 160
 161
 162
 163
 164
 165
 166
 167
 168
 169
 170
 171
 172
 173
 174
 175
 176
 177
 178
 179
 180
 181
 182
 183
 184
 185
 186
 187
 188
 189
 190
 191
 192
 193
 194
 195
 196
 197
 198
 199
 200
 201
 202
 203
 204
 205
 206
 207
 208
 209
 210
 211
 212
 213
 214
 215
 216
 217
 218
 219
 220
 221
 222
 223
 224
 225
 226
 227
 228
 229
 230
 231
 232
 233
 234
 235
 236
 237
 238
 239
 240
 241
 242
 243
 244
 245
 246
 247
 248
 249
 250
 251
 252
 253
 254
 255
 256
 257
 258
 259
 260
 261
 262
 263
 264
 265
 266
 267
 268
 269
 270
 271
 272
 273
 274
 275
 276
 277
 278
 279
 280
 281
 282
 283
 284
 285
 286
 287
 288
 289
 290
 291
 292
 293
 294
 295
 296
 297
 298
 299
 300
 301
 302
 303
 304
 305
 306
 307
 308
 309
 310
 311
 312
 313
 314
 315
 316
 317
 318
 319
 320
 321
 322
 323
 324
 325
 326
 327
 328
 329
 330
 331
 332
 333
 334
 335
 336
 337
 338
 339
 340
 341
 342
 343
 344
 345
 346
 347
 348
 349
 350
 351
 352
 353
 354
 355
 356
 357
 358
 359
 360
 361
 362
 363
 364
 365
 366
 367
 368
 369
 370
 371
 372
 373
 374
 375
 376
 377
 378
 379
 380
 381
 382
 383
 384
 385
 386
 387
 388
 389
 390
 391
 392
 393
 394
 395
 396
 397
 398
 399
 400
 401
 402
 403
 404
 405
 406
 407
 408
 409
 410
 411
 412
 413
 414
 415
 416
 417
 418
 419
 420
 421
 422
 423
 424
 425
 426
 427
 428
 429
 430
 431
 432
 433
 434
 435
 436
 437
 438
 439
 440
 441
 442
 443
 444
 445
 446
 447
 448
 449
 450
 451
 452
 453
 454
 455
 456
 457
 458
 459
 460
 461
 462
 463
 464
 465
 466
 467
 468
 469
 470
 471
 472
 473
 474
 475
 476
 477
 478
 479
 480
 481
 482
 483
 484
 485
 486
 487
 488
 489
 490
 491
 492
 493
 494
 495
 496
 497
 498
 499
 500
 501
 502
 503
 504
 505
 506
 507
 508
 509
 510
 511
 512
 513
 514
 515
 516
 517
 518
 519
 520
 521
 522
 523
 524
 525
 526
 527
 528
 529
 530
 531
 532
 533
 534
 535
 536
 537
 538
 539
 540
 541
 542
 543
 544
 545
 546
 547
 548
 549
 550
 551
 552
 553
 554
 555
 556
 557
 558
 559
 560
 561
 562
 563
 564
 565
 566
 567
 568
 569
 570
 571
 572
 573
 574
 575
 576
 577
 578
 579
 580
 581
 582
 583
 584
 585
 586
 587
 588
 589
 590
 591
 592
 593
 594
 595
 596
 597
 598
 599
 600
 601
 602
 603
 604
 605
 606
 607
 608
 609
 610
 611
 612
 613
 614
 615
 616
 617
 618
 619
 620
 621
 622
 623
 624
 625
 626
 627
 628
 629
 630
 631
 632
 633
 634
 635
 636
 637
 638
 639
 640
 641
 642
 643
 644
 645
 646
 647
 648
 649
 650
 651
 652
 653
 654
 655
 656
 657
 658
 659
 660
 661
 662
 663
 664
 665
 666
 667
 668
 669
 670
 671
 672
 673
 674
 675
 676
 677
 678
 679
 680
 681
 682
 683
 684
 685
 686
 687
 688
 689
 690
 691
 692
 693
 694
 695
 696
 697
 698
 699
 700
 701
 702
 703
 704
 705
 706
 707
 708
 709
 710
 711
 712
 713
 714
 715
 716
 717
 718
 719
 720
 721
 722
 723
 724
 725
 726
 727
 728
 729
 730
 731
 732
 733
 734
 735
 736
 737
 738
 739
 740
 741
 742
 743
 744
 745
 746
 747
 748
 749
 750
 751
 752
 753
 754
 755
 756
 757
 758
 759
 760
 761
 762
 763
 764
 765
 766
 767
 768
 769
 770
 771
 772
 773
 774
 775
 776
 777
 778
 779
 780
 781
 782
 783
 784
 785
 786
 787
 788
 789
 790
 791
 792
 793
 794
 795
 796
 797
 798
 799
 800
 801
 802
 803
 804
 805
 806
 807
 808
 809
 810
 811
 812
 813
 814
 815
 816
 817
 818
 819
 820
 821
 822
 823
 824
 825
 826
 827
 828
 829
 830
 831
 832
 833
 834
 835
 836
 837
 838
 839
 840
 841
 842
 843
 844
 845
 846
 847
 848
 849
 850
 851
 852
 853
 854
 855
 856
 857
 858
 859
 860
 861
 862
 863
 864
 865
 866
 867
 868
 869
 870
 871
 872
 873
 874
 875
 876
 877
 878
 879
 880
 881
 882
 883
 884
 885
 886
 887
 888
 889
 890
 891
 892
 893
 894
 895
 896
 897
 898
 899
 900
 901
 902
 903
 904
 905
 906
 907
 908
 909
 910
 911
 912
 913
 914
 915
 916
 917
 918
 919
 920
 921
 922
 923
 924
 925
 926
 927
 928
 929
 930
 931
 932
 933
 934
 935
 936
 937
 938
 939
 940
 941
 942
 943
 944
 945
 946
 947
 948
 949
 950
 951
 952
 953
 954
 955
 956
 957
 958
 959
 960
 961
 962
 963
 964
 965
 966
 967
 968
 969
 970
 971
 972
 973
 974
 975
 976
 977
 978
 979
 980
 981
 982
 983
 984
 985
 986
 987
 988
 989
 990
 991
 992
 993
 994
 995
 996
 997
 998
 999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
=head1 NAME

Lingua::EN::NameParse - routines for manipulating a person's name

=head1 SYNOPSIS

    use Lingua::EN::NameParse qw(clean case_surname);

    # optional configuration arguments
    my %args =
    (
        auto_clean      => 1,
        force_case      => 1,
        lc_prefix       => 1,
        initials        => 3,
        allow_reversed  => 1,
        joint_names     => 0,
        extended_titles => 0
    );

    my $name = new Lingua::EN::NameParse(%args);

    $error = $name->parse("MR AC DE SILVA");
    if ( $error )
    {
        $bad_input = $my_properties{non_matching};
    }
    else
    {
        %name_comps = $name->components;
        $surname = $name_comps{surname_1}; # DE SILVA

        %name_comps = $name->case_components;
        $surname = $name_comps{surname_1}; # De Silva

        $correct_casing = $name->case_all; # Mr AC de Silva

        $correct_casing = $name->case_all_reversed ; # de Silva, AC

        $good_name = clean("Bad Na9me   "); # "Bad Name"

        $salutation = $name->salutation(salutation => 'Dear',sal_default => 'Friend')); # Dear Mr de Silva

        %my_properties = $name->properties;
        $number_surnames = $my_properties{number}; # 1
    }

    $name->report; # create a report listing all information about the parsed name

    $lc_prefix = 0;
    $correct_case = case_surname("DE SILVA-MACNAY",$lc_prefix); # De Silva-MacNay



=head1 DESCRIPTION


This module takes as input a person or persons name in
free format text such as,

    Mr AB & M/s CD MacNay-Smith
    MR J.L. D'ANGELO
    Estate Of The Late Lieutenant Colonel AB Van Der Heiden

and attempts to parse it. If successful, the name is broken
down into components and useful functions can be performed such as :

   converting upper or lower case values to name case (Mr AB MacNay   )
   creating a personalised greeting or salutation     (Dear Mr MacNay )
   extracting the names individual components         (Mr,AB,MacNay   )
   determining the type of format the name is in      (Mr_A_Smith     )


If the name cannot be parsed you have the option of cleaning the name
of bad characters, or extracting any portion that was parsed and the
portion that failed.

This module can be used for analysing and improving the quality of
lists of names.


=head1 DEFINITIONS


The following terms are used by NameParse to define the components
that can make up a name.

   Precursor   - Estate of (The Late), Right Honourable ...
   Title       - Mr, Mrs, Ms., Sir, Dr, Major, Reverend ...
   Conjunction - word to separate names or initials, such as "And"
   Initials    - 1-3 letters, each with an optional space and/or dot
   Surname     - De Silva, Van Der Heiden, MacNay-Smith, O'Reilly ...
   Suffix      - Snr., Jnr, III, V ...

Refer to the component grammar defined within the code for a complete
list of combinations.

'Name casing' refers to the correct use of upper and lower case letters
in peoples names, such as Mr AB McNay.

To describe the formats supported by NameParse, a short hand representation
of the name is used. The following formats are currently supported :

    Mr_John_Smith_&Ms_Mary_Jones
    Mr_A_Smith_&Ms_B_Jones
    Mr_&Ms_A_&B_Smith
    Mr_A_&Ms_B_Smith
    Mr_&Ms_A_Smith
    Mr_A_&B_Smith
    John_Smith_&Mary_Jones
    John_&Mary_Smith
    A_Smith_&B_Jones

    Mr_John_Adam_Smith
    Mr_John_A_Smith
    Mr_J_Adam_Smith
    Mr_John_Smith
    Mr_A_Smith
    John_Adam_Smith
    John_A_Smith
    J_Adam_Smith
    John_Smith
    A_Smith
    John

Precursors and suffixes may be applied to single names that include a surname



=head1 METHODS

=head2 new

The C<new> method creates an instance of a name object and sets up
the grammar used to parse names. This must be called before any of the
following methods are invoked. Note that the object only needs to be
created ONCE, and should be reused with new input data. Calling C<new>
repeatedly will significantly slow your program down.

Various setup options may be defined in a hash that is passed as an optional
argument to the C<new> method. Note that all the arguments are optional. You
need to define the combination of arguments that are appropriate for your
usage.

   my %args =
   (
      auto_clean     => 1,
      force_case     => 1,
      lc_prefix      => 1,
      initials       => 3,
      allow_reversed => 1
   );


   my $name = new Lingua::EN::NameParse(%args);


=over 4

=item force_case

This option will force the C<case_all> method to name case the entire input
string, including any unmatched sections that failed parsing. For example, in
"MR A JONES & ASSOCIATES", "& ASSOCIATES" will also be name cased. The casing
rules for unmatched sections are the same as for surnames. This is usually
the best option, although any initials in the unmatched section will not
be correctly cased. This option is useful when you know you data has invalid
names, but you cannot filter out or reject them.

=item auto_clean

When this option is set to a positive value, any call to the C<parse> method
that fails will attempt to 'clean' the name and then reparse it. See the
C<clean> method for details. This is useful for dirty data with embedded
unprintable or non alphabetic characters.

=item lc_prefix

When this option is set to a positive value, it will force the C<case_all>
and C<case_component> methods to lower case the first letter of each word that
occurs in the prefix portion of a surname. For example, Mr AB de Silva,
or Ms AS von der Heiden.

=item initials

Allows the user to control the number of letters that can occur in the initials.
Valid settings are 1,2 or 3. If no value is supplied a default of 2 is used.

=item allow_reversed

When this option is set to a positive value, names in reverse order will be
processed. The only valid format is the surname followed by a comma and the
rest of the name, which can be in any of the combinations allowed by non
reversed names. Some examples are:

Smith, Mr AB
Jones, Jim
De Silva, Professor A.B.

The program changes the order of the name back to the non reversed format, and
then performs the normal parsing. Note that if the name can be parsed, the fact
that it's order was originally reversed, is not recorded as a property of the
name object.

=item joint_names

When this option is set to a positive value, joint names are accounted for:

Mr_A_Smith_&Ms_B_Jones
Mr_&Ms_A_&B_Smith
Mr_A_&Ms_B_Smith
Mr_&Ms_A_Smith
Mr_A_&B_Smith

Note that if this option is not specified, than by default joint names are
ignored. Disabling joint names speeds up the processing a lot.

=item extended_titles

When this option is set to a positive value, all combinations of titles,
such as Colonel, Mother Superior are used. If this value is not set, only
the following titles are accounted for:

    Mr
    Ms
    M/s
    Mrs
    Miss
    Dr
    Sir
    Dame


Note that if this option is not specified, than by default extended titles
are ignored. Disabling  extended titles speeds up the processing.

=back

=head2 parse

    $error = $name->parse("MR AC DE SILVA");

The C<parse> method takes a single parameter of a text string containing a
name. It attempts to parse the name and break it down into the components

Returns an error flag, if the name was parsed successfully, it's value is 0,
otherwise a 1. This step is a prerequisite for the following methods.


=head2 case_all

    $correct_casing = $name->case_all;

The C<case_all> method converts the first letter of each component to
capitals and the remainder to lower case, with the following exceptions-

   initials remain capitalised
   surname spelling such as MacNay-Smith, O'Brien and Van Der Heiden are preserved
   - see C<surname_prefs.txt> for user defined exceptions

A complete definition of the capitalising rules can be found by studying
the component grammar defined within the code.

The method returns the entire cased name as text.

=head2 case_all_reversed

    $correct_casing = $name->case_all_reversed;

The C<case_all_reversed> method applies the same type of casing as
C<case_all>. However, the name is returned as surname followed by a comma
and the rest of the name, which can be any of the combinations allowed
for a name, except the title. Some examples are: "Smith, John", "De Silva, A.B."
This is useful for sorting names alphabetically by surname.

The method returns the entire reverse order cased name as text.


=head2 case_components

   %my_name = $name->case_components;
   $cased_surname = $my_name{surname_1};


The C<case_components> method does the same thing as the C<case_all> method,
but returns the name cased components in a hash. The following keys are used
for each component:

   precursor
   title_1
   title_2
   given_name_1
   given_name_2
   initials_1
   initials_2
   middle_name
   conjunction_1
   conjunction_2
   surname_1
   surname_2
   suffix

If a component has no matching data for a given name, it's values will be
set to the empty string.

If the name could not be parsed, this method returns null. If you assign the return
value to a hash, you should check the error status returned by the C<parse> method first.
Ohterwise, you will get an odd number of values addigned to the hash.


=head2 components

   %name = $name->components;
   $surname = $my_name{surname_1};

The C<components> method does the same thing as the C<case_components> method,
but each component is returned as it appears in the input string, with no case
conversion.

=head2 case_surname

   $correct_casing = case_surname("DE SILVA-MACNAY" [,$lc_prefix]);

C<case_surname> is a stand alone function that does not require a name
object. The input is a text string. An optional input argument controls the
casing rules for prefix portions of a surname, as described above in the
C<lc_prefix> section.

The output is a string converted to the correct casing for surnames.
See C<surname_prefs.txt> for user defined exceptions

This function is useful when you know you are only dealing with names that
do not have initials like "Mr John Jones". It is much faster than the case_all
method, but does not understand context, and cannot detect errors on strings
that are not personal names.


=head2 surname_prefs.txt

Some surnames can have more than one form of valid capitalisation, such as
MacQuarie or Macquarie. Where the user wants to specify one form as the default,
a text file called surname_prefs.txt should be created and placed in the same
location as the NameParse module. The text file should contain one surname per
line, in the capitalised form you want, such as

   Macquarie
   MacHado

NameParse will still operate if the file does not exist

=head2 salutation

    $salutation = $name->salutation(salutation => 'Dear',sal_default => 'Friend',sal_type => 'given_name'));

The C<salutation> method converts a name into a personal greeting,
such as "Dear Mr & Mrs O'Brien" or "Dear Sue and John"

Optional parameters may be specided in a hash as follows:


    salutation:

    The greeting word such as 'Dear' or 'Greetings'. If not spefied than 'Dear' is used

    sal_default:

    The default word used when a personalised salution cannot be generated. If not
    specified, than 'Friend' is used.

    sal_type:

    Can be either 'given_name' such as 'Dear Sue' or 'title_plus_name' such as 'Dear Ms Smith'
    If not specified, than 'given_name' is used.

If an error is detected during parsing, such as with the name "AB Smith & Associates",
then the value of sal_default is used instead of a given name, or a title and surname.
If the input string contains a conjunction, an 's' is added to the value of sal_default.

If the name contains a precursor, a default salutation is produced.

=head2 clean

   $good_name = clean("Bad Na9me");

C<clean> is a stand alone function that does not require a name object.
The input is a text string and the output is the string with:

   all repeating spaces removed
   all characters not in the set (A-Z a-z - ' , . &) removed


=head2 properties

The C<properties> method returns all the properties of the name,
non_matching, number and type, as a hash.

=over 4

=item type

The type of format a name is in, as one of the following strings:

    Mr_A_Smith_&Ms_B_Jones
    Mr_&Ms_A_&B_Smith
    Mr_A_&Ms_B_Smith
    Mr_&Ms_A_Smith
    Mr_A_&B_Smith
    Mr_John_Adam_Smith
    Mr_John_A_Smith
    Mr_J_Adam_Smith
    Mr_John_Smith
    Mr_A_Smith
    John_Adam_Smith
    John_A_Smith
    J_Adam_Smith
    John_Smith
    A_Smith
    John
    unknown


=item non_matching

Returns any unmatched section that was found.

=back

=head2 report

Create a formatted text report to standard output listing
- the input string,
- the name and value of each defined component
- any non matching component


=head1 LIMITATIONS

The huge number of character combinations that can form a valid names makes
it is impossible to correctly identify them all. Firstly, there are many
ambiguities, which have no right answer.

   Macbeth or MacBeth, are both valid spellings
   Is ED WOOD E.D. Wood or Edward Wood
   Is 'Mr Rapid Print' a name or a company
   Does  John Bradfield Smith have a middle name of Bradfield, or a surname of Bradfield-Smith?

One approach is to have large lookup files of names and words, statistical rules
and fuzzy logic to attempt to derive context. This approach gives high levels of
accuracy but uses a lot of your computers time and resources.

NameParse takes the approach of using a limited set of rules, based on the
formats that are commonly used by business to represent peoples names. This
gives us fairly high accuracy, with acceptable speed and program size.

NameParse will accept names from many countries, like Van Der Heiden,
De La Mare and Le Fontain. Having said that, it is still biased toward English,
because the precursors, titles and conjunctions are based on English usage.

Names with two or more words, but no separating hyphen are not recognized.
This is a real quandary as Indian, Chinese and other names can have several
components. If these are allowed for, any component after the surname
will also be picked up. For example in "Mr AB Jones Trading As Jones Pty Ltd"
will return a surname of "Jones Trading".

Because of the large combination of possible names defined in the grammar, the
program is not very fast, except for the more limited C<case_surname> subroutine.
See the "Future Directions" section for possible speed ups.

As the parser has a very limited understanding of context, the "John_Adam_Smith"
name type is most likely  to cause problems, as it contains no known tokens
like a title. A string such as "National Australia Bank" would be accepted
as a valid name, first name National etc. Supplying  a list of common pronouns
as exceptions could solve this problem.


=head1 REFERENCES

"The Wordsworth Dictionary of Abbreviations & Acronyms" (1997)

Australian Standard AS4212-1994 "Geographic Information Systems -
Data Dictionary for transfer of street addressing information"


=head1 FUTURE DIRECTIONS

   Add filtering of very long names
   Add diagnostic messages explaining why parsing failed
   Add transforming methods to do things like remove dots from initials
   Try to derive gender (Mr... is male, Ms, Mrs... is female)


Define grammar for other languages. Hopefully, all that would be needed is
to specify a new module with its own grammar, and inherit all the existing
methods. I don't have the knowledge of the naming conventions for non-english
languages.


=head1 SEE ALSO

L<Lingua::EN::AddressParse>, L<Lingua::EN::MatchNames>, L<Lingua::EN::NickNames>,
L<Lingua::EN::NameCase>, L<Parse::RecDescent>


=head1 TO DO


=head1 BUGS

The dot in a suffix of Jnr. or Snr. will be consumed as unmatched text,
and not be retained with the suffix.

Names with accented characters (acute, circumfelx etc) will not be parsed
correctly. A work around is to replace the character class [a-z] with \w
in the appropriate rules in the grammar tree, but this could lower the accuracy
of names based purely on ASCII text.

=head1 CREDITS

Thanks to all the people who provided ideas and suggestions, including -

   QM Industries <http://www.qmi.com.au>
   Damian Conway,  author of Parse::RecDescent
   Mark Summerfield author of Lingua::EN::NameCase,
   Ron Savage, Alastair Adam Huffman, Douglas Wilson
   Peter Schendzielorz

=head1 AUTHOR

NameParse was written by Kim Ryan <kimryan at cpan dot org>

=head1 COPYRIGHT AND LICENSE

Copyright (c) 2013 Kim Ryan. All rights reserved.

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

=cut
#-------------------------------------------------------------------------------

package Lingua::EN::NameParse;

use strict;
use warnings;

use Lingua::EN::NameParse::Grammar;
use Parse::RecDescent;

use Exporter;
use vars qw (@ISA @EXPORT_OK);

our $VERSION = '1.32';
@ISA       = qw(Exporter);
@EXPORT_OK = qw(clean case_surname);

#-------------------------------------------------------------------------------
# Create a new instance of a name parsing object. This step is time consuming
# and should normally only be called once in your program.

sub new
{
    my $class = shift;
    my %args = @_;

    my $name = {};
    bless($name,$class);

    # Default to 2 initials per name. Can be overwritten if user defines
    # 'initials' as a key in the hash supplied to new method.
    $name->{initials} = 2;

    my $current_key;
    foreach my $current_key (keys %args)
    {
        $name->{$current_key} = $args{$current_key};
    }

    my $grammar = Lingua::EN::NameParse::Grammar::_create($name);
    $name->{parse} = new Parse::RecDescent($grammar);

    return ($name);
}
#-------------------------------------------------------------------------------
# Attempt to parse a string and retrieve it's components and properties
# Requires a name object to have been created with the 'new' method'
# Returns: an error code, 0 for success, 1 for failure

sub parse
{
    my $name = shift;
    my ($input_string) = @_;

    chomp($input_string);

    # If reverse ordered names are allowed, swap the surname component, before
    # the comma, with the rest of the name. Rejoin the name, replacing comma
    # with a space.

    if ( $name->{allow_reversed} and $input_string =~ /,/ )
    {
        my ($first,$second) = split(/,/,$input_string);
        $input_string = join(' ',$second,$first);
    }

    $name->{components} = ();
    $name->{properties} = ();
    $name->{properties}{type} = 'unknown';
    $name->{error} = 0;

    $name->{input_string} = $input_string;

    $name = _pre_parse($name);
    unless ( $name->{error} )
    {
        $name = _assemble($name);
        _validate($name);

        if ( $name->{error} and $name->{auto_clean} )
        {
            $name->{input_string} = clean($name->{input_string});
            $name = _assemble($name);
            _validate($name);
        }
    }

   return($name->{error});
}
#-------------------------------------------------------------------------------
# Clean the input string. Can be called as a stand alone function.

sub clean
{
    my ($input_string) = @_;

    # remove illegal characters
    $input_string =~ s/[^A-Za-z\-\'\.&\/ ]//go;

    # remove repeating spaces
    $input_string =~ s/  +/ /go ;

    # remove any remaining leading or trailing space
    $input_string =~ s/^ //;
    $input_string =~ s/ $//;

    return($input_string);
}
#-------------------------------------------------------------------------------
# Given a name object, returns all components in a hash.
# Else return no value. The error flag set in the parse method should be
# tested first to ensure only key/value pairs are assigned to the hash

sub components
{
    my $name = shift;
    if ( $name->{properties}{type} eq 'unknown'  )
    {
        return;
    }
    else
    {
        return(%{ $name->{components} });
    }
}
#-------------------------------------------------------------------------------
# Given a name object, apply correct capitalisation to each component of a
# person's name.
# Return all cased components in a hash.
# Else return no value. The error flag set in the parse method should be
# tested to ensure only key/value pairs are assigned to the hash


sub case_components
{
    my $name = shift;

    if ( $name->{properties}{type} eq 'unknown'  )
    {
        return;
    }
    else
    {
        my %orig_components = $name->components;

        my ($current_key,%cased_components);
        foreach $current_key ( keys %orig_components )
        {
            my $cased_value;
            if ( $current_key =~ /initials/ ) # initials_1, possibly initials_2
            {
                $cased_value = uc($orig_components{$current_key});
            }
            elsif ( $current_key =~ /surname|suffix/ )
            {
               $cased_value = case_surname($orig_components{$current_key},$name->{lc_prefix});
            }
            else
            {
                $cased_value = _case_word($orig_components{$current_key});
            }

            $cased_components{$current_key} = $cased_value;
        }
        return(%cased_components);
    }
}

#-------------------------------------------------------------------------------
# Hash of of lists, indicating the order that name components are assembled in.
# Each list element is itself the name of the key value in a name object.
# Used by the case_all and case_all_reversed  methods.
# These hashes are created here globally, as quite a large overhead is
# imposed if the are created locally, each time the method is invoked

my %component_order=
(
    'Mr_John_Smith_&Ms_Mary_Jones' => ['title_1','given_name_1','surname_1','conjunction_1','title_2','given_name_2','surname_2'],
    'Mr_A_Smith_&Ms_B_Jones' => ['title_1','initials_1','surname_1','conjunction_1','title_2','initials_2','surname_2'],
    'Mr_&Ms_A_&B_Smith'     => ['title_1','conjunction_1','title_2','initials_1','conjunction_1','initials_2','surname_1'],
    'Mr_A_&Ms_B_Smith'       => ['title_1','initials_1','conjunction_1','title_2','initials_2','surname_1'],
    'Mr_&Ms_A_Smith'         => ['title_1','conjunction_1','title_2','initials_1','surname_1'],
    'Mr_A_&B_Smith'          => ['title_1','initials_1','conjunction_1','initials_2','surname_1'],
    'John_Smith_&Mary_Jones' => ['given_name_1','surname_1','conjunction_1','given_name_2','surname_2'],
    'John_&Mary_Smith'       => ['given_name_1','conjunction_1','given_name_2','surname_1'],
    'A_Smith_&B_Jones'       => ['initials_1','surname_1','conjunction_1','initials_2','surname_2'],

    'Mr_John_Adam_Smith'      => ['precursor','title_1','given_name_1','middle_name','surname_1','suffix'],
    'Mr_John_A_Smith'         => ['precursor','title_1','given_name_1','initials_1','surname_1','suffix'],
    'Mr_J_Adam_Smith'         => ['precursor','title_1','initials_1','middle_name','surname_1','suffix'],
    'Mr_John_Smith'           => ['precursor','title_1','given_name_1','surname_1','suffix'],
    'Mr_A_Smith'              => ['precursor','title_1','initials_1','surname_1','suffix'],
    'John_Adam_Smith'         => ['precursor','given_name_1','middle_name','surname_1','suffix'],
    'John_A_Smith'            => ['precursor','given_name_1','initials_1','surname_1','suffix'],
    'J_Adam_Smith'            => ['precursor','initials_1','middle_name','surname_1','suffix'],
    'John_Smith'              => ['precursor','given_name_1','surname_1','suffix'],
    'A_Smith'                 => ['precursor','initials_1','surname_1','suffix'],
    'John'                    => ['given_name_1']
);


# only include names with a single surname
my %reverse_component_order=
(
   'Mr_&Ms_A_&B_Smith'  => ['surname_1','title_1','conjunction_1','title_2','initials_1','conjunction_1','initials_2'],
   'Mr_A_&Ms_B_Smith'    => ['surname_1','title_1','initials_1','conjunction_1','title_2','initials_2'],
   'Mr_&Ms_A_Smith'      => ['surname_1','title_1','title_1','conjunction_1','title_2','initials_1'],
   'Mr_A_&B_Smith'       => ['surname_1','title_1','initials_1','conjunction_1','initials_2'],
   'John_&Mary_Smith'    => ['surname_1','given_name_1','conjunction_1','given_name_2'],

   'Mr_John_Adam_Smith'   => ['surname_1','title_1','given_name_1','middle_name','suffix'],
   'Mr_John_A_Smith'      => ['surname_1','title_1','given_name_1','initials_1','suffix'],
   'Mr_J_Adam_Smith'      => ['surname_1','title_1','initials_1','middle_name','suffix'],
   'Mr_John_Smith'        => ['surname_1','title_1','given_name_1','suffix'],
   'Mr_A_Smith'           => ['surname_1','title_1','initials_1','suffix'],
   'John_Adam_Smith'      => ['surname_1','given_name_1','middle_name','suffix'],
   'John_A_Smith'         => ['surname_1','given_name_1','initials_1','suffix'],
   'J_Adam_Smith'         => ['surname_1','initials_1','middle_name','suffix'],
   'John_Smith'           => ['surname_1','given_name_1','suffix'],
   'A_Smith'              => ['surname_1','initials_1','suffix']
);

#-------------------------------------------------------------------------------
# Apply correct capitalisation to a person's entire name
# If the name type is unknown, return undef
# Else, return a string of all cased components in correct order

sub case_all
{
    my $name = shift;

    my @cased_name;

    if ( $name->{properties}{type} eq 'unknown' )
    {
        return undef;
    }

    unless ( $component_order{$name->{properties}{type}} )
    {
        # component order missing in array defined above
        warn "Component order not defined for: $name->{properties}{type}";
        return;
    }

    my %component_vals = $name->case_components;
    my @order = @{ $component_order{$name->{properties}{type}} };

    foreach my $component_key ( @order )
    {
        # As some components such as precursors are optional, they will appear
        # in the order array but may or may not have have a value, so only
        # process defined values
        if ( $component_vals{$component_key} )
        {
           push(@cased_name,$component_vals{$component_key});
        }
    }
    if ( $name->{error} and $name->{force_case} )
    {
       # Despite errors, try to name case non-matching section. As the format
       # of this section is unknown, surname case will provide the best
       # approximation, but still fail on initials of more than 1 letter
       push(@cased_name,case_surname($name->{properties}{non_matching},$name->{lc_prefix}));
    }

    return(join(' ',@cased_name));
}

#-------------------------------------------------------------------------------
=head1 case_all_reversed

Apply correct capitalisation to a person's entire name and reverse the order
so that surname is first, followed by the other components, such as: Smith, Mr John A
Useful for creating a list of names that can be sorted by surname.

If name type is unknown , returns null

If the name type has a joint name, such as 'Mr_A_Smith_Ms_B_Jones', return null,
as it is ambiguous which surname to place at the start of the string

Else, returns a string of all cased components in correct reversed order

=cut

sub case_all_reversed
{
    my $name = shift;

    my @cased_name_reversed;

    unless ( $name->{properties}{type} eq 'unknown'  )
    {
        unless ( $reverse_component_order{$name->{properties}{type} } )
        {
            # this type of name should not be reversed, such as two surnames
            return;
        }
        my %component_vals = $name->case_components;
        my @reverse_order = @{ $reverse_component_order{$name->{properties}{type} } };

        foreach my $component_key ( @reverse_order )
        {
            # As some components such as precursors are optional, they will appear
            # in the order array but may or may not have have a value, so only
            # process defined values

            my $component_value = $component_vals{$component_key};
            if ( $component_value )
            {
                if ($component_key eq 'surname_1')
                {
                    $component_value .= ',';
                }
                push(@cased_name_reversed,$component_value);
            }
        }
    }
    return(join(' ',@cased_name_reversed));
}
#-------------------------------------------------------------------------------
# The user may specify their own preferred spelling for surnames.
# These should be placed in a text file called surname_prefs.txt
# in the same location as the module itself.

BEGIN
{
   # Obtain the full path to NameParse module, defined in the %INC hash.
   my $prefs_file_location = $INC{"Lingua/EN/NameParse.pm"};
   # Now substitute the name of the preferences file
   $prefs_file_location =~ s/NameParse\.pm$/surname_prefs.txt/;

   if ( open(PREFERENCES_FH,"<$prefs_file_location") )
   {
      my @surnames = <PREFERENCES_FH>;
      foreach my $name ( @surnames )
      {
         chomp($name);
         # Build hash, lower case name is key for case insensitive
         # comparison, while value holds the actual capitalisation
         $Lingua::EN::surname_preferences{lc($name)} = $name;
      }
      close(PREFERENCES_FH);
   }
}
#-------------------------------------------------------------------------------
# Apply correct capitalisation to a person's surname. Can be called as a
# stand alone function.

sub case_surname
{
    my ($surname,$lc_prefix) = @_;

    unless ($surname)
    {
        return;
    }

    # If the user has specified a preferred capitalisation for this
    # surname in the surname_prefs.txt, it should be returned now.
    if ($Lingua::EN::surname_preferences{lc($surname)} )
    {
        return($Lingua::EN::surname_preferences{lc($surname)});
    }

    # Lowercase everything
    $surname = lc($surname);

    # Now uppercase first letter of every word. By checking on word boundaries,
    # we will account for apostrophes (D'Angelo) and hyphenated names
    $surname =~ s/\b(\w)/\u$1/g;

    # Name case Macs and Mcs
    # Exclude names with 1-2 letters after prefix like Mack, Macky, Mace
    # Exclude names ending in a,c,i,o,z or j, typically Polish or Italian

    if ( $surname =~ /\bMac[a-z]{2,}[^a|c|i|o|z|j]\b/i  )
    {
        $surname =~ s/\b(Mac)([a-z]+)/$1\u$2/ig;

        # Now correct for "Mac" exceptions
        $surname =~ s/MacHin/Machin/;
        $surname =~ s/MacHlin/Machlin/;
        $surname =~ s/MacHar/Machar/;
        $surname =~ s/MacKle/Mackle/;
        $surname =~ s/MacKlin/Macklin/;
        $surname =~ s/MacKie/Mackie/;

        # Portuguese
        $surname =~ s/MacHado/Machado/;

        # Lithuanian
        $surname =~ s/MacEvicius/Macevicius/;
        $surname =~ s/MacIulis/Maciulis/;
        $surname =~ s/MacIas/Macias/;
    }
    elsif ( $surname =~ /\bMc/i )
    {
        $surname =~ s/\b(Mc)([a-z]+)/$1\u$2/ig;
    }
    # Exceptions (only 'Mac' name ending in 'o' ?)
    $surname =~ s/Macmurdo/MacMurdo/;


    if ( $lc_prefix )
    {
        # Lowercase first letter of every word in prefix. The trailing space
        # prevents the surname from being altered. Note that spellings like
        # d'Angelo are not accounted for.
        $surname =~ s/\b(\w+ )/\l$1/g;
    }

    # Correct for possessives such as "John's" or "Australia's". Although this
    # should not occur in a person's name, they are valid for proper names.
    # As this subroutine may be used to capitalise words other than names,
    # we may need to account for this case. Note that the 's' must be at the
    # end of the string
    $surname =~ s/(\w+)'S(\s+)/$1's$2/;
    $surname =~ s/(\w+)'S$/$1's/;

    # Correct for roman numerals, excluding single letter cases I,V and X,
    # which will work with the above code
    $surname =~ s/\b(I{2,3})\b/\U$1/i;  # 2nd, 3rd
    $surname =~ s/\b(IV)\b/\U$1/i;      # 4th
    $surname =~ s/\b(VI{1,3})\b/\U$1/i; # 6th, 7th, 8th
    $surname =~ s/\b(IX)\b/\U$1/i;      # 9th
    $surname =~ s/\b(XI{1,3})\b/\U$1/i; # 11th, 12th, 13th

    return($surname);
}
#-------------------------------------------------------------------------------
# Create a personalised greeting from one or two person's names
# Returns the salutation as a string, such as "Dear Mr Smith", or "Dear Sue"

sub salutation
{
    my $name = shift;
    my %args = @_;

    my $salutation = 'Dear';
    my $sal_default = 'Friend';
    my $sal_type = 'title_plus_surname';

    # Check to see if we should override defualts with any user specified preferences
    if ( %args )
    {
        foreach my $current_key (keys %args)
        {
            $current_key eq 'salutation' and $salutation = $args{$current_key};
            $current_key eq 'sal_default' and $sal_default = $args{$current_key};
            $current_key eq 'sal_type' and $sal_type = $args{$current_key};
        }
    }


    my @greeting;
    push(@greeting,$salutation);

    # Personalised salutations cannot be created for Estates or people
    # without some title
    if
    (
        $name->{error} or
        ( $name->{components}{precursor} and  $name->{components}{precursor} =~ /Estate/i)
    )
    {
        # Despite an error, the presence of a conjunction probably
        # means we are dealing with 2 or more people.
        # For example Mr AB Smith & John Jones
        if ( $name->{input_string} =~ / (And|&) /i )
        {
           $sal_default .= 's';
        }
        push(@greeting,$sal_default);
    }
    else
    {
        my %component_vals = $name->case_components;

        if ( $sal_type eq 'given_name')
        {
            if ( $component_vals{'given_name_1'} )
            {
                push(@greeting,$component_vals{'given_name_1'});
                if ( $component_vals{'given_name_2'} )
                {
                    push(@greeting,$component_vals{'conjunction_1'});
                    push(@greeting,$component_vals{'given_name_2'});
                }
            }
            else
            {
                # No given name such as 'A_Smith','J_Adam_Smith','Mr_A_Smith'
                # Must use default
                push(@greeting,$sal_default);
            }
        }
        elsif ( $sal_type eq 'title_plus_surname' )
        {
            if ( $name->{properties}{number} == 1 )
            {
                if ( $component_vals{'title_1'} )
                {
                    push(@greeting,$component_vals{'title_1'});
                    push(@greeting,$component_vals{'surname_1'});
                }
                else
                {
                    # No title such as 'A_Smith','J_Adam_Smith', so must use default
                    push(@greeting,$sal_default);
                }
            }
            elsif ( $name->{properties}{number} == 2 )
            {
                # a joint name

                my $type = $name->{properties}{type};
                if ( $type eq 'Mr_&Ms_A_Smith' or $type eq 'Mr_A_&Ms_B_Smith' or $type eq 'Mr_&Ms_A_&B_Smith' )
                {
                    # common surname
                    push(@greeting,$component_vals{'title_1'});
                    push(@greeting,$component_vals{'conjunction_1'});
                    push(@greeting,$component_vals{'title_2'});
                    push(@greeting,$component_vals{'surname_1'});

                }
                elsif ( $type eq 'Mr_A_Smith_&Ms_B_Jones' or $type eq 'Mr_John_Smith_&Ms_Mary_Jones' )
                {
                    push(@greeting,$component_vals{'title_1'});
                    push(@greeting,$component_vals{'surname_1'});
                    push(@greeting,$component_vals{'conjunction_1'});
                    push(@greeting,$component_vals{'title_2'});
                    push(@greeting,$component_vals{'surname_2'});
                }
                else
                {
                    # No title such as A_Smith_&B_Jones', 'John_Smith_&Mary_Jones'
                    # Must use default
                    push(@greeting,$sal_default);
                }
            }
        }
        else
        {
            warn "Invalid sal_type : ", $sal_type;
            push(@greeting,$sal_default);
        }
    }
    return(join(' ',@greeting));
}
#-------------------------------------------------------------------------------
# Return all name properties as a hash

sub properties
{
    my $name = shift;
    return(%{ $name->{properties} });
}

#-------------------------------------------------------------------------------
# Create a text report to standard output listing
# - the input string,
# - the name of each defined component, if it exists
# - any non matching component

sub report
{
    my $name = shift;

    printf("%-17.17s : %-40.40s\n","Input",$name->{input_string});

    my %props = $name->properties;
    unless ($props{type} eq 'unknown')
    {
        my %comps = $name->case_components;
        if ( %comps )
        {
            foreach my $comp ( sort keys %comps)
            {
                printf("%-17.17s : %s\n",$comp,$comps{$comp});
            }
        }
    }

    if ( $props{type} )
    {
        printf("%-17.17s : %-40.40s\n","Name type",$props{type});
    }

    if ( $props{non_matching} )
    {
        printf("%-17.17s : %-40.40s\n","Parsing Error","Yes");
        printf("%-17.17s : %-40.40s\n","Non matching part",$props{non_matching});
    }
}
#-------------------------------------------------------------------------------

# PRIVATE METHODS

#-------------------------------------------------------------------------------

sub _pre_parse
{
    my $name = shift;
    # Check that common reserved word (as found in company names) do not appear
    if ( $name->{input_string} =~
         /\bPty\.? Ltd\.?$|\bLtd\.?$|\bPLC$|Association|Department|National|Society/i )
    {
        $name->{error} = 1;
        $name->{properties}{non_matching} = $name->{input_string};
    }

    # For the case of a single name such as 'Voltaire' we need to add a trailing space
    # to the input string. This is because the grammar tree expects a terminator (the space)
    # optionally followed by other productions or non matching text
   if ( $name->{input_string} =~ /^[A-Z]{2,}(\-)?[A-Z]{0,}$/i )
    {
        $name->{input_string} .= ' ';
    }
    return($name);

}
#-------------------------------------------------------------------------------
# Initialise all components to empty string. Assemble hashes of components
# and properties as part of the name object
#
sub _assemble
{
    my $name = shift;

    # $::RD_TRACE  = 1;  # for debugging RecDescent output
    # Use Parse::RecDescent to do the parsing. 'full_name' is a label for the complete grammar tree
    # defined in Lingua::EN::NameParse::Grammar
    my $parsed_name = $name->{parse}->full_name($name->{input_string});

    # Place components into a separate hash, so they can be easily returned
    # for the user to inspect and modify.

    # For correct matching, the grammar of each component must include the
    # trailing space that separates it from any following word. This should
    # now be removed from the components, and will be restored by the
    # case_all and salutation methods, if called.

    $name->{components}{precursor} = q{};
    if ( $parsed_name->{precursor} )
    {
        $name->{components}{precursor} = _trim_space($parsed_name->{precursor});
    }

    $name->{components}{title_1} = q{};
    if ( $parsed_name->{title_1} )
    {
        $name->{components}{title_1} = _trim_space($parsed_name->{title_1});
    }

    $name->{components}{title_2} = q{};
    if ( $parsed_name->{title_2} )
    {
        $name->{components}{title_2} = _trim_space($parsed_name->{title_2});
    }

    $name->{components}{given_name_1} = q{};
    if ( $parsed_name->{given_name_1} )
    {
        $name->{components}{given_name_1} = _trim_space($parsed_name->{given_name_1});
    }

    $name->{components}{given_name_2} = q{};
    if ( $parsed_name->{given_name_2} )
    {
        $name->{components}{given_name_2} = _trim_space($parsed_name->{given_name_2});
    }


    $name->{components}{middle_name} = q{};
    if ( $parsed_name->{middle_name} )
    {
        $name->{components}{middle_name} = _trim_space($parsed_name->{middle_name});
    }

    $name->{components}{initials_1} = q{};
    if ( $parsed_name->{initials_1} )
    {
        $name->{components}{initials_1} = _trim_space($parsed_name->{initials_1});
    }

    $name->{components}{initials_2} = q{};
    if ( $parsed_name->{initials_2} )
    {
        $name->{components}{initials_2} = _trim_space($parsed_name->{initials_2});
    }

    $name->{components}{conjunction_1} = q{};
    if ( $parsed_name->{conjunction_1} )
    {
        $name->{components}{conjunction_1} = _trim_space($parsed_name->{conjunction_1});
    }

    $name->{components}{conjunction_2} = q{};
    if ( $parsed_name->{conjunction_2} )
    {
        $name->{components}{conjunction_2} = _trim_space($parsed_name->{conjunction_2});
    }

    $name->{components}{surname_1} = q{};
    if ( $parsed_name->{surname_1} )
    {
        $name->{components}{surname_1} = _trim_space($parsed_name->{surname_1});
    }

    $name->{components}{surname_2} = q{};
    if ( $parsed_name->{surname_2} )
    {
        $name->{components}{surname_2} = _trim_space($parsed_name->{surname_2});
    }

    $name->{components}{suffix} = q{};
    if ( $parsed_name->{suffix} )
    {
        $name->{components}{suffix} = _trim_space($parsed_name->{suffix});
    }


    $name->{properties}{non_matching} = q{};
    if ( $parsed_name->{non_matching} )
    {
        $name->{properties}{non_matching}  = $parsed_name->{non_matching};
    }

    $name->{properties}{number} = 0;
    $name->{properties}{number} = $parsed_name->{number};
    $name->{properties}{type}   = $parsed_name->{type};

    return($name);
}
#-------------------------------------------------------------------------------
# Remove any trailing spaces

sub _trim_space
{
    my ($string) = @_;
    $string =~ s/ $//;
    return($string);
}
#-------------------------------------------------------------------------------
# Check if any name components have illegal characters, or do not have the
# correct syntax for a valid name.


sub _validate
{
    my $name = shift;

    if ( $name->{properties}{non_matching} )
    {
        $name->{error} = 1;
    }
    # illegal characters found
    elsif ( $name->{input_string} =~ /[^A-Za-z\-\'\.,&\/ ]/ )
    {
        $name->{error} = 1;
    }
    elsif ( not _valid_name($name->{components}{given_name_1}) )
    {
        $name->{error} = 1;
    }
    elsif ( not _valid_name($name->{components}{middle_name}) )
    {
        $name->{error} = 1;
    }

    elsif ( not _valid_name($name->{components}{surname_1}) )
    {
        $name->{error} = 1;
    }
    elsif ( not _valid_name($name->{components}{surname_2}) )
    {
        $name->{error} = 1;
    }
    else
    {
        $name->{error} = 0;
    }
}
#-------------------------------------------------------------------------------
# If the name has an assigned value, check that it contains a vowel sound,
# or matches the exceptions to this rule.
# Returns 1 if name is valid, otherwise 0

sub _valid_name
{
    my ($name) = @_;
    if ( not $name )
    {
        return(1);
    }
    # Names should have a vowel sound,
    # valid exceptions are Ng, Tsz,Md, Cng,Hng,Chng etc
    elsif ( $name and $name =~ /[aeiouyj]|^(ng|tsz|md|(c?h|[pts])ng)$/i )
    {
        return(1);
    }
    else
    {
        return(0);
    }
}
#-------------------------------------------------------------------------------
# Upper case first letter, lower case the rest, for all words in string
sub _case_word
{
    my ($word) = @_;

    $word =~ s/(\w+)/\u\L$1/g;
    return($word);
}
#-------------------------------------------------------------------------------
return(1);