Task 1 & 2

3 files changed, 125 insertions, 0 deletions

diff --git a/challenge-107/perlboy1967/perl/Calc.pm b/challenge-107/perlboy1967/perl/Calc.pm
new file mode 100644
index 0000000000..bcb40d6687
--- /dev/null
+++ b/challenge-107/perlboy1967/perl/Calc.pm
@@ -0,0 +1,15 @@
+
+package Calc;
+
+our $VERSION = 0.001;
+
+use strict;
+use warnings;
+
+sub new { bless {}, shift; }
+sub add { }
+sub mul { }
+sub div { }
+
+1;
+
diff --git a/challenge-107/perlboy1967/perl/ch-1.pl b/challenge-107/perlboy1967/perl/ch-1.pl
new file mode 100755
index 0000000000..1fe4c6d8d9
--- /dev/null
+++ b/challenge-107/perlboy1967/perl/ch-1.pl
@@ -0,0 +1,63 @@
+#!/usr/bin/perl
+
+# Perl Weekly Challenge - 107
+# - https://perlweeklychallenge.org/blog/perl-weekly-challenge-107/#TASK1
+#
+# Task 1 - Self-descriptive Numbers
+#
+# Author: Niels 'PerlBoy' van Dijke
+
+use v5.16;
+use strict;
+use warnings;
+
+use List::Util qw(min);
+
+# Prototypes
+sub incBaseNnumber ($\@);
+sub isSelfDescriptiveBaseNnumber ($\@);
+
+my ($found, $base) = (0, 1);
+
+while ($found < 3) {
+  my @d = (map { 0 } (1 .. $base - 1), 1);
+  do {
+    if (isSelfDescriptiveBaseNnumber($base,@d)) {
+      printf "Match: %s\n", join('',@d);
+      $found++;
+    }
+  } while (!incBaseNnumber($base,@d));
+  $base++;
+} 
+
+
+# This subroutine will only work up to base 26
+sub incBaseNnumber ($\@) {
+  my ($b,$arDigits) = @_;
+
+  my ($overflow,$d,$dMax) = (0,0,scalar(@$arDigits));
+
+  while (!$overflow) {
+    $arDigits->[$d] = ($arDigits->[$d] + 1) % $b;
+    last if $arDigits->[$d++];
+    if ($d >= $dMax) {
+      push(@$arDigits,1);
+      $overflow++; 
+    }
+  }
+
+  return $overflow; 
+}
+
+
+# This subroutine will only work up to base 10
+sub isSelfDescriptiveBaseNnumber ($\@) {
+  my ($b,$arDigits) = @_;
+
+  my @checkDigit;
+  for my $d (0 .. $b - 1) {
+    $checkDigit[$d] = scalar(grep { $_ == $d } @$arDigits) == $arDigits->[$d];
+  }
+
+  return min(@checkDigit) == 1;
+}
diff --git a/challenge-107/perlboy1967/perl/ch-2.pl b/challenge-107/perlboy1967/perl/ch-2.pl
new file mode 100755
index 0000000000..faed260ef4
--- /dev/null
+++ b/challenge-107/perlboy1967/perl/ch-2.pl
@@ -0,0 +1,47 @@
+#!/usr/bin/perl
+
+# Perl Weekly Challenge - 107
+# - https://perlweeklychallenge.org/blog/perl-weekly-challenge-107/#TASK2
+#
+# Task 2 - List Methods
+#
+# Author: Niels 'PerlBoy' van Dijke
+
+BEGIN {
+  use File::Basename qw(dirname);
+  use lib dirname($0);
+}
+
+use v5.16;
+use strict;
+use warnings;
+
+use CGI;
+
+@ARGV = ('Calc')
+  unless (scalar(@ARGV) > 0);
+
+my ($lib, $evade) = @ARGV;
+
+eval "use $lib";
+die $@ if ($@);
+
+
+if ($evade // 0) {
+  # Sneak dynamically a new method in...
+  eval sprintf q(sub %s::thatIsAllFolks { print "That\'s all folks!\n" }), $lib;
+}
+
+# Code taken from:
+# https://stackoverflow.com/questions/910430/how-do-i-list-available-methods-on-a-given-object-or-package-in-perl
+
+no strict 'refs';
+
+printf "methods = ('%s')\n",  
+       join("','", grep {defined &{"${lib}::$_"} } keys %{"${lib}::"});
+
+if ($evade // 0) {
+  &{"${lib}::thatIsAllFolks"}();
+}
+
+use strict 'refs';