blob: b1b468cc897c454bb0109135bd0b15acf924cf53 (
plain)
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
|
#!/usr/bin/env perl
#===============================================================================
#
# FILE: skript3.pl
#
# USAGE: ./skript3.pl
#
# DESCRIPTION:
#
# OPTIONS: ---
# REQUIREMENTS: ---
# BUGS: ---
# NOTES: ---
# AUTHOR: Stefan Suhren (su), suhren.stefan@fh-swf.de
# ORGANIZATION: FH Südwestfalen, Iserlohn
# VERSION: 1.0
# CREATED: 20.11.2015 00:14:20
# REVISION: ---
#===============================================================================
use strict;
use warnings;
use utf8;
# enforce utf-8 mode
binmode (STDIN, ":encoding(UTF-8)");
binmode (STDOUT, ":encoding(UTF-8)");
binmode (STDERR, ":encoding(UTF-8)");
use open ":encoding(UTF-8)";
my %wortliste;
my $german9_file_name = 'GERMAN9.LST'; # input file name
open my $german9, '<', $german9_file_name
or die "$0 : failed to open input file '$german9_file_name' : $!\n";
while (my $wort = <$german9>)
{
chomp $wort;
my $key = make_key($wort);
push @{$wortliste{$key}}, $wort;
}
close $german9
or warn "$0 : failed to close input file '$german9_file_name' : $!\n";
my $wort;
do
{
print "Verwürfeltes Wort eingeben: ";
$wort = <>;
chomp $wort;
}while( $wort !~ /^[\p{L}]{9}$/i );
my $key = make_key($wort);
if(exists $wortliste{$key})
{
print "Lösung(en) ist/sind: ";
foreach my $loesung (@{$wortliste{$key}})
{
print $loesung . ", ";
}
}
else
{
print "Wort konnte leider nicht gefunden werden.";
}
#=== FUNCTION ================================================================
# NAME: make_key
# PURPOSE: Creates a key for the hash of solutions.
# PARAMETERS: The string to make a key from.
# RETURNS: The key for the hash of solutions.
# DESCRIPTION: Creates a key for the hash of solutions.
# THROWS: no exceptions
# COMMENTS: none
# SEE ALSO: n/a
#===============================================================================
sub make_key {
my ( $zeichenkette ) = @_;
defined $zeichenkette or die "No zeichenkette supplied.";
chomp $zeichenkette;
my @feld = split //, uc $zeichenkette;
@feld = sort @feld;
return join ("", @feld);
} ## --- end sub make_key
|
