Thread zufällig Personennamen rezeugen...: modul funzt; jedoch feinheit (4 answers)
Opened by esskar at 2004-01-29 03:28

esskar
 2004-01-29 03:28
#79621 #79621
User since
2003-08-04
7321 Artikel
ModeratorIn

user image
Code: (dl )
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
package libyn::LinguaName;

use strict;
use warnings;

use Fcntl ':flock';

BEGIN
{
  use FindBin;
  use vars qw(@gfrequence $gpkgpath);

  $gpkgpath = "$FindBin::Bin/"._ _PACKAGE_ _;
  $gpkgpath =~ s!::!/!g;
}

use constant FILE_BOYS   => "$gpkgpath/boys.txt";
use constant FILE_GIRLS   => "$gpkgpath/girls.txt";
use constant FILE_SURNAMES   => "$gpkgpath/surnames.txt";

@gfrequence = (1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 3);

sub new
{
  my ($class) = @_;

  my $self = {};

  bless $self, $class;

  $self->{-boys} = _read_file(FILE_BOYS);
  $self->{-girls} = _read_file(FILE_GIRLS);
  $self->{-surnames} = _read_file(FILE_SURNAMES);

  return $self;
}

sub gen_people
{
  my ($self, $count) = @_;
  my @retval = ();

  return () if $count <= 0;

  while($count--) { push @retval, $self->gen_person(); }

  return @retval;
}

sub gen_person
{
  my ($self) = @_;

  return $self->gen_name();
}

sub gen_name
{
  my ($self) = @_;
  my $count = _get_rand_part(@gfrequence);

  my $allnames = [$self->{-boys}, $self->{-girls}];
  my $names = _get_rand_part(@{$allnames});
  my @name = ();

  while($count--) { push @name, _get_rand_part(@{$names}); }
  push @name, _get_rand_part(@{$self->{-surnames}});

  return join ' ', @name;
}

sub _get_rand_part
{
  my (@array) = @_;

  return $array[int(rand(scalar(@array)))];
}

sub _read_file
{
  my ($file) = @_;
  my $arrayref = [];

  if(open(FILE, "< $file"))
  {
     flock FILE, LOCK_SH;
     while(my $entry = <FILE>)
     {
        chomp $entry;
        push @{$arrayref}, $entry;
     }

     close(FILE);
  }

  return $arrayref;
}

1;


schaut euch mal den begin block an...
ist gemeine mäuse ka**e...
wie gehts besser? danke!

die Dateien liegen hier:
http://www.intertivity.com/share/boys.txt
http://www.intertivity.com/share/girls.txt
http://www.intertivity.com/share/surnames.txt\n\n

<!--EDIT|esskar|1075399605-->

View full thread zufällig Personennamen rezeugen...: modul funzt; jedoch feinheit