aboutsummaryrefslogtreecommitdiff
path: root/challenge-331/athanasius/perl/ch-1.pl
diff options
context:
space:
mode:
authorPerlMonk-Athanasius <PerlMonk.Athanasius@gmail.com>2025-07-26 22:53:31 +1000
committerPerlMonk-Athanasius <PerlMonk.Athanasius@gmail.com>2025-07-26 22:53:31 +1000
commitd29ace85b75fb266262c9cbb45fd5138cbac9fe2 (patch)
tree79e75ddd86e715cc50ef2e618967781eca43f5bd /challenge-331/athanasius/perl/ch-1.pl
parent1ff2c9796a511d63231d3757acb27e4046a91fb2 (diff)
downloadperlweeklychallenge-club-d29ace85b75fb266262c9cbb45fd5138cbac9fe2.tar.gz
perlweeklychallenge-club-d29ace85b75fb266262c9cbb45fd5138cbac9fe2.tar.bz2
perlweeklychallenge-club-d29ace85b75fb266262c9cbb45fd5138cbac9fe2.zip
Perl & Raku solutions to Tasks 1 & 2 for Week 331
Diffstat (limited to 'challenge-331/athanasius/perl/ch-1.pl')
-rw-r--r--challenge-331/athanasius/perl/ch-1.pl159
1 files changed, 159 insertions, 0 deletions
diff --git a/challenge-331/athanasius/perl/ch-1.pl b/challenge-331/athanasius/perl/ch-1.pl
new file mode 100644
index 0000000000..268de3f6db
--- /dev/null
+++ b/challenge-331/athanasius/perl/ch-1.pl
@@ -0,0 +1,159 @@
+#!perl
+
+################################################################################
+=comment
+
+Perl Weekly Challenge 331
+=========================
+
+TASK #1
+-------
+*Last Word*
+
+Submitted by: Mohammad Sajid Anwar
+
+You are given a string.
+
+Write a script to find the length of last word in the given string.
+
+Example 1
+
+ Input: $str = "The Weekly Challenge"
+ Output: 9
+
+Example 2
+
+ Input: $str = " Hello World "
+ Output: 5
+
+Example 3
+
+ Input: $str = "Let's begin the fun"
+ Output: 3
+
+=cut
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2025 PerlMonk Athanasius #
+#--------------------------------------#
+
+#===============================================================================
+=comment
+
+Interface
+---------
+1. If no command-line arguments are given, the test suite is run. Otherwise:
+2. A string is entered on the command-line.
+
+Assumption
+----------
+All non-word characters, including punctuation, are to be handled like the
+whitespace in the Examples.
+
+=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
+END
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+ $| = 1;
+ print "\nChallenge 331, Task #1: Last Word (Perl)\n\n";
+}
+
+#===============================================================================
+MAIN:
+#===============================================================================
+{
+ my $argc = scalar @ARGV;
+
+ if ($argc == 0)
+ {
+ run_tests();
+ }
+ elsif ($argc == 1)
+ {
+ my $str = $ARGV[ 0 ];
+
+ print qq[Input: \$str = "$str"\n];
+
+ my $length = find_last_word_len( $str );
+
+ print "Output: $length\n";
+ }
+ else
+ {
+ error( "Expected 1 or 0 command-line arguments, found $argc" );
+ }
+}
+
+#-------------------------------------------------------------------------------
+sub find_last_word_len
+#-------------------------------------------------------------------------------
+{
+ my ($str) = @_;
+
+ $str =~ / (\w+) \W* $ /x;
+
+ return length( $1 // '' );
+}
+
+#-------------------------------------------------------------------------------
+sub run_tests
+#-------------------------------------------------------------------------------
+{
+ print "Running the test suite\n";
+
+ while (my $line = <DATA>)
+ {
+ chomp $line;
+
+ my ($test_name, $str, undef, $expected) = split / \| /x, $line;
+
+ for ($test_name, $expected)
+ {
+ s/ ^ \s+ //x;
+ s/ \s+ $ //x;
+ }
+
+ my $length = find_last_word_len( $str );
+
+ is $length, $expected, $test_name;
+ }
+
+ done_testing;
+}
+
+#-------------------------------------------------------------------------------
+sub error
+#-------------------------------------------------------------------------------
+{
+ my ($message) = @_;
+
+ die "ERROR: $message\n$USAGE";
+}
+
+################################################################################
+
+__DATA__
+Example 1|The Weekly Challenge| | 9
+Example 2| Hello World | | 5
+Example 3|Let's begin the fun| | 3
+Question |Is this a good question?| | 8
+Empty || | 0
+No words |. ### //??? * &&& ! #/?*| | 0
+Long word|Supercalifragilisticexpialidocious!||34