Re: Random personal names

[choroba]

Similar programme I used to generate a patient list with birth certificate numbers in Czech.

!/usr/bin/perl

use warnings;
use strict;
use utf8;
use feature qw/say/;

use constant DAYS => qw/0 31 28 31 30 31 30 31 31 30 31 30 31/;

sub generate_rc {
    my $gender = shift;
    my $year   = int rand 100;
    my $month  = 1 + int rand 12;
    my $day    = 1 + int rand((DAYS)[$month]);

    $month += 50 if $gender eq 'female';
    $year += int rand 50 if $year < 50 and $year > 11;
    return sprintf '%02d%02d%02d/%04d', $year, $month, $day, rand 1000
+;
}

binmode STDOUT, ':utf8:crlf';

my %firstnames
  = ( male   => [qw/Adam Cyril David František Gustav Ivan Jakub Jan
                    Jaroslav Ji&#345;í Josef Karel Ladislav Lukáš Mart
+in
                    Michal Milan Ond&#345;ej Pavel Petr Radek Stanisla
+v Tomáš
                    Václav Vladimír Zden&#283;k/],
      female => [qw/Alena Anna Barbora Dana Eva Hana Helena Ivana Jana
                    Jitka Karolína Kate&#345;ina Klára Lenka Libuše Lu
+cie
                    Marie Petra Radka Simona V&#283;ra Veronika Zdena
                    Št&#283;pánka/] );

my %surnames
  = ( male   => [qw/Novák Stan&#283;k Bílý Zbo&#345;il Mat&#283;j&#367
+; Fu&#269;ík
                    Sedlá&#269;ek Svoboda Dvo&#345;ák &#268;erný Proch
+ázka Ku&#269;era Veselý
                    Horák N&#283;mec Pokorný Pospíšil Hájek Jelínek Be
+neš Urban
                    Blažek Musil Polák Kadlec Dostál Soukup Bureš Vace
+k/],
      female => [qw/Nováková Sta&#328;ková Bílá Zbo&#345;ilová Mat&#28
+3;j&#367; Fu&#269;íková
                    Sedlá&#269;ková Svobodová Dvo&#345;áková &#268;ern
+á Procházková
                    Ku&#269;erová Veselá Horáková N&#283;mcová Pokorná
+ Pospíšilová
                    Hájková Jelínková Benešová Urbanová Blažková Musil
+ová
                    Poláková Kadlecová Dostálová Soukupová Burešová Va
+cková/]
    );


my %rcs;
for (1 .. $ARGV[0]) {
    my $gender = (keys %firstnames)[rand 2];

    if ($ARGV[1] == 1) {
        say join ' ',
            $firstnames{$gender}[rand @{ $firstnames{$gender} } ],
            $surnames{$gender}[rand @{ $surnames{$gender} } ],
            generate_rc($gender);

    } elsif ($ARGV[1] == 2) {
        my $firstname = $firstnames{$gender}[rand @{ $firstnames{$gend
+er} } ];
        my $surname = $surnames{$gender}[rand @{ $surnames{$gender} } 
+];
        my $middlename;
        if(1 > rand 500) {
            $middlename = $firstnames{$gender}[rand @{ $firstnames{$ge
+nder} } ]
                until length $middlename and $middlename ne $firstname
+;
        }
        my $rc = q{};
        $rc = generate_rc($gender) while ! $rc or exists $rcs{$rc};
        undef $rcs{$rc};
        say $rc,
            ' ','"', $firstname, ' ',
              $middlename ? "$middlename " : q{}, $surname, '"';
    } else {
        die qq{ARG[1] == 1: Firstname Surname RC\nARG[1] == 2: RC "Fir
+stname(s) Surname"};
    }
}