#!/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";