#!perl
use warnings;
use strict;

package SQL_DSL;
use Exporter 'import';
our @EXPORT_OK = qw/SQL WHERE/;
use Carp;
sub SQL (&;@) {
	# $SQL_DSL::IN_SQL is *not* required when using 
	# SQL_DSL_Transform or SQL_DSL_Keyword
	croak "Already in SQL block" if $SQL_DSL::IN_SQL;
	local $SQL_DSL::IN_SQL = 1;
	print "Exec SQL\n"; # Debug
	shift->(@_)
}
sub WHERE (&;@) {
	croak "WHERE not in SQL block" unless $SQL_DSL::IN_SQL;
	print "Exec WHERE\n"; # Debug
	shift->(@_)
}

package LIKE;
use Carp;
sub AUTOLOAD {
	our $AUTOLOAD;
	croak "$AUTOLOAD not in SQL block" unless $SQL_DSL::IN_SQL;
	print "Exec $AUTOLOAD (@_)\n"; # Debug
}

1;

##</code><code>##

#!/usr/bin/env perl
use warnings;
use strict;

# Version "one":
#use SQL_DSL qw/SQL WHERE/;
# Version "two":
#use SQL_DSL_Keyword;
# Version "three":
#use SQL_DSL 'SQL';
#use Filter::PPI::Transform 'SQL_DSL_Transform';

my $x = '%abc%';
SQL {
	WHERE { print "Where: ",__PACKAGE__, "\n"; b LIKE $x };
};
WHERE {}; # dies b/c not in SQL { ... }

##</code><code>##

Exec SQL
Exec WHERE
Where: main
Exec LIKE::b (LIKE %abc%)
WHERE not in SQL block at ...

##</code><code>##

Exec SQL
Exec WHERE
Where: SQL_DSL
Exec LIKE::b (LIKE %abc%)
Can't call method "WHERE" without a package or object reference at ...

##</code><code>##

#!perl
package SQL_DSL_Keyword;
use warnings;
use 5.012; # for experimental pluggable keyword API

use parent 'SQL_DSL';
use Carp;
use Keyword::Simple;

sub import {
	Keyword::Simple::define SQL => sub {
		${$_[0]}=~s/^\s*\{/SQL_DSL::SQL { package SQL_DSL; /
			or croak "SQL keyword must be followed by a block";
	};
}

sub unimport {
	Keyword::Simple::undefine 'SQL';
}

1;

##</code><code>##

#!perl
package SQL_DSL_Transform;
use warnings;
use strict;

use Params::Util qw/_INSTANCE/;
use parent 'PPI::Transform';

sub new { shift->SUPER::new(@_) }

sub document {
	my $self = shift;
	my $document = _INSTANCE(shift, 'PPI::Document') or return undef;
	my $elements = $document->find( sub {
		$_[1]->isa('PPI::Token::Word') or return '';
		$_[1]->content eq 'SQL' or return '';
		$_[1]->snext_sibling->isa('PPI::Structure::Block') or return '';
		return 1;
	} );
	return undef unless defined $elements;
	return 0 unless $elements;
	foreach my $e (@$elements) {
		my $n = PPI::Document->new(\"package SQL_DSL;");
		for my $t (reverse $n->tokens) {
			$e->snext_sibling->first_token->insert_after($t->remove) or die;
		}
	}
	return scalar @$elements;
}

1;