Merge pull request #3981 from jacoby/master

Blogged

5 files changed, 92 insertions, 0 deletions

diff --git a/challenge-110/dave-jacoby/blog.txt b/challenge-110/dave-jacoby/blog.txt
new file mode 100644
index 0000000000..5190fb8a95
--- /dev/null
+++ b/challenge-110/dave-jacoby/blog.txt
@@ -0,0 +1 @@
+https://jacoby.github.io/2021/04/28/hanging-on-the-telephone-perl-weekly-challenge-110.html
\ No newline at end of file
diff --git a/challenge-110/dave-jacoby/perl/ch-1.pl b/challenge-110/dave-jacoby/perl/ch-1.pl
new file mode 100644
index 0000000000..49b6a0a1ed
--- /dev/null
+++ b/challenge-110/dave-jacoby/perl/ch-1.pl
@@ -0,0 +1,44 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use feature qw{ postderef say signatures state };
+no warnings qw{ experimental };
+
+use Getopt::Long;
+
+my $file = 'phone_numbers.txt';
+GetOptions( 'file=s' => \$file, );
+
+if ( -f $file && open my $fh, '<', $file ) {
+
+    # remove newlines from the numbers 
+    my @numbers = map { chomp $_; $_ } <$fh>;
+    close $fh;
+    say join "\n", ( grep { is_phone_number($_) } @numbers ), '';
+}
+
+sub is_phone_number( $string ) {
+    return 1 if $string =~ m{
+        ^\ *    # starts with maybe space
+        \d{4}   # then has four digits 
+        \       # then one space
+        \d{10}  # then has ten digits 
+        \s*$    # with maybe ending spaces
+        }mix;
+    return 1 if $string =~ m{
+        ^\ *    # starts with maybe space
+        \+\d{2} # then has a plus sign and two digits 
+        \ +     # then one or more space
+        \d{10}  # then has ten digits 
+        \s*$    # with maybe ending spaces
+        }mix;
+    return 1 if $string =~ m{
+        ^\ *        # starts with maybe space
+        \(\d{2}\)   # then has two digits within parens
+        \ +         # then one or more space
+        \d{10}      # then has eight digits 
+        \s*$        # with maybe ending spaces
+        }mix;
+    return 0;
+}
diff --git a/challenge-110/dave-jacoby/perl/ch-2.pl b/challenge-110/dave-jacoby/perl/ch-2.pl
new file mode 100644
index 0000000000..a9c2986061
--- /dev/null
+++ b/challenge-110/dave-jacoby/perl/ch-2.pl
@@ -0,0 +1,37 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use feature qw{ postderef say signatures state };
+no warnings qw{ experimental };
+
+use Carp;
+use JSON;
+use Text::CSV qw( csv );
+
+my $json = JSON->new;
+my $file = 'input.csv';
+
+my $obj = read_csv($file);
+my $jbo = transpose_csv($obj);
+write_csv( $file, $jbo );
+
+sub read_csv($file) {
+    croak unless -f $file;
+    my $object = csv( in => $file );
+    return $object;
+}
+
+sub transpose_csv($object) {
+    my $output = [];
+    for my $i ( 0 .. -1 + scalar $object->@* ) {
+        for my $j ( 0 .. -1 + scalar $object->[$i]->@* ) {
+            $output->[$j][$i] = $object->[$i][$j];
+        }
+    }
+    return $output;
+}
+
+sub write_csv ( $file, $csv ) {
+    csv( in => $csv, out => $file );
+}
diff --git a/challenge-110/dave-jacoby/perl/input.csv b/challenge-110/dave-jacoby/perl/input.csv
new file mode 100644
index 0000000000..716ebdce75
--- /dev/null
+++ b/challenge-110/dave-jacoby/perl/input.csv
@@ -0,0 +1,5 @@
+name,age,sex
+Mohammad,45,m
+Joe,20,m
+Julie,35,f
+Cristina,10,f
diff --git a/challenge-110/dave-jacoby/perl/phone_numbers.txt b/challenge-110/dave-jacoby/perl/phone_numbers.txt
new file mode 100644
index 0000000000..48d6254741
--- /dev/null
+++ b/challenge-110/dave-jacoby/perl/phone_numbers.txt
@@ -0,0 +1,5 @@
+0044 1148820341
+ +44 1148820341
+  44-11-4882-0341
+(44) 1148820341
+  00 1148820341