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"};
}
}
-
Are you posting in the right place? Check out Where do I post X? to know for sure.
-
Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
<code> <a> <b> <big>
<blockquote> <br /> <dd>
<dl> <dt> <em> <font>
<h1> <h2> <h3> <h4>
<h5> <h6> <hr /> <i>
<li> <nbsp> <ol> <p>
<small> <strike> <strong>
<sub> <sup> <table>
<td> <th> <tr> <tt>
<u> <ul>
-
Snippets of code should be wrapped in
<code> tags not
<pre> tags. In fact, <pre>
tags should generally be avoided. If they must
be used, extreme care should be
taken to ensure that their contents do not
have long lines (<70 chars), in order to prevent
horizontal scrolling (and possible janitor
intervention).
-
Want more info? How to link
or How to display code and escape characters
are good places to start.