Merge pull request #3991 from wanderdoc/master

Solutions to challenge-110

2 files changed, 119 insertions, 0 deletions

diff --git a/challenge-110/wanderdoc/perl/ch-1.pl b/challenge-110/wanderdoc/perl/ch-1.pl
new file mode 100644
index 0000000000..05ef28795e
--- /dev/null
+++ b/challenge-110/wanderdoc/perl/ch-1.pl
@@ -0,0 +1,55 @@
+#!perl
+use strict;
+use warnings FATAL => qw(all);
+
+=prompt
+You are given a text file. 
+Write a script to display all valid phone numbers in the given text file.
+
+Acceptable Phone Number Formats
++nn  nnnnnnnnnn (nn) nnnnnnnnnn nnnn nnnnnnnnnn
+
+Input File
+
+0044 1148820341
+ +44 1148820341
+  44-11-4882-0341
+(44) 1148820341
+  00 1148820341
+
+Output
+
+0044 1148820341
+ +44 1148820341
+(44) 1148820341
+=cut
+
+
+sub valid_phone_number
+{
+     my $text = $_[0];
+     $text =~ s/^\s*//;
+     $text =~ s/\s*$//;
+     my ($code, $number) = split(/\s/, $text);
+     return 0 unless defined $number;
+     return 0 unless $code =~ /^\+\d{2}|\(\d{2}\)|\d{4}$/;
+     return 0 unless $number =~ /\d{10}/;
+     return 1;
+}
+
+
+while (my $line = <DATA>)
+{
+     chomp $line;
+
+     print $line, $/ if valid_phone_number($line);
+}
+
+
+
+__END__
+0044 1148820341
+ +44 1148820341
+  44-11-4882-0341
+(44) 1148820341
+  00 1148820341
\ No newline at end of file
diff --git a/challenge-110/wanderdoc/perl/ch-2.pl b/challenge-110/wanderdoc/perl/ch-2.pl
new file mode 100644
index 0000000000..315c82145b
--- /dev/null
+++ b/challenge-110/wanderdoc/perl/ch-2.pl
@@ -0,0 +1,64 @@
+#!perl
+use strict;
+use warnings FATAL => qw(all);
+
+=prompt
+You are given a text file. Write a script to transpose the contents of the given file.
+Input File
+name,age,sex
+Mohammad,45,m
+Joe,20,m
+Julie,35,f
+Cristina,10,f
+
+Output:
+name,Mohammad,Joe,Julie,Cristina
+age,45,20,35,10
+sex,m,m,f,f
+=cut
+
+use Text::CSV_XS qw(csv);
+
+
+my $aoa = csv(in => *DATA, sep_char => ',');
+my $transposed = transpose($aoa);
+print_matrix($transposed);
+
+sub transpose
+{
+     my $aoa = $_[0];
+     my $output;
+     for my $i ( 0 .. $#$aoa )
+     {
+          for my $j ( 0 .. $#{$aoa->[$i]} )
+          {
+               $output->[$j][$i] = $aoa->[$i][$j];
+          }
+     }
+     return $output;
+
+
+}
+
+
+
+sub print_matrix
+{
+     my $mtr = $_[0];
+     for my $i ( 0 .. $#$mtr )
+
+     {
+          print join(',', @{$mtr->[$i]}), $/;
+     }
+}
+
+
+
+
+
+__END__
+name,age,sex
+Mohammad,45,m
+Joe,20,m
+Julie,35,f
+Cristina,10,f
\ No newline at end of file