real.aussie has asked for the wisdom of the Perl Monks concerning the following question:

Hi. (my first post - I did several queries and didn't get any hits on my problem.)

I have a requirement to parse a string with resursive statements. It happens to be SQL, but not sure that matters directly. I need to turn each field into field format \"%s|\". That is convert: 

"select A, B, C,
  (select D, E, F,
    (select G, H from AA where ID = Z) from BB where ID2 = X),
      I, J
        from CC;"

[download]
into 
"select A format \"%s|\", B format \"%s|\", C format \"%s|\",
  (select D format \"%s|\", E format \"%s|\", F format \"%s|\",
    (select G format \"%s|\", H format \"%s|\" from AA where ID = Z) f
+rom BB where ID2 = X),
      I format \"%s|\", J format \"%s|\"
        from CC;"

[download]
You can see that when I find a second "select" I have to go down a level to find each of the fields D thru F, then again for G & H. Then pop back out to finish I & J. And I'm not too sure how to go about it.

Alf

Replies are listed 'Best First'.
Re: Recursive parse -
by GrandFather (Saint) on Aug 19, 2011 at 11:46 UTC

    In this case it's probably easier to use a stack and a loop rather than recursion. Consider:

    use warnings;
use strict;

my $sql = <<SQL;
select A, B, C,
  (select D, E, F,
    (select G, H from AA where ID = Z) from BB where ID2 = X),
      I, J
        from CC;
SQL

my @parts = split /(\W+)/, $sql;
my @formatting = (undef);

for my $part (@parts) {
    print $part;

    if (lc $part eq 'select') {
        $formatting[-1] = 1;
        next;
    }

    if (lc $part eq 'from') {
        $formatting[-1] = undef;
        next;
    }

    if ($part =~ m'\)') {
        pop @formatting;
    }

    next if ! $formatting[-1];

    if ($part =~ m'\(') {
        push @formatting, undef;
        next;
    }

    print qq{ format \\"\%s|\\"} if $part =~ /\w/;
}

    [download]

    Prints:

    select A format \"%s|\", B format \"%s|\", C format \"%s|\",
  (select D format \"%s|\", E format \"%s|\", F format \"%s|\",
    (select G format \"%s|\", H format \"%s|\" from AA where ID = Z) f
+rom BB where ID2 = X),
      I format \"%s|\", J format \"%s|\"
        from CC;

    [download]
    True laziness is hard work
[reply]
[d/l]
[select]
Re: Recursive parse -
by Anonymous Monk on Aug 19, 2011 at 01:39 UTC
[reply]
Re: Recursive parse -
by tybalt89 (Monsignor) on Nov 05, 2024 at 22:58 UTC

    Recursion was required... 

    #!/usr/bin/perl

use strict; # https://perlmonks.org/?node_id=921111
use warnings;

my $sql = <<END;
select A, B, C,
  (select D, E, F,
    (select G, H from AA where ID = Z) from BB where ID2 = X),
      I, J
        from CC;
END

sub error
  {
  substr $_, pos($_), 0, "\e\[1;31;43m @_ \e[m";
  die $_,"\n";
  }

print "ORIGINAL:\n\n$sql";
my $adding = ' format \\"%s|\\"'; # NOTE after each field name
local $_ = $sql;
selectexpr();
/\G;/gc or error 'incomplete parse';
print "\nMODIFIED:\n\n$_";

sub selectexpr
  {
  /\G\s*select/gc || error 'missing select';
  do {
    /\G\s*(\w+)/gc ? do { # field name found
      my $pos = pos();
      substr $_, $pos, 0, $adding;
      pos() = $pos + length $adding;
      } :
    /\G\s*\(/gc ? (selectexpr(), /\G\s*\)/gc || error 'missing close p
+aren') :
    error 'either name or subselect expected';
    } while /\G\s*,/gc;
  /\G\s*from/gc || error 'missing from';
  /\G\s*\w+/gc || error 'missing table name';
  /\G\s*where[^);]*/gc; # optional
  }

    [download]

    Outputs:

    ORIGINAL:

select A, B, C,
  (select D, E, F,
    (select G, H from AA where ID = Z) from BB where ID2 = X),
      I, J
        from CC;

MODIFIED:

select A format \"%s|\", B format \"%s|\", C format \"%s|\",
  (select D format \"%s|\", E format \"%s|\", F format \"%s|\",
    (select G format \"%s|\", H format \"%s|\" from AA where ID = Z) f
+rom BB where ID2 = X),
      I format \"%s|\", J format \"%s|\"
        from CC;

    [download]
[reply]
[d/l]
[select]

Back to Seekers of Perl Wisdom