From 8226bc5c60d045f8dd7f9f66196fe7ae09433582 Mon Sep 17 00:00:00 2001 From: Joelle Maslak Date: Sat, 12 Oct 2019 17:21:06 -0600 Subject: Joelle's solution for 29.1 in Perl 5 --- challenge-029/joelle-maslak/perl5/ch-1.pl | 101 ++++++++++++++++++++++++++++++ 1 file changed, 101 insertions(+) create mode 100755 challenge-029/joelle-maslak/perl5/ch-1.pl diff --git a/challenge-029/joelle-maslak/perl5/ch-1.pl b/challenge-029/joelle-maslak/perl5/ch-1.pl new file mode 100755 index 0000000000..22ccf40a5a --- /dev/null +++ b/challenge-029/joelle-maslak/perl5/ch-1.pl @@ -0,0 +1,101 @@ +#!/usr/bin/env perl +use v5.22; +use strict; +use warnings; + +# This handles the following: +# +# a{1,2} +# a{1,2{3,4}}{5,6}b +# +# And similar versions. So, yes, you can nest and have multiple +# curlies. Note there is no way to "quote" commas or curlies at this +# time, but they would be reasonably straightforward to add. I have to +# admit Parse:RecDescent is awesome just as Perl 6 grammars are. +# + +# Turn on method signatures +use feature 'signatures'; +no warnings 'experimental::signatures'; + +use List::Util qw(uniqstr); +use Parse::RecDescent 1.511; + +my $parser = Parse::RecDescent->new( + q{ + + TOP : + + element(s?) + element : string | curly + string : /[^\{\}]+/ + curly : '{' option(s? /,/) '}' + option : innerele(s) + innerele : curly | innerstr + innerstr : /[^\{\}\,]*/ +} +); + +MAIN: { + die "Usage: $0 " if @ARGV != 1; + + my $str = $ARGV[0]; + my $parse = $parser->TOP( \$str ); + die "Invalid String" if ((!defined $parse) or ($str ne '')); + + my @expansion = expansion($parse, '' ); + say join "\n", uniqstr sort @expansion; + + exit; + + my $str1 = lc( $parse->{scheme} ) . ':'; + + $str .= '//' if defined $parse->{host}; + $str .= $parse->{userinfo} if defined $parse->{userinfo}; + + if ( lc( $parse->{scheme} ) eq 'http' and defined $parse->{port} ) { + $str .= ':' . $parse->{port} if $parse->{port} != 80; + } elsif ( lc( $parse->{scheme} ) eq 'https' and defined $parse->{port} ) { + $str .= ':' . $parse->{port} if $parse->{port} != 443; + } elsif ( defined $parse->{port} ) { + $str .= ':' . $parse->{port}; + } + + say "Scheme: " . ( $parse->{scheme} // '' ); + say "Userinfo: " . ( $parse->{userinfo} // '' ); + say "Host: " . ( $parse->{host} // '' ); + say "Port: " . ( $parse->{port} // '' ); + say "Path: " . ( $parse->{path} // '' ); + say "Query: " . ( $parse->{query} // '' ); + say "Fragment: " . ( $parse->{fragment} // '' ); + + say $str; +} + +sub expansion($tree, @arr) { + if (exists $tree->{'element(s?)'}) { + for my $ele ($tree->{'element(s?)'}->@*) { + @arr = expansion($ele, @arr); + } + return @arr; + } elsif (exists $tree->{'innerele(s)'}) { + for my $ele ($tree->{'innerele(s)'}->@*) { + @arr = expansion($ele, @arr); + } + return @arr; + } elsif (exists $tree->{string}) { + return map { $_ . $tree->{string}{__VALUE__} } @arr; + } elsif (exists $tree->{innerstr}) { + return map { $_ . $tree->{innerstr}{__VALUE__} } @arr; + } elsif (exists $tree->{curly}) { + my (@copy) = @arr; + @arr = (); + for my $ele ($tree->{curly}{'option(s?)'}->@*) { + push @arr, expansion($ele, @copy); + } + return @arr; + } else { + die join ' ', keys $tree->%*; + } +} + -- cgit