Merge pull request #3232 from brtastic/feature/challenge-95

Challenge 95 by brtastic

2 files changed, 123 insertions, 0 deletions

diff --git a/challenge-095/brtastic/perl/ch-1.pl b/challenge-095/brtastic/perl/ch-1.pl
new file mode 100644
index 0000000000..58944f5ad3
--- /dev/null
+++ b/challenge-095/brtastic/perl/ch-1.pl
@@ -0,0 +1,21 @@
+use v5.24;
+use warnings;
+use Scalar::Util qw(looks_like_number);
+
+sub palindrome_number
+{
+	my ($number) = @_;
+
+	return 0 unless looks_like_number($number);
+	return 0 unless $number eq scalar reverse $number;
+	return 1;
+}
+
+use Test::More;
+
+is !palindrome_number('aoeu'), !0;
+is !palindrome_number(1221), !1;
+is !palindrome_number(-101), !0;
+is !palindrome_number(90), !0;
+
+done_testing;
diff --git a/challenge-095/brtastic/perl/ch-2.pl b/challenge-095/brtastic/perl/ch-2.pl
new file mode 100644
index 0000000000..f5dbb17637
--- /dev/null
+++ b/challenge-095/brtastic/perl/ch-2.pl
@@ -0,0 +1,102 @@
+use v5.24;
+use warnings;
+
+package Stack {
+
+	use Scalar::Util qw(refaddr blessed);
+
+	my %vals;
+
+	my sub getval {
+		my ($node) = @_;
+		return defined $$node ? $vals{refaddr $node} : undef;
+	}
+
+	my sub rmval {
+		my ($node) = @_;
+		return delete $vals{refaddr $node}
+			if defined $$node;
+		return undef;
+	}
+
+	my sub addval {
+		my ($node, $value) = @_;
+		return $vals{refaddr $node} = $value
+			if defined $$node;
+		return undef;
+	}
+
+	sub new {
+		my ($self) = @_;
+		my $package = blessed $self || $self;
+		my $last = blessed $self ? $self : undef;
+
+		return bless \$last, $package;
+	}
+
+	sub push {
+		my ($self, $value) = @_;
+
+		my $new = $self->new;
+		addval($new, $value);
+		$_[0] = $new;
+		return;
+	}
+
+	sub pop {
+		my ($self) = @_;
+
+		if (defined $$self) {
+			my $value = rmval($self);
+			$_[0] = $$self;
+
+			return $value;
+		}
+
+		return undef;
+	}
+
+	sub min {
+		my ($self) = @_;
+
+		my $min = undef;
+		my $node = $self;
+		while ($$node) {
+			my $value = getval($node);
+			$min = ($min // $value) < $value ? $min : $value;
+			$node = $$node;
+		}
+
+		return $min;
+	}
+
+	sub top {
+		my ($self) = @_;
+
+		return getval($self);
+	}
+}
+
+use Test::More;
+
+my $stack = Stack->new;
+
+$stack->push(2);
+$stack->push(-1);
+$stack->push(0);
+
+is $stack->pop, 0;
+is $stack->top, -1;
+
+$stack->push(0);
+is $stack->min, -1;
+
+is $stack->pop, 0;
+is $stack->pop, -1;
+is $stack->top, 2;
+is $stack->pop, 2;
+is $stack->pop, undef;
+is $stack->top, undef;
+is $stack->min, undef;
+
+done_testing;