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 strict;
|
||||||
use base qw(Exporter);
|
use base qw(Exporter);
|
||||||
|
use Hydra::Helper::AttributeSet;
|
||||||
|
|
||||||
our @EXPORT = qw(escapeString);
|
our @EXPORT = qw(escapeString escapeAttributePath);
|
||||||
|
|
||||||
sub escapeString {
|
sub escapeString {
|
||||||
my ($s) = @_;
|
my ($s) = @_;
|
||||||
|
@ -12,3 +13,9 @@ sub escapeString {
|
||||||
$s =~ s|\$|\\\$|g;
|
$s =~ s|\$|\\\$|g;
|
||||||
return "\"" . $s . "\"";
|
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;
|
done_testing;
|
||||||
|
|
Loading…
Reference in a new issue