4 files changed, 86 insertions, 2 deletions
diff --git a/challenge-115/sgreen/README.md b/challenge-115/sgreen/README.md
index ee234128af..2ee9f5c3cd 100644
--- a/challenge-115/sgreen/README.md
+++ b/challenge-115/sgreen/README.md
@@ -1,3 +1,3 @@
-# The Weekly Challenge 114
+# The Weekly Challenge 115
 
-Solution by Simon Green. [Blog](https://dev.to/simongreennet/weekly-challenge-114-51h1)
+Solution by Simon Green. [Blog](https://dev.to/simongreennet/weekly-challenge-115-26c9)
diff --git a/challenge-115/sgreen/blog.txt b/challenge-115/sgreen/blog.txt
new file mode 100644
index 0000000000..9da2a5755f
--- /dev/null
+++ b/challenge-115/sgreen/blog.txt
@@ -0,0 +1 @@
+https://dev.to/simongreennet/weekly-challenge-115-26c9
diff --git a/challenge-115/sgreen/perl/ch-1.pl b/challenge-115/sgreen/perl/ch-1.pl
new file mode 100755
index 0000000000..26392374e6
--- /dev/null
+++ b/challenge-115/sgreen/perl/ch-1.pl
@@ -0,0 +1,48 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use feature 'say';
+
+use List::MoreUtils 'firstidx';
+
+sub _remove_word {
+    # Return an arrayref of the @$list without the first occurance of $word
+    my ( $word, $list ) = @_;
+    my $index = firstidx { $word eq $_ } @$list;
+    return [ map { $list->[$_] } grep { $_ != $index } 0 .. $#$list ];
+}
+
+sub _reduce_list {
+    my ( $used, $list ) = @_;
+
+    if (@$list) {
+        # We have words to use. Choose the words that begin with the last
+        #  letter of the last word
+        my @can_use = grep { substr( $_, 0, 1 ) eq substr( $used->[-1], -1 ) } @$list;
+
+        # Recursive call this function with each of these words
+        foreach my $word (@can_use) {
+            # Return '1' if we have a result
+            my $result = _reduce_list( [ @$used, $word ], _remove_word( $word, $list ) );
+            return 1 if $result;
+        }
+
+        # There is no solution that exist
+        return 0;
+    }
+
+    # We have use all the words. We need to check we can complete the
+    #  circle by checking if the first letter of the first word is the
+    #  same as the last letter of the last word
+    return substr( $used->[0], 0, 1 ) eq substr( $used->[-1], -1 ) ? 1 : 0;
+}
+
+sub main {
+    my @words      = @_;
+    my $first_word = shift @words;
+
+    say _reduce_list( [$first_word], \@words );
+}
+
+main(@ARGV);
diff --git a/challenge-115/sgreen/perl/ch-2.pl b/challenge-115/sgreen/perl/ch-2.pl
new file mode 100755
index 0000000000..e520066df1
--- /dev/null
+++ b/challenge-115/sgreen/perl/ch-2.pl
@@ -0,0 +1,35 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use feature 'say';
+
+use List::MoreUtils 'lastidx';
+
+sub main {
+    # Sort input in reverse order (highest value first)
+    my @numbers = sort { $b cmp $a } @_;
+
+    # Check that all inputs are a single digit (0 - 9)
+    foreach (@numbers) {
+        die "$_ is not a single digit\n" unless /^[0-9]$/;
+    }
+
+    # Find the position lowest even number
+    my $index = lastidx { $_ % 2 == 0 } @numbers;
+
+    if ( $index == -1 ) {
+        # If there are no even numbers, there is no solution!
+        say 'No solution';
+        return;
+    }
+    elsif ( $index != $#numbers ) {
+        # Remove the lowest even number, and put it at the end
+        my $digit = splice( @numbers, $index, 1, () );
+        push @numbers, $digit;
+    }
+
+    say join '', @numbers;
+}
+
+main(@ARGV);