diff --git a/challenge-313/ppentchev/perl/.gitignore b/challenge-313/ppentchev/perl/.gitignore new file mode 100644 index 0000000000..736ec121ad --- /dev/null +++ b/challenge-313/ppentchev/perl/.gitignore @@ -0,0 +1,4 @@ +# SPDX-FileCopyrightText: Peter Pentchev +# SPDX-License-Identifier: BSD-2-Clause + +.tidyall.d/ diff --git a/challenge-313/ppentchev/perl/.perlcriticrc b/challenge-313/ppentchev/perl/.perlcriticrc index 9c61e78d19..71f6e02090 100644 --- a/challenge-313/ppentchev/perl/.perlcriticrc +++ b/challenge-313/ppentchev/perl/.perlcriticrc @@ -13,3 +13,9 @@ theme = core [Documentation::PodSpelling] spell_command = aspell --lang=en_US list + +# We do need to match exactly the letters A-Z +[-RegularExpressions::ProhibitEnumeratedClasses] + +# We do run perltidy... +[-CodeLayout::RequireTidyCode] diff --git a/challenge-313/ppentchev/perl/ch-1.t b/challenge-313/ppentchev/perl/ch-1.t new file mode 100644 index 0000000000..3e4d2ac4c0 --- /dev/null +++ b/challenge-313/ppentchev/perl/ch-1.t @@ -0,0 +1,98 @@ +#!/usr/bin/perl5 +# SPDX-FileCopyrightText: Peter Pentchev +# SPDX-License-Identifier: BSD-2-Clause + +use strict; +use warnings; +use v5.16; ## no critic qw(ValuesAndExpressions::ProhibitVersionStrings) + +use List::Util qw(min reduce); +use Readonly; + +use Test::More; + +plan tests => 2; + +sub re_escape_char($) { + my ($chr) = @_; + + if ( $chr eq q{[} || $chr eq q{]} || $chr eq q{^} ) { + return "\\$chr"; + } + + return "[$chr]"; +} + +sub broken_keys($ $) { + my ( $name, $typed ) = @_; + my $pattern = + q{^} . join( q{}, map { re_escape_char($_) . q{+} } split //ms, $name ) . q{$}; + if ( $typed =~ qr{$pattern}xms ) { + return 1; + } + else { + return 0; + } +} + +Readonly my $TEST_ESCAPE_CHARS => + ' ~!@#%^&*()_+`1234567890-=abcdefghijklmnopqrstuvwxyz[];m,./{}:"<>$' . q{'}; ## no critic qw(ValuesAndExpressions::RequireInterpolationOfMetachars) + +Readonly my @TEST_BROKEN_KEYS => ( + [ 'perl', 'perrrl', 1 ], + [ 'raku', 'rrakuuuu', 1 ], + [ 'python', 'perl', 0 ], + [ 'coffeescript', 'cofffeescccript', 1 ], +); + +subtest check_re_escape => sub { + plan tests => length $TEST_ESCAPE_CHARS; + + for my $chr ( split //ms, $TEST_ESCAPE_CHARS ) { + subtest check_single_char => sub { + plan tests => length $TEST_ESCAPE_CHARS; + + my $pattern = q{^} . re_escape_char($chr) . q{$}; + my $re = qr{$pattern}xms; + + for my $other ( split //ms, $TEST_ESCAPE_CHARS ) { + subtest check_chars => sub { + plan tests => 5; + if ( $chr eq $other ) { + ok $other =~ $re, + "'$other' matches '$pattern'"; + } + else { + ok $other !~ $re, + "'$other' does not match '$pattern'"; + } + + ok q{} !~ $re, "'' does not match '$pattern'"; + + ok "$chr$chr" !~ $re, + "'$chr$chr' does not match '$pattern'"; + + ok "$chr$other" !~ $re, + "'$chr$other' does not match '$pattern'"; + + ok "$other$other" !~ $re, + "'$other$other' does not match '$pattern'"; + } + } + }; + } +}; + +subtest check_broken_keys => sub { + plan tests => scalar @TEST_BROKEN_KEYS; + + for my $tcase (@TEST_BROKEN_KEYS) { + my ( $name, $typed, $expected ) = @{$tcase}; + if ($expected) { + ok broken_keys( $name, $typed ), "'$typed' could be '$name'"; + } + else { + ok !broken_keys( $name, $typed ), "'$typed' could not be '$name'"; + } + } +}; diff --git a/challenge-313/ppentchev/perl/ch-2.t b/challenge-313/ppentchev/perl/ch-2.t new file mode 100644 index 0000000000..97734b778c --- /dev/null +++ b/challenge-313/ppentchev/perl/ch-2.t @@ -0,0 +1,133 @@ +#!/usr/bin/perl5 +# SPDX-FileCopyrightText: Peter Pentchev +# SPDX-License-Identifier: BSD-2-Clause + +use strict; +use warnings; +use v5.16; ## no critic qw(ValuesAndExpressions::ProhibitVersionStrings) + +use Carp qw(croak); +use English qw(--no_match_vars); +use Data::Dumper; +use List::Util qw(min reduce); +use Readonly; + +use Test::More; + +plan tests => 3; + +Readonly my $RE_STARTING_NON_LETTERS => qr{ + ^ + (?P [^A-Za-z]+ ) + (?P .* ) + $ +}xms; + +Readonly my $RE_LETTERS => qr{ + ^ + (?P [A-Za-z]+ ) + (?P [^A-Za-z]* ) + (?P .* ) + $ +}xms; + +sub parse_letters($) { + my ($str) = @_; + + my @res; + + if ( $str =~ $RE_STARTING_NON_LETTERS ) { + push @res, [ q{}, $LAST_PAREN_MATCH{weird} ]; + $str = $LAST_PAREN_MATCH{rest}; + } + + # Check for a non-letter at the very start + while ( $str ne q{} ) { + if ( $str !~ $RE_LETTERS ) { + croak 'Could not parse ' . Dumper($str); + } + push @res, [ $LAST_PAREN_MATCH{letters}, $LAST_PAREN_MATCH{others} ]; + $str = $LAST_PAREN_MATCH{rest}; + } + + return map { [ [ split //ms, $_->[0] ], $_->[1] ] } @res; +} + +sub reverse_parsed($) { + my ($parsed) = @_; + my @letters = reverse map { @{ $_->[0] } } @{$parsed}; + + my $res = q{}; + for my $group ( @{$parsed} ) { + my $count = scalar @{ $group->[0] }; + $res .= join q{}, @letters[ 0 .. ( $count - 1 ) ]; + @letters = @letters[ $count .. $#letters ]; + + $res .= $group->[1]; + } + return $res; +} + +sub reverse_letters($) { + my ($str) = @_; + my @parsed = parse_letters $str; + return reverse_parsed \@parsed; +} + +Readonly my @TEST_REVERSE_LETTERS => ( + [ + 'p-er?l', 'l-re?p', + [ [ [q{p}], q{-} ], [ [ q{e}, q{r} ], q{?} ], [ [q{l}], q{} ] ], + ], + [ + 'wee-k!L-y', + 'yLk-e!e-w', + [ + [ [ q{w}, q{e}, q{e} ], q{-} ], + [ [q{k}], q{!} ], + [ [q{L}], q{-} ], + [ [q{y}], q{} ], + ], + ], + [ + '_c-!h_all-en!g_e', + '_e-!g_nel-la!h_c', + [ + [ [], q{_} ], + [ [q{c}], q{-!} ], + [ [q{h}], q{_} ], + [ [ q{a}, q{l}, q{l} ], q{-} ], + [ [ q{e}, q{n} ], q{!} ], + [ [q{g}], q{_} ], + [ [q{e}], q{} ], + ], + ], +); + +subtest test_parse => sub { + plan tests => scalar @TEST_REVERSE_LETTERS; + for my $tcase (@TEST_REVERSE_LETTERS) { + my ( $str, undef, $exp_parsed ) = @{$tcase}; + my @parsed = parse_letters $str; + is_deeply \@parsed, $exp_parsed, + 'parse the string into letters and other characters'; + } +}; + +subtest test_reverse_parsed => sub { + plan tests => scalar @TEST_REVERSE_LETTERS; + for my $tcase (@TEST_REVERSE_LETTERS) { + my ( undef, $expected, $exp_parsed ) = @{$tcase}; + my $res = reverse_parsed $exp_parsed; + is $res, $expected, 'build a string back out of the parsed groups'; + } +}; + +subtest test_full => sub { + plan tests => scalar @TEST_REVERSE_LETTERS; + for my $tcase (@TEST_REVERSE_LETTERS) { + my ( $str, $expected, undef ) = @{$tcase}; + my $res = reverse_letters $str; + is $res, $expected, 'go all the way'; + } +}; diff --git a/challenge-313/ppentchev/perl/format.sh b/challenge-313/ppentchev/perl/format.sh new file mode 100755 index 0000000000..334b0a17bc --- /dev/null +++ b/challenge-313/ppentchev/perl/format.sh @@ -0,0 +1,104 @@ +#!/bin/sh +# SPDX-FileCopyrightText: Peter Pentchev +# SPDX-License-Identifier: BSD-2-Clause + +set -e + +usage() +{ + cat <<'EOUSAGE' +Usage: format.sh check + format.sh reformat + format.sh -h | -V | --help | --version +EOUSAGE +} + +version() +{ + echo 'format.sh 0.1.0' +} + +show_config() +{ + test -f .perltidyrc + test -f .tidyallrc + perltidy -dpro +} + +cmd_check() +{ + set -x + show_config + tidyall -a --check-only +} + +cmd_reformat() +{ + set -x + show_config + tidyall -a --no-backups +} + +unset show_help show_version +while getopts 'hV-:' o; do + case "$o" in + h) + show_help=1 + ;; + + V) + show_version=1 + ;; + + -) + case "$OPTARG" in + help) + show_help=1 + ;; + + version) + show_version=1 + ;; + + *) + echo "Unrecognized long option '--$OPTARG'" 1>&2 + usage 1>&2 + exit 1 + ;; + esac + ;; + + *) + usage 1>&2 + exit 1 + ;; + esac +done +shift "$((OPTIND - 1))" + +[ -z "$show_version" ] || version +[ -z "$show_help" ] || usage +[ -z "$show_version$show_help" ] || exit 0 + +if [ "$#" -lt 1 ]; then + echo 'No subcommand specified' 1>&2 + usage 1>&2 + exit 1 +fi +cmd="$1" +shift +case "$cmd" in + check) + cmd_check "$@" + ;; + + reformat) + cmd_reformat "$#" + ;; + + *) + echo "Unrecognized subcommand '$cmd' specified" 1>&2 + usage 1>&2 + exit 1 + ;; +esac diff --git a/challenge-313/ppentchev/perl/run-tests.sh b/challenge-313/ppentchev/perl/run-tests.sh new file mode 100755 index 0000000000..5832cf279b --- /dev/null +++ b/challenge-313/ppentchev/perl/run-tests.sh @@ -0,0 +1,14 @@ +#!/bin/sh +# SPDX-FileCopyrightText: Peter Pentchev +# SPDX-License-Identifier: BSD-2-Clause + +set -e + +echo '=== shellcheck' +shellcheck format.sh run-tests.sh + +echo '=== format check' +./format.sh check + +echo '=== prove' +prove ch-*.t