3 files changed, 53 insertions, 0 deletions
diff --git a/challenge-094/wlmb/blog.txt b/challenge-094/wlmb/blog.txt
new file mode 100644
index 0000000000..1883be5d3d
--- /dev/null
+++ b/challenge-094/wlmb/blog.txt
@@ -0,0 +1 @@
+https://wlmb.github.io/2021/01/04/PWC94/
diff --git a/challenge-094/wlmb/perl/ch-1.pl b/challenge-094/wlmb/perl/ch-1.pl
new file mode 100755
index 0000000000..786cd26dc7
--- /dev/null
+++ b/challenge-094/wlmb/perl/ch-1.pl
@@ -0,0 +1,9 @@
+#!/usr/bin/env perl
+# Perl weekly challenge 094
+# Task 1: Group anagrams.
+# From a list of strings recognize anagrams and group them.
+# See https:/wlmb.github.io/2020/01/04/PWC94/#task-1-group-anagrams
+use v5.12;
+my %anagrams;
+push @{$anagrams{join '', sort split '', $_}}, $_ foreach @ARGV;
+say join(" ", @{$anagrams{$_}})foreach keys %anagrams;
diff --git a/challenge-094/wlmb/perl/ch-2.pl b/challenge-094/wlmb/perl/ch-2.pl
new file mode 100755
index 0000000000..3823a20e59
--- /dev/null
+++ b/challenge-094/wlmb/perl/ch-2.pl
@@ -0,0 +1,43 @@
+#!/usr/bin/env perl
+# Perl weekly challenge 094
+# Task 2: Binary tree to linked list.
+#
+# See https:/wlmb.github.io/2020/01/04/PWC94/#task-1-binary-tree-to-linked-list
+use v5.12;
+use Text::Balanced qw(extract_bracketed extract_multiple);
+
+package Tree;
+use Moose;
+has value=>(is=>'ro', required=>1);
+has left=>(is=>'ro', required=>1);
+has right=>(is=>'ro', required=>1);
+
+sub flatten {
+    my $self=shift;
+    return () unless defined $self->value;
+    return $self->value
+	?($self->value, $self->left?$self->left->flatten:(), $self->right?$self->right->flatten:())
+	:();
+}
+
+package main;
+foreach(@ARGV){
+    # remove unnecesary commas
+    tr/,//d;
+    my $tree=build_tree($_);
+    die "Empty tree" unless defined $tree;
+    my @values=$tree->flatten;
+    say join '->', @values;
+}
+
+sub build_tree { #Build tree recursively from string representation
+    my $string=shift @_;
+    # strip parenthesis
+    die "Wrong format of string $string" unless $string=~s/^\s*\((.*)\)\s*$/$1/;
+    return undef if $string=~/^\s*$/; # empty tree
+    my @parts=extract_multiple($string,[\&extract_bracketed]);
+    die "Not a binary tree ", join " ",@parts unless @parts==3;
+    my($value, $left, $right)=@parts;
+    die "Value can contain only alphanumerics: $value" unless $value=~s/^\s*(\w+)\s*$/$1/;
+    return Tree->new(value=>$value, left=> build_tree($left), right=>build_tree($right));
+}