/usr/share/perl5/Parse/PlainConfig.pm is in libparse-plainconfig-perl 3.03-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
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 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 981 982 983 984 985 986 987 988 989 990 991 992 993 994 995 996 997 998 999 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103 1104 1105 1106 1107 1108 1109 1110 1111 1112 1113 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 1125 1126 1127 1128 1129 1130 1131 1132 1133 1134 1135 1136 1137 1138 1139 1140 1141 1142 1143 1144 1145 1146 1147 1148 1149 1150 1151 1152 1153 1154 1155 1156 1157 1158 1159 1160 1161 1162 1163 1164 1165 1166 1167 1168 1169 1170 1171 1172 1173 1174 1175 1176 1177 1178 1179 1180 1181 1182 1183 1184 1185 1186 1187 1188 1189 1190 1191 1192 1193 1194 1195 1196 1197 | # Parse::PlainConfig -- Parsing Engine for Parse::PlainConfig
#
# (c) 2002 - 2016, Arthur Corliss <corliss@digitalmages.com>,
#
# $Id: lib/Parse/PlainConfig.pm, 3.03 2016/08/09 16:11:12 acorliss Exp $
#
# This software is licensed under the same terms as Perl, itself.
# Please see http://dev.perl.org/licenses/ for more information.
#
#####################################################################
#####################################################################
#
# Environment definitions
#
#####################################################################
package Parse::PlainConfig;
use 5.008;
use strict;
use warnings;
use vars qw($VERSION);
($VERSION) = ( q$Revision: 3.03 $ =~ /(\d+(?:\.(\d+))+)/sm );
use Class::EHierarchy qw(:all);
use Parse::PlainConfig::Constants qw(:all);
use Parse::PlainConfig::Settings;
use Text::ParseWords;
use Text::Tabs;
use Fcntl qw(:seek :DEFAULT);
use Paranoid;
use Paranoid::Debug;
use Paranoid::IO;
use Paranoid::IO::Line;
use Paranoid::Input qw(:all);
use Paranoid::Glob;
use base qw(Class::EHierarchy);
use vars qw(@_properties @_methods %_parameters %_prototypes);
#####################################################################
#
# Module code follows
#
#####################################################################
sub _initialize {
# Purpose: Initialize config object and loads class defaults
# Returns: Boolean
# Usage: $rv = $obj->_initialize(@args);
my $obj = shift;
my $class = ref $obj;
my $rv = 1;
my ( $settings, %_globals, %_parameters, %_prototypes );
pdebug( 'entering w/%s', PPCDLEVEL1, $obj );
pIn();
# Create & adopt the settings object
$settings = new Parse::PlainConfig::Settings;
$obj->adopt($settings);
$settings->alias('settings');
# Read in class global settings
unless ( __PACKAGE__ eq $class ) {
pdebug( 'loading globals from %s', PPCDLEVEL2, $class );
{
no strict 'refs';
%_globals = %{ *{"${class}::_globals"}{HASH} }
if defined *{"${class}::_globals"};
}
if ( scalar keys %_globals ) {
foreach ( keys %_globals ) {
pdebug( 'overriding %s with (%s)',
PPCDLEVEL3, $_, $_globals{$_} );
$rv = 0 unless $settings->property( $_, $_globals{$_} );
}
}
}
# Read in class parameters
unless ( __PACKAGE__ eq $class ) {
pdebug( 'loading parameters from %s', PPCDLEVEL2, $class );
{
no strict 'refs';
%_parameters = %{ *{"${class}::_parameters"}{HASH} }
if defined *{"${class}::_parameters"};
}
if ( scalar keys %_parameters ) {
$settings->property( 'property types', %_parameters );
foreach ( keys %_parameters ) {
pdebug( 'creating property %s', PPCDLEVEL3, $_ );
unless (
_declProp(
$obj,
CEH_PUB | (
$_parameters{$_} == PPC_HDOC
? PPC_SCALAR
: $_parameters{$_}
),
$_
)
) {
$rv = 0;
last;
}
# Store property regex
$settings->store(
'property regexes',
$_,
qr#(\s*)(\Q$_\E)\s*\Q@{[ $settings->delimiter ]}\E\s*(.*)#s
);
}
}
}
# Read in class prototypes
unless ( __PACKAGE__ eq $class ) {
pdebug( 'loading prototypes from %s', PPCDLEVEL2, $class );
{
no strict 'refs';
%_prototypes = %{ *{"${class}::_prototypes"}{HASH} }
if defined *{"${class}::_prototypes"};
}
if ( scalar keys %_prototypes ) {
$settings->property( 'prototypes', %_prototypes );
foreach ( keys %_prototypes ) {
# Store property meta-data
$settings->store(
'prototype regexes',
$_,
qr#(\s*)(\Q$_\E)\s+(\S+)\s*\Q@{[ $settings->delimiter ]}\E\s*(.*)#s
);
}
}
}
# Read in defaults from DATA
$rv = $obj->parse( $obj->default );
pOut();
pdebug( 'leaving w/rv: %s', PPCDLEVEL1, $rv );
return $rv;
}
sub settings {
# Purpose: Returns object reference to the settings object
# Returns: Object reference
# Usage: $settings = $obj->settings;
my $obj = shift;
return $obj->relative('settings');
}
sub default {
# Purpose: Returns the DATA block from the calling
# Returns: Array
# Usage: @lines = $obj->_getData;
my $obj = shift;
my $class = ref $obj;
my ( $fn, @chunk, @lines );
pdebug( 'entering', PPCDLEVEL2 );
pIn();
$class =~ s#::#/#sg;
$class .= '.pm';
$fn = $INC{$class};
pdebug( 'attempting to read from %s', PPCDLEVEL3, $fn );
if ( popen( $fn, O_RDONLY ) ) {
# Read in file
while ( sip( $fn, @chunk ) and @chunk ) { push @lines, @chunk }
# Purge all lines prior to __DATA__
while ( @lines and $lines[0] !~ /^\s*__DATA__\s*$/s ) {
shift @lines;
}
shift @lines;
# Purge all lines after __END__
if ( @lines and grep /^\s*__END__\s*$/s, @lines ) {
while ( @lines and $lines[-1] !~ /^\s*__END__\s*$/s ) {
pop @lines;
}
pop @lines;
}
pseek( $fn, 0, SEEK_SET );
}
pOut();
pdebug( 'leaving w/%s lines', PPCDLEVEL2, scalar @lines );
return wantarray ? @lines : join '', @lines;
}
sub get {
# Purpose: Returns the value of the specified parameter
# Returns: Scalar/List/Hash
# Usage: $val = $obj->get('foo');
my $obj = shift;
my $p = shift;
my $valp;
pdebug( 'entering w/%s', PPCDLEVEL1, $p );
pIn();
if ( defined $p ) {
$valp = scalar grep /^\Q$p\E$/s, $obj->propertyNames;
}
$obj->error(
pdebug( 'specified invalid parameter name: %s', PPCDLEVEL1, $p ) )
unless $valp;
pOut();
pdebug( 'leaving', PPCDLEVEL1 );
return $valp ? $obj->property($p) : undef;
}
sub set {
# Purpose: Assigns the desired values to the specified parameter
# Returns: Boolean
# Usage: $rv = $obj->set($prop, @values);
my $obj = shift;
my $p = shift;
my @vals = @_;
my %propTypes = $obj->settings->propertyTypes;
my ( $valp, $rv );
pdebug( 'entering w/(%s)(%s)', PPCDLEVEL1, $p, @vals );
pIn();
if ( defined $p ) {
$valp = scalar grep /^\Q$p\E$/s, $obj->propertyNames;
}
$obj->error(
pdebug( 'specified invalid parameter name: %s', PPCDLEVEL1, $p ) )
unless $valp;
if ($valp) {
if (@vals) {
# Set whatever's assigned
$rv = $obj->property( $p, @vals );
} else {
# Assume that no values means purge/undef
if ( $propTypes{$p} == PPC_SCALAR or $propTypes{$p} == PPC_HDOC )
{
$rv = $obj->property( $p, undef );
} else {
$rv = $obj->purge($p);
}
}
}
pOut();
pdebug( 'leaving', PPCDLEVEL1 );
return $valp ? $rv : undef;
}
sub _snarfBlock (\@\$\$$) {
# Purpose: Finds and returns the block with the value
# string extracted.
# Returns: Boolean
# Usage: $rv = _snarfBlock(@lines, $val);
my $lref = shift;
my $pref = shift;
my $vref = shift;
my $settings = shift;
my $obj = $settings->parent;
my %regex = $settings->propertyRegexes;
my %pregex = $settings->prototypeRegexes;
my %propTypes = $settings->propertyTypes;
my %prototypes = $settings->prototypes;
my $subi = $settings->subindentation;
my ( $rv, $indent, $prop, $proto, $trailer, $iwidth, $line, $preg );
pdebug( 'entering', PPCDLEVEL2 );
pIn();
# Match line to a property/prototype declaration
#
# First try to match against properties
foreach ( keys %regex ) {
if ( $$lref[0] =~ /^$regex{$_}$/s ) {
( $indent, $prop, $trailer ) = ( $1, $2, $3 );
$rv = 1;
shift @$lref;
last;
}
}
unless ( $rv and defined $prop and length $prop ) {
foreach ( keys %pregex ) {
if ( $$lref[0] =~ /^$pregex{$_}$/s ) {
( $indent, $proto, $prop, $trailer ) = ( $1, $2, $3, $4 );
$rv = 1;
shift @$lref;
last;
}
}
}
# Define all prototyped properties
if ( defined $proto and length $proto ) {
if ( defined $prop and length $prop ) {
if ( exists $regex{$prop} ) {
$obj->error(
pdebug(
'token (%s) for prototype (%s) attempted to override property',
PPCDLEVEL1,
$prop,
$proto
) );
$rv = 0;
} else {
if ( exists $propTypes{$prop} ) {
# Make sure they haven't been previously defined,
# or if they have, they match the same type
unless ( $propTypes{$prop} == $prototypes{$proto} ) {
$rv = 0;
$obj->error(
pdebug(
'prototype mismatch with previous declaration: %s',
PPCDLEVEL1,
$proto
) );
pdebug( 'current type: %s prototype: %s',
PPCDLEVEL1, $propTypes{$prop},
$prototypes{$proto} );
}
} else {
# Create a new property
pdebug( 'creating property based on prototype %s: %s',
PPCDLEVEL3, $proto, $prop );
$rv = _declProp(
$obj,
CEH_PUB | (
$prototypes{$proto} == PPC_HDOC
? PPC_SCALAR
: $prototypes{$proto}
),
$prop
);
# Record the prop type
if ($rv) {
$settings->store( 'property types',
$prop, $propTypes{$prop} = $prototypes{$proto} );
$preg =
$settings->retrieve( 'prototype registry',
$proto );
$preg = [] unless defined $preg;
push @$preg, $prop;
$settings->store( 'prototype registry',
$proto => $preg );
} else {
$obj->error(
pdebug(
'failed to declare prototype: %s %s',
PPCDLEVEL1, $proto, $prop
) );
}
}
}
} else {
$obj->error(
pdebug(
'invalid token used for prototype %s: %s', PPCDLEVEL1,
$proto, $prop
) );
$rv = 0;
}
}
# Grab additional lines as needed
if ($rv) {
if ( $propTypes{$prop} == PPC_HDOC ) {
# Snarf all lines until we hit the HDOC marker
$rv = 0;
while (@$lref) {
$line = shift @$lref;
if ( $line =~ /^\s*\Q@{[ $settings->hereDoc ]}\E\s*$/s ) {
$rv = 1;
last;
} else {
$line =~ s/^\s{1,$subi}//s;
$trailer .= $line;
}
}
# Error out if we never found the marker
$obj->error(
pdebug( 'failed to find the here doc marker', PPCDLEVEL1 ) )
unless $rv;
} else {
# All non-HDOCs are handled the same
$iwidth = defined $indent ? length $indent : 0;
while (@$lref) {
# We're done if this is a line break
last if $$lref[0] =~ /^\s*$/s;
# We're also done if indentation isn't greater
# than the parameter declaration line
($indent) = ( $$lref[0] =~ /^(\s*)/s );
last if !defined $indent or $iwidth >= length $indent;
# Append content to the trailer
$line = shift @$lref;
$line =~ s/^\s{1,$subi}//s;
pchomp($line);
$trailer .= $line;
}
}
$trailer =~ s/\s+$//s if defined $trailer;
}
if ($rv) {
pchomp($trailer);
( $$pref, $$vref ) = ( $prop, $trailer );
pdebug( 'extracted value for %s: %s', PPCDLEVEL3, $prop, $trailer );
}
pOut();
pdebug( 'leaving w/rv: %s', PPCDLEVEL2, $rv );
return $rv;
}
sub _snarfProp {
# Purpose: Takes the property value and parses according to its type,
# then stores it
# Returns: Boolean
# Usage: $rv = _snarfProp($obj, $prop, $val);
my $obj = shift;
my $prop = shift;
my $val = shift;
my $settings = $obj->settings;
my %propTypes = $settings->propertyTypes;
my $ldelim = $settings->listDelimiter;
my $hdelim = $settings->hashDelimiter;
my $rv = 1;
my @elements;
pdebug( 'entering w/(%s)(%s)', PPCDLEVEL2, $prop, $val );
pIn();
if ( $propTypes{$prop} == PPC_HDOC
or $propTypes{$prop} == PPC_SCALAR ) {
# Here Docs and scalars are stored as-is
$obj->property( $prop, $val );
} else {
if ( $propTypes{$prop} == PPC_ARRAY ) {
# Split into a list
@elements = quotewords( qr/\Q$ldelim\E/s, 0, $val );
foreach (@elements) { s/^\s+//s; s/\s+$//s; }
} else {
# Split into a hash
@elements =
quotewords( qr/(?:\Q$ldelim\E|\Q$hdelim\E)/s, 0, $val );
foreach (@elements) { s/^\s+//s; s/\s+$//s; }
}
# Store the list value
pdebug( 'storing in %s: %s', PPCDLEVEL3, $prop, @elements );
$obj->purge($prop);
$obj->property( $prop, @elements );
}
pOut();
pdebug( 'leaving w/rv: %s', PPCDLEVEL2, $rv );
return $rv;
}
sub parse {
# Purpose: Parses passed content and extracts values
# Returns: Boolean
# Usage: $rv = $obj->parse(@lines);
my $obj = shift;
my @lines = @_;
my $settings = $obj->settings;
my $delim = $settings->delimiter;
my $cre = qr#^\s*\Q@{[ $settings->comment ]}\E#s;
my $rv = 1;
my ( $text, $prop, $value, $glob );
pdebug( 'entering', PPCDLEVEL1 );
pIn();
# Some preprocessing of lines
if (@lines) {
$tabstop = $settings->tabStop;
@lines = expand(@lines);
foreach (@lines) {
$text =
( defined $text and length $text )
? join "\n", $text, split NEWLINE_REGEX, $_
: join "\n", split NEWLINE_REGEX, $_;
}
}
while (@lines) {
# Skip comments and empty lines
if ( $lines[0] =~ /^$cre/s
or $lines[0] =~ /^\s*(?:@{[ NEWLINE_REGEX ]})?$/s ) {
shift @lines;
next;
}
# Handle "include" statements
if ( $lines[0] =~ /^\s*include\s+(.+?)\s*$/s ) {
$glob = new Paranoid::Glob globs => [$1];
shift @lines;
$rv = 0 unless $obj->read($glob);
next;
}
# See if we have property block
if ( _snarfBlock( @lines, $prop, $value, $settings ) ) {
# Parse the block (but preserve earlier errors)
$rv = 0 unless _snarfProp( $obj, $prop, $value );
} else {
pdebug( 'discarding invalid input: %s', PPCDLEVEL1, $lines[0] );
shift @lines;
$rv = 0;
}
}
pOut();
pdebug( 'leaving w/rv: %s', PPCDLEVEL1, $rv );
return $rv;
}
sub read {
# Purpose: Reads the passed file(s)
# Returns: Boolean
# Usage: $rv = $obj->read($filename);
my $obj = shift;
my $source = shift;
my ( $rv, @lines );
pdebug( 'entering w/%s', PPCDLEVEL1, $source );
pIn();
if (@_) {
# Work all entries passed if handed a list
$rv = $obj->read($source);
foreach (@_) { $rv = 0 unless $obj->read($_) }
} elsif ( ref $source eq '' ) {
# Treat all non-reference files as filenames
if ( slurp( $source, @lines ) ) {
$rv = $obj->parse(@lines);
pdebug( 'errors parsing %s', PPCDLEVEL1, $source ) unless $rv;
} else {
$obj->error(
pdebug(
'failed to read %s: %s', PPCDLEVEL1,
$source, Paranoid::ERROR() ) );
}
} elsif ( ref $source eq 'Paranoid::Glob' ) {
# Handle Paranoid globs specially
$rv = 1;
foreach (@$source) { $rv = 0 unless $obj->read($_) }
} else {
# Handle everything else as if it was a glob
if ( slurp( $source, @lines ) ) {
$rv = $obj->parse(@lines);
pdebug( 'errors parsing %s', PPCDLEVEL1, $source ) unless $rv;
} else {
$obj->error(
pdebug(
'failed to read %s: %s', PPCDLEVEL1,
$source, Paranoid::ERROR() ) );
}
}
pOut();
pdebug( 'leaving w/rv: %s', PPCDLEVEL1, $rv );
return $rv;
}
sub reset {
# Purpose: Resets configuration state to defaults
# Returns: Boolean
# Usage: $rv = $obj->reset;
my $obj = shift;
my $settings = $obj->settings;
my %propTypes = $settings->propertyTypes;
my $rv;
pdebug( 'entering', PPCDLEVEL1 );
pIn();
# Purge all property values
foreach ( keys %propTypes ) {
pdebug( 'clearing stored values for %s', PPCDLEVEL2, $_ );
if ( $propTypes{$_} == PPC_SCALAR or $propTypes{$_} == PPC_HDOC ) {
$obj->property( $_, undef );
} else {
$obj->purge($_);
}
}
$rv = $obj->parse( $obj->default );
pOut();
pdebug( 'leaving w/rv: %s', PPCDLEVEL1, $rv );
return $rv;
}
sub prototyped {
# Purpose: Returns a list of properties that were created with
# prototypes
# Returns: Array
# Usage: @protos = $obj->prototyped;
my $obj = shift;
my $proto = shift;
my ( %preg, @prval );
pdebug( 'entering w/%s', PPCDLEVEL1, $proto );
pIn();
%preg = $obj->settings->property('prototype registry');
if ( defined $proto and length $proto ) {
if ( exists $preg{$proto} ) {
@prval = @{ $preg{$proto} };
} else {
pdebug( 'no prototype properties declared w/%s',
PPCDLEVEL2, $proto );
}
} else {
pdebug( 'dumping all declared prototyped properties', PPCDLEVEL2 );
foreach ( keys %preg ) { push @prval, @{ $preg{$_} } }
}
pOut();
pdebug( 'leaving w/%s', PPCDLEVEL1, @prval );
return @prval;
}
sub error {
# Purpose: Sets/gets the last error message
# Returns: Scalar/undef
# Usage: $errStr = $obj->error;
# Usage: $errStr = $obj->error($msg);
my $obj = shift;
my $msg = shift;
if ( defined $msg ) {
$obj->settings->property( 'error', $msg );
} else {
$msg = $obj->settings->property('error');
}
return $msg;
}
1;
__END__
=head1 NAME
Parse::PlainConfig - Configuration file class
=head1 VERSION
$Id: lib/Parse/PlainConfig.pm, 3.03 2016/08/09 16:11:12 acorliss Exp $
=head1 SYNOPSIS
=head2 SAMPLE CONFIG CLASS
package MyConfig;
use Parse::PlainConfig;
use Parse::PlainConfig::Constants;
use base qw(Parse::PlainConfig);
use vars qw(%_globals %_parameters %_prototypes);
%_globals = (
'comment' => '#',
'delimiter' => ':',
'list delimiter' => ',',
'hash delimiter' => '=>',
'subindentation' => 4,
'here doc' => 'EOF',
);
%_parameters = (
'daemon ports' => PPC_ARRAY,
'banner' => PPC_HDOC,
'user' => PPC_SCALAR,
'group' => PPC_SCALAR,
'database' => PPC_HASH,
'acls' => PPC_HASH,
);
%_prototypes = (
'define net' => PPC_ARRAY,
);
1;
__DATA__
# This is the default configuration for MyConfig.
# Newly created objects based on this class will
# inherit the below configuration as default values.
#
# daemon ports: list of ports to listen on
daemon ports: 8888, 9010
# banner: default banner to display on each connection
banner:
******** WARNING ********
You are being watched
******** WARNING ********
EOF
user: nobody
group: nogroup
database:
host => localhost,
db => mydb,
user => dbuser,
pass => dbpass
define net loopback: 127.0.0.1/8, ::1/128
define net localnet: 192.168.0.0/24, 192.168.35.0/24
define net nonlocal: ! 192.168.0.0/16
acls: loopback => allow, localnet => allow, nonlocal => deny
__END__
=head1 NAME
normal pod text can be put here...
=head2 SAMPLE OBJECT USAGE
$config = new MyConfig;
print "default user: ", $config->get('user'), "\n";
print "default group: ", $config->get('group'), "\n";
# Override value
$config->set('user', 'root');
# Get config from a file
$rv = $config->read($filename);
# Parse config from in-memory text
$rv = $config->parse(@lines);
# Prototyps are accessed like parameters
@localnets = $config->get('localnet');
# Reset config values back to class defaults
$config->reset;
# Print default config file
print $config->default;
=head1 DESCRIPTION
B<Parse::PlainConfig> provides a simple way to write a config object class
that supports all the basic primitive data types (scalar, array, and hashes)
while allowing for arbitrary delimiters, comment characters, and more.
The use of a B<__DATA__> block to store your default config not only provides
for a reference config but a convenient way to set default values for
parameters and prototypes. Use of B<__END__> also allows you to append your
standard POD text to allow for the creation of man pages documenting your
configuration options.
The parser supports the use of "include {filename|glob}" syntax for splitting
configuration parameters amongst multiple config files. Even without it every
call to L<read> or L<parse> only applies new settings on top of the existing
set, allowing you to aggregate multiple config file parameters into one set of
parameters.
Unlike previous versions of this module B<Parse::PlainConfig> is strictly a
parser, not a generator. That functionality never seem to be used enough to
be worth maintaining with this upgrade. For backwards compatibility the old
Parser/Generator is still included under the new namespace
L<Parse::PlainConfig::Legacy>. Updating legacy scripts to use that package
name instead should keep everything working.
B<Parse::PlainConfig> is a subclass of L<Class::EHierarchy>, and all
parameters are public properties allowing access to the full set of data-aware
methods provided by that module (such as B<store>, B<purge>, B<pop>, B<shift>,
and others).
I/O is also done in a platform-agnostic manner, allowing parsed values to read
reliably on any platform regardless of line termination style used to author
the config file.
=head1 SUBCLASSING
All parsing objects are now subclasses of L<Parse::PlainConfig> tuned for a
specific style and a known list of parameters and/or prototypes. This makes
coding for config file parsing extremely simple and convenient.
Control of the parser is performed by setting values in three class hashes:
=head2 %_globals
The B<%_globals> hash is primarily used to specify special character sequences
the parser will key to identify comments and the various parameters and data
types. The following key/value are supported:
Key Default Description
---------------------------------------------------------------
comment # Character(s) used to denote comments
delimiter : Parameter/value delimiter
list delimiter , Ordinal array values delimiter
hash delimiter => Hash values' key/value pair delimiter
subindentation 4 Default level of indentation to
expect for line continuations
here doc EOF Token used for terminating here doc
parameter values
If all of the defaults are acceptable this hash can be omitted entirely.
Note that the I<subindentation> is merely advisory, any additional level of
subindentation on line continuations will work. What this does, however, is
trim up to that amount of preceding white space on each line within a
here-doc. This allows one to indent blocks of text to maintain the visual
flow of the config file, while still allowing the editor the use of all
columns in the display.
=head2 %_parameters
The B<%_parameters> hash is used to list all of the formal parameters
recognized by this config object. All parameters must be one of four data
types:
Type Description
----------------------------------------------------------------
PPC_SCALAR Simple strings
PPC_ARRAY Arrays/lists
PPC_HASH Hashes/Associative arrays
PPC_HDOC Essentially a PPC_SCALAR that preserves formatting
All but B<PPC_HDOC> will trim leading/trailing white space and collapse all
lines into a single line for parsing. That means that no string, ordinal
value, key, or associative value can have embedded line breaks. You can,
however, have delimiter characters as part of any values as long as they are
encapusated in quoted text or escaped.
B<PPC_HDOC> will preserve line breaks, but will trim leading white space on
each line up to the value given to B<$_globals{subindentation}>.
=head2 %_prototypes
B<%_prototypes> exist to allow for user-defined parameters that fall outside
of the formal parameterss in B<%_parameters>. ACLs, for instance, are often
of indeterminate number and naming, which is a perfect use-case for
prototypes.
Like parameters prototypes are assigned a data type. Unlike parameters
prototypes are assigned types based on a declarative preamble since the the
name (or token) is not known in advance.
To continue with the ACL example we could define a prototype like so:
%_prototypes = ( 'define acl' => PPC_ARRAY );
The config editor could then define any number of ACLs:
define acl loopback 127.0.0.1/8
define acl localnet 192.168.0.0/24,192.168.1.0/24
Once parsed those ACL parameters can then be accessed simply by their unique
token:
@localnets = $config->get('localnet');
=head1 CONFIG FILE FORMAT RULES
This module is intended to provide support for parsing human-readable config
files, while supporting basic data structures and delimiter flexibility. That
said, there are a few basic rules by which the parser operates.
Note that the use B<__DATA__> and/or B<__END__> blocks are entirely optional.
=head2 DELIMITERS
Delimiters must be unique. You cannot use the same character(s) for
both list delimiters and hash key/value pair delimiters, for instance. That
said, the parser is very forgiving on the use of whitespace around all
delimiters, even if one of your delimiters is literally a space.
Hash and array delimiters can be embedded in elements as long as they're
quoted or escaped appropriately. Those elements are split using
L<Text::ParseWords>' L<quotewords> function.
=head2 LINE CONTINUATIONS
Parameters values may need to be, by necessity, longer than a single line.
This is fully supported for all data types. All that is needed that the line
continuations be at least one space more indented than the preceding line.
Empty lines are considered to be line breaks which terminate the parameter
value. Likewise, a line that is indented equal or less than the parameter
declaration line implies a new block of content.
There is one exception to that rule: here docs. If you need to preserve
formatting, which can include line breaks, the use of here docs will suck in
everything up to the next here doc EOF token. The entire here doc, however,
is treated as scalar value for purposes of parameter storage.
=head2 COMMENTS
Comments can be any sequence of characters, but must be on a line by
themselves. Preceding white space is allowed.
=head2 PARAMETER NAMES
Given that parameters are actually formal object properties it could go
without saying that each parameter must be uniquely named. Parameters
names can include white space or other miscellaneous punctuation.
=head2 PROTOTYPES
Prototypes allow for the dynamic creation of parameters. There are a few
caveats in their usage, however. Prototypes are specified through a unique
preamble followed by a unique token. Unlike parameter names this token
cannot have embedded white space. But like parameters they are specified by
that unique token (minus the preamble) during L<get> and L<set> operations.
Since these dynamic properties are also formal properties the token must not
be in use as a formal property. In other words, all prototype tokens and
parameter names must be unique as a set.
Parsing errors will be generated if the token occurs as a formal parameter.
It will also be generated if you attempt to redfine a token as a different
type of data structure.
=head1 SUBROUTINES/METHODS
=head2 new
$conf = new MyConfig;
This creates a new config object based on the specified config class,
initialized with the defaults stored in B<__DATA__>. No additional arguments
are supported. This will fail if the default config is invalid in any way.
=head2 settings
$settings = $config->settings;
This provides a reference to the engine settings object from which you can
interrogate various settings such as delimiters, etc. The full set of methods
supported by the settings object is documented in
L<Parse::PlainConfig::Settings>.
=head2 default
$text = $config->default;
@lines = $config->default;
This returns the text of the default configuration file embedded in the
B<__DATA__> section of the config class.
=head2 get
$val = $config->get($parameter);
@val = $config->get($parameter);
%val = $config->get($parameter);
This returns the stored value(s) for the specified parameter. It is
essentially the same as using the parent class L<property> method, although
this will not cause the program to L<croak> like L<property> does. It will
L<carp>, instead.
=head2 set
$rv = $config->set($parameter);
$rv = $config->set($parameter, $newval);
$rv = $config->set($parameter, @newval);
$rv = $config->set($parameter, %newval);
This method sets the desired parameter to the newly specified value(s). If no
values are provided it will assume that you wish to set scalars to B<undef> or
empty arrays and hashes.
=head2 parse
$rv = $config->parse($text);
$rv = $config->parse(@lines);
This will parse and set any parameters or prototypes found in the content. It
will return false if any parsing errors are found (spurious text, etc.) but
will extract everything of intelligible value it can.
=head2 read
$rv = $config->read($filename);
$rv = $config->read(@files);
$rv = $config->read($pglob);
$rv = $config->read(*fh);
This method will attempt to read every file passed to it, whether it be passed
by file name, file handle, L<Paranoid::Glob>, or objec reference support I/O
functions. Fair warning: this does observe file locking semantics (L<flock>)
and it will close any file handles passed to it after consuming the content.
Also note that this method uses L<Paranoid::IO::Line>, which implements
protections against memory-utilization attacks. You may need to adjust the
following parameters depending on the size of your config files:
use Paranoid::IO qw(PIOMAXFSIZE PIOBLKSIZE);
use Paranoid::IO qw(PIOMAXLNSIZE);
# Adjust read block size for performance
PIOBLKSIZE = 16 * 1024;
# Allow file sizes up to 128KB
PIOMAXFSIZE = 128 * 1024;
# Allow individual lines to be 4KB long
PIOMAXLNSIZE = 4 * 1024;
=head2 reset
$rv = $config->reset;
This method purges the contents of all parameters and prototypes, then applies
the default settings as found in B<__DATA__>.
=head2 prototyped
@protos = $config->prototyped;
@protos = $config->prototyped($preamble);
This method returns a list of properties that were defined as the result of
prototypes. With no arguments it returns all properties that were defined.
With an argument it returns only those properties that were defined by that
specific prototype preamble.
=head2 error
$errStr = $config->error;
Returns the last error that occurred. Note that this isn't reset between
method invocations.
=head1 DEPENDENCIES
=over
=item o
L<Class::EHierarchy>
=item o
L<Fcntl>
=item o
L<Paranoid>
=item o
L<Paranoid::Debug>
=item o
L<Paranoid::Glob>
=item o
L<Paranoid::IO>
=item o
L<Paranoid::IO::Line>
=item o
L<Paranoid::Input>
=item o
L<Parse::PlainConfig::Constants>
=item o
L<Parse::PlainConfig::Settings>
=item o
L<Text::ParseWords>
=item o
L<Text::Tabs>
=back
=head1 DIAGNOSTICS
Through the use of B<Paranoid::Debug> this module will produce internal
diagnostic output to STDERR. It begins logging at log level 7. To enable
debugging output please see the pod for L<Paranoid::Debug>.
=head1 BUGS AND LIMITATIONS
=head1 AUTHOR
Arthur Corliss (corliss@digitalmages.com)
=head1 LICENSE AND COPYRIGHT
This software is licensed under the same terms as Perl, itself.
Please see http://dev.perl.org/licenses/ for more information.
(c) 2002 - 2016, Arthur Corliss (corliss@digitalmages.com)
|