diff options
| author | Jörg Sommrey <28217714+jo-37@users.noreply.github.com> | 2025-07-18 16:51:18 +0200 |
|---|---|---|
| committer | Jörg Sommrey <28217714+jo-37@users.noreply.github.com> | 2025-07-18 16:51:18 +0200 |
| commit | a673ca6e298dc2252c603fbb0f0db9d41d5cb336 (patch) | |
| tree | 981893792062da2efc7f858e1f751a2529fba423 | |
| parent | c426fab2721595210e8e2ad3cef39a501b938e30 (diff) | |
| parent | bb8c3a95a734f77184b1b1a244aecbf6a2a18dfc (diff) | |
| download | perlweeklychallenge-club-a673ca6e298dc2252c603fbb0f0db9d41d5cb336.tar.gz perlweeklychallenge-club-a673ca6e298dc2252c603fbb0f0db9d41d5cb336.tar.bz2 perlweeklychallenge-club-a673ca6e298dc2252c603fbb0f0db9d41d5cb336.zip | |
Solutions to challenge 330
| -rw-r--r-- | challenge-330/jo-37/blog.txt | 1 | ||||
| -rwxr-xr-x | challenge-330/jo-37/perl/ch-1.pl | 95 | ||||
| -rwxr-xr-x | challenge-330/jo-37/perl/ch-2.pl | 96 |
3 files changed, 192 insertions, 0 deletions
diff --git a/challenge-330/jo-37/blog.txt b/challenge-330/jo-37/blog.txt new file mode 100644 index 0000000000..4593d4f9e8 --- /dev/null +++ b/challenge-330/jo-37/blog.txt @@ -0,0 +1 @@ +https://github.sommrey.de/the-bears-den/2025/07/18/ch-330.html diff --git a/challenge-330/jo-37/perl/ch-1.pl b/challenge-330/jo-37/perl/ch-1.pl new file mode 100755 index 0000000000..87cb0a3d16 --- /dev/null +++ b/challenge-330/jo-37/perl/ch-1.pl @@ -0,0 +1,95 @@ +#!/usr/bin/perl + +use v5.26; +use Test2::V0 -no_srand; +use Test2::Tools::Subtest 'subtest_streamed'; +use Getopt::Long; +use experimental 'signatures'; + + +### Options and Arguments + +my ($tests, $examples, $verbose); +GetOptions( + 'examples!' => \$examples, + 'tests!' => \$tests, + 'verbose!' => \$verbose, +) or usage(); + +run_tests($examples, $tests); # tests do not return + +usage() unless @ARGV; + +sub usage { + die <<~EOS; + $0 - clear digits + + usage: $0 [-examples] [-tests] [STR] + + -examples + run the examples from the challenge + + -tests + run some tests + + STR + a string + + EOS +} + + +### Input and Output + +say clear_digits(shift); + + +### Implementation +# +# For details see: +# https://github.sommrey.de/the-bears-den/2025/07/18/ch-330.html#task-1 + +sub clear_digits ($str) { + 1 while $str =~ s/\P{N}?\p{N}//; + $str; +} + + +### Examples and Tests + +sub run_tests ($examples, $tests) { + return unless $examples || $tests; + + state sub run_example ($args, $expected, $name) { + my $result = clear_digits(@$args); + is $result, $expected, + "$name: '@$args' -> '$expected'"; + } + + plan 2; + + $examples ? subtest_streamed(examples => sub { + my @examples = ( + [["cab12"], "c", 'example 1'], + [["xy99"], "", 'example 2'], + [["pa1erl"], "perl", 'example 3'], + ); + plan scalar @examples; + for (@examples) { + run_example @$_; + } + }) : pass 'skip examples'; + + $tests ? subtest_streamed(tests => sub { + my @tests = ( + [["12ab3"], "a", 'leading digits'], + [["ab¹c²d"], "ad", 'superscripts'], + ); + plan scalar @tests; + for (@tests) { + run_example @$_; + } + }) : pass 'skip tests'; + + exit; +} diff --git a/challenge-330/jo-37/perl/ch-2.pl b/challenge-330/jo-37/perl/ch-2.pl new file mode 100755 index 0000000000..cea49d1a22 --- /dev/null +++ b/challenge-330/jo-37/perl/ch-2.pl @@ -0,0 +1,96 @@ +#!/usr/bin/perl + +use v5.26; +use Test2::V0 -no_srand; +use Test2::Tools::Subtest 'subtest_streamed'; +use Getopt::Long; +use experimental 'signatures'; + + +### Options and Arguments + +my ($tests, $examples, $verbose); +GetOptions( + 'examples!' => \$examples, + 'tests!' => \$tests, + 'verbose!' => \$verbose, +) or usage(); + +run_tests($examples, $tests); # tests do not return + +usage() unless @ARGV; + +sub usage { + die <<~EOS; + $0 - title capital + + usage: $0 [-examples] [-tests] [WORD...] + + -examples + run the examples from the challenge + + -tests + run some tests + + WORD... + list of words or strings + + EOS +} + + +### Input and Output + +say title_capital("@ARGV"); + + +### Implementation +# +# For details see: +# https://github.sommrey.de/the-bears-den/2025/07/18/ch-330.html#task-2 + + +sub title_capital { + lc(shift) =~ s/\w{3,}/\u$&/gr; +} + + +### Examples and Tests + +sub run_tests ($examples, $tests) { + return unless $examples || $tests; + + state sub run_example ($args, $expected, $name) { + my $result = title_capital(@$args); + is $result, $expected, + "$name: '@$args' -> '$expected'"; + } + + plan 2; + + $examples ? subtest_streamed(examples => sub { + my @examples = ( + [["PERL IS gREAT"], "Perl is Great" , 'example 1'], + [["THE weekly challenge"], "The Weekly Challenge", 'example 2'], + [["YoU ARE A stAR"], "You Are a Star" , 'example 3'], + ); + plan scalar @examples; + for (@examples) { + run_example @$_; + } + }) : pass 'skip examples'; + + $tests ? subtest_streamed(tests => sub { + my @tests = ( + [["LJETo sUMMER sommer"], "Ljeto Summer Sommer", + 'titlecase digraph'], + [["ÜBLER ärger mit Öl"], "Übler Ärger Mit öl" , 'Umlauts'], + ); + plan scalar @tests; + for (@tests) { + run_example @$_; + } + }) : pass 'skip tests'; + + exit; +} |
