Perl & Raku solutions to Tasks 1 & 2 for Week 330

4 files changed, 656 insertions, 0 deletions

diff --git a/challenge-330/athanasius/perl/ch-1.pl b/challenge-330/athanasius/perl/ch-1.pl
new file mode 100644
index 0000000000..7474f2ee83
--- /dev/null
+++ b/challenge-330/athanasius/perl/ch-1.pl
@@ -0,0 +1,167 @@
+#!perl
+
+################################################################################
+=comment
+
+Perl Weekly Challenge 330
+=========================
+
+TASK #1
+-------
+*Clear Digits*
+
+Submitted by: Mohammad Sajid Anwar
+
+You are given a string containing only lower case English letters and digits.
+
+Write a script to remove all digits by removing the first digit and the closest
+non-digit character to its left.
+
+Example 1
+
+  Input: $str = "cab12"
+  Output: "c"
+
+  Round 1: remove "1" then "b" => "ca2"
+  Round 2: remove "2" then "a" => "c"
+
+Example 2
+
+  Input: $str = "xy99"
+  Output: ""
+
+  Round 1: remove "9" then "y" => "x9"
+  Round 2: remove "9" then "x" => ""
+
+Example 3
+
+  Input: $str = "pa1erl"
+  Output: "perl"
+
+=cut
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2025 PerlMonk Athanasius #
+#--------------------------------------#
+
+#===============================================================================
+=comment
+
+Interface
+---------
+1. If no command-line arguments are given, the test suite is run. Otherwise:
+2. A string containing only lower case English letters and digits is entered on
+   the command-line.
+
+Assumptions
+-----------
+At each step of the process:
+1. it is the left-most digit that is removed; and
+2. if there are no non-digit characters to its left, only the digit is removed.
+
+=cut
+#===============================================================================
+
+use v5.32;         # Enables strictures
+use warnings;
+use Const::Fast;
+use Test::More;
+
+const my $USAGE => <<END;
+Usage:
+  perl $0 <str>
+  perl $0
+
+    <str>    A string containing only lower-case English letters and digits
+END
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 330, Task #1: Clear Digits (Perl)\n\n";
+}
+
+#===============================================================================
+MAIN:
+#===============================================================================
+{
+    my $argc = scalar @ARGV;
+
+    if    ($argc == 0)
+    {
+        run_tests();
+    }
+    elsif ($argc == 1)
+    {
+        my $str = $ARGV[ 0 ];
+
+        $str =~ / ([^a-z0-9]) /x and error( qq[Invalid character "$1"] );
+
+        print qq[Input: \$str = "$str"\n];
+
+        my $cleared = clear_digits( $str );
+
+        print qq[Output:       "$cleared"\n];
+    }
+    else
+    {
+        error( "Expected 1 or 0 command-line arguments, found $argc" );
+    }
+}
+
+#-------------------------------------------------------------------------------
+sub clear_digits
+#-------------------------------------------------------------------------------
+{
+    my ($str) = @_;
+        $str  =~ / ([^a-z0-9]) /x and die qq[Invalid character "$1"];
+
+    1 while $str =~ s/ (?: ^ | \D ) \d //x;
+
+    return $str;
+}
+
+#-------------------------------------------------------------------------------
+sub run_tests
+#-------------------------------------------------------------------------------
+{
+    print "Running the test suite\n";
+
+    while (my $line = <DATA>)
+    {
+        chomp $line;
+
+        my  ($test_name, $str, $expected) = split / \| /x, $line;
+
+        for ($test_name, $str, $expected)
+        {
+            s/ ^ \s+   //x;
+            s/   \s+ $ //x;
+        }
+
+        my $cleared = clear_digits( $str );
+
+        is $cleared, $expected, $test_name;
+    }
+
+    done_testing;
+}
+
+#-------------------------------------------------------------------------------
+sub error
+#-------------------------------------------------------------------------------
+{
+    my ($message) = @_;
+
+    die "ERROR: $message\n$USAGE";
+}
+
+################################################################################
+
+__DATA__
+Example 1|cab12 |c
+Example 2|xy99  |
+Example 3|pa1erl|perl
diff --git a/challenge-330/athanasius/perl/ch-2.pl b/challenge-330/athanasius/perl/ch-2.pl
new file mode 100644
index 0000000000..2da8775985
--- /dev/null
+++ b/challenge-330/athanasius/perl/ch-2.pl
@@ -0,0 +1,178 @@
+#!perl
+
+################################################################################
+=comment
+
+Perl Weekly Challenge 330
+=========================
+
+TASK #2
+-------
+*Title Capital*
+
+Submitted by: Mohammad Sajid Anwar
+
+You are given a string made up of one or more words separated by a single space.
+
+Write a script to capitalise the given title. If the word length is 1 or 2 then
+convert the word to lowercase otherwise make the first character uppercase and
+remaining lowercase.
+
+Example 1
+
+  Input: $str = "PERL IS gREAT"
+  Output: "Perl is Great"
+
+Example 2
+
+  Input: $str = "THE weekly challenge"
+  Output: "The Weekly Challenge"
+
+Example 3
+
+  Input: $str = "YoU ARE A stAR"
+  Output: "You Are a Star"
+
+=cut
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2025 PerlMonk Athanasius #
+#--------------------------------------#
+
+#===============================================================================
+=comment
+
+Interface
+---------
+1. If no command-line arguments are given, the test suite is run. Otherwise:
+2. A string made up of one or more words separated by single spaces is entered
+   on the command-line.
+
+Assumption
+----------
+The first word of the title should be title-cased, even if it is only 1 or 2
+characters long.
+
+=cut
+#===============================================================================
+
+use v5.32;         # Enables strictures
+use warnings;
+use Const::Fast;
+use Test::More;
+
+const my $INPUT_RE => qr/ ^ [A-Za-z]+ (?: [ ] [A-Za-z]+ )* $ /x;
+const my $USAGE    => <<END;
+Usage:
+  perl $0 <str>
+  perl $0
+
+    <str>    A string made up of one or more words separated by single spaces
+END
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 330, Task #2: Title Capital (Perl)\n\n";
+}
+
+#===============================================================================
+MAIN:
+#===============================================================================
+{
+    my $argc = scalar @ARGV;
+
+    if    ($argc == 0)
+    {
+        run_tests();
+    }
+    elsif ($argc == 1)
+    {
+        my $str =  $ARGV[ 0 ];
+           $str =~ $INPUT_RE or error( 'Invalid input string' );
+
+        print qq[Input: \$str = "$str"\n];
+
+        my $title = capitalise( $str );
+
+        print qq[Output:       "$title"\n];
+    }
+    else
+    {
+        error( "Expected 1 or 0 command-line arguments, found $argc" );
+    }
+}
+
+#-------------------------------------------------------------------------------
+sub capitalise
+#-------------------------------------------------------------------------------
+{
+    my ($str)  =  @_;
+        $str   =~ $INPUT_RE or die 'Invalid string';
+    my  @words =  split / /, $str;
+    my  @title =  tclc( shift @words );
+
+    for my $word (@words)
+    {
+        push @title, length $word > 2 ? tclc( $word ) : lc $word;
+    }
+
+    return join ' ', @title;
+}
+
+#-------------------------------------------------------------------------------
+sub tclc
+#-------------------------------------------------------------------------------
+{
+    my ($str) = @_;
+
+    $str =~ s/ ^ (.) (.*) $ / uc( $1 ) . lc( $2 ) /ex;
+
+    return $str;
+}
+
+#-------------------------------------------------------------------------------
+sub run_tests
+#-------------------------------------------------------------------------------
+{
+    print "Running the test suite\n";
+
+    while (my $line = <DATA>)
+    {
+        chomp $line;
+
+        my  ($test_name, $str, $expected) = split / \| /x, $line;
+
+        for ($test_name, $str, $expected)
+        {
+            s/ ^ \s+   //x;
+            s/   \s+ $ //x;
+        }
+
+        my $title = capitalise( $str );
+
+        is $title, $expected, $test_name;
+    }
+
+    done_testing;
+}
+
+#-------------------------------------------------------------------------------
+sub error
+#-------------------------------------------------------------------------------
+{
+    my ($message) = @_;
+
+    die "ERROR: $message\n$USAGE";
+}
+
+################################################################################
+
+__DATA__
+Example 1 |PERL IS gREAT       |Perl is Great
+Example 2 |THE weekly challenge|The Weekly Challenge
+Example 3 |YoU ARE A stAR      |You Are a Star
+First word|a star IS born      |A Star is Born
diff --git a/challenge-330/athanasius/raku/ch-1.raku b/challenge-330/athanasius/raku/ch-1.raku
new file mode 100644
index 0000000000..4f9403930e
--- /dev/null
+++ b/challenge-330/athanasius/raku/ch-1.raku
@@ -0,0 +1,155 @@
+use v6d;
+
+################################################################################
+=begin comment
+
+Perl Weekly Challenge 330
+=========================
+
+TASK #1
+-------
+*Clear Digits*
+
+Submitted by: Mohammad Sajid Anwar
+
+You are given a string containing only lower case English letters and digits.
+
+Write a script to remove all digits by removing the first digit and the closest
+non-digit character to its left.
+
+Example 1
+
+  Input: $str = "cab12"
+  Output: "c"
+
+  Round 1: remove "1" then "b" => "ca2"
+  Round 2: remove "2" then "a" => "c"
+
+Example 2
+
+  Input: $str = "xy99"
+  Output: ""
+
+  Round 1: remove "9" then "y" => "x9"
+  Round 2: remove "9" then "x" => ""
+
+Example 3
+
+  Input: $str = "pa1erl"
+  Output: "perl"
+
+=end comment
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2025 PerlMonk Athanasius #
+#--------------------------------------#
+
+#===============================================================================
+=begin comment
+
+Interface
+---------
+1. If no command-line arguments are given, the test suite is run. Otherwise:
+2. A string containing only lower case English letters and digits is entered on
+   the command-line.
+
+Assumptions
+-----------
+At each step of the process:
+1. it is the left-most digit that is removed; and
+2. if there are no non-digit characters to its left, only the digit is removed.
+
+=end comment
+#===============================================================================
+
+use Test;
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    "\nChallenge 330, Task #1: Clear Digits (Raku)\n".put;
+}
+
+#===============================================================================
+multi sub MAIN
+(
+    #| A string containing only lower-case English letters and digits
+
+    Str:D $str where / ^ <[ a..z 0..9 ]>* $ /
+)
+#===============================================================================
+{
+    qq[Input: \$str = "$str"].put;
+
+    my Str $cleared = clear-digits( $str );
+
+    qq[Output:       "$cleared"].put;
+}
+
+#===============================================================================
+multi sub MAIN()                                  # No input: run the test suite
+#===============================================================================
+{
+    run-tests();
+}
+
+#-------------------------------------------------------------------------------
+sub clear-digits( Str:D $str where / ^ <[ a..z 0..9 ]>* $ / --> Str:D )
+#-------------------------------------------------------------------------------
+{
+    my Str $cleared = $str;
+
+    Nil while $cleared ~~ s/ [ ^ || \D ] \d //;
+
+    return $cleared;
+}
+
+#-------------------------------------------------------------------------------
+sub run-tests()
+#-------------------------------------------------------------------------------
+{
+    'Running the test suite'.put;
+
+    for test-data.lines -> Str $line
+    {
+        my Str ($test-name, $str, $expected) = $line.split: / \| /;
+
+        for     $test-name, $str, $expected
+        {
+            s/ ^ \s+   //;
+            s/   \s+ $ //;
+        }
+
+        my Str $cleared = clear-digits( $str );
+
+        is $cleared, $expected, $test-name;
+    }
+
+    done-testing;
+}
+
+#-------------------------------------------------------------------------------
+sub USAGE()
+#-------------------------------------------------------------------------------
+{
+    my Str $usage = $*USAGE;
+
+    $usage ~~ s:g/ ($*PROGRAM-NAME) /raku $0/;
+
+    $usage.put;
+}
+
+#-------------------------------------------------------------------------------
+sub test-data( --> Str:D )
+#-------------------------------------------------------------------------------
+{
+    return q:to/END/;
+        Example 1|cab12 |c
+        Example 2|xy99  |
+        Example 3|pa1erl|perl
+        END
+}
+
+################################################################################
diff --git a/challenge-330/athanasius/raku/ch-2.raku b/challenge-330/athanasius/raku/ch-2.raku
new file mode 100644
index 0000000000..b2fce87d11
--- /dev/null
+++ b/challenge-330/athanasius/raku/ch-2.raku
@@ -0,0 +1,156 @@
+use v6d;
+
+################################################################################
+=begin comment
+
+Perl Weekly Challenge 330
+=========================
+
+TASK #2
+-------
+*Title Capital*
+
+Submitted by: Mohammad Sajid Anwar
+
+You are given a string made up of one or more words separated by a single space.
+
+Write a script to capitalise the given title. If the word length is 1 or 2 then
+convert the word to lowercase otherwise make the first character uppercase and
+remaining lowercase.
+
+Example 1
+
+  Input: $str = "PERL IS gREAT"
+  Output: "Perl is Great"
+
+Example 2
+
+  Input: $str = "THE weekly challenge"
+  Output: "The Weekly Challenge"
+
+Example 3
+
+  Input: $str = "YoU ARE A stAR"
+  Output: "You Are a Star"
+
+=end comment
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2025 PerlMonk Athanasius #
+#--------------------------------------#
+
+#===============================================================================
+=begin comment
+
+Interface
+---------
+1. If no command-line arguments are given, the test suite is run. Otherwise:
+2. A string made up of one or more words separated by single spaces is entered
+   on the command-line.
+
+Assumption
+----------
+The first word of the title should be title-cased, even if it is only 1 or 2
+characters long.
+
+=end comment
+#===============================================================================
+
+use Test;
+
+my regex input-re { ^ <[ A..Z a..z ]>+ [ ' ' <[ A..Z a..z ]>+ ]* $ }
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    "\nChallenge 330, Task #2: Title Capital (Raku)\n".put;
+}
+
+#===============================================================================
+multi sub MAIN
+(
+    #| A string made up of one or more words separated by single spaces
+
+    Str:D $str where m[ <input-re> ]
+)
+#===============================================================================
+{
+    qq[Input: \$str = "$str"].put;
+
+    my Str $title = capitalise( $str );
+
+    qq[Output:       "$title"].put:
+}
+
+#===============================================================================
+multi sub MAIN()                                  # No input: run the test suite
+#===============================================================================
+{
+    run-tests();
+}
+
+#-------------------------------------------------------------------------------
+sub capitalise( Str:D $str where m[ <input-re> ] --> Str:D )
+#-------------------------------------------------------------------------------
+{
+    my Str @words = $str.split: ' ';
+    my Str @title = @words.shift.tclc;
+
+    for @words -> Str $word
+    {
+        @title.push: $word.chars > 2 ?? $word.tclc !! $word.lc;
+    }
+
+    return @title.join: ' ';
+}
+
+#-------------------------------------------------------------------------------
+sub run-tests()
+#-------------------------------------------------------------------------------
+{
+    'Running the test suite'.put;
+
+    for test-data.lines -> Str $line
+    {
+        my Str ($test-name, $str, $expected) = $line.split: / \| /;
+
+        for     $test-name, $str, $expected
+        {
+            s/ ^ \s+   //;
+            s/   \s+ $ //;
+        }
+
+        my Str $title = capitalise( $str );
+
+        is $title, $expected, $test-name;
+    }
+
+    done-testing;
+}
+
+#-------------------------------------------------------------------------------
+sub USAGE()
+#-------------------------------------------------------------------------------
+{
+    my Str $usage = $*USAGE;
+
+    $usage ~~ s:g/ ($*PROGRAM-NAME) /raku $0/;
+
+    $usage.put;
+}
+
+#-------------------------------------------------------------------------------
+sub test-data( --> Str:D )
+#-------------------------------------------------------------------------------
+{
+    return q:to/END/;
+        Example 1 |PERL IS gREAT       |Perl is Great
+        Example 2 |THE weekly challenge|The Weekly Challenge
+        Example 3 |YoU ARE A stAR      |You Are a Star
+        First word|a star is born      |A Star is Born
+        END
+}
+
+################################################################################