Ich poste mal die Funktion, die das AoH aufbaut. Die Funktion modify() verfeinert die eingelesene RE und gibt etwas in der ganz oben im ersten Post geschilderten Form zurück.
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
sub create_aoh ($) {
# -----------------------------------------------------------------------------
# sub : c r e a t e _ a o h
# -----------------------------------------------------------------------------
# Autor : CD
# Aufgabe : WZ-Liste in AoH übernehmen
# Parameter : Name der Listendatei
# Rückgabewert : Eingelesenes AoH
# -----------------------------------------------------------------------------
# 0.0.1 - 12.03.2004 - CD - Erstellt
# -----------------------------------------------------------------------------
my $file = shift;
my @wz = ();
open (LST, $file) or die "Kann Datei '$file' nicht zum Lesen oeffnen: $!";
while (<LST>) {
next if m~^\s*$~; # Leerzeilen überspringen
my ($id, $code, $vor_re) = split /\t/;
unless (defined $vor_re) {
warn "Fehler in Listendatei Zeile $. '$_'";
next;
}
my $re = modify($vor_re);
my ($qr, $mod) = $re =~ m#^m~(.*)~(.*)$#;
push @wz, {
id => $id,
wzcode => $code,
re => qr~(?$mod:$qr)o~,
};
}
close LST or warn $!;
return @wz;
} # sub create_aoh
später wird das erstellte Array (AoH) in der Funktion wzcode wie folgt verwendet:
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
sub wzcode ($$) {
# -----------------------------------------------------------------------------
# sub : wzcode
# -----------------------------------------------------------------------------
# Autor : CD
# Aufgabe : Vergabe des WZ-Codes
# Parameter : 1) Begriff
# 2) Referenz auf wz-AoH
# Rückgabewert : gefundene Zahl oder 00000
# -----------------------------------------------------------------------------
# 0.0.1 - 12.03.2004 - CD - Erstellt
# -----------------------------------------------------------------------------
my $begriff = shift;
my $refwz = shift;
my $ret = '00000';
for (@$refwz) {
if ($begriff =~ $_->{re}) {
$ret = $_->{wzcode};
last;
}
}
return $ret;
} # sub wzcode
Diese wiederum wird in der Schleife aufgerufen, die die Datendatei einliest. In jeder Zeile werden dann zu bestimmten Daten mit dieser Funktion die wzcodes zurückgegeben, wenn der entsprechende reguläre Ausdruck passt.
Edit: Hmmm für pq hätte ich jetzt das
= () besser wegnehmen sollen ;)\n\n
<!--EDIT|Crian|1079106717-->
s--Pevna-;s.([a-z]).chr((ord($1)-84)%26+97).gee; s^([A-Z])^chr((ord($1)-52)%26+65)^gee;print;
use strict; use warnings; Link zu meiner Perlseite