added tests and doc for the -with feature (Common Table Expressions)

damil · Jan 13, 2024 · 56f02e1 · 56f02e1
1 parent a15fcc9
commit 56f02e1
Show file tree

Hide file tree

Showing 4 changed files with 280 additions and 3 deletions.
diff --git a/MANIFEST b/MANIFEST
@@ -79,4 +79,5 @@ t/v2_multischema.t
 t/v2_Oracle.t
 t/v2_result_as.t
 t/v3_Oracle12c.t
+t/v3_with_recursive.t
 xt/pod.t
diff --git a/lib/DBIx/DataModel/Doc/Cookbook.pod b/lib/DBIx/DataModel/Doc/Cookbook.pod
@@ -437,11 +437,11 @@ that :
 
 =over
 
-=item a.
+=item *
 
 they are blessed into a source class
 
-=item b.
+=item *
 
 they may contain an additional key C<< $row->{__schema}  >>
 if C<DBIx::DataModel> is used in
@@ -459,6 +459,107 @@ recursively applied to nested datastructures :
   my $json = JSON->new->encode($rows);
 
 
+=head2 Common table expressions (WITH RECURSIVE)
+
+The SQL syntax for I<common table expressions> (CTEs),
+introduced in L<SQL 1999|https://en.wikipedia.org/wiki/SQL:1999>,
+defines a temporary name corresponding to a simple query,
+so that this name can be used in a more general SQL statement :
+
+  WITH [RECURSIVE] <tmp_table_name> (<col1>, ...) AS (<simple_query>)
+  SELECT <main_query>
+
+This is useful in two situations :
+
+=over
+
+=item *
+
+when the I<tmp_table_name> is needed at several places within the main query
+
+=item *
+
+for expressing queries that willl I<recursively> traverse a graph of related nodes.
+See SQLite examples at L<https://sqlite.org/lang_with.html>; but many other database
+management systems also support CTEs. possibly with some slight variations.
+
+=back
+
+For using CTEs within C<DBIx::DataModel>, the first step is encapsulate the WITH query
+as a new instance of L<SQL::Abstract::More>, through the 
+L<SQL::Abstract::More/with_recursive> method.
+Then that instance can be passed to C<DBIx::DataModel> statements through the 
+C<-with> argument. Here is an example borrowed from L<https://sqlite.org/lang_with.html> : 
+
+=over
+
+=item *
+
+suppose an initial table like this :
+
+  CREATE TABLE family(name, mom, dad, bord, died)
+
+The declaration within C<DBIx::DataModel> looks like this :
+
+  my $schema = DBIx::DataModel->Schema('CTE_example');
+  $schema->Table(qw/Family family name/); 
+
+=item *
+
+Encapsulate a C<descendant_of> common table expression as a new instance of L<SQL::Abstract::More> :
+
+  sub sqla_with_CTE_descendant_of {
+    my ($schema, $ancestor) = @_;
+
+    return $schema->sql_abstract->with_recursive(
+      [ -table     => 'parent_of',
+        -columns   => [qw/name parent/],
+        -as_select => {-columns => [qw/name mom/],
+                       -from    => 'family',
+                       -union   => [-columns => [qw/name dad/]]},
+       ],
+      [ -table     => 'descendant_of',
+        -columns   => [qw/name/],
+        -as_select => {-columns   => [qw/name/],
+                       -from      => 'parent_of',
+                       -where     => {parent => $ancestor},
+                       -union_all => [-columns => [qw/parent_of.name/],
+                                      -from    => [qw/-join parent_of {parent=name} descendant_of/]],
+                   },
+       ],
+      );
+  }
+
+=item *
+
+The CTE table C<descendant_of> will recursively find all descendants of any given ancestor.
+This can be used as a subquery for selecting family members who are descendants :
+
+  my $subquery    = \ ["SELECT name FROM descendant_of"];
+  my $descendants = $schema->table('Family')->select(
+    -with     => sqla_with_CTE_descendant_of($schema, $ancestor),
+    -columns  => [qw/name born died/],
+    -where    => {name => {-in => $subquery }},
+    -order_by => 'born',
+  );
+
+=back
+
+Another approach would be to declare C<ancestor_of> as a new table, and add a new association
+with the C<family> table. This approach is displayed below; but it is not
+recommanded because it creates I<permanent> metada within the schema, while CTEs are meant to be
+used as I<temporary> constructs for building complex queries. Here is the example :
+
+  $schema->Table(qw/Descendant_of descendant_of name/)
+         ->Association([qw/Descendant_of descendants *  name/],
+                       [qw/Family        family      1  name/]);
+
+  my $descendants = $schema->join(qw/Descendant_of family/)->select(
+    -with     => sqla_with_CTE_descendant_of($schema, $ancestor),
+    -columns  => [qw/family.name born died/],
+    -order_by => 'born',
+  );
+
 
 =head1 DATA UPDATE
 

diff --git a/lib/DBIx/DataModel/Doc/Reference.pod b/lib/DBIx/DataModel/Doc/Reference.pod
@@ -1892,7 +1892,20 @@ overrides the L</sql_abstract> parameter specified at the schema level.
 
 =item C<< -with => $an_sql_abstract_instance >>
 
-synonym for C<< -sql_abstract >>.
+synonym for C<< -sql_abstract >>, in order to facilitate the generation of
+I<common table expressions> in collaboration with L<SQL::Abstract::More/with_recursive, with> :
+
+  my $sqla_with_added_CTE = $schema->sql_abstract->with_recursive(
+   [ -table     => $CTE_table_name,
+     -columns   => \@CTE_columns,
+     -as_select => \%select_args ],
+  );
+
+  my $rows = $schema->join(...)->select(
+    -with    => $sqla_with_added_CTE,
+    -columns => ...,
+    -where   => ...,
+  );
 
 
 =item C<< -result_as => $result_kind >>

diff --git a/t/v3_with_recursive.t b/t/v3_with_recursive.t
@@ -0,0 +1,162 @@
+use strict;
+use warnings;
+
+use SQL::Abstract::Test import => [qw/is_same_sql_bind/];
+use DBI;
+use DBIx::DataModel;
+use Test::More;
+
+
+# create a database of Bach's descendents
+my $dbh = DBI->connect('dbi:SQLite:dbname=:memory:', '', '', {
+  RaiseError => 1,
+  AutoCommit => 1,
+  sqlite_allow_multiple_statements => 1,
+});
+$dbh->do(q{
+  CREATE TABLE family(name TEXT PRIMARY KEY, mom, dad, born, died);
+
+  -- source : http://www.classichistory.net/archives/bach-family-tree
+  INSERT INTO family VALUES 
+    ('Johann Sebastian',         'Maria Elisabeth',   'Johann Ambrosius',       1685, 1750),
+    ('Maria Barbara',            NULL,                NULL,                     1684, 1720),
+    ('Catharina Dorothea',       'Maria Barbara',     'Johann Sebastian',       1708, 1774),
+    ('Wilhelm Friedmann',        'Maria Barbara',     'Johann Sebastian',       1710, 1784),
+    ('Carl Philipp Emanuel',     'Maria Barbara',     'Johann Sebastian',       1714, 1788),
+    ('J. Gottfried Bernhard',    'Maria Barbara',     'Johann Sebastian',       1715, 1739),
+    ('Friederica Sophie',        NULL,                'Wilhelm Friedmann',      1757, 1801),
+    ('Johann August',            NULL,                'Carl Philipp Emanuel',   1745, 1789),
+    ('J. Sebastian (J. Samuel)', NULL,                'Carl Philipp Emanuel',   1748, 1778),
+    ('Maria Magdalena',          NULL,                NULL,                     1701, 1760),
+    ('Gottfried Heinrich',       'Maria Magdalena',   'Johann Sebastian',       1724, 1763),
+    ('Elisabeth Juliane',        'Maria Magdalena',   'Johann Sebastian',       1726, 1781),
+    ('J. Christoph Friedrich',   'Maria Magdalena',   'Johann Sebastian',       1732, 1795),
+    ('Johann Christian',         'Maria Magdalena',   'Johann Sebastian',       1735, 1782),
+    ('Johann Caroline',          'Maria Magdalena',   'Johann Sebastian',       1737, 1781),
+    ('Regine Susanna',           'Maria Magdalena',   'Johann Sebastian',       1742, 1809),
+    ('Augusta Magdalena',        'Elisabeth Juliane', NULL,                     1751, 1809),
+    ('Juliane Wilhelmine',       'Elisabeth Juliane', NULL,                     1754, 1815),
+    ('Anna Philippine',          NULL,                'J. Christoph Friedrich', 1755, 1804),
+    ('Wilhelm Friedrich Ernst',  NULL,                'J. Christoph Friedrich', 1755, 1804)
+  ;
+});
+
+my @expected_descendants_of_Johann_Sebastian = (
+  'Catharina Dorothea (1708-1774)',
+  'Wilhelm Friedmann (1710-1784)',
+  'Carl Philipp Emanuel (1714-1788)',
+  'J. Gottfried Bernhard (1715-1739)',
+  'Gottfried Heinrich (1724-1763)',
+  'Elisabeth Juliane (1726-1781)',
+  'J. Christoph Friedrich (1732-1795)',
+  'Johann Christian (1735-1782)',
+  'Johann Caroline (1737-1781)',
+  'Regine Susanna (1742-1809)',
+  'Johann August (1745-1789)',
+  'J. Sebastian (J. Samuel) (1748-1778)',
+  'Augusta Magdalena (1751-1809)',
+  'Juliane Wilhelmine (1754-1815)',
+  'Anna Philippine (1755-1804)',
+  'Wilhelm Friedrich Ernst (1755-1804)',
+  'Friederica Sophie (1757-1801)',
+ );
+
+my @expected_descendants_of_Maria_Barbara = (
+  'Catharina Dorothea (1708-1774)',
+  'Wilhelm Friedmann (1710-1784)',
+  'Carl Philipp Emanuel (1714-1788)',
+  'J. Gottfried Bernhard (1715-1739)',
+  'Johann August (1745-1789)',
+  'J. Sebastian (J. Samuel) (1748-1778)',
+  'Friederica Sophie (1757-1801)'
+ );
+
+
+
+
+# declare the schema and the 'Family' table
+my $schema = DBIx::DataModel->Schema('BACHs')->Table(Family => family => qw/name mom dat born died/);
+
+# connect schema to database
+$schema->dbh($dbh);
+
+# use Common Table Expressions (CTE) through subqueries
+is_deeply names_and_dates(descendants_through_subquery('Johann Sebastian')), 
+          \@expected_descendants_of_Johann_Sebastian,
+          "descendants of Johann-Sebastian Bach through subquery";
+
+is_deeply names_and_dates(descendants_through_subquery('Maria Barbara')), 
+          \@expected_descendants_of_Maria_Barbara,
+          "descendants of Maria Barbara Bach through subquery";
+
+
+# use Common Table Expressions through joins -- but these are permanent declarations, not suitable for a CTE
+$schema
+    ->Table(qw/Descendant_of descendant_of name/)
+    ->Association([qw/Descendant_of descendants *  name/],
+                  [qw/Family        family      1  name/]);
+
+
+is_deeply names_and_dates(descendants_through_join('Johann Sebastian')), 
+          \@expected_descendants_of_Johann_Sebastian,
+          "descendants of Johann-Sebastian Bach through join";
+
+
+is_deeply names_and_dates(descendants_through_join('Maria Barbara')), 
+          \@expected_descendants_of_Maria_Barbara,
+          "descendants of Maria Barbara Bach through join";
+
+
+done_testing;
+
+
+
+
+
+sub names_and_dates {
+  my $list = shift;
+  return [map {"$_->{name} ($_->{born}-$_->{died})"} @$list];
+}
+
+sub descendants_through_subquery {
+  my $ancestor = shift;
+
+  return $schema->table('Family')->select(
+    -with     => sqla_with_CTE_descendant_of($schema, $ancestor),
+    -columns  => [qw/name born died/],
+    -where    => {name => {-in => \ ["SELECT name FROM descendant_of"] }},
+    -order_by => 'born',
+  );
+}
+
+sub descendants_through_join {
+  my $ancestor = shift;
+
+  return $schema->join(qw/Descendant_of family/)->select(
+    -with     => sqla_with_CTE_descendant_of($schema, $ancestor),
+    -columns  => [qw/family.name born died/],
+    -order_by => 'born',
+  );
+}
+
+sub sqla_with_CTE_descendant_of {
+  my ($schema, $ancestor) = @_;
+
+  return $schema->sql_abstract->with_recursive(
+    [ -table     => 'parent_of',
+      -columns   => [qw/name parent/],
+      -as_select => {-columns => [qw/name mom/],
+                     -from    => 'family',
+                     -union   => [-columns => [qw/name dad/]]},
+     ],
+    [ -table     => 'descendant_of',
+      -columns   => [qw/name/],
+      -as_select => {-columns   => [qw/name/],
+                     -from      => 'parent_of',
+                     -where     => {parent => $ancestor},
+                     -union_all => [-columns => [qw/parent_of.name/],
+                                    -from    => [qw/-join parent_of {parent=name} descendant_of/]],
+                 },
+     ],
+    );
+}