YAML-AppConfig-0.16/0000755000175000017500000000000010454131034013745 5ustar matthewmatthewYAML-AppConfig-0.16/t/0000755000175000017500000000000010454131034014210 5ustar matthewmatthewYAML-AppConfig-0.16/t/data/0000755000175000017500000000000010454131034015121 5ustar matthewmatthewYAML-AppConfig-0.16/t/data/vars.yaml0000644000175000017500000000210610447356167017001 0ustar matthewmatthew--- dapper: life breezy: $dapper is good hoary: $breezy, but so is food stable: $hoary and so, once again, $breezy. nonvar: $these are $non $vars with a var, $dapper circ1: $circ2 eep circ2: $circ3 oop circ3: $circ4 bop circ4: $circ1 lop refs: $list will not render, nor will $hash list: - - - - - - - - $dapper - $stable - $hoary hash: key: key: key: key: key: $breezy other: $dapper something: $dapper nest1: blah: - harry potter - golem - mickey mouse - $nestee loop: foopy: - $nestee - $breezy boop: $nestee nest2: cows: - are - good nestee: food: $dapper drink: - $nest2 - $breezy and ${dapper}yummy circrefref1: - $circrefref2 circrefref2: - $circrefref1 YAML-AppConfig-0.16/t/data/merge.yaml0000644000175000017500000000006110446427506017116 0ustar matthewmatthew--- # To be merged with basic.yaml foo: 2 baz: 3 YAML-AppConfig-0.16/t/data/normal.yaml0000644000175000017500000000034110446427506017310 0ustar matthewmatthew--- food: oh man: yeah good: it is: good i_like: - tofu - spatetee - ice cream and: yummy: stuff like: popcorn or: - candy - fruit - bars 'somtin!^^^wild': cows '12_foo': blah YAML-AppConfig-0.16/t/data/config.yaml0000644000175000017500000000003410446427506017264 0ustar matthewmatthew--- foo: 1 bar: 2 eep: $foo YAML-AppConfig-0.16/t/data/scoping.yaml0000644000175000017500000000131710447667340017471 0ustar matthewmatthew--- foo: top scope hello: world bar: qux: $foo blah: blah: self ref test ego: $blah circ: circ: $prolog prolog: $cows_are_good cows_are_good: $circ simple_circ: simple_circ: $simple_circ bigcirc: thing: $level3 level1: level2: level3: level4: level5: $thing baz: foo: baz scope qux: $foo qux test: $hello quxx: - food: burger: $foo test: $hello fries: $qux test: $hello - foo: inner scope food: burger: $foo test: $hello fries: $qux test: $hello YAML-AppConfig-0.16/t/data/basic.yaml0000644000175000017500000000002210446427506017075 0ustar matthewmatthew--- foo: 1 bar: 2 YAML-AppConfig-0.16/t/03-vars.t0000644000175000017500000001450610447646405015615 0ustar matthewmatthewuse strict; use warnings; use Test::More tests => 56; do "t/lib/helpers.pl"; use Storable qw(dclone); BEGIN { use_ok('YAML::AppConfig') } # TEST: Variable usage. { my $app = YAML::AppConfig->new( file => 't/data/vars.yaml' ); ok($app, "Created object."); # Check basic retrieval is( $app->get_dapper, "life", "Checking variables." ); is( $app->get_breezy, "life is good", "Checking variables." ); is( $app->get_hoary, "life is good, but so is food", "Checking variables." ); is( $app->get_stable, "life is good, but so is food and so, once again, life is good.", "Checking variables." ); is( $app->get_nonvar, '$these are $non $vars with a var, life', "Checking variables." ); # Check get()'s no resolve flag is( $app->get( 'breezy', 1 ), '$dapper is good', "Checking variables, no resolve." ); is( $app->get_hoary(1), '$breezy, but so is food', "Checking variables, no resolve." ); # Check basic setting $app->set_dapper("money"); is( $app->get_dapper, "money", "Checking variables." ); is( $app->get_breezy, "money is good", "Checking variables." ); is( $app->get_hoary, "money is good, but so is food", "Checking variables." ); is( $app->get_stable, "money is good, but so is food and so, once again, money is good.", "Checking variables." ); is( $app->get_nonvar, '$these are $non $vars with a var, money', "Checking variables." ); # Check that our circular references break. for my $n ( 1 .. 4 ) { my $method = "get_circ$n"; eval { $app->$method }; like( $@, qr/Circular reference/, "Checking that get_circ$n failed" ); } # Break the circular reference. $app->set_circ1("dogs"); is($app->get_circ1, "dogs", "Checking circularity removal."); is($app->get_circ2, "dogs lop bop oop", "Checking circularity removal."); is($app->get_circ3, "dogs lop bop", "Checking circularity removal."); is($app->get_circ4, "dogs lop", "Checking circularity removal."); # Test that we references load up in the expected way within scalars. like( $app->get_refs, qr/^ARRAY\(.*?\) will not render, nor will HASH\(.*?\)$/, "Checking that references are not used as variables." ); # Test that nesting and interpolation of references works my $nestee = { food => 'money', drink => [{ cows => [qw(are good)]}, "money is good and moneyyummy"], }; is_deeply( $app->get_nest1, { blah => ["harry potter", "golem", "mickey mouse", $nestee], loop => {foopy => [$nestee, "money is good"], boop => $nestee}, }, "Checking variable interpolation with references." ); # Make sure circular references between references breaks eval { $app->get_circrefref1 }; like( $@, qr/Circular reference/, "Checking that get_circreref1 failed" ); # Look in the heart of our deep data structures is_deeply($app->get_list, [[[[[[[ [ 'money', "money is good, but so is food and so, once again, money is good.", ], "money is good, but so is food" ]]]]]]], "Testing nested list."); is_deeply( $app->get_hash, { key => { key => { key => { key => { key => 'money is good', other => 'money' }, something => 'money' } } } }, "Testing nested hash." ); } # TEST: no_resolve { my $app = YAML::AppConfig->new( file => 't/data/vars.yaml', no_resolve => 1 ); ok($app, "Created object."); # Check basic retrieval is( $app->get_dapper, "life", "Checking variables, no_resolve => 1" ); is( $app->get_breezy, '$dapper is good', "Checking variables, no_resolve => 1" ); is( $app->get_hoary, '$breezy, but so is food', "Checking variables, no_resolve => 1" ); is( $app->get_stable, '$hoary and so, once again, $breezy.', "Checking variables, no_resolve => 1" ); is( $app->get_nonvar, '$these are $non $vars with a var, $dapper', "Checking variables, no_resolve => 1" ); } # TEST: Substituting in a variable with no value does not produce warnings { my $app = YAML::AppConfig->new( string => "---\nnv:\nfoo: \$nv bar\n" ); ok($app, "Object created"); local $SIG{__WARN__} = sub { die }; eval { $app->get_nv }; ok( !$@, "Getting a setting with no value does not produce warnings." ); eval { $app->get_foo }; ok( !$@, "Getting a setting using a no value variable does not warn." ); is( $app->get_foo, " bar", "No value var used as empty string." ); } # TEST: Make sure ${foo} style vars work. { my $yaml =<<'YAML'; --- xyz: foo xyzbar: bad '{xyzbar': bad 'xyz}bar': bad test1: ${xyz}bar test2: ${xyzbar test3: $xyz}bar YAML my $app = YAML::AppConfig->new( string => $yaml ); ok($app, "Object created"); is( $app->get_test1, 'foobar', "Testing \${foo} type variables." ); is( $app->get_test2, '${xyzbar', "Testing \${foo} type variables." ); is( $app->get_test3, 'foo}bar', "Testing \${foo} type variables." ); } # TEST: Escaping of variables. { my $yaml =<<'YAML'; --- paulv: likes cheese nosubst: \$paulv a lot usens: $nosubst \$paulv $paulv \\\$paulv \\$paulv cows. YAML my $ESCAPE_N = 10; # Add \\$paulv, \\\$paulv, \\\\$paulv, ... for my $n (1 .. $ESCAPE_N) { $yaml .= "literal$n: " . '\\'x$n . "\\\$paulv stuffs\n"; } my $app = YAML::AppConfig->new( string => $yaml ); ok($app, "Object created"); for my $n (1 .. $ESCAPE_N) { my $string = '\\'x$n . '$paulv stuffs'; is( $app->get("literal$n"), $string, "Testing escapes: $string" ); } is( $app->get_usens, '$paulv a lot $paulv likes cheese \\\\$paulv \\$paulv cows.', "Testing vars with escapes." ); } # TEST: self-circular references { my $yaml = <<'YAML'; --- foo: $foo bar: - cows - $bar YAML my $app = YAML::AppConfig->new( string => $yaml ); ok( $app, "Object loaded" ); eval { $app->get_foo }; like( $@, qr/Circular reference/, "Testing self-circular references. " ); eval { $app->get_bar }; like( $@, qr/Circular reference/, "Testing self-circular references. " ); } YAML-AppConfig-0.16/t/00-load.t0000644000175000017500000000326610447633156015556 0ustar matthewmatthewuse strict; use warnings; use Test::More tests => 28; do "t/lib/helpers.pl"; use lib 't/lib'; BEGIN { use_ok('YAML::AppConfig') } my $SKIP_NUM = 0; test_load("YAML"); test_load("YAML::Syck"); ok($SKIP_NUM < 2, "Asserting at least one YAML parser was tested"); sub test_load { my $class = shift; SKIP: { delete $INC{'YAML/Syck.pm'}; delete $INC{'YAML.pm'}; eval "require $class; 0;"; if ($@) { $SKIP_NUM++; skip "$class did not load, this might be ok.", 13 } else { ok(1, "Testing $class"); } # TEST: Object creation { my $app = YAML::AppConfig->new(); ok($app, "Instantiated object"); is($app->{yaml_class}, $class, "Testing class is right."); isa_ok( $app, "YAML::AppConfig", "Asserting isa YAML::AppConfig" ); ok( $app->can('new'), "\$app has new() method." ); } # TEST: Loading a different YAML class, string. { my $test_class = 'MatthewTestClass'; my $app = YAML::AppConfig->new(string => "cows", yaml_class => $test_class); ok($app, "Instantiated object"); is($app->{yaml_class}, $test_class, "Testing class is right."); isa_ok( $app, "YAML::AppConfig", "Asserting isa YAML::AppConfig." ); is($app->get_string, "cows", "Testing alternate YAML class (stirng)."); } # TEST: Loading a different YAML class, file. { my $test_class = 'MatthewTestClass'; my $app = YAML::AppConfig->new(file => "dogs", yaml_class => $test_class); ok($app, "Instantiated object"); is($app->{yaml_class}, $test_class, "Testing class is right."); isa_ok( $app, "YAML::AppConfig", "Asserting isa YAML::AppConfig." ); is($app->get_file, "dogs", "Testing alternate YAML class (file)."); } } # end SKIP } # end SUB YAML-AppConfig-0.16/t/lib/0000755000175000017500000000000010454131034014756 5ustar matthewmatthewYAML-AppConfig-0.16/t/lib/helpers.pl0000644000175000017500000000021010446427506016763 0ustar matthewmatthewsub slurp { my $file = shift; local $/ = undef; open my $fh, $file or die "Could not open $file: $!\n"; return <$fh>; } YAML-AppConfig-0.16/t/lib/MatthewTestClass.pm0000644000175000017500000000017010447326105020560 0ustar matthewmatthewpackage MatthewTestClass; sub LoadFile { return {file => shift}; } sub Load { return {string => shift}; } 1; YAML-AppConfig-0.16/t/02-normal.t0000644000175000017500000000616610446576335016137 0ustar matthewmatthewuse strict; use warnings; use Test::More tests => 106; do "t/lib/helpers.pl"; BEGIN { use_ok('YAML::AppConfig') } # TEST: Object creation from a file, string, and object. { test_object_creation( string => slurp("t/data/normal.yaml") ); my $app = test_object_creation( file => "t/data/normal.yaml" ); test_object_creation( object => $app ); } sub test_object_creation { my $app = YAML::AppConfig->new( @_ ); ok( $app, "Checking object creation." ); # Test obvious accessors are there. for my $method (qw(food man good is i_like and)) { ok( $app->can("get_$method"), "Testing $method getter" ); ok( $app->can("set_$method"), "Testing $method setter" ); } # Test we didn't get some strays. for my $not_method (qw(yummy like or)) { ok( !$app->can("get_$not_method"), "Testing !$not_method getter" ); ok( !$app->can("set_$not_method"), "Testing !$not_method getter" ); } # Test our wild things ok( !$app->can('get_somtin!^^^wild'), "Checking we can't do get_somtin!^^^wild" ); ok( !$app->can('set_somtin!^^^wild'), "Checking we can't do set_somtin!^^^wild" ); is( $app->get('somtin!^^^wild'), 'cows', "Retrieving somtin!^^^wild" ); ok( !$app->can('get_12_foo'), "Checking we can't do get_12_foo" ); ok( !$app->can('set_12_foo'), "Checking we can't do set_12_foo" ); is( $app->get('12_foo'), 'blah', "Retrieving 12_foo" ); # Test the values is( $app->get_food, 'oh', "food test" ); is( $app->get_man, 'yeah', "man test" ); is( $app->get_good, 'it', "good test" ); is( $app->get_is, 'good', "is test" ); is_deeply( $app->get_i_like, [ 'tofu', 'spatetee', 'ice cream' ], "i_like test" ); is_deeply( $app->get_and, { yummy => 'stuff', like => 'popcorn', 'or' => [qw(candy fruit bars)] }, "and test" ); return $app; } # TEST: Two objects don't clober each others methods. { my $bar = "get_bar"; my $app1 = YAML::AppConfig->new( string => "---\nfoo: 1\nbar: 2\n" ); ok( $app1, "Checking object creation." ); ok( $app1->can("get_foo"), "Checking that \$app1 has get_foo method." ); ok( $app1->can("get_bar"), "Checking that \$app1 has get_bar method." ); is( $app1->$bar, 2, "Checking bar1 is ok." ); my $app2 = YAML::AppConfig->new( string => "---\nqux: 3\nbar: 5\n" ); ok( $app2, "Checking object creation." ); ok( $app2->can("get_qux"), "Checking that \$app2 has get_qux method." ); ok( $app2->can("get_bar"), "Checking that \$app2 has get_bar method." ); is( $app2->$bar, 5, "Checking bar2 is ok." ); # Make sure we didn't clober each other. is( $app1->$bar, 2, "Checking that value of bar1 in app1 is the same." ); is( $app2->$bar, 5, "Checking that value of bar2 in app1 is the same." ); } # TEST: Make sure we don't get warnings on undef. values { my $app = YAML::AppConfig->new( string => "---\nnovalue:\n" ); ok($app, "Object created"); local $SIG{__WARN__} = sub { die }; eval { $app->get_novalue }; ok( !$@, "Getting a setting with no value does not produce warnings." ); } YAML-AppConfig-0.16/t/05-scoping.t0000644000175000017500000000316310447667337016312 0ustar matthewmatthewuse strict; use warnings; use Test::More tests => 9; do "t/lib/helpers.pl"; use Storable qw(dclone); BEGIN { use_ok('YAML::AppConfig') } # TEST: Testing dynamically scoped variables { my $app = YAML::AppConfig->new( file => 't/data/scoping.yaml' ); ok( $app, "Created object." ); is( $app->get_foo, "top scope", "Testing foo's value" ); is_deeply( $app->get_bar, { qux => "top scope" }, "Testing top scope." ); is_deeply( $app->get_baz, { foo => 'baz scope', qux => 'baz scope qux', test => 'world', quxx => [ { food => { burger => 'baz scope', test => 'world' }, fries => 'baz scope qux', test => 'world', }, { foo => 'inner scope', food => { burger => 'inner scope', test => 'world' }, fries => 'inner scope qux', test => 'world', }, ], }, "Testing big baz structure." ); is_deeply( $app->get_blah, { blah => "self ref test", ego => "self ref test" }, "Dynamic scoping handles self-refs right." ); eval {$app->get_simple_circ}; like( $@, qr/Circular reference in simple_circ/, "Checking circular dynamic variables." ); eval {$app->get_circ}; like( $@, qr/Circular reference in prolog/, "Checking circular dynamic variables." ); eval {$app->get_bigcirc}; like( $@, qr/Circular reference in thing/, "Checking circular dynamic variables." ); } YAML-AppConfig-0.16/t/01-basic.t0000644000175000017500000000301310446427506015706 0ustar matthewmatthewuse strict; use warnings; use Test::More tests => 21; do "t/lib/helpers.pl"; BEGIN { use_ok('YAML::AppConfig') } # TEST: Object creation from a file. { my $app = YAML::AppConfig->new( file => "t/data/basic.yaml" ); ok( $app, "Instantiated object from file." ); isa_ok( $app, "YAML::AppConfig", "Asserting isa YAML::AppConfig" ); my $c = 1; for my $var qw(foo bar) { is( $app->get($var), $c, "Retrieving value for $var." ); my $method = "get_$var"; ok( $app->can($method), "Checking that \$app can get_$var." ); is( $app->$method($var), $c, "Retrieving $var with $method." ); $c++; } $app->set("bar", 99); is($app->get("bar"), 99, "Setting bar, type set()."); $app->set_bar(101); is( $app->get("bar"), 101, "Setting bar, type set_bar()." ); } # TEST: Object creation from string. { my $app = YAML::AppConfig->new( string => slurp("t/data/basic.yaml") ); ok( $app, "Instantiated object from string." ); isa_ok( $app, "YAML::AppConfig", "Asserting isa YAML::AppConfig" ); my $c = 1; for my $var qw(foo bar) { is( $app->get($var), $c, "Retrieving value for $var." ); my $method = "get_$var"; ok( $app->can($method), "Checking that \$app can get_$var." ); is( $app->$method($var), $c, "Retrieving $var with $method." ); $c++; } $app->set("bar", 99); is($app->get("bar"), 99, "Setting bar, type set()."); $app->set_bar(101); is( $app->get("bar"), 101, "Setting bar, type set_bar()." ); } YAML-AppConfig-0.16/t/04-api.t0000644000175000017500000000520010447640172015376 0ustar matthewmatthewuse strict; use warnings; use Test::More tests => 24; do "t/lib/helpers.pl"; BEGIN { use_ok('YAML::AppConfig') } # TEST: config and config_keys { my $app = YAML::AppConfig->new( file => 't/data/config.yaml' ); ok( $app, "Object created." ); is_deeply( $app->config, { foo => 1, bar => 2, eep => '$foo' }, "config() method." ); is_deeply( [ $app->config_keys ], [qw(bar eep foo)], "config_keys() method." ); } # TEST: merge { my $app = YAML::AppConfig->new( file => 't/data/basic.yaml' ); ok( $app, "Object created." ); is( $app->get_foo, 1, "Checking foo before merge()." ); is( $app->get_bar, 2, "Checking bar before merge()." ); $app->merge( file => 't/data/merge.yaml' ); is( $app->get_foo, 2, "Checking foo after merge()." ); is( $app->get_bar, 2, "Checking bar after merge()." ); is( $app->get_baz, 3, "Checking bar after merge()." ); } # TEST: resolve { my $yaml = <<'YAML'; --- foo: hello bar: $foo world circ1: $circ2 circ2: $circ1 cows: - are - wonderful - $bar YAML my $app = YAML::AppConfig->new( string => $yaml ); ok($app, "Object loaded"); is( $app->resolve('I like $bar a lot'), 'I like hello world a lot', 'Testing our resolve()' ); is_deeply( $app->resolve('$cows'), [qw(are wonderful), "hello world"], 'Testing our resolve() with references', ); eval { $app->resolve('$circ1 is a loop!') }; like( $@, qr/Circular reference/, 'Testing our resolve() with circular refs' ); my $template = { qux => '$foo is good', baz => [ '$foo', '$cows' ] }; my $new = $app->resolve($template); isnt( $new, $template, "Testing we did not smash our old object" ); is_deeply( $new, { qux => 'hello is good', baz => [ 'hello', [ qw(are wonderful), "hello world" ], ], }, "Testing our resolve() with nested structures." ); } # TEST: dump { my $yaml = "---\nfoo: 1\nbar: 2\n"; my $app = YAML::AppConfig->new( string => $yaml ); ok( $app, "Object created." ); $app->set_foo(42); my $dump = $app->dump(); like( $dump, qr/foo:\s*42/, "Testing dump()" ); like( $dump, qr/bar:\s*2/, "Testing dump()" ); my $file = 't/data/dump.yaml'; $app->dump($file); ok( ( -f $file ), "Testing dump() with file: $file" ); ok( open( FILE, $file ), "Opening file: $file" ); my $text = join( "", ); like( $text, qr/foo:\s*42/, "Testing dump() with file: $file" ); like( $text, qr/bar:\s*2/, "Testing dump() with file: $file" ); is( $text, $dump, "Testing that dump() and dump() to file are same" ); } YAML-AppConfig-0.16/lib/0000755000175000017500000000000010454131034014513 5ustar matthewmatthewYAML-AppConfig-0.16/lib/YAML/0000755000175000017500000000000010454131034015255 5ustar matthewmatthewYAML-AppConfig-0.16/lib/YAML/AppConfig.pm0000644000175000017500000004550010454130640017467 0ustar matthewmatthewpackage YAML::AppConfig; use strict; use warnings; use Carp; use UNIVERSAL qw(isa); use Storable qw(dclone); # For Deep Copy #################### # Global Variables #################### our $VERSION = '0.16'; our @YAML_PREFS = qw(YAML::Syck YAML); ######################### # Class Methods: Public ######################### sub new { my ($class, %args) = @_; my $self = bless( \%args, ref($class) || $class ); # Load a YAML parser. $self->{yaml_class} = $self->_load_yaml_class(); # Load config from file, string, or object. if ( exists $self->{file} ) { my $load_file = eval "\\&$self->{yaml_class}::LoadFile"; $self->{config} = $load_file->( $self->{file} ); } elsif ( exists $self->{string} ) { my $load = eval "\\&$self->{yaml_class}::Load"; $self->{config} = $load->( $self->{string} ); } elsif ( exists $self->{object} ) { $self->{config} = dclone( $self->{object}->{config} ); } else { $self->{config} = {}; } # Initialize internal state $self->_install_accessors(); # Install convenience accessors. $self->{seen} = {}; # For finding circular references. $self->{scope_stack} = []; # For implementing dynamic variables. return $self; } ############################# # Instance Methods: Public ############################# sub config { my $self = shift; return $self->{config}; } sub config_keys { my $self = shift; return sort keys %{$self->config}; } sub get { my $self = shift; $self->{seen} = {}; # Don't know if we exited cleanly, so clean up. return $self->_get(@_); } # Inner get so we can clear the seen hash above. Listed here for readability. sub _get { my ( $self, $key, $no_resolve ) = @_; return unless $self->_scope_has($key); return $self->config->{$key} if $self->{no_resolve} or $no_resolve; croak "Circular reference in $key." if exists $self->{seen}->{$key}; $self->{seen}->{$key} = 1; my $value = $self->_resolve_refs($self->_get_from_scope($key)); delete $self->{seen}->{$key}; return $value; } sub set { my ($self, $key, $value) = @_; return $self->config->{$key} = $value; } sub merge { my ( $self, %args ) = @_; my $other_conf = $self->new( %args ); for my $key ( $other_conf->config_keys ) { $self->set( $key, $other_conf->get( $key, 'no vars' ) ); } } sub resolve { my ( $self, $thing ) = @_; $self->{seen} = {}; # Can't be sure this is empty, could've croaked. return $self->_resolve_refs($thing); } sub dump { my ( $self, $file ) = @_; my $func = eval "\\&$self->{yaml_class}::" . ($file ? 'DumpFile' : 'Dump'); die "Could not find $func: $@" if $@; $func->($file ? ($file) : (), $self->config); } ############################## # Instance Methods: Private ############################## # void _resolve_refs(Scalar $value) # # Recurses on $value until a non-reference scalar is found, in which case we # defer to _resolve_scalar. In this manner things like hashes and arrays are # traversed depth-first. sub _resolve_refs { my ( $self, $value ) = @_; if ( not ref $value ) { $value = $self->_resolve_scalar($value); } elsif ( isa $value, 'HASH' ) { $value = dclone($value); my @hidden = $self->_push_scope($value); for my $key ( keys %$value ) { $value->{$key} = $self->_resolve_refs( $value->{$key} ); } $self->_pop_scope(@hidden); return $value; } elsif ( isa $value, 'ARRAY' ) { $value = dclone($value); for my $item (@$value) { $item = $self->_resolve_refs( $item ); } } elsif ( isa $value, 'SCALAR' ) { $value = $self->_resolve_scalar($$value); } else { my ($class, $type) = map ref, ($self, $value); die "${class}::_resolve_refs() can't handle $type references."; } return $value; } # List _push_scope(HashRef scope) # # Pushes a new scope onto the stack. Variables in this scope are hidden from # the seen stack. This allows us to reference variables in the current scope # even if they have the same name as a variable higher up in chain. The # hidden variables are returned. sub _push_scope { my ( $self, $scope ) = @_; unshift @{ $self->{scope_stack} }, dclone($scope); my @hidden; for my $key ( keys %$scope ) { if ( exists $self->{seen}->{$key} ) { push @hidden, $key; delete $self->{seen}->{$key}; } } return @hidden; } # void _pop_scope(@hidden) # # Removes the currently active scope from the stack and unhides any variables # passed in via @hidden, which is usually returned from _push_scope. sub _pop_scope { my ( $self, @hidden ) = @_; shift @{$self->{scope_stack}}; for my $key ( @hidden ) { $self->{seen}->{$key} = 1; # Unhide } } # void _resolve_scalar(String $value) # # This function should only be called with strings (or numbers), not # references. $value is treated as a string and is searched for $foo type # variables, which are then resolved. The new string with variables resolved # is returned. sub _resolve_scalar { my ( $self, $value ) = @_; return unless defined $value; my @parts = grep length, # Empty strings are useless, discard them split /((?_get($name) if $self->_scope_has($name); } else { # Unescape slashes. Example: \\\$foo -> \\$foo, ditto with ${foo} $part =~ s/(\\*)\\(\$(?:{(\w+)}|(\w+)))/$1$2/g; } } return $parts[0] if @parts == 1 and ref $parts[0]; # Preserve references return join "", map { defined($_) ? $_ : "" } @parts; } # HashRef _scope(void) # # Returns the current scope. There is always a currenty defined scope, even # if it's just the global scope. sub _scope { my $self = shift; return $self->{scope_stack}->[0] || $self->config; } # List _scope_stack(void) # # Returns the list of currently active scopes. The list is ordered from inner # most scope to outer most scope. The global scope is always the last scope # in the list. sub _scope_stack { my $self = shift; return ( @{ $self->{scope_stack} }, $self->config ); } # Boolean _get_from_scope(String key) # # This method returns true if the key is in any scope enclosing the current # scope or in the current scope. False otherwise. sub _scope_has { my ( $self, $name ) = @_; for my $scope ( $self->_scope_stack ) { return 1 if exists $scope->{$name}; } return 0; } # Scalar _get_from_scope(String key) # # Given a key this method returns its value as it's defined in the inner most # enclosing scope containing the key. That is to say, this method implements # the dyanmic scoping lookup for key. sub _get_from_scope { my ( $self, $key ) = @_; for my $scope ( $self->_scope_stack ) { return $scope->{$key} if exists $scope->{$key}; } return undef; } # void _load_yaml_class # # Attempts to load a YAML class that can parse YAML for us. We prefer the # yaml_class attribute over everything, then fall back to a previously loaded # YAML parser from @YAML_PREFS, and failing that try to load a parser from # @YAML_PREFS. sub _load_yaml_class { my $self = shift; # Always use what we were given. if (defined $self->{yaml_class}) { eval "require $self->{yaml_class}; 0;"; croak "$@\n" if $@; return $self->{yaml_class}; } # Use what's already been loaded. for my $module (@YAML_PREFS) { my $filename = $module . ".pm"; $filename =~ s{::}{/}; return $self->{yaml_class} = $module if exists $INC{$filename}; } # Finally, try and load something. for my $module (@YAML_PREFS) { eval "require $module; 0;"; return $self->{yaml_class} = $module unless $@; } die "Could not load: " . join(" or ", @YAML_PREFS); } # void _install_accessors(void) # # Installs convienence methods for getting and setting configuration values. # These methods are just curryed versions of get() and set(). sub _install_accessors { my $self = shift; for my $key ($self->config_keys) { next unless $key and $key =~ /^[a-zA-Z_]\w*$/; for my $method (qw(get set)) { no strict 'refs'; no warnings 'redefine'; my $method_name = ref($self) . "::${method}_$key"; *{$method_name} = sub { $_[0]->$method($key, $_[1]) }; } } } 1; __END__ =head1 NAME YAML::AppConfig - Manage configuration files with YAML and variable reference. =head1 SYNOPSIS use YAML::AppConfig; # An extended example. YAML can also be loaded from a file. my $string = <<'YAML'; --- root_dir: /opt etc_dir: $root_dir/etc cron_dir: $etc_dir/cron.d var_dir $root_dir/var var2_dir: ${var_dir}2 usr: $root_dir/usr usr_local: $usr/local libs: system: $usr/lib local: $usr_local/lib perl: vendor: $system/perl site: $local/perl escape_example: $root_dir/\$var_dir/\\$var_dir YAML # Load the YAML::AppConfig from the given YAML. my $conf = YAML::AppConfig->new(string => $string); # Get settings in two different ways, both equivalent: $conf->get("etc_dir"); # returns /opt/etc $conf->get_etc_dir; # returns /opt/etc # Get raw settings (with no interpolation) in three equivalent ways: $conf->get("etc_dir", 1); # returns '$root_dir/etc' $conf->get_etc_dir(1); # returns '$root_dir/etc' $conf->config->{etc_dir}; # returns '$root_dir/etc' # Set etc_dir in three different ways, all equivalent. $conf->set("etc_dir", "/usr/local/etc"); $conf->set_etc_dir("/usr/local/etc"); $conf->config->{etc_dir} = "/usr/local/etc"; # Changing a setting can affect other settings: $config->get_var2_dir; # returns /opt/var2 $config->set_var_dir('/var/'); # change var_dr, which var2_dir uses. $config->get_var2_dir; # returns /var2 # Variables are dynamically scoped: $config->get_libs->{perl}->{vendor}; # returns "/opt/usr/lib/perl" # As seen above, variables are live and not static: $config->usr_dir('cows are good: $root_dir'); $config->get_usr_dir(); # returns "cows are good: /opt" $config->resolve('rm -fR $root_dir'); # returns "rm -fR /opt" # Variables can be escaped, to avoid accidental interpolation: $config->get_escape_example(); # returns "/opt/$var_dir/\$var_dir" # Merge in other configurations: my $yaml =<<'YAML'; --- root_dir: cows foo: are good YAML $config->merge(string => $yaml); $config->get_root_dir(); # returns "cows" $config->get_foo(); # returns "are good" # Get the raw YAML for your current configuration: $config->dump(); # returns YAML as string $config->dump("./conf.yaml"); # Writes YAML to ./conf.yaml =head1 DESCRIPTION L extends the work done in L and L to allow more flexiable configuration files. Your configuration is stored in YAML and then parsed and presented to you via L. Settings can be referenced using C and C methods and settings can refer to one another by using variables of the form C<$foo>, much in the style of C. See B below for more details. The underlying YAML parser is either L, L or one of your chosing. See B below for more information on how a YAML parser is picked. =head1 THE YAML LIBRARY At this time there are two API compatible YAML libraries for Perl. L and L. L chooses which YAML parser to use as follows: =over =item yaml_class If C is given to C then it used above all other considerations. You can use this to force use of L or L when L isn't using the one you'd like. You can also use it specify your own YAML parser, as long as it's API compatiable with L and L. =item The currently loaded YAML Parser If you don't specify C then L will default to using an already loaded YAML parser, e.g. one of L or L. If both are loaded then L is preferred. =item An installed YAML Parser. If no YAML parser has already been loaded then L will attempt to load L and failing that it will attempt to load L. If both fail then L will C when you create a new object instance. =over =head1 USING VARIABLES =head2 Variable Syntax Variables refer to other settings inside the configuration file. L variables have the same form as scalar variables in Perl. That is they begin with a dollar sign and then start with a letter or an underscore and then have zero or more letters, numbers, or underscores which follow. For example, C<$foo>, C<$_bar>, and C<$cat_3> are all valid variable names. Variable names can also be contained in curly brackets so you can have a variable side-by-side with text that might otherwise be read as the name of the variable itself. For example, C<${foo}bar> is the the variable C<$foo> immediately followed by the literal text C. Without the curly brackets L would assume the variable name was C<$foobar>, which is incorrect. Variables can also be escaped by using backslashes. The text C<\$foo> will resolve to the literal string C<$foo>. Likewise C<\\$foo> will resolve to the literal string C<\$foo>, and so on. =head2 Variable Scoping YAML is essentially a serialization language and so it follows that your configuration file is just an easy to read serialization of some data structure. L assumes the top most data structure is a hash and that variables are keys in that hash, or in some hash contained within. If every hash in the configuration file is thought of as a namespace then the variables can be said to be dynamically scoped. For example, consider the following configuration file: --- foo: world bar: hello baz: - $foo - {foo: dogs, cats: $foo} - $foo $bar qux: quack: $baz In this sample configuration the array contained by C<$baz> has two elements. The first element resolves to the value C, the second element resolves to the value "dogs", and the third element resolves to C. =head2 Variable Resolving Variables can also refer to entire data structures. For example, C<$quack> will resolve to the same three element array as C<$baz>. However, YAML natively gives you this ability and then some. So consider using YAML's ability to take references to structures if L is not providing enough power for your use case. In a L object the variables are not resolved until you retrieve the variable (e.g. using C. This allows you to change settings which are used by other settings and update many settings at once. For example, if I call C then C will resolve to C. If a variable can not be resolved because it doesn't correspond to a key currently in scope then the variable will be left verbatim in the text. Consider this example: --- foo: bar: food qux: baz: $bar qix: $no_exist In this example C<$baz> resolves to the literal string C<$bar> since C<$bar> is not visible within the current scope where C<$baz> is used. Likewise, C<$qix> resolves to the literal string C<$no_exist> since there is no key in the current scope named C. =head1 METHODS =head2 new(%args) Creates a new YAML::AppConfig object and returns it. new() accepts the following key values pairs: =over 8 =item file The name of the file which contains your YAML configuration. =item string A string containing your YAML configuration. =item object A L object which will be deep copied into your object. =item no_resolve If true no attempt at variable resolution is done on calls to C. =item yaml_class The name of the class we should use to find our C and C functions for parsing YAML files and strings, respectively. The named class should provide both C and C as functions and should be loadable via C. =back =head2 get(key, [no_resolve]) Given C<$key> the value of that setting is returned, same as C. If C<$no_resolve> is true then the raw value associated with C<$key> is returned, no variable interpolation is done. It is assumed that C<$key> refers to a setting at the top level of the configuration file. =head2 set(key, value) The setting C<$key> will have its value changed to C<$value>. It is assumed that C<$key> refers to a setting at the top level of the configuration file. =head2 get_*([no_resolve]) Convenience methods to retrieve values using a method, see C. For example if C is a configuration key in top level of your YAML file then C retrieves its value. These methods are curried versions of C. These functions all take a single optional argument, C<$no_resolve>, which is the same as C C<$no_resolve>. =head2 set_*(value) Convience methods to set values using a method, see C and C. These methods are curried versions of C. =head2 config Returns the hash reference to the raw config hash. None of the values are interpolated, this is just the raw data. =head2 config_keys Returns the keys in C sorted from first to last. =head2 merge(%args) Merge takes another YAML configuration and merges it into this one. C<%args> are the same as those passed to C, so the configuration can come from a file, string, or existing L object. =head2 resolve($scalar) C runs the internal parser on non-reference scalars and returns the result. If the scalar is a reference then it is deep copied and a copy is returned where the non-reference leaves of the data struture are parsed and replaced as described in B. =head2 dump([$file]) Serializes the current configuration using the YAML parser's Dump or, if C<$file> is given, DumpFile functions. No interpolation is done, so the configuration is saved raw. Things like comments will be lost, just as they would if you did C, because that is what what calling C on an instantiated object amounts to. =head1 AUTHORS Matthew O'Connor Ematthew@canonical.orgE Original implementations by Kirrily "Skud" Robert (as L) and Shawn Boyette (as L). =head1 SEE ALSO L, L, L, L =head1 COPYRIGHT Copyright 2006 Matthew O'Connor, All Rights Reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. YAML-AppConfig-0.16/META.yml0000644000175000017500000000076410454131034015225 0ustar matthewmatthew# http://module-build.sourceforge.net/META-spec.html #XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX# name: YAML-AppConfig version: 0.16 version_from: lib/YAML/AppConfig.pm installdirs: site requires: Carp: 0 Storable: 0 UNIVERSAL: 0 YAML: 0.38 YAML::Syck: 0 distribution_type: module generated_by: ExtUtils::MakeMaker version 6.17 YAML-AppConfig-0.16/MANIFEST0000644000175000017500000000054110447664217015116 0ustar matthewmatthewlib/YAML/AppConfig.pm Makefile.PL MANIFEST t/00-load.t t/01-basic.t t/02-normal.t t/03-vars.t t/04-api.t t/05-scoping.t t/data/basic.yaml t/data/config.yaml t/data/merge.yaml t/data/normal.yaml t/data/scoping.yaml t/data/vars.yaml t/lib/helpers.pl t/lib/MatthewTestClass.pm META.yml Module meta-data (added by MakeMaker) YAML-AppConfig-0.16/Makefile.PL0000644000175000017500000000126310452034357015731 0ustar matthewmatthewuse strict; use warnings; use ExtUtils::MakeMaker; WriteMakefile( NAME => 'YAML::AppConfig', ABSTRACT => 'Manage config files with YAML and variable references.', AUTHOR => 'Matthew O\'Connor ', VERSION_FROM => 'lib/YAML/AppConfig.pm', PREREQ_PM => { get_yamls(), 'Storable' => 0, 'Carp' => 0, 'UNIVERSAL' => 0, }, ); sub get_yamls { my @yamls; for my $info (['YAML::Syck' => 0], [YAML => 0.38]) { eval "require $info->[0]; 0;"; push @yamls, @$info unless $@; } die "YAML >= 0.38 or YAML::Syck >= 0 required.\n" unless @yamls; return @yamls; }