package cfgparser; use strict; require Exporter; @cfgparser::ISA = qw(Exporter); @cfgparser::EXPORT = qw( parse_structure parse_cfg_file ); use logging; use JSON; use Data::Dumper; sub check_structure ($$$); sub check_structure ($$$) { my ($label, $structure, $grammar) = @_; my $stype = ref($structure); my $gtype = $$grammar{Type}; if ($gtype eq 'or') { my $options = $$grammar{Options}; if ($stype eq 'LIST') { foreach my $subgrammar (@$options) { my $gtype = $$subgrammar{Type}; if ($gtype eq 'list') { return check_structure($label, $structure, $subgrammar); } } print_log('config', ERROR, 'Found LIST, not expecting this at %s', $label); return 0; } elsif ($stype eq 'HASH') { foreach my $subgrammar (@$options) { my $gtype = $$subgrammar{Type}; if ($gtype eq 'map' || $gtype eq 'struct') { return check_structure($label, $structure, $subgrammar); } } print_log('config', ERROR, 'Found HASH, not expecting this at %s', $label); return 0; } elsif ($stype eq '') { foreach my $subgrammar (@$options) { my $gtype = $$subgrammar{Type}; if ($gtype eq 'string' || $gtype eq 'integer') { return check_structure($label, $structure, $subgrammar); } } print_log('config', ERROR, 'Found SCALAR, not expecting this at %s', $label); return 0; } else { print_log('config', ERROR, 'Found %s, not expecting this at %s', $stype, $label); return 0; } } if ($gtype eq 'map') { if ($stype ne 'HASH') { print_log('config', ERROR, 'Expecting HASH, found %s at %s', $stype, $label); return 0; } my $sublabel = $label; $sublabel .= '/' unless $sublabel eq '/'; foreach my $key (keys %$structure) { return 0 unless check_structure($sublabel.$key, $$structure{$key}, $$grammar{Elements}); } return 1; } if ($gtype eq 'struct') { if ($stype ne 'HASH') { print_log('config', ERROR, 'Expecting HASH, found %s at %s', $stype, $label); return 0; } my $sublabel = $label; $sublabel .= '/' unless $sublabel eq '/'; my $keywords = $$grammar{Keywords}; foreach my $key (keys %$structure) { my $kw = $$keywords{$key}; if (! defined $kw) { print_log('config', ERROR, 'Unknown keyword %s at %s', $key, $label); return 0; } return 0 unless check_structure($sublabel.$key, $$structure{$key}, $kw); } foreach my $key (keys %$keywords) { my $kw = $$keywords{$key}; next unless defined $$kw{Mandatory} && $$kw{Mandatory}; if (! defined $$structure{$key}) { print_log('config', ERROR, 'Missing mandatory keyword %s at %s', $key, $label); return 0; } } my $checkfunc = $$grammar{Check}; return 0 if defined $checkfunc && ! &{$checkfunc}($structure, $label); return 1; } if ($gtype eq 'list') { if ($stype ne 'ARRAY') { print_log('config', ERROR, 'Expecting ARRAY, found %s at %s', $stype, $label); return 0; } my $index = 0; foreach my $element (@$structure) { $index++; return 0 unless check_structure($label.'['.$index.']', $element, $$grammar{Elements}); } return 1; } if ($stype ne '') { print_log('config', ERROR, 'Expecting SCALAR, found %s at %s', $stype, $label); return 0; } if ($gtype eq 'string') { print_log('config', DEBUG2, 'Found string value %s at %s', $structure, $label); } elsif ($gtype eq 'integer') { if ($structure !~ /^\d+$/o) { print_log('config', ERROR, 'Expecting integer value, found %s at %s', $structure, $label); return 0; } print_log('config', DEBUG2, 'Found integer value %s at %s', $structure, $label); } else { print_log('config', ERROR, 'Unknown grammar element type: %s', $gtype); return 0; } return 1; } sub parse_structure ($$$) { my ($path, $contents, $grammar) = @_; my $structure = eval { decode_json($contents) }; if (! defined $structure) { my $error = $@; print_log('config', ERROR, 'Cannot parse config file %s: %s', $path, $error); return undef; } return undef unless check_structure('/', $structure, $grammar); return $structure; } sub parse_cfg_file ($$) { my ($path, $grammar) = @_; if (! open(FILE, '<', $path)) { print_log('config', ERROR, 'Cannot open file %s: %s', $path, $!); return undef; } my $contents = ''; while () { $contents .= $_; } close(FILE); return parse_structure($path, $contents, $grammar); } 1;