1package Config::Grammar; 2use strict; 3 4$Config::Grammar::VERSION = '1.10'; 5 6sub new($$) 7{ 8 my $proto = shift; 9 my $grammar = shift; 10 my $class = ref($proto) || $proto; 11 12 my $self = {grammar => $grammar}; 13 bless($self, $class); 14 return $self; 15} 16 17sub err($) 18{ 19 my $self = shift; 20 return $self->{'err'}; 21} 22 23sub _make_error($$) 24{ 25 my $self = shift; 26 my $text = shift; 27 $self->{'err'} = "$self->{file}, line $self->{line}: $text"; 28} 29 30sub _peek($) 31{ 32 my $a = shift; 33 return $a->[$#$a]; 34} 35 36sub _quotesplit($) 37{ 38 my $line = shift; 39 my @items; 40 while ($line ne "") { 41 if ($line =~ s/^"((?:\\.|[^"])*)"\s*//) { 42 my $frag = $1; 43 $frag =~ s/\\(.)/$1/g; 44 push @items, $frag; 45 } elsif ($line =~ s/^'((?:\\.|[^'])*)'\s*//) { 46 my $frag = $1; 47 $frag =~ s/\\(.)/$1/g; 48 push @items, $frag; 49 } 50 elsif ($line =~ s/^((?:\\.|[^\s])*)(?:\s+|$)//) { 51 my $frag = $1; 52 $frag =~ s/\\(.)/$1/g; 53 push @items, $frag; 54 } 55 else { 56 die "Internal parser error for '$line'"; 57 } 58 } 59 return @items; 60} 61 62sub _check_mandatory($$$$) 63{ 64 my $self = shift; 65 my $g = shift; 66 my $c = shift; 67 my $section = shift; 68 69 # check _mandatory sections, variables and tables 70 if (defined $g->{_mandatory}) { 71 for (@{$g->{_mandatory}}) { 72 if (not defined $g->{$_}) { 73 $g->{$_} = {}; 74 } 75 if (not defined $c->{$_}) { 76 if (defined $section) { 77 $self->{'err'} .= "$self->{file} ($section): "; 78 } 79 else { 80 $self->{'err'} = "$self->{file}: "; 81 } 82 83 if (defined $g->{$_}{_is_section}) { 84 $self->{'err'} .= "mandatory (sub)section '$_' not defined"; 85 } 86 elsif ($_ eq '_table') { 87 $self->{'err'} .= "mandatory table not defined"; 88 } 89 else { 90 $self->{'err'} .= "mandatory variable '$_' not defined"; 91 } 92 return 0; 93 } 94 } 95 } 96 97 for (keys %$c) { 98 99 # do some cleanup 100 ref $c->{$_} eq 'HASH' or next; 101 defined $c->{$_}{_is_section} or next; 102 $self->_check_mandatory($g->{$c->{$_}{_grammar}}, $c->{$_}, 103 defined $section ? "$section/$_" : "$_") or return 0; 104 delete $c->{$_}{_is_section}; 105 delete $c->{$_}{_grammar}; 106 delete $c->{$_}{_order_count} if exists $c->{$_}{_order_count}; 107 } 108 109 return 1; 110} 111 112######### SECTIONS ######### 113 114# search grammar definition of a section 115sub _search_section($$) 116{ 117 my $self = shift; 118 my $name = shift; 119 120 if (not defined $self->{grammar}{_sections}) { 121 $self->_make_error("no sections are allowed"); 122 return undef; 123 } 124 125 # search exact match 126 for (@{$self->{grammar}{_sections}}) { 127 if ($name eq $_) { 128 return $_; 129 } 130 } 131 132 # search regular expression 133 for (@{$self->{grammar}{_sections}}) { 134 if (m|^/(.*)/$|) { 135 if ($name =~ /^$1$/) { 136 return $_; 137 } 138 } 139 } 140 141 # no match 142 $self->_make_error("unknown section '$name'"); 143 return undef; 144} 145 146# fill in default values for this section 147sub _fill_defaults ($) { 148 my $self = shift; 149 my $g = $self->{grammar}; 150 my $c = $self->{cfg}; 151 if ($g->{_vars}) { 152 for my $var (@{$g->{_vars}}) { 153 next if exists $c->{$var}; 154 my $value = $g->{$var}{_default} 155 if exists $g->{$var}{_default}; 156 next unless defined $value; 157 $c->{$var} = $value; 158 } 159 } 160 161} 162 163sub _next_level($$$) 164{ 165 my $self = shift; 166 my $name = shift; 167 168 # section name 169 if (defined $self->{section}) { 170 $self->{section} .= "/$name"; 171 } 172 else { 173 $self->{section} = $name; 174 } 175 176 # grammar context 177 my $s = $self->_search_section($name); 178 return 0 unless defined $s; 179 if (not defined $self->{grammar}{$s}) { 180 $self->_make_error("Config::Grammar internal error (no grammar for $s)"); 181 return 0; 182 } 183 push @{$self->{grammar_stack}}, $self->{grammar}; 184 $self->{grammar} = $self->{grammar}{$s}; 185 186 # support for inherited values 187 # note that we have to do this on the way down 188 # and keep track of which values were inherited 189 # so that we can propagate the values even further 190 # down if needed 191 my %inherited; 192 if ($self->{grammar}{_inherited}) { 193 for my $var (@{$self->{grammar}{_inherited}}) { 194 next unless exists $self->{cfg}{$var}; 195 my $value = $self->{cfg}{$var}; 196 next unless defined $value; 197 next if ref $value; # it's a section 198 $inherited{$var} = $value; 199 } 200 } 201 202 # config context 203 my $order; 204 if (defined $self->{grammar}{_order}) { 205 if (defined $self->{cfg}{_order_count}) { 206 $order = ++$self->{cfg}{_order_count}; 207 } 208 else { 209 $order = $self->{cfg}{_order_count} = 0; 210 } 211 } 212 213 if (defined $self->{cfg}{$name}) { 214 $self->_make_error('section or variable already exists'); 215 return 0; 216 } 217 $self->{cfg}{$name} = { %inherited }; # inherit the values 218 push @{$self->{cfg_stack}}, $self->{cfg}; 219 $self->{cfg} = $self->{cfg}{$name}; 220 221 # keep track of the inherited values here; 222 # we delete it on the way up in _prev_level() 223 $self->{cfg}{_inherited} = \%inherited; 224 225 # list of already defined variables on this level 226 if (defined $self->{grammar}{_varlist}) { 227 $self->{cfg}{_varlist} = []; 228 } 229 230 # meta data for _mandatory test 231 $self->{grammar}{_is_section} = 1; 232 $self->{cfg}{_is_section} = 1; 233 $self->{cfg}{_grammar} = $s; 234 $self->{cfg}{_order} = $order if defined $order; 235 236 # increase level 237 $self->{level}++; 238 239 return 1; 240} 241 242sub _prev_level($) 243{ 244 my $self = shift; 245 246 # fill in the values from _default keywords when going up 247 $self->_fill_defaults; 248 249 # section name 250 if (defined $self->{section}) { 251 if ($self->{section} =~ /\//) { 252 $self->{section} =~ s/\/.*?$//; 253 } 254 else { 255 $self->{section} = undef; 256 } 257 } 258 259 # clean up the _inherited hash, we won't need it anymore 260 delete $self->{cfg}{_inherited}; 261 262 # config context 263 $self->{cfg} = pop @{$self->{cfg_stack}}; 264 265 # grammar context 266 $self->{grammar} = pop @{$self->{grammar_stack}}; 267 268 # decrease level 269 $self->{level}--; 270} 271 272sub _goto_level($$$) 273{ 274 my $self = shift; 275 my $level = shift; 276 my $name = shift; 277 278 # _text is multi-line. Check when changing level 279 $self->_check_text($self->{section}) or return 0; 280 281 if ($level > $self->{level}) { 282 if ($level > $self->{level} + 1) { 283 $self->_make_error("section nesting error"); 284 return 0; 285 } 286 $self->_next_level($name) or return 0; 287 } 288 else { 289 290 while ($self->{level} > $level) { 291 $self->_prev_level; 292 } 293 if ($level != 0) { 294 $self->_prev_level; 295 $self->_next_level($name) or return 0; 296 } 297 } 298 299 return 1; 300} 301 302######### VARIABLES ######### 303 304# search grammar definition of a variable 305sub _search_variable($$) 306{ 307 my $self = shift; 308 my $name = shift; 309 310 if (not defined $self->{grammar}{_vars}) { 311 $self->_make_error("no variables are allowed"); 312 return undef; 313 } 314 315 # search exact match 316 for (@{$self->{grammar}{_vars}}) { 317 if ($name eq $_) { 318 return $_; 319 } 320 } 321 322 # search regular expression 323 for (@{$self->{grammar}{_vars}}) { 324 if (m|^/(.*)/$|) { 325 if ($name =~ /^$1$/) { 326 return $_; 327 } 328 } 329 } 330 331 # no match 332 $self->_make_error("unknown variable '$name'"); 333 return undef; 334} 335 336sub _set_variable($$$) 337{ 338 my $self = shift; 339 my $key = shift; 340 my $value = shift; 341 342 my $gn = $self->_search_variable($key); 343 defined $gn or return 0; 344 345 my $varlistref; 346 if (defined $self->{grammar}{_varlist}) { 347 $varlistref = $self->{cfg}{_varlist}; 348 } 349 350 if (defined $self->{grammar}{$gn}) { 351 my $g = $self->{grammar}{$gn}; 352 353 # check regular expression 354 if (defined $g->{_re}) { 355 $value =~ /^$g->{_re}$/ or do { 356 if (defined $g->{_re_error}) { 357 $self->_make_error($g->{_re_error}); 358 } 359 else { 360 $self->_make_error("syntax error in value of '$key'"); 361 } 362 return 0; 363 } 364 } 365 if (defined $g->{_sub}){ 366 my $error = &{$g->{_sub}}($value, $varlistref); 367 if (defined $error){ 368 $self->_make_error($error); 369 return 0; 370 } 371 } 372 } 373 $self->{cfg}{$key} = $value; 374 push @{$varlistref}, $key if ref $varlistref; 375 376 return 1; 377} 378 379######### PARSER ######### 380 381sub _parse_table($$) 382{ 383 my $self = shift; 384 local $_ = shift; 385 386 my $g = $self->{grammar}{_table}; 387 defined $g or do { 388 $self->_make_error("table syntax error"); 389 return 0; 390 }; 391 392 my @l = _quotesplit $_; 393 394 # check number of columns 395 my $columns = $g->{_columns}; 396 if (defined $columns and $#l + 1 != $columns) { 397 $self->_make_error("row must have $columns columns (has " . ($#l + 1) 398 . ")"); 399 return 0; 400 } 401 402 # check columns 403 my $n = 0; 404 for my $c (@l) { 405 my $gc = $g->{$n}; 406 defined $gc or next; 407 408 # regular expression 409 if (defined $gc->{_re}) { 410 $c =~ /^$gc->{_re}$/ or do { 411 if (defined $gc->{_re_error}) { 412 $self->_make_error("column ".($n+1).": $gc->{_re_error}"); 413 } 414 else { 415 $self->_make_error("syntax error in column ".($n+1)); 416 } 417 return 0; 418 }; 419 } 420 if (defined $gc->{_sub}){ 421 my $error = &{$gc->{_sub}}($c); 422 if (defined $error) { 423 $self->_make_error($error); 424 return 0; 425 } 426 } 427 $n++; 428 } 429 430 # hash (keyed table) 431 if (defined $g->{_key}) { 432 my $kn = $g->{_key}; 433 if ($kn < 0 or $kn > $#l) { 434 $self->_make_error("grammar error: key out of bounds"); 435 } 436 my $k = $l[$kn]; 437 438 if (defined $self->{cfg}{$k}) { 439 $self->_make_error("table row $k already defined"); 440 return 0; 441 } 442 $self->{cfg}{$k} = \@l; 443 } 444 445 # list (unkeyed table) 446 else { 447 push @{$self->{cfg}{_table}}, \@l; 448 } 449 450 return 1; 451} 452 453sub _parse_text($$) 454{ 455 my ($self, $line) = @_; 456 457 $self->{cfg}{_text} .= $line; 458 459 return 1; 460} 461 462sub _check_text($$) 463{ 464 my ($self, $name) = @_; 465 466 my $g = $self->{grammar}{_text}; 467 defined $g or return 1; 468 469 # chop empty lines at beginning and end 470 if(defined $self->{cfg}{_text}) { 471 $self->{cfg}{_text} =~ s/\A([ \t]*[\n\r]+)*//m; 472 $self->{cfg}{_text} =~ s/^([ \t]*[\n\r]+)*\Z//m; 473 } 474 475 if (defined $g->{_re}) { 476 $self->{cfg}{_text} =~ /^$g->{_re}$/ or do { 477 if (defined $g->{_re_error}) { 478 $self->_make_error($g->{_re_error}); 479 } 480 else { 481 $self->_make_error("syntax error"); 482 } 483 return 0; 484 } 485 } 486 if (defined $g->{_sub}){ 487 my $error = &{$g->{_sub}}($self->{cfg}{_text}); 488 if (defined $error) { 489 $self->_make_error($error); 490 return 0; 491 } 492 } 493 return 1; 494} 495 496sub _parse_file($$); 497 498sub _parse_line($$$) 499{ 500 my $self = shift; 501 local $_ = shift; 502 my $source = shift; 503 504 /^\@include\s+["']?(.*)["']?$/ and do { 505 my $inc = $1; 506 if ( ( $^O eq 'win32' and $inc !~ m|^(?:[a-z]:)?[/\\]|i and $self->{file} =~ m|^(.+)[\\/][^/]+$| ) or 507 ( $inc !~ m|^/| and $self->{file} =~ m|^(.+)/[^/]+$| ) ){ 508 $inc = "$1/$inc"; 509 } 510 push @{$self->{file_stack}}, $self->{file}; 511 push @{$self->{line_stack}}, $self->{line}; 512 $self->_parse_file($inc) or return 0; 513 $self->{file} = pop @{$self->{file_stack}}; 514 $self->{line} = pop @{$self->{line_stack}}; 515 return 1; 516 }; 517 /^\@define\s+(\S+)\s+(.*)$/ and do { 518 $self->{defines}{$1}=$2; 519 return 1; 520 }; 521 522 if(defined $self->{defines}) { 523 for my $d (keys %{$self->{defines}}) { 524 s/$d/$self->{defines}{$d}/g; 525 } 526 } 527 528 /^\*\*\*\s*(.*?)\s*\*\*\*$/ and do { 529 my $name = $1; 530 $self->_goto_level(1, $name) or return 0; 531 $self->_check_section_sub($name) or return 0; 532 return 1; 533 }; 534 /^(\++)\s*(.*)$/ and do { 535 my $level = length $1; 536 my $name = $2; 537 $self->_goto_level($level + 1, $name) or return 0; 538 $self->_check_section_sub($name) or return 0; 539 return 1; 540 }; 541 542 if (defined $self->{grammar}{_text}) { 543 $self->_parse_text($source) or return 0; 544 return 1; 545 } 546 /^(\S+)\s*=\s*(.*)$/ and do { 547 if (defined $self->{cfg}{$1}) { 548 if (exists $self->{cfg}{_inherited}{$1}) { 549 # it's OK to override any inherited values 550 delete $self->{cfg}{_inherited}{$1}; 551 delete $self->{cfg}{$1}; 552 } else { 553 $self->_make_error('variable already defined'); 554 return 0; 555 } 556 } 557 $self->_set_variable($1, $2) or return 0; 558 return 1; 559 }; 560 561 $self->_parse_table($_) or return 0; 562 563 return 1; 564} 565 566sub _check_section_sub($$) { 567 my $self = shift; 568 my $name = shift; 569 my $g = $self->{grammar}; 570 if (defined $g->{_sub}){ 571 my $error = &{$g->{_sub}}($name); 572 if (defined $error){ 573 $self->_make_error($error); 574 return 0; 575 } 576 } 577 return 1; 578} 579 580sub _parse_file($$) 581{ 582 my $self = shift; 583 my $file = shift; 584 585 local *File; 586 unless ($file) { $self->{'err'} = "no filename given" ; 587 return undef;}; 588 open(File, "$file") or do { 589 $self->{'err'} = "can't open $file: $!"; 590 return undef; 591 }; 592 $self->{file} = $file; 593 594 local $_; 595 my $source = ''; 596 while (<File>) { 597 $source .= $_; 598 chomp; 599 s/^\s+//; 600 s/\s+$//; # trim 601 s/\s*#.*$//; # comments 602 next if $_ eq ''; # empty lines 603 while (/\\$/) {# continuation 604 s/\\$//; 605 my $n = <File>; 606 last if not defined $n; 607 chomp $n; 608 $n =~ s/^\s+//; 609 $n =~ s/\s+$//; # trim 610 $_ .= ' ' . $n; 611 } 612 613 $self->{line} = $.; 614 $self->_parse_line($_, $source) or do{ close File; return 0; }; 615 $source = ''; 616 } 617 close File; 618 return 1; 619} 620 621sub makepod($) { 622 my $pod = eval { 623 require Config::Grammar::Document; 624 return Config::Grammar::Document::makepod(@_); 625 }; 626 defined $pod or die "ERROR: install Config::Grammar::Document in order to use makepod(): $@\n"; 627 return $pod; 628} 629 630sub maketmpl ($@) { 631 my $pod = eval { 632 require Config::Grammar::Document; 633 return Config::Grammar::Document::maketmpl(@_); 634 }; 635 defined $pod or die "ERROR: install Config::Grammar::Document in order to use maketmpl()\n"; 636 return $pod; 637} 638 639sub makemintmpl ($@) { 640 my $pod = eval { 641 require Config::Grammar::Document; 642 return Config::Grammar::Document::makemintmpl(@_); 643 }; 644 defined $pod or die "ERROR: install Config::Grammar::Document in order to use makemintmpl()\n"; 645 return $pod; 646} 647 648sub parse($$) 649{ 650 my $self = shift; 651 my $file = shift; 652 653 $self->{cfg} = {}; 654 $self->{level} = 0; 655 $self->{cfg_stack} = []; 656 $self->{grammar_stack} = []; 657 $self->{file_stack} = []; 658 $self->{line_stack} = []; 659 660 $self->_parse_file($file) or return undef; 661 662 $self->_goto_level(0, undef) or return undef; 663 664 # fill in the top level values from _default keywords 665 $self->_fill_defaults; 666 667 $self->_check_mandatory($self->{grammar}, $self->{cfg}, undef) 668 or return undef; 669 670 return $self->{cfg}; 671 672} 673 6741; 675 676__END__ 677 678=head1 NAME 679 680Config::Grammar - A grammar-based, user-friendly config parser 681 682=head1 SYNOPSIS 683 684 use Config::Grammar; 685 686 my $parser = Config::Grammar->new(\%grammar); 687 my $cfg = $parser->parse('app.cfg') or die "ERROR: $parser->{err}\n"; 688 my $pod = $parser->makepod(); 689 my $ex = $parser->maketmpl('TOP','SubNode'); 690 my $minex = $parser->maketmplmin('TOP','SubNode'); 691 692=head1 DESCRIPTION 693 694Config::Grammar is a module to parse configuration files. The 695configuration may consist of multiple-level sections with assignments 696and tabular data. The parsed data will be returned as a hash 697containing the whole configuration. Config::Grammar uses a grammar 698that is supplied upon creation of a Config::Grammar object to parse 699the configuration file and return helpful error messages in case of 700syntax errors. Using the B<makepod> method you can generate 701documentation of the configuration file format. 702 703The B<maketmpl> method can generate a template configuration file. If 704your grammar contains regexp matches, the template will not be all 705that helpful as Config::Grammar is not smart enough to give you sensible 706template data based in regular expressions. The related function 707B<maketmplmin> generates a minimal configuration template without 708examples, regexps or comments and thus allows an experienced user to 709fill in the configuration data more efficiently. 710 711 712=head2 Grammar Definition 713 714The grammar is a multiple-level hash of hashes, which follows the structure of 715the configuration. Each section or variable is represented by a hash with the 716same structure. Each hash contains special keys starting with an underscore 717such as '_sections', '_vars', '_sub' or '_re' to denote meta data with information 718about that section or variable. Other keys are used to structure the hash 719according to the same nesting structure of the configuration itself. The 720starting hash given as parameter to 'new' contains the "root section". 721 722=head3 Special Section Keys 723 724=over 12 725 726=item _sections 727 728Array containing the list of sub-sections of this section. Each sub-section 729must then be represented by a sub-hash in this hash with the same name of the 730sub-section. 731 732The sub-section can also be a regular expression denoted by the syntax '/re/', 733where re is the regular-expression. In case a regular expression is used, a 734sub-hash named with the same '/re/' must be included in this hash. 735 736=item _vars 737 738Array containing the list of variables (assignments) in this section. 739Analogous to sections, regular expressions can be used. 740 741=item _mandatory 742 743Array containing the list of mandatory sections and variables. 744 745=item _inherited 746 747Array containing the list of the variables that should be assigned the 748same value as in the parent section if nothing is specified here. 749 750=item _table 751 752Hash containing the table grammar (see Special Table Keys). If not specified, 753no table is allowed in this section. The grammar of the columns if specified 754by sub-hashes named with the column number. 755 756=item _text 757 758Section contains free-form text. Only sections and @includes statements will 759be interpreted, the rest will be added in the returned hash under '_text' as 760string. 761 762B<_text> is a hash reference which can contain a B<_re> and a B<_re_error> key 763which will be used to scrutanize the text ... if the hash is empty, all text 764will be accepted. 765 766=item _order 767 768If defined, a '_order' element will be put in every hash containing the 769sections with a number that determines the order in which the sections were 770defined. 771 772=item _doc 773 774Describes what this section is about 775 776=item _sub 777 778A function pointer. It is called for every instance of this section, 779with the real name of the section passed as its first argument. This is 780probably only useful for the regexp sections. If the function returns 781a defined value it is assumed that the test was not successful and an 782error is generated with the returned string as content. 783 784=back 785 786=head3 Special Variable Keys 787 788=over 12 789 790=item _re 791 792Regular expression upon which the value will be checked. 793 794=item _re_error 795 796String containing the returned error in case the regular expression doesn't 797match (if not specified, a generic 'syntax error' message will be returned). 798 799=item _sub 800 801A function pointer. It called for every value, with the value passed as its 802first argument. If the function returns a defined value it is assumed that 803the test was not successful and an error is generated with the returned 804string as content. 805 806If the '_varlist' key (see above) is defined in this section, the '_sub' 807function will also receive an array reference as the second argument. The 808array contains a list of those variables already defined in the same 809section. This can be used to enforce the order of the variables. 810 811=item _default 812 813A default value that will be assigned to the variable if none is specified or inherited. 814 815=item _doc 816 817Description of the variable. 818 819=item _example 820 821A one line example for the content of this variable. 822 823=back 824 825=head3 Special Table Keys 826 827=over 12 828 829=item _columns 830 831Number of columns. If not specified, it will not be enforced. 832 833=item _key 834 835If defined, the specified column number will be used as key in a hash in the 836returned hash. If not defined, the returned hash will contain a '_table' 837element with the contents of the table as array. The rows of the tables are 838stored as arrays. 839 840=item _sub 841 842they work analog to the description in the previous section. 843 844=item _doc 845 846describes the content of the column. 847 848=item _example 849 850example for the content of this column 851 852=back 853 854=head3 Special Text Keys 855 856=over 12 857 858=item _re 859 860Regular expression upon which the text will be checked (everything as a single 861line). 862 863=item _re_error 864 865String containing the returned error in case the regular expression doesn't 866match (if not specified, a generic 'syntax error' message will be returned). 867 868=item _sub 869 870they work analog to the description in the previous section. 871 872=item _doc 873 874Ditto. 875 876=item _example 877 878Potential multi line example for the content of this text section 879 880=back 881 882=head2 Configuration Syntax 883 884=head3 General Syntax 885 886'#' denotes a comment up to the end-of-line, empty lines are allowed and space 887at the beginning and end of lines is trimmed. 888 889'\' at the end of the line marks a continued line on the next line. A single 890space will be inserted between the concatenated lines. 891 892'@include filename' is used to include another file. Include works relative to the 893directory where the parent file is in. 894 895'@define a some value' will replace all occurences of 'a' in the following text 896with 'some value'. 897 898Fields in tables that contain white space can be enclosed in either C<'> or C<">. 899Whitespace can also be escaped with C<\>. Quotes inside quotes are allowed but must 900be escaped with a backslash as well. 901 902=head3 Sections 903 904Config::Grammar supports hierarchical configurations through sections, whose 905syntax is as follows: 906 907=over 15 908 909=item Level 1 910 911*** section name *** 912 913=item Level 2 914 915+ section name 916 917=item Level 3 918 919++ section name 920 921=item Level n, n>1 922 923+..+ section name (number of '+' determines level) 924 925=back 926 927=head3 Assignments 928 929Assignements take the form: 'variable = value', where value can be any string 930(can contain whitespaces and special characters). The spaces before and after 931the equal sign are optional. 932 933=head3 Tabular Data 934 935The data is interpreted as one or more columns separated by spaces. 936 937=head2 Example 938 939=head3 Code 940 941 use Data::Dumper; 942 use Config::Grammar; 943 944 my $RE_IP = '\d+\.\d+\.\d+\.\d+'; 945 my $RE_MAC = '[0-9a-f]{2}(?::[0-9a-f]{2}){5}'; 946 my $RE_HOST = '\S+'; 947 948 my $parser = Config::Grammar->new({ 949 _sections => [ 'network', 'hosts' ], 950 network => { 951 _vars => [ 'dns' ], 952 _sections => [ "/$RE_IP/" ], 953 dns => { 954 _doc => "address of the dns server", 955 _example => "ns1.oetiker.xs", 956 _re => $RE_HOST, 957 _re_error => 958 'dns must be an host name or ip address', 959 }, 960 "/$RE_IP/" => { 961 _doc => "Ip Adress", 962 _example => '10.2.3.2', 963 _vars => [ 'netmask', 'gateway' ], 964 netmask => { 965 _doc => "Netmask", 966 _example => "255.255.255.0", 967 _re => $RE_IP, 968 _re_error => 969 'netmask must be a dotted ip address' 970 }, 971 gateway => { 972 _doc => "Default Gateway address in IP notation", 973 _example => "10.22.12.1", 974 _re => $RE_IP, 975 _re_error => 976 'gateway must be a dotted ip address' }, 977 }, 978 }, 979 hosts => { 980 _doc => "Details about the hosts", 981 _table => { 982 _doc => "Description of all the Hosts", 983 _key => 0, 984 _columns => 3, 985 0 => { 986 _doc => "Ethernet Address", 987 _example => "0:3:3:d:a:3:dd:a:cd", 988 _re => $RE_MAC, 989 _re_error => 990 'first column must be an ethernet mac address', 991 }, 992 1 => { 993 _doc => "IP Address", 994 _example => "10.11.23.1", 995 _re => $RE_IP, 996 _re_error => 997 'second column must be a dotted ip address', 998 }, 999 2 => { 1000 _doc => "Host Name", 1001 _example => "tardis", 1002 }, 1003 }, 1004 }, 1005 }); 1006 1007 my $cfg = $parser->parse('test.cfg') or 1008 die "ERROR: $parser->{err}\n"; 1009 print Dumper($cfg); 1010 print $parser->makepod; 1011 1012=head3 Configuration 1013 1014 *** network *** 1015 1016 dns = 192.168.7.87 1017 1018 + 192.168.7.64 1019 1020 netmask = 255.255.255.192 1021 gateway = 192.168.7.65 1022 1023 *** hosts *** 1024 1025 00:50:fe:bc:65:11 192.168.7.97 plain.hades 1026 00:50:fe:bc:65:12 192.168.7.98 isg.ee.hades 1027 00:50:fe:bc:65:14 192.168.7.99 isg.ee.hades 1028 1029=head3 Result 1030 1031 { 1032 'hosts' => { 1033 '00:50:fe:bc:65:11' => [ 1034 '00:50:fe:bc:65:11', 1035 '192.168.7.97', 1036 'plain.hades' 1037 ], 1038 '00:50:fe:bc:65:12' => [ 1039 '00:50:fe:bc:65:12', 1040 '192.168.7.98', 1041 'isg.ee.hades' 1042 ], 1043 '00:50:fe:bc:65:14' => [ 1044 '00:50:fe:bc:65:14', 1045 '192.168.7.99', 1046 'isg.ee.hades' 1047 ] 1048 }, 1049 'network' => { 1050 '192.168.7.64' => { 1051 'netmask' => '255.255.255.192', 1052 'gateway' => '192.168.7.65' 1053 }, 1054 'dns' => '192.168.7.87' 1055 } 1056 }; 1057 1058=head1 SEE ALSO 1059 1060L<Config::Grammar::Dynamic> 1061 1062=head1 COPYRIGHT 1063 1064Copyright (c) 2000-2005 by ETH Zurich. All rights reserved. 1065Copyright (c) 2007 by David Schweikert. All rights reserved. 1066 1067=head1 LICENSE 1068 1069This program is free software; you can redistribute it and/or modify it 1070under the same terms as Perl itself. 1071 1072=head1 AUTHORS 1073 1074David Schweikert, 1075Tobias Oetiker, 1076Niko Tyni 1077 1078=cut 1079 1080# Emacs Configuration 1081# 1082# Local Variables: 1083# mode: cperl 1084# eval: (cperl-set-style "PerlStyle") 1085# mode: flyspell 1086# mode: flyspell-prog 1087# End: 1088# 1089# vi: sw=4 1090