Beefy Boxes and Bandwidth Generously Provided by pair Networks
Welcome to the Monastery
 
PerlMonks  

comment on

( [id://3333]=superdoc: print w/replies, xml ) Need Help??
# # Proof of concept for a parser for the diagrams found at: # http://publib.boulder.ibm.com/infocenter/db2v8luw/index.jsp?topic=/c +om.ibm.db2.udb.doc/admin/r0006726.htm # # Implementation Notes # ==================== # - Parser::RecDescent wasn't really providing anything, # so I decided to rewrite the program to not use # Parser::RecDescent. # - Printing out the result as a grammar is left as an # excersise for the reader. It should be extremely simple. # - "parameter-block" and "large bullets" (*) that denote # unordered sequences are not supported. Those are # relatively simple or similar to implement, and therefore # they are not needed in this proof of concept program. # - "--text.*--" (a replaceable immediately followed by # literals) is handled differently than "--text--.*--" # in case the user wishes to forbid whitespace between # the replaceable and the literals in the former. # - Most rules don't clone $self, since they only modify # it on a successful match. # # Bugs # ==== # - Needs trace statements for debugging. # - This is not a validator. The input is assumed to be # valid. Adding validation would be simple, but it would # be time consuming to code, and it would hinder code # readability. # - No meaningful error reporting. # - Didn't look into whether <commit> could be used to # improve efficiency in this grammar. # - Something tells me the regexp for sql_literal is # expensive because of the backtracking necessary to # locate a dash. The LHS of the | should probably have # a lookahead. # - Definitions for "sql_literal" and "sql_replaceable" # are guesswork and may require tweaking. # # ---------------------------------------- use strict; use warnings; use Algorithm::Loops (); use Data::Dumper (); # ---------------------------------------- package ikegami::Parser; # --- sub IDX_DATA () { 0 } sub IDX_STATE () { 1 } sub NEXT_IDX () { 2 } sub NEXT_DT_IDX () { 0 } sub NEXT_ST_IDX () { 0 } # --- sub new { my ($class) = @_; return ( bless([ [], # IDX_DATA [], # IDX_STATE ], $class) ); } sub clone { my ($self) = @_; return ( bless([ $self->[IDX_DATA], # IDX_DATA [], # IDX_STATE ], ref($self)) ); } sub repeat($$;$$) { my ($self, $rule, $min, $max) = @_; { my $self = $self->clone(); my @items; my $item; my $reps = 0; while (defined($item = $self->$rule())) { push(@items, $item); ++$reps; (!$max) or ($reps < $max) or last; } (!defined($min)) or ($reps >= $min) or last; $_[0] = $self; return \@items; } return; } sub rule() { my $subname = (caller(1))[3]; $subname =~ s/^.*:://; return $subname; } # ---------------------------------------- package ikegami::Db2SqlSyntax::Parser; # --- use vars qw( @ISA ); BEGIN { @ISA = 'ikegami::Parser'; } sub IDX_DATA () { &ikegami::Parser::IDX_DATA } sub IDX_STATE () { &ikegami::Parser::IDX_STATE } sub DT_IDX_TEXT () { &ikegami::Parser::NEXT_DT_IDX + 0 } sub DT_IDX_TXET () { &ikegami::Parser::NEXT_DT_IDX + 1 } sub NEXT_DT_IDX () { &ikegami::Parser::NEXT_DT_IDX + 2 } sub ST_IDX_SKIPF () { &ikegami::Parser::NEXT_ST_IDX + 0 } sub ST_IDX_Y () { &ikegami::Parser::NEXT_ST_IDX + 1 } sub ST_IDX_X () { &ikegami::Parser::NEXT_ST_IDX + 2 } sub ST_IDX_D () { &ikegami::Parser::NEXT_ST_IDX + 3 } sub ST_IDX_STACK () { &ikegami::Parser::NEXT_ST_IDX + 4 } sub NEXT_ST_IDX () { &ikegami::Parser::NEXT_ST_IDX + 5 } sub STACK_IDX_ID () { 0 } sub STACK_NEXT_IDX () { 1 } sub CHOICE_IDX_Y () { STACK_NEXT_IDX+0 } sub CHOICE_IDX_X () { STACK_NEXT_IDX+1 } sub CHOICE_IDX_D () { STACK_NEXT_IDX+2 } sub LOOP_IDX_END_Y () { STACK_NEXT_IDX+0 } sub LOOP_IDX_END_X () { STACK_NEXT_IDX+1 } sub DIR_N () { 0 } sub DIR_E () { 1 } sub DIR_S () { 2 } sub DIR_W () { 3 } sub DIR_C () { 4 } use vars qw( @DIR_X @DIR_Y @DIR_DASH ); BEGIN { # N E S W . @DIR_X = ( 0, +1, 0, -1, 0 ); @DIR_Y = ( -1, 0, +1, 0, 0 ); @DIR_DASH = qw( | - | - ); } # --- sub new { my $class = $_[0]; #my $text = $_[1]; my $self = $class->ikegami::Parser::new(); my @text = $_[1] =~ /([^\n]*)\n/gs; my $text = \@text; my $txet = transpose_AoS($text); my $dt = $self->[IDX_DATA ]; my $st = $self->[IDX_STATE]; $dt->[DT_IDX_TEXT ] = $text; $dt->[DT_IDX_TXET ] = $txet; $st->[ST_IDX_SKIPF] = 'SKIP_NOTHING'; $st->[ST_IDX_Y ] = 0; $st->[ST_IDX_X ] = undef; $st->[ST_IDX_D ] = undef; $st->[ST_IDX_STACK] = []; $self->DO_MOVE_TO_START(); return $self; } sub clone { my ($src) = @_; my $dst = $src->ikegami::Parser::clone(); my $src_st = $src->[IDX_STATE]; my $dst_st = $dst->[IDX_STATE]; $dst_st->[ST_IDX_SKIPF] = $src_st->[ST_IDX_SKIPF]; $dst_st->[ST_IDX_Y ] = $src_st->[ST_IDX_Y ]; $dst_st->[ST_IDX_X ] = $src_st->[ST_IDX_X ]; $dst_st->[ST_IDX_D ] = $src_st->[ST_IDX_D ]; $dst_st->[ST_IDX_STACK] = $src_st->[ST_IDX_STACK]; # Stack not cloned deeply. Must be done explicitely by caller. #$dst_st->[ST_IDX_STACK] = [ @{$src_st->[ST_IDX_STACK]} ]; return $dst; } sub text { $_[0]->[IDX_DATA ]->[DT_IDX_TEXT ] } sub txet { $_[0]->[IDX_DATA ]->[DT_IDX_TXET ] } sub skipf { $_[0]->[IDX_STATE]->[ST_IDX_SKIPF] } sub y { $_[0]->[IDX_STATE]->[ST_IDX_Y ] } sub x { $_[0]->[IDX_STATE]->[ST_IDX_X ] } sub d { $_[0]->[IDX_STATE]->[ST_IDX_D ] } sub stack { $_[0]->[IDX_STATE]->[ST_IDX_STACK] } sub set_skipf { $_[0]->[IDX_STATE]->[ST_IDX_SKIPF] = $_[1]; $_[0] } sub set_y { $_[0]->[IDX_STATE]->[ST_IDX_Y ] = $_[1]; $_[0] } sub set_x { $_[0]->[IDX_STATE]->[ST_IDX_X ] = $_[1]; $_[0] } sub set_d { $_[0]->[IDX_STATE]->[ST_IDX_D ] = $_[1]; $_[0] } sub set_stack { $_[0]->[IDX_STATE]->[ST_IDX_STACK] = $_[1]; $_[0] } # [ [ # 'aeh', # 'abcd', 'bfi', # 'efg', ==> 'cgj', # 'hijkl', 'd k', # ' l', # ] ] sub transpose_AoS { return [ Algorithm::Loops::MapCarU { join('', map { defined($_) ? $ +_ : ' ' } @_) } map { [ /(.)/gs ] } @{$_[0]} ]; } sub get_char_at { my ($text, $y, $x, $d) = @_; $d = DIR_C unless (defined($d)); $y += $DIR_Y[$d] - 1; # Make zero-based. $x += $DIR_X[$d] - 1; # Make zero-based. return undef unless ($y >= 0); return undef unless ($y < @$text); my $line = $text->[$y]; return undef if ($x < 0 || $x >= length($line)); return substr($line, $x, 1); } sub is_loop_return { my ($text, $y, $x) = @_; my $ch; $ch = get_char_at($text, $y + $DIR_Y[DIR_N]*0, $x + $DIR_X[DIR_N]*0 +); return undef unless (defined($ch) && $ch eq '-'); $ch = get_char_at($text, $y + $DIR_Y[DIR_N]*1, $x + $DIR_X[DIR_N]*1 +); return undef unless (defined($ch) && $ch eq 'V'); $ch = get_char_at($text, $y + $DIR_Y[DIR_N]*2, $x + $DIR_X[DIR_N]*2 +); return undef unless (defined($ch) && ($ch eq '.' || $ch eq '|')); return 1; } sub is_dash { my ($text, $y, $x, $d) = @_; my $ch = get_char_at($text, $y, $x); return undef unless (defined($ch)); return undef unless ($ch eq $DIR_DASH[$d]); return !(is_loop_return($text, $y, $x)); } sub skip { my ($self) = @_; my $skipf = $self->skipf(); $self->$skipf(); } # --- sub DO_MOVE_TO_START { my ($self) = @_; my $text = $self->text(); my $y = $self->y(); my $num_lines = scalar(@$text); my $x = 0; # 0-based. --$y; # Make 0-based. while (++$y < $num_lines) { last if (substr($text->[$y], $x) =~ /^>/s); } ++$y; # Make 1-based. ++$x; # Make 1-based. $self->set_y($y)->set_x($x)->set_d(DIR_E); return 1; } # Skips whitespace like a MATCH. sub DO_SET_DIR { my ($self, $new_d) = @_; $self->skip(); my $old_d = $self->d(); $self->set_d($new_d); return $old_d; } sub DO_SET_SKIP { my ($self, $new_skipf) = @_; my $old_skipf = $self->skipf(); $self->set_skipf($new_skipf); return $old_skipf; } sub SKIP_NOTHING {} sub SKIP_LINE { my ($self) = @_; my $text = $self->text(); my $y = $self->y(); my $x = $self->x(); my $d = $self->d(); my $moved; while (is_dash($text, $y, $x, $d)) { $y += $DIR_Y[$d]; $x += $DIR_X[$d]; $moved = 1; } $self->set_y($y)->set_x($x) if ($moved); } # Replacement for //. sub MATCH { my ($self, $regexp) = @_; $self->skip(); my $text = $self->text(); my $txet = $self->txet(); my $y = $self->y(); my $x = $self->x(); my $d = $self->d(); --$y; # Make 0-based. --$x; # Make 0-based. my $line; my $setter; my $pos; my $match; my $sign; if ($DIR_X[$d]) { $line = $text->[$y]; return undef unless (defined($line)); $setter = 'set_x'; $pos = $x; } else { $line = $txet->[$x]; return undef unless (defined($line)); $setter = 'set_y'; $pos = $y; } if ($DIR_X[$d] >= 0 && $DIR_Y[$d] >= 0) { $line = ($pos < length($line) ? substr($line, $pos) : ''); ($match) = $line =~ /^($regexp)/s; $sign = +1; } else { $line = substr($line, 0, $pos+1); ($match) = $line =~ /($regexp)$/s; $sign = -1; } return undef unless (defined($match)); $pos += length($match) * $sign; ++$pos; # Make 1-based. $self->$setter($pos); return $match; } sub MATCH_LOOP_RET { my ($self) = @_; $self->skip(); my $text = $self->text(); my $y = $self->y(); my $x = $self->x(); return undef unless (is_loop_return($text, $y, $x)); $y += $DIR_Y[DIR_E]; $x += $DIR_X[DIR_E]; $self->set_y($y)->set_x($x); return 1; } sub MATCH_EOF { my ($self) = @_; my $text = $self->text(); my $y = $self->y(); --$y; # Make 0-based. return ($y >= scalar(@$text) ? 1 : undef); } # Skips whitespace like a MATCH. sub DO_CHOICE_START { my ($self) = @_; $self->skip(); my $y = $self->y(); my $x = $self->x(); my $d = $self->d(); my $stack = $self->stack(); $stack = [ @$stack ]; push(@$stack, [ 'choice', # STACK_IDX_ID $y, # CHOICE_IDX_Y $x, # CHOICE_IDX_X $d, # CHOICE_IDX_D ], ); $self->set_stack($stack); return 1; } sub DO_GO_CHOICE_START { my ($self) = @_; my $stack = $self->stack(); my $record = $stack->[$#$stack]; my ($y, $x, $d) = @$record[CHOICE_IDX_Y, CHOICE_IDX_X, CHOICE_IDX_D +]; $self->set_y($y)->set_x($x)->set_d($d); return 1; } sub DO_CHOICE_END { my ($self) = @_; my $stack = $self->stack(); $stack = [ @$stack ]; pop(@$stack); $self->set_stack($stack); return 1; } # Skips whitespace like a MATCH. sub DO_LOOP_START { my ($self) = @_; $self->skip(); my $y = $self->y(); my $x = $self->x(); my $d = $self->d(); my $stack = $self->stack(); $stack = [ @$stack ]; push(@$stack, [ 'loop', # STACK_IDX_ID undef, # LOOP_IDX_END_Y undef, # LOOP_IDX_END_X ], ); $self->set_stack($stack); return 1; } # Skips whitespace like a MATCH. sub DO_LOOP_BACK { my ($self) = @_; $self->skip(); my $y = $self->y(); my $x = $self->x(); my $stack = $self->stack(); $stack = [ @$stack ]; my $record = $stack->[$#$stack]; @$record[LOOP_IDX_END_Y, LOOP_IDX_END_X] = ($y, $x); $self->set_stack($stack); return 1; } sub DO_GO_LOOP_BACK { my ($self) = @_; my $stack = $self->stack(); my $record = $stack->[$#$stack]; my ($y, $x) = @$record[LOOP_IDX_END_Y, LOOP_IDX_END_X]; $self->set_y($y)->set_x($x)->set_d(DIR_E); return 1; } sub DO_LOOP_END { my ($self) = @_; my $stack = $self->stack(); $stack = [ @$stack ]; pop(@$stack); $self->set_stack($stack); return 1; } # --- Basics sub parse { { my $self = $_[0]->clone(); my @items; my $i; defined($items[++$i] = $self->repeat('stmt', 0) ) or + last; defined($items[++$i] = $self->MATCH_EOF() ) or + last; $_[0] = $self; return $items[1]; } return undef; } sub stmt { { my $self = $_[0]->clone(); my @items; my $i; defined($items[++$i] = $self->DO_SET_SKIP('SKIP_NOTHING') ) or + last; defined($items[++$i] = $self->MATCH('>>') ) or + last; defined($items[++$i] = $self->DO_SET_SKIP('SKIP_LINE') ) or + last; defined($items[++$i] = $self->repeat('expr', 0) ) or + last; defined($items[++$i] = $self->repeat('stmt_extention', 0) ) or + last; defined($items[++$i] = $self->MATCH('><') ) or + last; defined($items[++$i] = $self->DO_MOVE_TO_START() ) or + last; $_[0] = $self; return [ @{$items[4]}, map { @{$_} } @{$items[5]} ]; } return undef; } sub stmt_extention { { my $self = $_[0]->clone(); my @items; my $i; defined($items[++$i] = $self->MATCH('>(?!<)') ) or + last; defined($items[++$i] = $self->DO_MOVE_TO_START() ) or + last; defined($items[++$i] = $self->MATCH('>(?!>)') ) or + last; defined($items[++$i] = $self->repeat('expr', 0) ) or + last; $_[0] = $self; return $items[4]; } return undef; } sub expr { { my $self = $_[0]->clone(); my @items; my $i; defined($items[++$i] = $self->sql_text() ) or + last; $_[0] = $self; return $items[1]; } { my $self = $_[0]->clone(); my @items; my $i; defined($items[++$i] = $self->choice() ) or + last; $_[0] = $self; return $items[1]; } { my $self = $_[0]->clone(); my @items; my $i; defined($items[++$i] = $self->loop() ) or + last; $_[0] = $self; return $items[1]; } return undef; } # --- Literals sub sql_text { { my $self = $_[0]->clone(); my @items; my $i; $items[0] = $self->rule(); defined($items[++$i] = $self->sql_component() ) or + last; defined($items[++$i] = $self->DO_SET_SKIP('SKIP_NOTHING') ) or + last; defined($items[++$i] = $self->repeat('sql_component', 0) ) or + last; defined($items[++$i] = $self->DO_SET_SKIP($items[2]) ) or + last; $_[0] = $self; return [ $items[0], $items[1], @{$items[3]} ]; } return undef; } sub sql_component { { my $self = $_[0]->clone(); my @items; my $i; defined($items[++$i] = $self->sql_literal() ) or + last; $_[0] = $self; return $items[1]; } { my $self = $_[0]->clone(); my @items; my $i; defined($items[++$i] = $self->sql_replaceable() ) or + last; $_[0] = $self; return $items[1]; } return undef; } sub sql_literal { { my $self = $_[0]->clone(); my @items; my $i; $items[0] = $self->rule(); defined($items[++$i] = $self->MATCH( qr/(?:[+<>'.])*[^a-z-+<>'.\s](?:[^a-z-+<>]|[A-Z]-[A-Z])*/ )) or last; $_[0] = $self; return \@items; } return undef; } sub sql_replaceable { { my $self = $_[0]->clone(); my @items; my $i; $items[0] = $self->rule(); defined($items[++$i] = $self->MATCH( qr/[a-z](?:[a-z]|-[a-z])*/ )) or last; $_[0] = $self; return \@items; } return undef; } # --- Choices sub choice { { my $self = $_[0]->clone(); my @items; my $i; $items[0] = $self->rule(); defined($items[++$i] = $self->DO_CHOICE_START() ) or + last; defined($items[++$i] = $self->choice_branches() ) or + last; defined($items[++$i] = $self->DO_GO_CHOICE_START() ) or + last; defined($items[++$i] = $self->DO_SET_DIR(DIR_E) ) or + last; defined($items[++$i] = $self->MATCH('\\+') ) or + last; defined($items[++$i] = $self->repeat('expr', 0) ) or + last; defined($items[++$i] = $self->MATCH('\\+') ) or + last; defined($items[++$i] = $self->DO_CHOICE_END() ) or + last; $_[0] = $self; return [ $items[0], @{$items[2]}, $items[6] ]; } return undef; } sub choice_branches { { my $self = $_[0]->clone(); my @items; my $i; defined($items[++$i] = $self->north_branches() ) or + last; defined($items[++$i] = $self->repeat('south_branches', 0, 1)) or + last; $_[0] = $self; return [ $items[1], @{$items[2]} ]; } { my $self = $_[0]->clone(); my @items; my $i; defined($items[++$i] = $self->south_branches() ) or + last; $_[0] = $self; return [ $items[1] ]; } return undef; } sub north_branches { { my $self = $_[0]->clone(); my @items; my $i; defined($items[++$i] = $self->DO_GO_CHOICE_START() ) or + last; defined($items[++$i] = $self->DO_SET_DIR(DIR_N) ) or + last; defined($items[++$i] = $self->MATCH('\\+') ) or + last; defined($items[++$i] = $self->north_branch() ) or + last; $_[0] = $self; return $items[4]; } return undef; } sub south_branches { { my $self = $_[0]->clone(); my @items; my $i; defined($items[++$i] = $self->DO_GO_CHOICE_START() ) or + last; defined($items[++$i] = $self->DO_SET_DIR(DIR_S) ) or + last; defined($items[++$i] = $self->MATCH('\\+') ) or + last; defined($items[++$i] = $self->south_branch() ) or + last; $_[0] = $self; return $items[4]; } return undef; } sub north_branch { { my $self = $_[0]->clone(); my @items; my $i; defined($items[++$i] = $self->DO_CHOICE_START() ) or + last; defined($items[++$i] = $self->DO_SET_DIR(DIR_N) ) or + last; defined($items[++$i] = $self->MATCH('\\+') ) or + last; defined($items[++$i] = $self->north_branch() ) or + last; defined($items[++$i] = $self->DO_GO_CHOICE_START() ) or + last; defined($items[++$i] = $self->DO_SET_DIR(DIR_E) ) or + last; defined($items[++$i] = $self->MATCH('\\+') ) or + last; defined($items[++$i] = $self->repeat('expr', 0) ) or + last; defined($items[++$i] = $self->MATCH('\\+') ) or + last; defined($items[++$i] = $self->DO_CHOICE_END() ) or + last; $_[0] = $self; return [ @{$items[4]}, $items[8] ]; } { my $self = $_[0]->clone(); my @items; my $i; defined($items[++$i] = $self->DO_SET_DIR(DIR_E) ) or + last; defined($items[++$i] = $self->MATCH('\\.') ) or + last; defined($items[++$i] = $self->repeat('expr', 0) ) or + last; defined($items[++$i] = $self->MATCH('\\.') ) or + last; $_[0] = $self; return $items[3]; } return undef; } sub south_branch { { my $self = $_[0]->clone(); my @items; my $i; defined($items[++$i] = $self->DO_CHOICE_START() ) or + last; defined($items[++$i] = $self->DO_SET_DIR(DIR_S) ) or + last; defined($items[++$i] = $self->MATCH('\\+') ) or + last; defined($items[++$i] = $self->south_branch() ) or + last; defined($items[++$i] = $self->DO_GO_CHOICE_START() ) or + last; defined($items[++$i] = $self->DO_SET_DIR(DIR_E) ) or + last; defined($items[++$i] = $self->MATCH('\\+') ) or + last; defined($items[++$i] = $self->repeat('expr', 0) ) or + last; defined($items[++$i] = $self->MATCH('\\+') ) or + last; defined($items[++$i] = $self->DO_CHOICE_END() ) or + last; $_[0] = $self; return [ @{$items[4]}, $items[8] ]; } { my $self = $_[0]->clone(); my @items; my $i; defined($items[++$i] = $self->DO_SET_DIR(DIR_E) ) or + last; defined($items[++$i] = $self->MATCH("'") ) or + last; defined($items[++$i] = $self->repeat('expr', 0) ) or + last; defined($items[++$i] = $self->MATCH("'") ) or + last; $_[0] = $self; return $items[3]; } return undef; } # --- Loops sub loop { { my $self = $_[0]->clone(); my @items; my $i; $items[0] = $self->rule(); defined($items[++$i] = $self->DO_LOOP_START() ) or + last; defined($items[++$i] = $self->MATCH_LOOP_RET() ) or + last; defined($items[++$i] = $self->repeat('expr', 0) ) or + last; defined($items[++$i] = $self->DO_LOOP_BACK() ) or + last; defined($items[++$i] = $self->DO_SET_DIR(DIR_N) ) or + last; defined($items[++$i] = $self->MATCH('\\+') ) or + last; defined($items[++$i] = $self->DO_SET_DIR(DIR_W) ) or + last; defined($items[++$i] = $self->MATCH('\\.') ) or + last; defined($items[++$i] = $self->loop_seperator() ) or + last; defined($items[++$i] = $self->DO_SET_DIR(DIR_S) ) or + last; defined($items[++$i] = $self->MATCH('\\.') ) or + last; defined($items[++$i] = $self->MATCH('V') ) or + last; defined($items[++$i] = $self->DO_GO_LOOP_BACK() ) or + last; defined($items[++$i] = $self->MATCH('\\+') ) or + last; defined($items[++$i] = $self->DO_LOOP_END() ) or + last; $_[0] = $self; return [ $items[0], $items[3], $items[9] ]; } return undef; } sub loop_seperator { { my $self = $_[0]->clone(); my @items; my $i; defined($items[++$i] = $self->MATCH(',') ) or + last; $_[0] = $self; return $items[1]; } { my $self = $_[0]->clone(); my @items; my $i; $_[0] = $self; return ''; } return undef; } # ---------------------------------------- package main; # --- { my $text = <<'__EOI__'; >>-ACTIVATE--+-DATABASE-+--database-alias-----------------------> '-DB-------' >--+-------------------------------------+--------------------->< '-USER--username--+-----------------+-' '-USING--password-' >>-select-clause--from-clause--+--------------+-----------------> '-where-clause-' >--+-----------------+--+---------------+---------------------->< '-group-by-clause-' '-having-clause-' .-ALL------. >>-SELECT--+----------+-----------------------------------------> '-DISTINCT-' >--+-*-----------------------------------------------+--------->< | .-,-------------------------------------------. | | V | | '---+-expression--+-------------------------+-+-+-' | | .-AS-. | | | '-+----+--new-column-name-' | '-exposed-name.*--------------------------' __EOI__ my $result = ikegami::Db2SqlSyntax::Parser->new($text)->parse(); die("Bad text.\n") unless (defined($result)); print(Data::Dumper->Dump([ $result ],[qw( $result )])); } # ---------------------------------------- __END__ Must Parse ========== >>-ACTIVATE--+-DATABASE-+--database-alias-----------------------> '-DB-------' >--+-------------------------------------+--------------------->< '-USER--username--+-----------------+-' '-USING--password-' >>-select-clause--from-clause--+--------------+-----------------> '-where-clause-' >--+-----------------+--+---------------+---------------------->< '-group-by-clause-' '-having-clause-' .-ALL------. >>-SELECT--+----------+-----------------------------------------> '-DISTINCT-' >--+-*-----------------------------------------------+--------->< | .-,-------------------------------------------. | | V | | '---+-expression--+-------------------------+-+-+-' | | .-AS-. | | | '-+----+--new-column-name-' | '-exposed-name.*--------------------------' __END__ Must Parse (Simpler) ==================== >>--------------------------------------------------------------> >-------------------------------------------------------------->< >>-ACTIVATE----------------database-alias---------------------->< >>-ACTIVATE--+-DATABASE-+--database-alias---------------------->< '-DB-------' .-ALL------. >>-SELECT--+----------+---------------------------------------->< '-DISTINCT-' >>-+-*-----------------------------------------------+--word2-->< | .-,-----------------------------------. | | V | | '-----expression------------------------+--word1--' __END__ Output ====== $result = [ [ [ 'sql_text', [ 'sql_literal', 'ACTIVATE' ] ], [ 'choice', [ [ 'sql_text', [ 'sql_literal', 'DB' ] ] ], [ [ 'sql_text', [ 'sql_literal', 'DATABASE' ] ] ] ], [ 'sql_text', [ 'sql_replaceable', 'database-alias' ] ], [ 'choice', [ [ 'sql_text', [ 'sql_literal', 'USER' ] ], [ 'sql_text', [ 'sql_replaceable', 'username' ] ], [ 'choice', [ [ 'sql_text', [ 'sql_literal', 'USING' ] ], [ 'sql_text', [ 'sql_replaceable', 'password' ] ] ], [] ] ], [] ] ], [ [ 'sql_text', [ 'sql_replaceable', 'select-clause' ] ], [ 'sql_text', [ 'sql_replaceable', 'from-clause' ] ], [ 'choice', [ [ 'sql_text', [ 'sql_replaceable', 'where-clause' ] ] ], [] ], [ 'choice', [ [ 'sql_text', [ 'sql_replaceable', 'group-by-clause' ] ] ], [] ], [ 'choice', [ [ 'sql_text', [ 'sql_replaceable', 'having-clause' ] ] ], [] ] ], [ [ 'sql_text', [ 'sql_literal', 'SELECT' ] ], [ 'choice', [ [ 'sql_text', [ 'sql_literal', 'ALL' ] ] ], [ [ 'sql_text', [ 'sql_literal', 'DISTINCT' ] ] ], [] ], [ 'choice', [ [ 'loop', [ [ 'choice', [ [ 'sql_text', [ 'sql_replaceable', 'exposed-name' ], [ 'sql_literal', '.*' ] ] ], [ [ 'sql_text', [ 'sql_replaceable', 'expression' ] ], [ 'choice', [ [ 'choice', [ [ 'sql_text', [ 'sql_literal', 'AS' ] ] ], [] ], [ 'sql_text', [ 'sql_replaceable', 'new-column-name' ] ] ], [] ] ] ] ], ',' ] ], [ [ 'sql_text', [ 'sql_literal', '*' ] ] ] ] ] ];

In reply to Parsing 2D Graphs by ikegami

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":



  • Are you posting in the right place? Check out Where do I post X? to know for sure.
  • Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
    <code> <a> <b> <big> <blockquote> <br /> <dd> <dl> <dt> <em> <font> <h1> <h2> <h3> <h4> <h5> <h6> <hr /> <i> <li> <nbsp> <ol> <p> <small> <strike> <strong> <sub> <sup> <table> <td> <th> <tr> <tt> <u> <ul>
  • Snippets of code should be wrapped in <code> tags not <pre> tags. In fact, <pre> tags should generally be avoided. If they must be used, extreme care should be taken to ensure that their contents do not have long lines (<70 chars), in order to prevent horizontal scrolling (and possible janitor intervention).
  • Want more info? How to link or How to display code and escape characters are good places to start.
Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others examining the Monastery: (4)
As of 2024-03-29 09:19 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found