this is just a rough hack demonstrating a proof of concept for a "SQL::DSL".

(and a general pattern for designing complex domain specific languages)

I'm currently refactoring it out into clean sub-modules but wanted to show something already.

The demonstrated ideas here are already sufficiently complex to discuss.

(The implementation of named operators like BETWEEN and a JOIN mechanism are subject of threads to come)

given this input:

my ($user, $workhrs0, $geo0, $workhrs1, $geo1) =
  ('NWIGER', '20', 'ASIA', '50', 'EURO');

query  {
  package Table;
  WHERE
    (
     ANDS (
           user == $user,
           ORS (
                ANDS ( workhrs > $workhrs0 , geo == 20 ),
                ORS  ( $workhrs1 < workhrs,  geo == $geo1 )
               )
          )
    );
};
[download]

will the function query return an AST (abstract syntax tree) of nested "SQL::DSL" objects, which can be rendered into a target dialect like MySQL, Oracle ... (or maybe even SQL::Abstract or DBIx code ).

Some basic ideas are:

• SQL-Tables (here "Table") are realized as packages
• These packages are limited to the scope of the surrounding code-block such that no namespace pollution occurs (a common problem with DSLs)
• The Columns (here user) are realized as constants in this namespace returning "SQL::DSL::Column" objects
• The operators are overloaded for Column objects and return "SQL::DSL::Operator" objects with nested Operand objects
• Literal operands (like 20) are identified because they are readonly
• Variable operands are identified and can be replaced by ? placeholders at render-time
• actual values of the placeholders can be captured as variable references from the closure-vars and can be bound to the DBI->execute() later
• "higher order" operations on nested operations just return the nested objects in a higher blessed container augmenting the AST
• the rendering happens by walking the generated AST and calling a render methods on the encountered objects
• the whole algorithm might look slow but we only need to run it once and memoize the result for later executions.

=== B::Deparse of the Code: 
{
    package Table;
    use warnings;
    use strict;
    use feature 'say';
    WHERE(ANDS(user() == $user, ORS(ANDS(workhrs() > $workhrs0, geo() 
+== 20), ORS($workhrs1 < workhrs(), geo() == $geo1))));
} at d:/Users/lanx/vm_share/perl/Talks/DSL/2018_GPW/exp/SQL_abstract.p
+l line 51.


=== Tidy of deparsed Perl-code: 
{

    package Table;
    use warnings;
    use strict;
    use feature 'say';
    WHERE(
        ANDS(
            user() == $user,
            ORS(
                ANDS( workhrs() > $workhrs0, geo() == 20 ),
                ORS( $workhrs1 < workhrs(), geo() == $geo1 )
            )
        )
    );
}


=== Abstract Syntax Tree (simplified): 
  :'WHERE' is ::Clause
    :'ANDS' is ::Joiner
      :'=' is ::Infix
        :'user' is ::Column
        :'NWIGER' is ::Placeholder
["\n        ", "NWIGER"]
      :'ORS' is ::Joiner
        :'ANDS' is ::Joiner
          :'>' is ::Infix
            :'workhrs' is ::Column
            :'20' is ::Placeholder
["\n            ", 20]
          :'=' is ::Infix
            :'geo' is ::Column
            :'20' is SCALAR
        :'ORS' is ::Joiner
          :'<' is ::Infix
            :'50' is ::Placeholder
["\n            ", 50]
            :'workhrs' is ::Column
          :'=' is ::Infix
            :'geo' is ::Column
            :'EURO' is ::Placeholder
["\n            ", "EURO"]


=== Produced SQL: 

   WHERE 
    ( 
       user = ? AND 
      ( 
        ( 
           workhrs > ? AND 
           geo = 20 
        ) OR 
        ( 
           ? < workhrs OR 
           geo = ? 
        ) 
      ) 
    )  at d:/Users/lanx/vm_share/perl/Talks/DSL/2018_GPW/exp/SQL_abstr
+act.pl line 59.
[download]

here the code

Any comments so far? :)