forked from lix-project/hydra
Create a helper for dealing with nested attribute sets
This commit is contained in:
parent
d62a2c1657
commit
88e0198a8e
56
src/lib/Hydra/Helper/AttributeSet.pm
Normal file
56
src/lib/Hydra/Helper/AttributeSet.pm
Normal file
|
@ -0,0 +1,56 @@
|
|||
package Hydra::Helper::AttributeSet;
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
sub new {
|
||||
my ($self) = @_;
|
||||
return bless { "paths" => [] }, $self;
|
||||
}
|
||||
|
||||
sub registerValue {
|
||||
my ($self, $attributePath) = @_;
|
||||
|
||||
my @pathParts = splitPath($attributePath);
|
||||
|
||||
pop(@pathParts);
|
||||
if (scalar(@pathParts) == 0) {
|
||||
return;
|
||||
}
|
||||
|
||||
my $lineage = "";
|
||||
for my $pathPart (@pathParts) {
|
||||
$lineage = $self->registerChild($lineage, $pathPart);
|
||||
}
|
||||
}
|
||||
|
||||
sub registerChild {
|
||||
my ($self, $parent, $attributePath) = @_;
|
||||
if ($parent ne "") {
|
||||
$parent .= "."
|
||||
}
|
||||
|
||||
my $name = $parent . $attributePath;
|
||||
if (!grep { $_ eq $name} @{$self->{"paths"}}) {
|
||||
push(@{$self->{"paths"}}, $name);
|
||||
}
|
||||
return $name;
|
||||
}
|
||||
|
||||
sub splitPath {
|
||||
my ($s) = @_;
|
||||
|
||||
if ($s eq "") {
|
||||
return ('')
|
||||
}
|
||||
|
||||
return split(/\./, $s, -1);
|
||||
}
|
||||
|
||||
sub enumerate {
|
||||
my ($self) = @_;
|
||||
my @paths = sort { length($a) <=> length($b) } @{$self->{"paths"}};
|
||||
return wantarray ? @paths : \@paths;
|
||||
}
|
||||
|
||||
1;
|
|
@ -2,8 +2,9 @@ package Hydra::Helper::Escape;
|
|||
|
||||
use strict;
|
||||
use base qw(Exporter);
|
||||
use Hydra::Helper::AttributeSet;
|
||||
|
||||
our @EXPORT = qw(escapeString);
|
||||
our @EXPORT = qw(escapeString escapeAttributePath);
|
||||
|
||||
sub escapeString {
|
||||
my ($s) = @_;
|
||||
|
@ -12,3 +13,9 @@ sub escapeString {
|
|||
$s =~ s|\$|\\\$|g;
|
||||
return "\"" . $s . "\"";
|
||||
}
|
||||
|
||||
sub escapeAttributePath {
|
||||
my ($s) = @_;
|
||||
|
||||
return join(".", map( { escapeString($_) } Hydra::Helper::AttributeSet::splitPath($s)));
|
||||
}
|
||||
|
|
53
t/Helper/attributeset.t
Normal file
53
t/Helper/attributeset.t
Normal file
|
@ -0,0 +1,53 @@
|
|||
use strict;
|
||||
use warnings;
|
||||
use Setup;
|
||||
use Data::Dumper;
|
||||
use Test2::V0;
|
||||
use Hydra::Helper::AttributeSet;
|
||||
|
||||
|
||||
subtest "splitting an attribute path in to its component parts" => sub {
|
||||
my %values = (
|
||||
"" => [''],
|
||||
"." => ['', ''],
|
||||
"...." => ['', '', '', '', ''],
|
||||
"foobar" => ['foobar'],
|
||||
"foo.bar" => ['foo', 'bar'],
|
||||
"🌮" => ['🌮'],
|
||||
|
||||
# not supported: 'foo."bar.baz".tux' => [ 'foo', 'bar.baz', 'tux' ]
|
||||
# the edge cases are fairly significant around escaping and unescaping.
|
||||
);
|
||||
|
||||
for my $input (keys %values) {
|
||||
my @value = @{$values{$input}};
|
||||
my @components = Hydra::Helper::AttributeSet::splitPath($input);
|
||||
is(\@components, \@value, "Splitting the attribute path: " . $input);
|
||||
}
|
||||
};
|
||||
|
||||
my $attrs = Hydra::Helper::AttributeSet->new();
|
||||
$attrs->registerValue("foo");
|
||||
$attrs->registerValue("bar.baz.tux");
|
||||
$attrs->registerValue("bar.baz.bux.foo.bar.baz");
|
||||
|
||||
is(
|
||||
$attrs->enumerate(),
|
||||
[
|
||||
# "foo": skipped since we're registering values, and we
|
||||
# only want to track nested attribute sets.
|
||||
|
||||
# "bar.baz.tux": expand the path
|
||||
"bar",
|
||||
"bar.baz",
|
||||
|
||||
#"bar.baz.bux.foo.bar.baz": expand the path, but only register new
|
||||
# attribute set names.
|
||||
"bar.baz.bux",
|
||||
"bar.baz.bux.foo",
|
||||
"bar.baz.bux.foo.bar",
|
||||
],
|
||||
"Attribute set paths are registered."
|
||||
);
|
||||
|
||||
done_testing;
|
|
@ -22,4 +22,23 @@ subtest "checking individual attribute set elements" => sub {
|
|||
}
|
||||
};
|
||||
|
||||
subtest "escaping path components of a nested attribute" => sub {
|
||||
my %values = (
|
||||
"" => '""',
|
||||
"." => '"".""',
|
||||
"...." => '""."".""."".""',
|
||||
"foobar" => '"foobar"',
|
||||
"foo.bar" => '"foo"."bar"',
|
||||
"🌮" => '"🌮"',
|
||||
'foo"bar' => '"foo\"bar"',
|
||||
'foo\\bar' => '"foo\\\\bar"',
|
||||
'$bar' => '"\\$bar"',
|
||||
);
|
||||
|
||||
for my $input (keys %values) {
|
||||
my $value = $values{$input};
|
||||
is(escapeAttributePath($input), $value, "Escaping the attribute path: " . $input);
|
||||
}
|
||||
};
|
||||
|
||||
done_testing;
|
||||
|
|
Loading…
Reference in a new issue