scip/Config-General
1
0
Fork 0
mirror of https://codeberg.org/scip/Config-General.git synced 2025-12-16 20:21:01 +01:00
Code Issues Packages Projects Releases Wiki Activity

added ::getbypath() which allows to fetch subhashes by specifying

Browse Source 
a path (just like xpath)


git-svn-id: http://dev.catalyst.perl.org/repos/Config-General/trunk@88 be1acefe-a474-0410-9a34-9b3221f2030f
This commit is contained in:
Thomas von Dein
2010-08-25 13:23:58 +00:00
parent 5f3800ba29
commit 78d7f3d6f9
1 changed files with 49 additions and 4 deletions
Download Patch File Download Diff File Expand all files Collapse all files

53
General/Extended.pm
View File

@@ -1,7 +1,7 @@
# #
# Config::General::Extended - special Class based on Config::General # Config::General::Extended - special Class based on Config::General
# #
# Copyright (c) 2000-2008 Thomas Linden <tlinden |AT| cpan.org>. # Copyright (c) 2000-2010 Thomas Linden <tlinden |AT| cpan.org>.
# All Rights Reserved. Std. disclaimer applies. # All Rights Reserved. Std. disclaimer applies.
# Artistic License, same as perl itself. Have fun. # Artistic License, same as perl itself. Have fun.
# #
@@ -23,7 +23,7 @@ use vars qw(@ISA @EXPORT);
use strict; use strict;
$Config::General::Extended::VERSION = "2.04"; $Config::General::Extended::VERSION = "2.05";
sub new { sub new {
@@ -32,6 +32,51 @@ sub new {
} }
sub getbypath {
my ($this, $path) = @_;
my $xconfig = $this->{config};
$path =~ s#^/##;
$path =~ s#/$##;
my @pathlist = split /\//, $path;
my $index;
foreach my $element (@pathlist) {
if($element =~ /^([^\[]*)\[(\d+)\]$/) {
$element = $1;
$index = $2;
}
else {
$index = undef;
}
if(ref($xconfig) eq "ARRAY") {
return {};
}
elsif (! exists $xconfig->{$element}) {
return {};
}
if(ref($xconfig->{$element}) eq "ARRAY") {
if(! defined($index) ) {
#croak "$element is an array but you didn't specify an index to access it!\n";
$xconfig = $xconfig->{$element};
}
else {
if(exists $xconfig->{$element}->[$index]) {
$xconfig = $xconfig->{$element}->[$index];
}
else {
croak "$element doesn't have an element with index $index!\n";
}
}
}
else {
$xconfig = $xconfig->{$element};
}
}
return $xconfig;
}
sub obj { sub obj {
# #
# returns a config object from a given key # returns a config object from a given key
@@ -576,7 +621,7 @@ values under the given key will be overwritten.
=head1 COPYRIGHT =head1 COPYRIGHT
Copyright (c) 2000-2008 Thomas Linden Copyright (c) 2000-2010 Thomas Linden
This library is free software; you can redistribute it and/or This library is free software; you can redistribute it and/or
modify it under the same terms as Perl itself. modify it under the same terms as Perl itself.
@@ -593,7 +638,7 @@ Thomas Linden <tlinden |AT| cpan.org>
=head1 VERSION =head1 VERSION
2.04 2.05
=cut =cut