in reply to Random personal names
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ří Josef Karel Ladislav Lukáš Mart +in Michal Milan Ondřej Pavel Petr Radek Stanisla +v Tomáš Václav Vladimír Zdeněk/], female => [qw/Alena Anna Barbora Dana Eva Hana Helena Ivana Jana Jitka Karolína Kateřina Klára Lenka Libuše Lu +cie Marie Petra Radka Simona Věra Veronika Zdena Štěpánka/] ); my %surnames = ( male => [qw/Novák Staněk Bílý Zbořil Matějů +; Fučík Sedláček Svoboda Dvořák Černý Proch +ázka Kučera Veselý Horák Ně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ňková Bílá Zbořilová Mat +3;jů Fučíková Sedláčková Svobodová Dvořáková Čern +á Procházková Kučerová Veselá Horáková Ně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"}; } }
لսႽ† ᥲᥒ⚪⟊Ⴙᘓᖇ Ꮅᘓᖇ⎱ Ⴙᥲ𝇋ƙᘓᖇ
|
---|
In Section
Cool Uses for Perl