Merge pull request #3137 from Abigail/abigail/week-093

Abigail/week 093

12 files changed, 663 insertions, 27 deletions

diff --git a/challenge-093/abigail/README.md b/challenge-093/abigail/README.md
index 5a536096fe..ce16bd000c 100644
--- a/challenge-093/abigail/README.md
+++ b/challenge-093/abigail/README.md
@@ -1,50 +1,70 @@
 # Solution by Abigail
 
-## Task 1: Isomorphic Strings
+## Task 1: Max Points
 
-You are given two strings `$A` and `$B`.
+You are given set of co-ordinates `@N`.
 
-Write a script to check if the given strings are Isomorphic. Print
-`1` if they are otherwise `0`.
+Write a script to count maximum points on a straight line when given
+co-ordinates plotted on 2-d plane.
 
 ### Examples
 ~~~~
-Input: $A = "abc"; $B = "xyz"
-Output: 1
+|
+|     x
+|   x
+| x
++ _ _ _ _
 
-Input: $A = "abb"; $B = "xyy"
-Output: 1
+Input: (1,1), (2,2), (3,3)
+Output: 3
 
-Input: $A = "sum"; $B = "add"
-Output: 0
+
+|
+|
+| x       x
+|   x
+| x   x
++ _ _ _ _ _
+
+Input: (1,1), (2,2), (3,1), (1,3), (5,3)
+Output: 3
 ~~~~
 
 ### Solutions
-* [Perl](perl/ch-1.pl).
+* [Perl](perl/ch-1.pl)
 
-### Blog
-[Blog Post](https://wp.me/pcxd30-jK).
 
-## Task 2: Insert Interval
 
-You are given a set of sorted non-overlapping intervals and a new interval.
+## Task 2: Sum Path
 
-Write a script to merge the new interval to the given set of intervals.
+You are given binary tree containing numbers `0-9` only.
+
+Write a script to sum all possible paths from root to leaf.
 
 ### Examples
 ~~~~
-Input $S = (1,4), (8,10); $N = (2,6)
-Output: (1,6), (8,10)
-
-Input $S = (1,2), (3,7), (8,10); $N = (5,8)
-Output: (1,2), (3,10)
+Input:
+     1
+    /
+   2
+  / \
+ 3   4
+
+Output: 13
+~~~~
+as sum two paths (1->2->3) and (1->2->4)
 
-Input $S = (1,5), (7,9); $N = (10,11)
-Output: (1,5), (7,9), (10,11)
 ~~~~
+Input:
+     1
+    / \
+   2   3
+  /   / \
+ 4   5   6
+
+Output: 26
+~~~~
+as sum three paths (1->2->4), (1->3->5) and (1->3->6)
 
 ### Solutions
-* [Perl](perl/ch-2.pl).
-
-### Blog
-[Blog Post](https://wp.me/pcxd30-ka).
+* [Perl](perl/ch-2.pl)
diff --git a/challenge-093/abigail/perl/ch-1.pl b/challenge-093/abigail/perl/ch-1.pl
new file mode 100644
index 0000000000..5c16f6f6d8
--- /dev/null
+++ b/challenge-093/abigail/perl/ch-1.pl
@@ -0,0 +1,152 @@
+#!/opt/perl/bin/perl
+
+use 5.032;
+
+use strict;
+use warnings;
+no  warnings 'syntax';
+
+use experimental 'signatures';
+use experimental 'lexical_subs';
+
+use List::Util qw [max];
+
+#
+# For the challenge description, see ../README.md
+#
+# There are two things to consider for this challenge:
+# efficiency and accuracy.
+#
+# Effiency
+# --------
+#
+# We could take all pairs of points, draw the line through them, and
+# check how many of the other points lie on that line, and find the
+# line with the most points on them.
+#
+# But this leads to a cubic algorithm.
+#
+# Observation:
+#     If we have three points p_i, p_j, p_k, and the slope of the line
+#     through p_i and p_j is the same as the slope of the line between
+#     p_i and p_k then p_i, p_j, and p_k are colinear. Ergo, all points
+#     p_l, i <> l, for which the line through p_i and p_l has the same
+#     slope are colinear (and p_i is colinear with them as well).
+#     And the reverse holds as well.
+# 
+# So, for each point p_i, we look at each point p_j, (i < j), and
+# we calculate the slope the line through the two points make. For
+# each slope calculated, we count how often it was calculated; adding 1
+# to this value gives us the number of colinear points for a line with
+# that slope which passes through p_i. It's then a matter of finding
+# the maximum over all slopes, and all points.
+#
+# This leads to a quadractic solution, as we consider each pair of 
+# points once.
+#
+#
+# Accurancy
+# ---------
+#
+# The algorithm involves calculating and comparing slopes. But slopes
+# are ratios between numbers, and ratios have the tendency to not be
+# integers. Computers are bad at comparing non-integers, due to rounding.
+#
+# To combat that, we will assume the input numbers are decimal numbers;
+# that is, we're accepting numbers like 1, -7, and 3.5789, but we're
+# not accepting number like 2E7. If we have any numbers with a radix point
+# (decimal numbers which aren't integers), we first add enough zeros
+# so all numbers have the same number of digits after the radix point
+# (for integers, we add a radix point, and a bunch of zeros). Then we
+# we remove the radix point. In effect, we have multiplied all numbers by
+# a power of 10 (the same power for all numbers), avoiding any arithmetic
+# on non-integers (so we have avoided any rounding).
+#
+# Of course, the resulting integers may be too big to fit in 64-bit,
+# but that's a trade off we are making.
+#
+# However, that doesn't mean the slopes we get are integers. All we
+# have succeeded so far is that the slopes will be rational numbers:
+# a ratio between two integers. But instead of the slope itself, we
+# can just store the two numbers forming the ratio. However, a ratio
+# doesn't not have a unique representation: 2/3 and 4/6 are the same
+# ratio (aka slope), but have different representation.
+#
+# Therefore, if we calculate a slope as a ratio of two numbers, we
+# divide the numbers by their GCD, so we have a unique representation.
+#
+
+
+#
+# Calculate the GCD of two numbers.
+#
+sub stein;
+sub stein ($u, $v) {
+    return $u if $u == $v || !$v;
+    return $v if             !$u;
+    my $u_odd = $u % 2;
+    my $v_odd = $v % 2;
+    return stein ($u >> 1, $v >> 1) << 1 if !$u_odd && !$v_odd;
+    return stein ($u >> 1, $v)           if !$u_odd &&  $v_odd;
+    return stein ($u,      $v >> 1)      if  $u_odd && !$v_odd;
+    return stein ($u - $v, $v)           if  $u     >   $v;
+    return stein ($v - $u, $u);
+}
+
+while (<>) {
+    my %lines;
+    my @numbers = /-?\d+(?:\.\d+)?/ag;
+    #
+    # Scale the numbers so are dealing with integers.
+    # Note that we must do this work on strings, as we want to avoid
+    # arithmetic on non-integer numbers.
+    #
+    my $max = max map {/\.(\d+)/a ? length $1 : 0} @numbers;
+    if ($max) {
+        #
+        # Add 0's so all numbers have the same number of digits
+        # after the radix point (and add a radix point first if
+        # there isn't one yet); then remove the radix point.
+        #
+        foreach (@numbers) {
+            /\.(\d+)/a ? ($_ .= "0" x ($max - length $1)) 
+                       : ($_ .= "." . ("0" x $max));
+            s/\.//;
+        }
+    }
+    my @points  = map {[@numbers [$_ - 1, $_]]} grep {$_ % 2} keys @numbers;
+    my $max_colinear = 0;
+
+    for (my $i = 0; $i < @points - 1; $i ++) {
+        my ($x1, $y1) = @{$points [$i]};
+        my %slopes;
+        for (my $j = $i + 1; $j < @points; $j ++) {
+            my ($x2, $y2) = @{$points [$j]};
+            #
+            # Special case for vertical lines
+            #
+            my $slope;
+            if ($x1 == $x2) {
+                $slope = "v";
+            }
+            else {
+                my $y_diff = $y2 - $y1;
+                my $x_diff = $x2 - $x1;
+                my $gcd    = stein abs ($y_diff), abs ($x_diff);
+                my $neg    = (($y_diff < 0) xor ($x_diff < 0));
+                $slope     = join ";" => ($neg ? "-" : "+"),
+                                         abs ($y_diff) / $gcd,
+                                         abs ($x_diff) / $gcd;
+            }
+            $slopes {$slope} ++;
+        }
+        my $best_colinear = 1 + max values %slopes; # Max number of points
+                                                    # colinear with each
+                                                    # other, and $point [$i]
+        $max_colinear = $best_colinear if $best_colinear > $max_colinear;
+    }
+    say $max_colinear;
+}
+
+
+__END__
diff --git a/challenge-093/abigail/perl/ch-2.pl b/challenge-093/abigail/perl/ch-2.pl
new file mode 100644
index 0000000000..cb5fe45311
--- /dev/null
+++ b/challenge-093/abigail/perl/ch-2.pl
@@ -0,0 +1,74 @@
+#!/opt/perl/bin/perl
+
+use 5.032;
+
+use strict;
+use warnings;
+no  warnings 'syntax';
+
+use experimental 'signatures';
+use experimental 'lexical_subs';
+
+my $LEFT  = 0;
+my $NODE  = 1;
+my $RIGHT = 2;
+
+#
+# Recursively calculate the "tree sum". sum_tree returns a tuple:
+#    - $sum:   The sum tree of the tree
+#    - $paths: The number of possible paths
+#
+sub sum_tree ($tree) {
+    return (0, 0) unless @$tree;  # Empty tree
+
+    #
+    # Recurse
+    #
+    my ($s_l, $p_l) = sum_tree ($$tree [$LEFT]);
+    my ($s_r, $p_r) = sum_tree ($$tree [$RIGHT]);
+
+    #
+    # The number of paths is the sum of the number of paths of each
+    # child, or 1 if both childs are empty.
+    # The sum is the sum of the tree sums of both children, plus the
+    # value of the node itself, times the number of paths.
+    #
+    my $paths = ($p_l + $p_r) || 1;
+    my $sum   =  $s_l + $s_r + $paths * $$tree [$NODE];
+
+    ($sum, $paths);
+}
+
+#
+# Did not want to parse the input, as two examples are not enough
+# to deduce how the input looks like -- for instance, if we have
+# a root with two children, which each has two children, how is
+# it going to look? 
+#
+# So, we're just hard coding the two examples. Blech.
+#
+
+my $leaf = [];
+
+#
+# Tree from example 1
+#
+my $t1_3 = [$leaf, 3, $leaf];
+my $t1_4 = [$leaf, 4, $leaf];
+my $t1_2 = [$t1_3, 2, $t1_4];
+my $t1_1 = [$t1_2, 1, $leaf];
+
+#
+# Tree from example 2
+#
+my $t2_4 = [$leaf, 4, $leaf];
+my $t2_2 = [$t2_4, 2, $leaf];
+my $t2_5 = [$leaf, 5, $leaf];
+my $t2_6 = [$leaf, 6, $leaf];
+my $t2_3 = [$t2_5, 3, $t2_6];
+my $t2_1 = [$t2_2, 1, $t2_3];
+
+say +(sum_tree $t1_1) [0];
+say +(sum_tree $t2_1) [0];
+
+__END__
diff --git a/challenge-093/abigail/t/input-1-1 b/challenge-093/abigail/t/input-1-1
new file mode 100644
index 0000000000..ea9dd73d30
--- /dev/null
+++ b/challenge-093/abigail/t/input-1-1
@@ -0,0 +1,2 @@
+(1,1), (2,2), (3,3)
+(1,1), (2,2), (3,1), (1,3), (5,3)
diff --git a/challenge-093/abigail/t/input-1-2 b/challenge-093/abigail/t/input-1-2
new file mode 100644
index 0000000000..370fcecd44
--- /dev/null
+++ b/challenge-093/abigail/t/input-1-2
@@ -0,0 +1,2 @@
+(4.1, 4.1), (4.2, 4.2), (4.3, 4.3)
+(8.1, 5.1), (8.2, 5.2), (8.3, 5.1), (8.1, 5.3), (8.5, 5.3)
diff --git a/challenge-093/abigail/t/input-2-1 b/challenge-093/abigail/t/input-2-1
new file mode 100644
index 0000000000..d3630d1698
--- /dev/null
+++ b/challenge-093/abigail/t/input-2-1
@@ -0,0 +1,5 @@
+     1
+    /
+   2
+  / \
+ 3   4
diff --git a/challenge-093/abigail/t/input-2-2 b/challenge-093/abigail/t/input-2-2
new file mode 100644
index 0000000000..f153f6f962
--- /dev/null
+++ b/challenge-093/abigail/t/input-2-2
@@ -0,0 +1,5 @@
+     1
+    / \
+   2   3
+  /   / \
+ 4   5   6
diff --git a/challenge-093/abigail/t/output-1-1.exp b/challenge-093/abigail/t/output-1-1.exp
new file mode 100644
index 0000000000..c972e4075b
--- /dev/null
+++ b/challenge-093/abigail/t/output-1-1.exp
@@ -0,0 +1,3 @@
+# Given Examples
+3
+3
diff --git a/challenge-093/abigail/t/output-1-2.exp b/challenge-093/abigail/t/output-1-2.exp
new file mode 100644
index 0000000000..e73a67cfe4
--- /dev/null
+++ b/challenge-093/abigail/t/output-1-2.exp
@@ -0,0 +1,3 @@
+# Given Examples, after scaling and translating
+3
+3
diff --git a/challenge-093/abigail/t/output-2-1.exp b/challenge-093/abigail/t/output-2-1.exp
new file mode 100644
index 0000000000..fb5508838d
--- /dev/null
+++ b/challenge-093/abigail/t/output-2-1.exp
@@ -0,0 +1,2 @@
+# First given example
+13
diff --git a/challenge-093/abigail/t/output-2-2.exp b/challenge-093/abigail/t/output-2-2.exp
new file mode 100644
index 0000000000..6909cff9cc
--- /dev/null
+++ b/challenge-093/abigail/t/output-2-2.exp
@@ -0,0 +1,2 @@
+# Second given example
+26
diff --git a/challenge-093/abigail/test.pl b/challenge-093/abigail/test.pl
new file mode 100755
index 0000000000..8971d7d938
--- /dev/null
+++ b/challenge-093/abigail/test.pl
@@ -0,0 +1,366 @@
+#!/opt/perl/bin/perl
+
+#
+# Test the solutions. Either call it with the directory name you
+# want to test in, or call it as "../test.pl" from within the directory.
+#
+
+use 5.032;
+
+use strict;
+use warnings;
+no  warnings 'syntax';
+
+chdir ".." if -f "../test.pl";
+
+use experimental 'signatures';
+
+use Test::More;
+use DBI;
+
+use Getopt::Long;
+
+GetOptions 'slow'              =>  \my $run_slow_tests,
+           'lang|language=s'   =>  \my @languages,
+;
+
+my $HOME = $ENV {HOME};
+
+my %languages = (
+    Perl        =>   {
+        exe     =>   "/opt/perl/bin/perl",
+        ext     =>   "pl",
+    },
+    JavaScript  =>   {
+        exe     =>   "/usr/local/bin/node",
+        ext     =>   "js",
+        dir     =>   "node",
+    },
+    bc          =>   {
+        exe     =>   "/usr/bin/bc",
+        ext     =>   "bc",
+        filter  =>   's/.*/main($&)/',
+    },
+    awk         =>   {
+        exe     =>   "/usr/bin/awk",
+        ext     =>   "awk",
+        args    =>   ["-f"],
+    },
+    C           =>   {
+        comp    =>   "/usr/bin/cc",
+        ext     =>   "c",
+    },
+    SQL         =>   {
+        ext     =>   "sql",
+    },
+   'Befunge-93' =>   {
+        ext     =>   "bf93",
+        exe     =>   "$HOME/Bin/run-language",
+    },
+    BASIC       =>   {
+        ext     =>   "bas",
+        exe     =>   "$HOME/Bin/run-language",
+    },
+    Bash        =>   {
+        ext     =>   "sh",
+        exe     =>   "/bin/sh",
+    },
+    Python      =>   {
+        ext     =>   "py",
+        exe     =>   "/opt/local/bin/python",
+    },
+    Ruby        =>   {
+        ext     =>   "rb",
+        exe     =>   "/usr/bin/ruby",
+    },
+    Csh         =>   {
+        ext     =>   "csh",
+        exe     =>   "/bin/csh",
+    },
+    Fortran     =>   {
+        ext     =>   "f90",
+        comp    =>   "/opt/local/bin/gfortran-mp-4.4",
+    },
+   'Brainfuck'  =>   {
+        ext     =>   "bf",
+        exe     =>   "$HOME/Bin/brainfuck",
+    },
+   'Ook!'       =>   {
+        ext     =>   "ook",
+        dir     =>   "ook",
+        exe     =>   "$HOME/Bin/ook",
+    },
+    MUMPS       =>   {
+        ext     =>   "mps",
+        exe     =>   "TIO",   # Language::Mumps is really broken
+    },
+    Forth       =>   {
+        ext     =>   "fs",
+        exe     =>   "TIO",   # Could no build gforth
+    },
+    Chef        =>   {
+        ext     =>   "chef",
+        exe     =>   "/opt/perl/bin/chef",
+    },
+    Pascal      =>   {
+        ext     =>   "p",
+        exe     =>   "TIO",
+    },
+    Cobol       =>   {
+        ext     =>   "cb",
+        exe     =>   "TIO",
+    },
+);
+
+my $perl_exe = $languages {Perl} {exe};
+
+@languages = sort {lc $a cmp lc $b} keys %languages if !@languages;
+my @challenges = @ARGV ? @ARGV : (1, 2);
+
+foreach my $challenge (@challenges) {
+    my ($dbh, $query, $tables_info);   # Only for SQL tests.
+
+    my @outputs = <t/output-$challenge-*> or next;
+    subtest "Challenge $challenge" => sub {
+        foreach my $language (@languages) {
+            my $info     =   $languages {$language};
+            my $exe      =   $$info {exe};
+            my $ext      =   $$info {ext};
+            my $comp     =   $$info {comp};
+            my $dir      =   $$info {dir}     // lc $language;
+            my @args     = @{$$info {args}    // []};
+            my $filter   =   $$info {filter}  // '';
+            my $ext_out  =   $$info {ext_out} // "out";
+            my $source   =  "$dir/ch-$challenge.$ext";
+            my $compiled;
+            next unless -r $source;
+
+            subtest $language => sub {
+              SKIP: {
+                if ($exe && $exe eq "TIO") {
+                    skip "No executable present, please use tio.net", 1;
+                }
+
+                #
+                # Some languages first need to be compiled.
+                #
+                if ($comp) {
+                    $compiled = $source =~ s/\.$ext$/.$ext_out/r;
+                    system $comp, "-o", $compiled, $source;
+                }
+
+                #
+                # SQL requires requires creating an in-memory database,
+                # and loading some tables. For that, we need a .tables
+                # file. We also read the actual query at this time.
+                #
+                if ($language eq "SQL") {
+                    my $tables = $source =~ s/\.\Q$ext\E$/.table/r;
+                   ($dbh, $query, $tables_info) = init_sql ($source, $tables);
+                }
+
+                foreach my $output_exp (@outputs) {
+                  SKIP: {
+                    my $input      = $output_exp =~ s/output/input/r
+                                                 =~ s/\.exp$//r;
+                    my $exp        = `cat $output_exp`;
+
+                    my $name = $input;
+
+                    if (!-f $input) {
+                        $name  = "No input";
+                        $input = "/dev/null";
+                    }
+
+                    my %pragma;
+                    my @options;
+
+                    while ($exp =~ s/^\s*#%\s*(.*)\n//) {
+                        my $pragma = $1;
+                        $pragma =~ s/\s+$//;
+                        if ($pragma =~ s/^\@(\S+)\s*//) {
+                            next unless lc ($1) eq lc ($language);
+                        }
+                        if ($pragma =~ /^[-\w]+$/) {
+                            $pragma {lc $pragma} = 1;
+                            next;
+                        }
+                        if ($pragma =~ /^\s*(\w+):\s*(.*)/) {
+                            my ($key, $value) = ($1, $2);
+                            if (lc $key eq "opt") {
+                                push @options => $value;
+                            }
+                        }
+                    }
+
+                    if ($exp =~ s/^\s*#\s*(.*)\n//) {
+                        $name = $1;
+                    }
+
+                    skip "Skipping slow test", 1
+                        if $pragma {slow} && !$run_slow_tests;
+
+                    my $got;
+                    if ($compiled) {
+                        $got = `$perl_exe -ple '$filter' $input |\
+                              ./$compiled @options`;
+                    }
+                    elsif ($language eq "SQL") {
+                        $got = test_sql ($dbh, $query, $tables_info, $input);
+                    }
+                    else {
+                        $got = `$perl_exe -ple '$filter' $input |\
+                                $exe @args ./$source @options`;
+                    }
+
+                    s/\h+$//gm for $exp, $got;
+                    if ($pragma {trim}) {
+                        s/^\h+//gm for $exp, $got;
+                    }
+                    if ($pragma {"swap-pairs"}) {
+                        my @got = split /\n/ => $got;
+                        for (my $i = 0; $i + 1 < @got; $i += 2) {
+                            @got [$i, $i + 1] = @got [$i + 1, $i];
+                        }
+                        $got = join "\n" => @got, "";
+                    }
+                    is $got, $exp, $name;
+                }}
+                unlink $compiled if $compiled;
+            }}
+        }
+    }
+}
+
+done_testing;
+
+#
+# Parse the tables SQL, extract the table names, and the column names,
+# *EXCLUDING* any primary key of the form "integer PRIMARY KEY"
+# We're assuming some sane formatting (one column per line).
+#
+# Returns an array of arrays. Each (inner) array consists of a table
+# name, followed by the name of the columns of that table.
+#
+# We will also create the database handle, use it to create the tables,
+# and return the database handle as a second value.
+#
+sub init_sql ($query_file, $tables_file) {
+    my $query  = `cat $query_file`;
+    my $tables = -f $tables_file ? `cat $tables_file` : "";
+
+    my $in_table = 0;
+    my @info;
+    foreach (split /\n/ => $tables) {
+        if (!$in_table) {
+            if (/^\s* CREATE \s+ TABLE \s+ (\w+)/xi) {
+                $in_table = 1;
+                push @info => [$1];
+            }
+            next;
+        }
+        else {
+            if (/^\s* \)/x) {
+                $in_table = 0;
+                next;
+            }
+            # Any other line is a column definition
+            next if /^ \s* \w+ \s+ integer \s+ PRIMARY \s+ KEY \s*,/xi;
+            if (/^ \s* (\w+)/x) {
+                push @{$info [-1]} => $1;
+            }
+        }
+    }
+    #
+    # Does the query have place holders?
+    #
+    if ($query =~ /\?/) {
+        push @info => ["Placeholder"];
+    }
+
+    my $dbh = DBI:: -> connect ("dbi:SQLite:dbname=:memory:", "", "",
+                                {RaiseError   =>  1,
+                                 PrintError   =>  1,
+                                 AutoCommit   =>  1});
+    $dbh -> do ($tables) if $tables;
+
+    return ($dbh, $query, \@info);
+}
+
+
+sub test_sql ($dbh, $query, $tables_info, $input) {
+    #
+    # For now, assume we each set of N lines, where N is the number of tables
+    # is a test. We also assume that if a line has P items (space separated),
+    # and the corresponing table has Q columns (not counting any integer primary
+    # keys, as SQLite fills them automatically), we have to fill int (P/Q) rows.
+    #
+
+    #
+    # Read the input, if any
+    #
+    my @input;
+    if (-f $input) {
+        open my $i_fh, "<", $input or die "Failed to open $input: $!";
+        @input = <$i_fh>;
+    }
+
+    my $output = "";
+
+  TEST:
+    while (@input >= @$tables_info) {
+        my $real_query = $query;
+        foreach my $table_info (@$tables_info) {
+            my ($table, @fields) = @$table_info;
+            my $input            = shift @input;
+            my @values           = split ' ' => $input;
+            last TEST if @values < @fields && $table ne "Placeholder";
+
+            #
+            # Handle place holder queries
+            #
+            if ($table eq "Placeholder") {
+                $real_query =~ s/\?/shift @values/eg;
+                next;
+            }
+
+            #
+            # Clear the table
+            #
+            $dbh -> do ("DELETE FROM $table");
+
+            #
+            # Construct an input query
+            #
+            my $place  = "(" . join (", " => ("?") x @fields) . ")";
+            my $insert = do {local $" = ", "; <<~ "--"};
+                INSERT
+                  INTO  $table
+                       (@fields)
+                VALUES  @{[($place) x (@values / @fields)]}
+            --
+
+            $dbh -> do ($insert, undef, @values);
+        }
+
+
+        #
+        # Run the query. If we have multiple results, join columns
+        # by spaces, and rows by newlines.
+        #
+        foreach my $query (split /^\s*;\s*$/m => $real_query) {
+            my $result = $dbh -> selectall_arrayref ($query);
+            $output   .= join "\n" => map {join " " => @$_} @$result;
+            $output   .= "\n";
+        }
+
+        last unless @input;
+    }
+
+    $output;
+}
+
+
+
+
+__END__