#!/usr/bin/perl
use strict ;
use warnings ;
use Term::ANSIColor ;
use v5.40 ;

# *************************************************************** #
# subtest.pl: Test various ways to define and call a subroutine.  #
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
# Author : Mahlon R. Smith - The Software Samurai                 #
#   Copyright (c) 2026-2027 Mahlon R. Smith, The Software Samurai #
# Updated: 19-Jun-2026                                            #
#     GNU GPL copyright notice in README file.                    #
# Developed under: Perl 5.40.3                                    #
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
#                                                                 #
# Usage: -[ t | a | p=WIDTH ]                                     #
#        See the README file for more information.                #
# Also included:                                                  #
# 1) ARGV[0] == '-a'                                              #
#    Pass an array to a subroutine by-reference.                  #
#    The subroutine modifies the array contents.                  #
# 2) ARGV[0] value between 18 - 120                               #
#    Test of padding a string to specified length with equal      #
#    leading and trailing padding.                                #
# *************************************************************** #

   system ( "clear" ) ;                                  # clear the display
   my $Title = "Usage: subtest.pl [ -a | -p=WIDTH ]\n" ; # construct the title
   $Title .= ('=' x (length($Title) - 1)) ;              # underline the title
   print colored ( "$Title\n", 'blue' ) ;                # write the title

   if ( @ARGV == 0 )
   {
      my $testdata = "Horney Toad Goes a-Hoppin!" ;
      my $teststr  = $testdata ;
      print colored ( "subtest1 : receives anonymous parameter (by-reference)\n", 'blue' ) ;
      print colored ( "call with: '$teststr'\n", 'blue' ) ;
      subtest1 ( $teststr ) ;
      print colored ( "returned : '$teststr'\n\n", 'blue' ) ;

      $teststr  = $testdata ;
      print colored ( "subtest2 : receives named parameter (by-value)\n", 'blue' ) ;
      print colored ( "call with: '$teststr'\n", 'blue' ) ;
      subtest2 ( $teststr ) ;
      print colored ( "returned : '$teststr'\n\n", 'blue' ) ;

      $teststr  = $testdata ;
      print colored ( "subtest3 : receives named parameter (by-reference)\n", 'blue' ) ;
      print colored ( "call with: '$teststr'\n", 'blue' ) ;
      subtest3 ( \$teststr ) ;
      print colored ( "returned : '$teststr'\n\n", 'blue' ) ;
   }
   else     # argument(s) provided
   {
      if ( @ARGV[0] eq "-a" )
      {
         print colored ( "subtest4: Pass array by anonymous reference: \n", 'blue underline' ) ;
         my @testArray = ( "Apple", "Orange", "Pear", "Peach", "Grape" ) ;
         foreach my $i ( @testArray ) { print colored ( "  '$i'", 'blue' ) ; }
         print "\n" ;
         subtest4 ( \@testArray ) ;
         print colored ( "subtest4: Data returned:                              \n", 'blue underline' ) ;
         foreach my $i ( @testArray ) { print colored ( "  '$i'", 'blue' ) ; }
         print "\n" ;
      }
      elsif ( (index ( "@ARGV[0]", "-p")) == 0 )
      {
         # Isolate the parameter argument (numeric value expected).
         if ( (index ( "@ARGV[0]", "-p=")) == 0 )
         { @ARGV[0] = substr ( "@ARGV[0]", 3, 3 ) ; }
         else  # invoke the minimum value
         { @ARGV[0] = 0 ; }
         padTest ( @ARGV[0] ) ;
      }
      # Undocumented option - used to create documentation: #
      elsif ( (index ( "@ARGV[0]", "-f")) == 0 )
      {
         my @FruitBowl = ( "Apple", "Orange", "Pear", "Peach", "Kumquat" ) ;
         print colored ( "FruitSalad: Pass an array by reference in multiple ways:           \n", 'blue underline' ) ;
         print colored ( "     Original Data :", 'blue' ) ;
         foreach my $i ( @FruitBowl ) { print colored ( "  '$i'", 'blue' ) ; }
         print "\n" ;
         FruitSaladA ( @FruitBowl ) ;
         print colored ( "      Unnamed Array:", 'blue' ) ;
         foreach my $i ( @FruitBowl ) { print colored ( "  '$i'", 'blue' ) ; }
         print "\n" ;
         FruitSaladB ( \@FruitBowl ) ;
         print colored ( "Named Array Pointer:", 'blue' ) ;
         foreach my $i ( @FruitBowl ) { print colored ( "  '$i'", 'blue' ) ; }
         print "\n" ;
         print colored ( " Array of Arrays #1:", 'blue' ) ;
         FruitSaladC ( \@FruitBowl ) ;
         foreach my $i ( @FruitBowl ) { print colored ( "  '$i'", 'blue' ) ; }
         print "\n" ;
         print colored ( " Array of Arrays #2:", 'blue' ) ;
         FruitSaladD ( \@FruitBowl ) ;
         foreach my $i ( @FruitBowl ) { print colored ( "  '$i'", 'blue' ) ; }
         print "\n" ;
      }
      else
      {
        print colored ( "-------------> RTFM <--------------\n\n", 'blue' ) ;
      }
   }
   exit ;

# Parameter is an implied (anonymous) pointer to a parameter array.
# (Note however, that only the first element of the array is accessed.)
# Element is accessed "by-reference" via index.
# Called as: subtest1 ( $teststr ) ;
# Parameter is by-reference, and is referenced by anonymous pointer.
sub subtest1
{
   print colored ( "  subtest1 in : '$_[0]'\n", 'cyan' ) ;
   $_[0] = "Hop To It!" ;
   print colored ("  subtest1 out: '$_[0]'\n", 'cyan' ) ;
}

# Parameter is a named by-value variable.
# Called as: subtest2 ( $teststr ) ;
sub subtest2 ( $t )
{
   print colored ( "  subtest2 in : '$t'\n", 'cyan' ) ;
   $t = "Hop To It!" ;
   print colored ("  subtest2 out: '$t'\n", 'cyan' ) ;
}

# Parameter is a named alias for a pointer to a by-reference variable.
# Called as: subtest3 ( \$teststr ) ;
# Parameter is by-reference, de-referenced locally using double-dollar: "$$".
sub subtest3 ( $t )
{
   print colored ( "  subtest3 in : '$$t'\n", 'cyan' ) ;
   $$t = "Hop To It!" ;
   print colored ("  subtest3 out: '$$t'\n", 'cyan' ) ;
}

# Implied pointer to an array:
# Called as: subtest4 ( \@testArray ) ;
# Parameter (pointer) is assigned by-reference to a local name.
sub subtest4
{
   # Name the caller's array as a scalar i.e. a pointer.
   my ($arrayPtr) = @_ ;
   my $itemCnt = scalar @$arrayPtr ; # number of elements in array
   print colored ( "  subtest4 in : items:$itemCnt\n", 'cyan' ) ;
   for ( my $i = 0 ; $i < $itemCnt ; $i++ )
   { print colored ( "  '$arrayPtr->[$i]'", 'cyan' ) ; }
   print "\n" ;

   # Add an element to the array.
   $arrayPtr->[$itemCnt] = "Trout" ;
   $itemCnt++ ;

   # Shuffle the elements.
   my $buff ;                       # temp buffer
   my $si = $itemCnt - 1 ;          # source index
   my $ti = 0 ;                     # target index
   while ( $si > $ti )
   {
      $buff = $arrayPtr->[$si] ;
      $arrayPtr->[$si] = $arrayPtr->[$ti] ;
      $arrayPtr->[$ti] = $buff ;
      $si-- ;
      $ti++ ;
   }

   print colored ( "  subtest4 out: items:$itemCnt\n", 'cyan' ) ;
   foreach my $i ( @$arrayPtr )
   { print colored ( "  '$i'", 'cyan' ) ; }
   print "\n" ;
}

# Undocumented subroutine - used to create the documentation: #
#              (anonymous by-reference parameter)             #
sub FruitSaladA
{
   my $itemCnt = scalar @_ ;     # number of elements in array
   my $indxA = $itemCnt - 1 ;
   my $indxB = 0 ;               # array item indices
   my $buff ;                    # temp buffer

   while ( $indxA > $indxB )     # Shuffle the elements.
   {
      $buff = @_[$indxA] ;
      @_[$indxA] = @_[$indxB] ;
      @_[$indxB] = $buff ;
      $indxA-- ;
      $indxB++ ;
   }
}  # FruitSaladA() #

# Undocumented subroutine - used to create the documentation: #
#                 (named by-reference pointer)                #
sub FruitSaladB ( $fPtr )
{
   my $itemCnt = scalar @$fPtr ; # number of elements in array
   my $indxA = $itemCnt - 1 ;
   my $indxB = 0 ;               # array item indices
   my $buff ;                    # temp buffer

   while ( $indxA > $indxB )     # Shuffle the elements.
   {
      $buff = $fPtr->[$indxA] ;
      $fPtr->[$indxA] = $fPtr->[$indxB] ;
      $fPtr->[$indxB] = $buff ;
      $indxA-- ;
      $indxB++ ;
   }
}  # FruitSaladB() #

# Undocumented subroutine - used to create the documentation: #
#                  (named by-reference array)                 #
sub FruitSaladC ( @fArray )
{
   my $itemCnt = @{$fArray[0]} ; # number of elements in array (note funky syntax)
   my $indxA = $itemCnt - 1 ;
   my $indxB = 0 ;               # array item indices
   my $buff ;                    # temp buffer

   while ( $indxA > $indxB )     # Shuffle the elements.
   {
      $buff = $fArray[0][$indxA] ;
      $fArray[0][$indxA] = $fArray[0][$indxB] ;
      $fArray[0][$indxB] = $buff ;
      $indxA-- ;
      $indxB++ ;
   }
}  # FruitSaladC() #

# Undocumented subroutine - used to create the documentation: #
#                  (named by-reference array)                 #
sub FruitSaladD ( @fArray )
{
   my $fPtr = @fArray[0] ;
   my $itemCnt = scalar @$fPtr ; # number of elements in array
   my $indxA = $itemCnt - 1 ;
   my $indxB = 0 ;               # array item indices
   my $buff ;                    # temp buffer

   while ( $indxA > $indxB )     # Shuffle the elements.
   {
      $buff = $fPtr->[$indxA] ;
      $fPtr->[$indxA] = $fPtr->[$indxB] ;
      $fPtr->[$indxB] = $buff ;
      $indxA-- ;
      $indxB++ ;
   }
}  # FruitSaladD() #

# Test for splitting padding equally between leading and trailing whitespace.
# Caller's parameter is by-value and indicates the width of the output
# string in characters. 
# Note that in the real world, this would be a column count, NOT a character 
# count, but we are safe for this test because the data are pure ASCII.
# 
# Argument '$trgWidth' (pass-by-value) is the total output width.
# 
# The padding calculation:
# Leading and trailing padding should be as close to equal as possible.
# The exact with is calculated based on modulus-2, that is:
# a) base text width is an even or odd number of characters
# b) total output width is an even or odd number of characters
# c) pad char count is an even or odd value.
sub padTest ( $trgWidth )
{
   my $basetext = "Hello World!" ;        # base text
   my $btLen = length ( $basetext ) ;     # characters in base text
   my $pad_char = "=" ;                   # padding character
   my $MINIPAD = $btLen + 6 ;
   my $DFLTPAD = $btLen * 3 ;
   my $MAXIPAD = $btLen * 10 ;
   # Note the magic regular-expression test for a numeric value.
   if ( $trgWidth =~ /^\d+$/ )
   {
      if ( $trgWidth < $MINIPAD )         # range check
      { $trgWidth = $MINIPAD ; }
      elsif ( $trgWidth > $MAXIPAD )
      { $trgWidth = $MAXIPAD ; }
   }
   else                             { $trgWidth = $DFLTPAD ; } # non numeric value

# If base + char_count is even, then leading == trailing.
# Else leading == trailing - 1
   my $buffer = $basetext ;               # initialize buffer
   my $pad_total = $trgWidth - $btLen ;
   my $pad_left  = int($pad_total / 2) ;  # divide padding count in half
   my $pad_right = $pad_left ;
   # If an odd total pad char count, then trailing
   # count is one greater than leading count.
   if ( ($pad_total % 2) != 0 )
   { $pad_right++ ; }
   print colored ( " Leading/Trailing Padding Test:\n", 'blue' ) ;
   print colored ( " string width : $btLen\n", 'blue' ) ;
   print colored ( " target width : $trgWidth\n", 'blue' ) ;
   print colored ( " padding width: $pad_total ($pad_left + $pad_right)\n", 'blue' ) ;

   $buffer = ($pad_char x ($pad_left)) . $buffer ; # insert leading padding
   $buffer .= ($pad_char x $pad_right) ;           # append trailing padding
   print colored ( "$buffer\n", 'blue' ) ;

   # Construct the legend for visual verification.
   my $plen = index ( $buffer, $basetext ) ;
   my $legend = '|' . (' ' x ($plen - length($plen) - 2)) ;
   $legend .= "$plen|" ;
   $legend .= ('.' x $btLen) . "|$pad_right" ;
   $legend .= (' ' x ($trgWidth - length($legend) - 1)) ;
   $legend .= '|' ;
   print "$legend\n\n" ;
}

