diff --git a/lib/Struct/Path/PerlStyle.pm b/lib/Struct/Path/PerlStyle.pm index ef95473..4291fca 100644 --- a/lib/Struct/Path/PerlStyle.pm +++ b/lib/Struct/Path/PerlStyle.pm @@ -212,7 +212,7 @@ sub _push_hash { push @{$step{K}}, $body; } elsif ($delim eq '/' and !$type or $type eq 'm') { $mods = join('', sort(split('', $mods))); - eval { push @{$step{R}}, $QR_MAP->{$mods}->($body) }; + eval { push @{$step{K}}, $QR_MAP->{$mods}->($body) }; if ($@) { (my $err = $@) =~ s/ at .+//s; croak "Step #" . scalar @{$steps} . " $err"; @@ -369,44 +369,38 @@ sub path2str($) { $out .= "[" . join(",", @{items}) . "]"; } elsif (ref $step eq 'HASH') { - my $types = [ grep { exists $step->{$_} } qw(K R) ]; - if (keys %{$step} != @{$types}) { - $types = { map { $_, 1 } @{$types} }; - my @errs = grep { !exists $types->{$_} } sort keys %{$step}; - croak "Unsupported hash definition (" . - join(',', @errs) . "), step #$sc" - } + my $keys; if (exists $step->{K}) { croak "Unsupported hash keys definition, step #$sc" unless (ref $step->{K} eq 'ARRAY'); + croak "Unsupported hash definition (extra keys), step #$sc" + if (keys %{$step} > 1); + $keys = $step->{K}; - for my $k (@{$step->{K}}) { - croak "Unsupported hash key type 'undef', step #$sc" - unless (defined $k); - croak "Unsupported hash key type '@{[ref $k]}', step #$sc" - if (ref $k); + } elsif (keys %{$step}) { + croak "Unsupported hash definition (unknown keys), step #$sc"; + } else { + $keys = []; + } + for my $k (@{$keys}) { + if (is_regexp($k)) { + my ($patt, $mods) = regexp_pattern($k); + $mods =~ s/[dlu]//g; # for Perl's internal use (c) perlre + push @items, "/$patt/$mods"; + + } elsif (defined $k and ref $k eq '') { push @items, $k; unless ($k =~ /^$HASH_KEY_CHARS+$/) { $items[-1] =~ s/([\Q$ESCP\E])/$ESCP{$1}/gs; # escape $items[-1] = qq("$items[-1]"); # quote } - } - } - - if (exists $step->{R}) { - croak "Unsupported hash regexps definition, step #$sc" - unless (ref $step->{R} eq 'ARRAY'); - - for my $r (@{$step->{R}}) { - croak "Regexp expected for regexps item, step #$sc" - unless (is_regexp($r)); - my ($patt, $mods) = regexp_pattern($r); - $mods =~ s/[dlu]//g; # for Perl's internal use (c) perlre - push @items, "/$patt/$mods"; + } else { + croak "Unsupported hash key type '" . + (ref($k) || 'undef') . "', step #$sc" } } diff --git a/t/hashes-keys.t b/t/hashes-keys.t index a76324b..fad6f38 100644 --- a/t/hashes-keys.t +++ b/t/hashes-keys.t @@ -11,13 +11,13 @@ use lib 't'; use _common qw(roundtrip t_dump); eval { path2str([{garbage => ['a']}]) }; -like($@, qr/^Unsupported hash definition \(garbage\), step #0 /); +like($@, qr/^Unsupported hash definition \(unknown keys\), step #0 /); eval { path2str([{K => 'a'}]) }; like($@, qr/^Unsupported hash keys definition, step #0 /); eval { path2str([{K => ['a'], garbage => ['b']}]) }; -like($@, qr/^Unsupported hash definition \(garbage\), step #0 /); +like($@, qr/^Unsupported hash definition \(extra keys\), step #0 /); eval { path2str([{K => [undef]}]) }; like($@, qr/^Unsupported hash key type 'undef', step #0 /); diff --git a/t/hashes-regs.t b/t/hashes-regs.t index 5444765..3f378fc 100644 --- a/t/hashes-regs.t +++ b/t/hashes-regs.t @@ -3,7 +3,7 @@ use strict; use warnings FATAL => 'all'; -use Test::More tests => 24; +use Test::More tests => 22; use Struct::Path::PerlStyle qw(str2path path2str); use lib 't'; @@ -47,74 +47,68 @@ SKIP: { like($@, qr|^Step #0 Eval-group not allowed |); } -eval { path2str([{R => 1}]) }; -like($@, qr/^Unsupported hash regexps definition, step #0 /); - -eval { path2str([{R => [1]}]) }; -like($@, qr/^Regexp expected for regexps item, step #0 /); - roundtrip ( - [{R => [qr/pat/,qr/pat/i,qr/pat/m,qr/pat/s,qr/pat/x]}], + [{K => [qr/pat/,qr/pat/i,qr/pat/m,qr/pat/s,qr/pat/x]}], '{/pat/,/pat/i,/pat/m,/pat/s,/pat/x}', '//' ); is_deeply( str2path('{m/pat/,m!pat!i,m|pat|m,m#pat#s,m{pat}x,m(pat)i,m[pat]i,mi,m"pat"i,m\'pat\'i}'), - [{R => [qr/pat/,qr/pat/i,qr/pat/m,qr/pat/s,qr/pat/x,qr/pat/i,qr/pat/i,qr/pat/i,qr/pat/i,qr/pat/i]}], + [{K => [qr/pat/,qr/pat/i,qr/pat/m,qr/pat/s,qr/pat/x,qr/pat/i,qr/pat/i,qr/pat/i,qr/pat/i,qr/pat/i]}], "m//" ); roundtrip ( - [{R => [qr/^Lonesome regexp$/mi]}], + [{K => [qr/^Lonesome regexp$/mi]}], '{/^Lonesome regexp$/mi}', 'Lonesome regexp' ); roundtrip ( - [{K => ['Mixed', 'with'], R => [qr/regular keys/]}], - '{Mixed,with,/regular keys/}', + [{K => ['Mixed', 'with', qr/regular/, 'keys']}], + '{Mixed,with,/regular/,keys}', 'Regexps mixed with keys' ); roundtrip ( - [{R => [qr//,qr//msix]}], + [{K => [qr//,qr//msix]}], '{//,//msix}', 'Empty pattern' ); roundtrip ( - [{R => [qr|^Regular\/\/Slashes|]}], + [{K => [qr|^Regular\/\/Slashes|]}], '{/^Regular\/\/Slashes/}', 'Regular slashes' ); roundtrip ( - [{R => [qr/^TwoBack\\Slashes/]}], + [{K => [qr/^TwoBack\\Slashes/]}], '{/^TwoBack\\\\Slashes/}', 'Back slashes' ); roundtrip ( - [{R => [qr/Character\b\B\d\D\s\S\w\WClasses/]}], + [{K => [qr/Character\b\B\d\D\s\S\w\WClasses/]}], '{/Character\b\B\d\D\s\S\w\WClasses/}', 'Character classes' ); roundtrip ( - [{R => [qr/Escape\t\n\r\f\b\a\eSequences/]}], + [{K => [qr/Escape\t\n\r\f\b\a\eSequences/]}], '{/Escape\t\n\r\f\b\a\eSequences/}', 'Escape sequences' ); roundtrip ( - [{R => [qr/Escape\x{263A}|\x1b|\N{U+263D}|\c[|\033Sequences2/]}], + [{K => [qr/Escape\x{263A}|\x1b|\N{U+263D}|\c[|\033Sequences2/]}], '{/Escape\x{263A}|\x1b|\N{U+263D}|\c[|\033Sequences2/}', 'Escape sequences2' ); roundtrip ( - [{R => [qr#^([^\?]{1,5}|.+|\\?|)*$#]}], + [{K => [qr#^([^\?]{1,5}|.+|\\?|)*$#]}], '{/^([^\?]{1,5}|.+|\\\\?|)*$/}', 'Metacharacters' );