Schau mal ob das etwas schneller ist.
Ich habe hier eine Klasse zusammengebaut, die das Parsen übernehmen soll. Ganz unten sind ein paar Beispiele.
Leider wird der Parser in der untersten Ebene der verschachtelung immer noch recht langsam sein, da immernoch der gesammte String durchgearbeitet werden muß. (Der Parser wird bei der Objektinitialisierung aufgerufen) aber mit jeder verschachtelungstiefe sollte er viel schneller werden.
Nach der initialisierung des Objektes mit
my $bnf=BNF::new('BNF-String');
stehen dir eine Reihe von Funktionen zur Verfügung:
Die wichtigsten dürften "get_key" und "get_keys" sein.
"get_key" liefert den inhalt des schlüssels mit dem übergebenen Namen. Entwerder ist es ein Objekt aus der Klasse "BNF" oder ein string mit dem Wert zu dem Schlüssel.
"get_keys" funktioniert so ähnlich nur lifert es einen anonymen Hash zurück, der alle Schlüssel und die dazugehörigen Werte dieses Objektes enthält.
"get_key_typ" dient zum herausfinden ob der Wert zum Schlüssel ein Objekt oder ein String ist.
"get_keys_name" gibt eine Liste der Schlüssel zurück.
"get_bnf_string" "set_bnf_string" liest oder schreibt den BNF string des Objektes. Wird ein neuer String an das Objekt übergeben, so wird er geparst.
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
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
#!/usr/bin/perl
use strict;
use warnings;
use Data::Dumper;
my $data='{key1={key11=value11} | key2 = value2 | key3 = {key31=value31 | key32 = value32 | key33 = {key331=value331|key332={key3321=value3321|key3322=value3322|key3321=value3322}|key333=value333|key334=value334}}}';
package BNF;
sub new
{
my $bnf_string=shift(@_);
my $self={};
bless($self);
$self->{string}=$bnf_string;
$self->{BNF}={};
return undef unless($self->_parse());
return $self;
}
sub set_bnf_string
{
my $self=shift(@_);
my $string=shift(@_);
$self->{string}=$string;
return 0 unless($self->_parse());
return 1;
}
sub get_key
{
my $self=shift(@_);
my $key=shift(@_);
if(exists($self->{BNF}->{$key}))
{
if($self->get_key_typ($key) eq 'block')
{ return new($self->{BNF}->{$key}); }
else
{ return $self->{BNF}->{$key}; }
}
else
{ return undef; }
}
sub get_keys
{
my $self=shift(@_);
my %childs=();
for my $key (keys(%{$self->{BNF}}))
{
if($self->get_key_typ($key) eq 'block')
{ $childs{$key}=new($self->{BNF}->{$key}); }
else
{ $childs{$key}=$self->{BNF}->{$key}; }
}
return \%childs;
}
sub get_key_typ
{
my $self=shift(@_);
my $key=shift(@_);
if(exists($self->{BNF}->{$key}))
{
if($self->{BNF}->{$key}=~/^\{/)
{ return 'block'; }
else
{ return 'value'; }
}
else
{ return undef; }
}
sub get_keys_name
{
my $self=shift(@_);
my %childs=();
return keys(%{$self->{BNF}});
}
sub get_bnf_string
{
my $self=shift(@_);
return '{'.$self->{string}.'}';
}
sub _parse
{
my $self=shift(@_);
return 0 if($self->{string} eq '');
$self->{BNF}={};
$self->{string}=~s/^[^\{]*\{(.+)\}[^\}]*$/$1/s;
$self->{string}=~s/\s+([\|\{\}\=])/$1/sg;
$self->{string}=~s/([\|\{\}\=])\s+/$1/sg;
my @lst=split(/(?<=\{|\}|\|)/s,$self->{string});
@lst=map{ length($_)>1?($_,chop($_)):$_ }@lst;
my $val;
my $cnt=0;
for my $i (@lst)
{
$cnt++ if($i eq '{');
$self->{BNF}->{$val}.=$i if($cnt>0);
$val=$1 if($cnt==0 && $i =~/^(.+)=$/);
$self->{BNF}->{$1}=$2 if($cnt==0 && $i =~/^(.+)=(.+)$/);
$cnt-- if($i eq '}');
}
return 1;
}
package main;
my $bnf=BNF::new($data);
print "key3->key33->key333=".$bnf->get_key('key3')->get_key('key33')->get_key('key333')."\n";
print "key3->key33->key333=".$bnf->get_keys()->{key3}->get_keys()->{key33}->get_keys()->{key333}."\n";
print "Schlüsselnamen von key3->key33: ".join('; ',$bnf->get_key('key3')->get_keys()->{key33}->get_keys_name())."\n";
print "BNF von key3->key33: ".$bnf->get_key('key3')->get_key('key33')->get_bnf_string()."\n";