4 files changed, 111 insertions, 0 deletions
diff --git a/challenge-095/polettix/blog.txt b/challenge-095/polettix/blog.txt
new file mode 100644
index 0000000000..7bc5bb1579
--- /dev/null
+++ b/challenge-095/polettix/blog.txt
@@ -0,0 +1 @@
+https://github.polettix.it/ETOOBUSY/2021/01/13/palindrome-number/
diff --git a/challenge-095/polettix/blog1.txt b/challenge-095/polettix/blog1.txt
new file mode 100644
index 0000000000..9409554145
--- /dev/null
+++ b/challenge-095/polettix/blog1.txt
@@ -0,0 +1 @@
+https://github.polettix.it/ETOOBUSY/2021/01/14/demo-stack/
diff --git a/challenge-095/polettix/perl/ch-1.pl b/challenge-095/polettix/perl/ch-1.pl
new file mode 100644
index 0000000000..5ee9854c8d
--- /dev/null
+++ b/challenge-095/polettix/perl/ch-1.pl
@@ -0,0 +1,16 @@
+#!/usr/bin/env perl
+use 5.024;
+use warnings;
+use experimental qw< postderef signatures >;
+no warnings qw< experimental::postderef experimental::signatures >;
+
+sub is_palindrome ($s) {
+   for my $i (0 .. length($s) / 2 - 1) {
+      return 0 if substr($s, $i, 1) ne substr($s, -1 - $i, 1);
+   }
+   return 1;
+}
+
+sub palindrome_number ($N) { return is_palindrome($N) }
+
+say palindrome_number(shift || 1221);
diff --git a/challenge-095/polettix/perl/ch-2.pl b/challenge-095/polettix/perl/ch-2.pl
new file mode 100644
index 0000000000..bfea1d7119
--- /dev/null
+++ b/challenge-095/polettix/perl/ch-2.pl
@@ -0,0 +1,93 @@
+#!/usr/bin/env perl
+use 5.024;
+use warnings;
+use experimental qw< postderef signatures >;
+no warnings qw< experimental::postderef experimental::signatures >;
+$|++;
+
+my $stack = VerboseStack->new;
+$stack->print;
+
+# run with --interactive to have... an interactive session
+if (@ARGV && $ARGV[0] eq '--interactive') {
+   my $real_stack = $stack->stack;
+   my $prompt = "\ncommand> ";
+   print {*STDOUT} $prompt;
+   while (<STDIN>) {
+      my ($cmd, @args) = split m{\s+}mxs;
+      $cmd = lc($cmd);
+      last if grep { $_ eq $cmd } qw< quit exit bye >;
+      eval {
+         my $v = $real_stack->$cmd(@args);
+         say "$cmd: $v" if grep { $_ eq $cmd } qw< max min pop top >;
+         1;
+      } or do {
+         say $@ =~ m{\s at \s}mxs ? "unknown command $cmd" : "error: $@";
+      };
+      $stack->print;
+      print {*STDOUT} $prompt;
+   }
+}
+else {
+   $stack->push(2);
+   $stack->push(-1);
+   $stack->push(0);
+   $stack->pop;       # removes 0
+   say 'top returns --> ', $stack->top; # prints -1
+   $stack->push(0);
+   say 'min returns --> ', $stack->min; # prints -1
+}
+
+package VerboseStack;
+use 5.024;
+use experimental qw< postderef signatures >;
+sub AUTOLOAD ($self, @as) {
+   my ($stack, $echo) = $self->@{qw< stack echo >};
+   (my $mname = our $AUTOLOAD) =~ s{\A.*::}{}mxs;
+   say "\n$mname @as" if $echo;
+   my $method = $stack->can($mname) or die "no method '$mname'\n";
+   my @r = wantarray ? $stack->$method(@as) : scalar $stack->$method(@as);
+   $self->print;
+   return wantarray ? @r : defined(wantarray) ? $r[0] : ();
+}
+sub DESTROY {}
+sub echo ($s) { $s->{echo} = 1 }
+sub new ($pk, @as) { bless {echo => 1, @as, stack => Stack->new}, $pk }
+sub noecho ($s) { $s->{echo} = 0 }
+sub print ($self) {
+   my $stack = $self->{stack};
+   my ($n, $dump, $siz_ind) = ($stack->size, '', 'empty');
+   ($dump, $siz_ind) = ("$stack\n", $n == 1 ? '1 item' : "$n items") if $n;
+   print {*STDOUT} "---\n$dump------- ($siz_ind)\n";
+}
+sub stack ($self) { return $self->{stack} }
+1;
+
+package Stack;
+use 5.024;
+use experimental qw< postderef signatures >;
+use List::Util ();
+use overload qq{""} => \&to_string;
+sub is_empty ($s)  { !($s->@*) }
+sub max ($s)       { $s->@* ? List::Util::max($s->@*) : die "empty\n" }
+sub min ($s)       { $s->@* ? List::Util::min($s->@*) : die "empty\n" }
+sub new ($package) { bless [], $package }
+sub pop ($s)       { $s->@* ? CORE::pop $s->@* : die "empty\n" }
+sub push ($s, $e)  { CORE::push $s->@*, $e }
+sub size ($s)      { scalar $s->@* }
+sub top ($s)       { $s->@* ? $s->[-1] : die "empty\n" }
+sub to_string ($s, @rest) {
+   return '' unless $s->@*;
+   my ($min, $max, $is_top, @lines) = ($s->min, $s->max, 1);
+   for my $e (reverse $s->@*) {
+      CORE::push @lines, sprintf '{%5s}', $e;
+      my @features;
+      CORE::push @features, 'top' if $is_top;
+      CORE::push @features, 'min' if $e == $min;
+      CORE::push @features, 'max' if $e == $max;
+      $lines[-1] .= ' (' . join(', ', @features) . ')' if @features;
+      $is_top = 0;
+   }
+   return join "\n", @lines;
+}
+1;