/[cvs]/nfo/patches/cpan/SQL/Parser.pm
ViewVC logotype

Diff of /nfo/patches/cpan/SQL/Parser.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.2 by joko, Wed Nov 13 21:24:24 2002 UTC revision 1.3 by joko, Mon Dec 2 05:51:58 2002 UTC
# Line 2  Line 2 
2  package SQL::Parser;  package SQL::Parser;
3  ######################################################################  ######################################################################
4  #  #
5  # This module is copyright (c), 2001 by Jeff Zucker.  # This module is copyright (c), 2001,2002 by Jeff Zucker.
6  # All rights resered.  # All rights resered.
7    #
8  # It may be freely distributed under the same terms as Perl itself.  # It may be freely distributed under the same terms as Perl itself.
9  # See below for help and copyright information (search for SYNOPSIS).  # See below for help and copyright information (search for SYNOPSIS).
10  #  #
# Line 11  package SQL::Parser; Line 12  package SQL::Parser;
12    
13  use strict;  use strict;
14  use vars qw($VERSION);  use vars qw($VERSION);
15    use constant FUNCTION_NAMES => join '|', qw(
16        TRIM SUBSTRING UPPER LOWER TO_CHAR
17    );
18    
19    $VERSION = '1.005';
20    
21  $VERSION = '1.004';  BEGIN { if( $ENV{SQL_USER_DEFS} ) { require SQL::UserDefs; } }
22    
23    
24  #############################  #############################
# Line 90  sub parse { Line 96  sub parse {
96              delete $self->{"struct"}->{"join"};              delete $self->{"struct"}->{"join"};
97          }          }
98          $self->replace_quoted_ids();          $self->replace_quoted_ids();
99    $self->{struct}->{org_table_names} = $self->{struct}->{table_names};
100    my @uTables = map {uc $_ } @{$self->{struct}->{table_names}};
101    $self->{struct}->{table_names} = \@uTables;
102    $self->{struct}->{org_col_names} = $self->{struct}->{column_names};
103    my @uCols = map {uc $_ } @{$self->{struct}->{column_names}};
104    $self->{struct}->{column_names} = \@uCols;
105            if ($self->{original_string} =~ /Y\.\*/) {
106    #use mylibs; zwarn $self; exit;
107            }
108          return $rv;          return $rv;
109      }      }
110      else {      else {
111           $self->{struct}={};
112           if ($ENV{SQL_USER_DEFS}) {
113               return SQL::UserDefs::user_parse($self,$sql);
114           }
115         return $self->do_err("Command '$com' not recognized or not supported!");         return $self->do_err("Command '$com' not recognized or not supported!");
116      }      }
117  }  }
# Line 214  sub DROP { Line 233  sub DROP {
233      my $stmt = shift;      my $stmt = shift;
234      my $table_name;      my $table_name;
235      $self->{"struct"}->{"command"}     = 'DROP';      $self->{"struct"}->{"command"}     = 'DROP';
236        if ($stmt =~ /^\s*DROP\s+TABLE\s+IF\s+EXISTS\s+(.*)$/si ) {
237            $stmt = "DROP TABLE $1";
238            $self->{"struct"}->{ignore_missing_table}=1;
239        }
240      if ($stmt =~ /^\s*DROP\s+(\S+)\s+(.+)$/si ) {      if ($stmt =~ /^\s*DROP\s+(\S+)\s+(.+)$/si ) {
241         my $com2    = $1 || '';         my $com2    = $1 || '';
242         $table_name = $2;         $table_name = $2;
# Line 450  sub INSERT { Line 473  sub INSERT {
473      my $col_str;      my $col_str;
474      my($table_name,$val_str) = $str =~      my($table_name,$val_str) = $str =~
475          /^INSERT\s+INTO\s+(.+?)\s+VALUES\s+\((.+?)\)$/i;          /^INSERT\s+INTO\s+(.+?)\s+VALUES\s+\((.+?)\)$/i;
476      if ($table_name =~ /[()]/ ) {      if ($table_name and $table_name =~ /[()]/ ) {
477      ($table_name,$col_str,$val_str) = $str =~      ($table_name,$col_str,$val_str) = $str =~
478          /^INSERT\s+INTO\s+(.+?)\s+\((.+?)\)\s+VALUES\s+\((.+?)\)$/i;          /^INSERT\s+INTO\s+(.+?)\s+\((.+?)\)\s+VALUES\s+\((.+?)\)$/i;
479      }      }
480      return $self->do_err('No table name specified!') unless $table_name;      return $self->do_err('No table name specified!') unless $table_name;
481      return $self->do_err('Missing values list!') unless $val_str;      return $self->do_err('Missing values list!') unless defined $val_str;
482      return undef unless $self->TABLE_NAME($table_name);      return undef unless $self->TABLE_NAME($table_name);
483      $self->{"struct"}->{"command"} = 'INSERT';      $self->{"struct"}->{"command"} = 'INSERT';
484      $self->{"struct"}->{"table_names"} = [$table_name];      $self->{"struct"}->{"table_names"} = [$table_name];
# Line 510  sub CREATE { Line 533  sub CREATE {
533      my $self = shift;      my $self = shift;
534      my $stmt = shift;      my $stmt = shift;
535      $self->{"struct"}->{"command"} = 'CREATE';      $self->{"struct"}->{"command"} = 'CREATE';
536      my($table_name,$table_element_def);      my($table_name,$table_element_def,%is_col_name);
537      if ($stmt =~ /^CREATE (LOCAL|GLOBAL) TEMPORARY TABLE(.*)$/si ) {      if ($stmt =~ /^CREATE (LOCAL|GLOBAL) TEMPORARY TABLE(.*)$/si ) {
538          $self->{"struct"}->{"table_type"} = "$1 TEMPORARY";          $self->{"struct"}->{"table_type"} = "$1 TEMPORARY";
539          $stmt = "CREATE TABLE$2";          $stmt = "CREATE TABLE$2";
# Line 531  sub CREATE { Line 554  sub CREATE {
554      else {      else {
555          return $self->do_err( "Can't find column definitions!" );          return $self->do_err( "Can't find column definitions!" );
556      }      }
557        return undef unless $self->TABLE_NAME($table_name);
558      $table_element_def =~ s/\s+\(/(/g;      $table_element_def =~ s/\s+\(/(/g;
559      my $primary_defined;      my $primary_defined;
560      for my $col(split ',',$table_element_def) {      for my $col(split ',',$table_element_def) {
# Line 552  sub CREATE { Line 576  sub CREATE {
576             for my $constr(@c) {             for my $constr(@c) {
577                 if ( $constr =~ /^\s*(UNIQUE|NOT_NULL|PRIMARY_KEY)\s*$/i ) {                 if ( $constr =~ /^\s*(UNIQUE|NOT_NULL|PRIMARY_KEY)\s*$/i ) {
578                     my $cur_c = uc $1;                     my $cur_c = uc $1;
579                     if ($has_c{$cur_c}) {                     if ($has_c{$cur_c}++) {
580                         return $self->do_err(                         return $self->do_err(
581                             qq~Duplicate constraint: '$constr'!~                             qq~Duplicate column constraint: '$constr'!~
582                         );                         );
583                     }                     }
584                     if ($cur_c eq 'PRIMARY_KEY' and $primary_defined++ ) {                     if ($cur_c eq 'PRIMARY_KEY' and $primary_defined++ ) {
585                         return $self->do_err(                         return $self->do_err(
586                             qq~There can be only one PRIMARY KEY in a table!~                             qq~Can't have two PRIMARY KEYs in a table!~
587                          );                          );
588                     }                     }
589                     $constr =~ s/_/ /g;                     $constr =~ s/_/ /g;
# Line 567  sub CREATE { Line 591  sub CREATE {
591    
592                 }                 }
593                 else {                 else {
594                     return $self->do_err("Bad column constraint: '$constr'!");                     return $self->do_err("Unknown column constraint: '$constr'!");
595                 }                 }
596             }             }
597          }          }
# Line 583  sub CREATE { Line 607  sub CREATE {
607          $self->{"struct"}->{"column_defs"}->{"$name"}->{"data_type"} = $type;          $self->{"struct"}->{"column_defs"}->{"$name"}->{"data_type"} = $type;
608          $self->{"struct"}->{"column_defs"}->{"$name"}->{"data_length"} = $length;          $self->{"struct"}->{"column_defs"}->{"$name"}->{"data_length"} = $length;
609          push @{$self->{"struct"}->{"column_names"}},$name;          push @{$self->{"struct"}->{"column_names"}},$name;
610            my $tmpname = $name;
611            $tmpname = uc $tmpname unless $tmpname =~ /^"/;
612            return $self->do_err("Duplicate column names!")
613              if $is_col_name{$tmpname}++;
614    
615      }      }
616      $self->{"struct"}->{"table_names"} = [$table_name];      $self->{"struct"}->{"table_names"} = [$table_name];
# Line 601  sub SET_CLAUSE_LIST { Line 629  sub SET_CLAUSE_LIST {
629      my(@cols,@vals);      my(@cols,@vals);
630      for(@sets) {      for(@sets) {
631          my($col,$val) = split / = /,$_;          my($col,$val) = split / = /,$_;
632          return $self->do_err('Incomplete SET clause!') if !$col or !$val;          return $self->do_err('Incomplete SET clause!') if !defined $col or !defined $val;
633          push @cols, $col;          push @cols, $col;
634          push @vals, $val;          push @vals, $val;
635      }      }
# Line 636  sub SELECT_LIST { Line 664  sub SELECT_LIST {
664      $col =~ s/^\s+//;      $col =~ s/^\s+//;
665      $col =~ s/\s+$//;      $col =~ s/\s+$//;
666          if ($col =~ /^(\S+)\.\*$/) {          if ($col =~ /^(\S+)\.\*$/) {
667              my $table = $1;          my $table = $1;
668            my %is_table_alias = %{$self->{"tmp"}->{"is_table_alias"}};
669            $table = $is_table_alias{$table} if $is_table_alias{$table};
670            $table = $is_table_alias{"\L$table"} if $is_table_alias{"\L$table"};
671    #        $table = uc $table unless $table =~ /^"/;
672    #use mylibs; zwarn \%is_table_alias;
673    #print "\n<<$table>>\n";
674              return undef unless $self->TABLE_NAME($table);              return undef unless $self->TABLE_NAME($table);
675              $table = $self->replace_quoted_ids($table);              $table = $self->replace_quoted_ids($table);
676              push @newcols, "$table.*";              push @newcols, "$table.*";
# Line 661  sub SET_FUNCTION_SPEC { Line 695  sub SET_FUNCTION_SPEC {
695              my $distinct;              my $distinct;
696              if ( $set_function_arg =~ s/(DISTINCT|ALL) (.+)$/$2/i ) {              if ( $set_function_arg =~ s/(DISTINCT|ALL) (.+)$/$2/i ) {
697                  $distinct = uc $1;                  $distinct = uc $1;
698                    $self->{"struct"}->{"set_quantifier"} = $distinct;
699              }              }
700              my $count_star = 1 if $set_function_name eq 'COUNT'              my $count_star = 1 if $set_function_name eq 'COUNT'
701                                and $set_function_arg eq '*';                                and $set_function_arg eq '*';
# Line 986  sub group_ands{ Line 1021  sub group_ands{
1021  # replaces string function parens with square brackets  # replaces string function parens with square brackets
1022  # e.g TRIM (foo) -> TRIM[foo]  # e.g TRIM (foo) -> TRIM[foo]
1023  #  #
1024    
1025  sub nongroup_string {  sub nongroup_string {
1026        my $f= FUNCTION_NAMES;
1027      my $str = shift;      my $str = shift;
1028      $str =~ s/(TRIM|SUBSTRING|UPPER|LOWER) \(([^()]+)\)/$1\[$2\]/gi;  #    $str =~ s/(TRIM|SUBSTRING|UPPER|LOWER) \(([^()]+)\)/$1\[$2\]/gi;
1029      if ( $str =~ /(TRIM|SUBSTRING|UPPER|LOWER) \(/i ) {      $str =~ s/($f) \(([^()]+)\)/$1\[$2\]/gi;
1030    #    if ( $str =~ /(TRIM|SUBSTRING|UPPER|LOWER) \(/i ) {
1031        if ( $str =~ /($f) \(/i ) {
1032          return nongroup_string($str);          return nongroup_string($str);
1033      }      }
1034      else {      else {
# Line 1126  sub PREDICATE { Line 1165  sub PREDICATE {
1165    
1166  sub undo_string_funcs {  sub undo_string_funcs {
1167      my $str = shift;      my $str = shift;
1168      $str =~ s/(TRIM|UPPER|LOWER|SUBSTRING)\[([^\]\[]+?)\]/$1 ($2)/;      my $f= FUNCTION_NAMES;
1169      if ($str =~ /(TRIM|UPPER|LOWER|SUBSTRING)\[/) {  #    $str =~ s/(TRIM|UPPER|LOWER|SUBSTRING)\[([^\]\[]+?)\]/$1 ($2)/;
1170    #    if ($str =~ /(TRIM|UPPER|LOWER|SUBSTRING)\[/) {
1171        $str =~ s/($f)\[([^\]\[]+?)\]/$1 ($2)/;
1172        if ($str =~ /($f)\[/) {
1173          return undo_string_funcs($str);          return undo_string_funcs($str);
1174      }      }
1175      return $str;      return $str;
# Line 1208  sub ROW_VALUE { Line 1250  sub ROW_VALUE {
1250          };          };
1251      }      }
1252    
1253        # TO_CHAR (value)
1254        #
1255        if ($str =~ /^TO_CHAR \((.+)\)\s*$/i ) {
1256            my $name  = 'TO_CHAR';
1257            my $value = $self->ROW_VALUE($1);
1258            return undef unless $value;
1259            return {
1260                type  => 'function',
1261                name  => $name,
1262                value => $value,
1263            };
1264        }
1265    
1266      # UPPER (value) and LOWER (value)      # UPPER (value) and LOWER (value)
1267      #      #
# Line 1365  sub COLUMN_NAME { Line 1419  sub COLUMN_NAME {
1419      $col_name =~ s/\s+$//;      $col_name =~ s/\s+$//;
1420      return undef unless $col_name eq '*' or $self->IDENTIFIER($col_name);      return undef unless $col_name eq '*' or $self->IDENTIFIER($col_name);
1421  #  #
1422  # MAKE COL NAMES ALL LOWER CASE  # MAKE COL NAMES ALL UPPER CASE
1423      my $orgcol = $col_name;      my $orgcol = $col_name;
1424      if ($col_name =~ /^\?QI(\d+)\?$/) {      if ($col_name =~ /^\?QI(\d+)\?$/) {
1425          $col_name = $self->replace_quoted_ids($col_name);          $col_name = $self->replace_quoted_ids($col_name);
# Line 1379  sub COLUMN_NAME { Line 1433  sub COLUMN_NAME {
1433  #  #
1434      if ($table_name) {      if ($table_name) {
1435         my $alias = $self->{tmp}->{is_table_alias}->{"\L$table_name"};         my $alias = $self->{tmp}->{is_table_alias}->{"\L$table_name"};
1436  #use mylibs; print "$table_name"; zwarn $self->{tmp}; exit;  #use mylibs; print "$table_name"; zwarn $self->{tmp};
1437         $table_name = $alias if defined $alias;         $table_name = $alias if defined $alias;
1438  $table_name = uc $table_name;  $table_name = uc $table_name;
1439         $col_name = "$table_name.$col_name";         $col_name = "$table_name.$col_name";
1440    #print "<<$col_name>>";
1441      }      }
1442      return $col_name;      return $col_name;
1443  }  }
# Line 1484  sub TABLE_NAME { Line 1539  sub TABLE_NAME {
1539      if (!$table_name) {      if (!$table_name) {
1540          return $self->do_err('No table name specified!');          return $self->do_err('No table name specified!');
1541      }      }
1542      return undef if !($self->IDENTIFIER($table_name));      return $self->IDENTIFIER($table_name);
1543      return 1;  #    return undef if !($self->IDENTIFIER($table_name));
1544    #    return 1;
1545  }  }
1546    
1547    
# Line 1502  sub IDENTIFIER { Line 1558  sub IDENTIFIER {
1558      }      }
1559      return 1 if $id =~ /^".+?"$/s; # QUOTED IDENTIFIER      return 1 if $id =~ /^".+?"$/s; # QUOTED IDENTIFIER
1560      my $err  = "Bad table or column name '$id' ";        # BAD CHARS      my $err  = "Bad table or column name '$id' ";        # BAD CHARS
1561      if ($id !~ /\w|\./) {      if ($id =~ /\W/) {
1562          $err .= "has chars not alphanumeric or underscore!";          $err .= "has chars not alphanumeric or underscore!";
1563          return $self->do_err( $err );          return $self->do_err( $err );
1564      }      }
# Line 1514  sub IDENTIFIER { Line 1570  sub IDENTIFIER {
1570          $err .= "contains more than 128 characters!";          $err .= "contains more than 128 characters!";
1571          return $self->do_err( $err );          return $self->do_err( $err );
1572      }      }
1573      if ( $self->{"opts"}->{"reserved_words"}->{"$id"} ) {   # BAD RESERVED WORDS  $id = uc $id;
1574    #print "<$id>";
1575    #use mylibs; zwarn $self->{opts}->{reserved_words};
1576    #exit;
1577        if ( $self->{"opts"}->{"reserved_words"}->{$id} ) {   # BAD RESERVED WORDS
1578          $err .= "is a SQL reserved word!";          $err .= "is a SQL reserved word!";
1579          return $self->do_err( $err );          return $self->do_err( $err );
1580      }      }
# Line 1705  sub do_err { Line 1765  sub do_err {
1765      $self->{"struct"}->{"errstr"} = $err;      $self->{"struct"}->{"errstr"} = $err;
1766      #$self->{"errstr"} = $err;      #$self->{"errstr"} = $err;
1767      warn $err if $self->{"PrintError"};      warn $err if $self->{"PrintError"};
1768      die if $self->{"RaiseError"};      die $err if $self->{"RaiseError"};
1769      return undef;      return undef;
1770  }  }
1771    
# Line 1713  sub do_err { Line 1773  sub do_err {
1773    
1774  __END__  __END__
1775    
1776    =pod
1777    
1778  =head1 NAME  =head1 NAME
1779    
# Line 1775  this is what is supported: Line 1836  this is what is supported:
1836    
1837   CREATE [ {LOCAL|GLOBAL} TEMPORARY ] TABLE $table   CREATE [ {LOCAL|GLOBAL} TEMPORARY ] TABLE $table
1838          (          (
1839             $col_1 $col_type1 $col_constraints1,             $col_1 $col_type1 $col_constraints1,
1840             ...,             ...,
1841             $col_N $col_typeN $col_constraintsN,             $col_N $col_typeN $col_constraintsN,
1842          )          )
1843          [ ON COMMIT {DELETE|PRESERVE} ROWS ]          [ ON COMMIT {DELETE|PRESERVE} ROWS ]
1844    
# Line 1832  this is what is supported: Line 1893  this is what is supported:
1893    
1894        SELECT select_clause        SELECT select_clause
1895          FROM from_clause          FROM from_clause
1896       [ WHERE search_condition ]       [ WHERE search_condition ]
1897    [ ORDER BY $ocol1 [ASC|DESC], ... $ocolN [ASC|DESC] ]    [ ORDER BY $ocol1 [ASC|DESC], ... $ocolN [ASC|DESC] ]
1898       [ LIMIT [start,] length ]       [ LIMIT [start,] length ]
1899    
# Line 1849  this is what is supported: Line 1910  this is what is supported:
1910               table1 [, table2, ... tableN]               table1 [, table2, ... tableN]
1911             | table1 NATURAL [join_type] JOIN table2             | table1 NATURAL [join_type] JOIN table2
1912             | table1 [join_type] table2 USING (col1,col2, ... colN)             | table1 [join_type] table2 USING (col1,col2, ... colN)
1913             | table1 [join_type] JOIN table2 ON (table1.colA = table2.colB)             | table1 [join_type] JOIN table2 ON table1.colA = table2.colB
1914    
1915        * join type ::=        * join type ::=
1916               INNER               INNER
# Line 1863  this is what is supported: Line 1924  this is what is supported:
1924        * self-joins are not currently supported        * self-joins are not currently supported
1925        * if implicit joins are used, the WHERE clause must contain        * if implicit joins are used, the WHERE clause must contain
1926          and equijoin condition for each table          and equijoin condition for each table
1927              
1928    
1929  =head2 SEARCH CONDITION  =head2 SEARCH CONDITION
1930    
# Line 1872  this is what is supported: Line 1933  this is what is supported:
1933    
1934  =head2 OPERATORS  =head2 OPERATORS
1935    
1936         $op  = |  <> |  < | > | <= | >=         $op  = |  <> |  < | > | <= | >=
1937                | IS NULL | IS NOT NULL | LIKE | CLIKE | BETWEEN | IN                | IS NULL | IS NOT NULL | LIKE | CLIKE | BETWEEN | IN
1938    
1939    The "CLIKE" operator works exactly the same as the "LIKE"    The "CLIKE" operator works exactly the same as the "LIKE"
1940    operator, but is case insensitive.  For example:    operator, but is case insensitive.  For example:
1941    
1942        WHERE foo LIKE 'bar%'   # succeeds if foo is "barbaz"        WHERE foo LIKE 'bar%'   # succeeds if foo is "barbaz"
# Line 1908  both sides of a string. Line 1969  both sides of a string.
1969    
1970   Examples:   Examples:
1971    
1972   TRIM( string )   TRIM( string )
1973     trims leading and trailing spaces from string     trims leading and trailing spaces from string
1974    
1975   TRIM( LEADING FROM str )   TRIM( LEADING FROM str )
Legend:
Removed from v.1.2  
changed lines
  Added in v.1.3
MailToCvsAdmin">MailToCvsAdmin
 ViewVC Help
Powered by ViewVC 1.1.26 RSS 2.0 feed