From 56f02e1283c7047712de36b0fdbbbf09b7ec1bc2 Mon Sep 17 00:00:00 2001 From: Laurent Dami Date: Sat, 13 Jan 2024 22:38:57 +0100 Subject: [PATCH] added tests and doc for the -with feature (Common Table Expressions) --- MANIFEST | 1 + lib/DBIx/DataModel/Doc/Cookbook.pod | 105 ++++++++++++++++- lib/DBIx/DataModel/Doc/Reference.pod | 15 ++- t/v3_with_recursive.t | 162 +++++++++++++++++++++++++++ 4 files changed, 280 insertions(+), 3 deletions(-) create mode 100644 t/v3_with_recursive.t diff --git a/MANIFEST b/MANIFEST index 626281a..789cafb 100644 --- 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 \ No newline at end of file diff --git a/lib/DBIx/DataModel/Doc/Cookbook.pod b/lib/DBIx/DataModel/Doc/Cookbook.pod index 9c5b7fd..3521629 100644 --- 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 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 (CTEs), +introduced in L, +defines a temporary name corresponding to a simple query, +so that this name can be used in a more general SQL statement : + + WITH [RECURSIVE] (, ...) AS () + SELECT + +This is useful in two situations : + +=over + +=item * + +when the I is needed at several places within the main query + +=item * + +for expressing queries that willl I traverse a graph of related nodes. +See SQLite examples at L; but many other database +management systems also support CTEs. possibly with some slight variations. + +=back + +For using CTEs within C, the first step is encapsulate the WITH query +as a new instance of L, through the +L method. +Then that instance can be passed to C statements through the +C<-with> argument. Here is an example borrowed from L : + +=over + +=item * + +suppose an initial table like this : + + CREATE TABLE family(name, mom, dad, bord, died) + +The declaration within C looks like this : + + my $schema = DBIx::DataModel->Schema('CTE_example'); + $schema->Table(qw/Family family name/); + +=item * + +Encapsulate a C common table expression as a new instance of L : + + 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 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 as a new table, and add a new association +with the C table. This approach is displayed below; but it is not +recommanded because it creates I metada within the schema, while CTEs are meant to be +used as I 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 index cb43eca..fdd31d7 100644 --- a/lib/DBIx/DataModel/Doc/Reference.pod +++ b/lib/DBIx/DataModel/Doc/Reference.pod @@ -1892,7 +1892,20 @@ overrides the L 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 in collaboration with L : + + 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 new file mode 100644 index 0000000..016b96c --- /dev/null +++ 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/]], + }, + ], + ); +}