home *** CD-ROM | disk | FTP | other *** search
/ PC Professionell 2004 December / PCpro_2004_12.ISO / files / webserver / xampp / xampp-perl-addon-1.4.9-installer.exe / Nano.pm < prev    next >
Encoding:
Perl POD Document  |  2004-03-09  |  24.1 KB  |  690 lines
  1. #######################################################################
  2. #
  3. #  DBI::SQL::Nano - a very tiny SQL engine
  4. #
  5. #  Copyright (c) 2004 by Jeff Zucker < jzucker AT cpan.org >
  6. #
  7. #  All rights reserved.
  8. #
  9. #  You may freely distribute and/or modify this  module under the terms
  10. #  of either the GNU  General Public License (GPL) or the Artistic License,
  11. #  as specified in the Perl README file.
  12. #
  13. #  See the pod at the bottom of this file for help information
  14. #
  15. #######################################################################
  16.  
  17. #######################
  18. package DBI::SQL::Nano;
  19. #######################
  20. use strict;
  21. use warnings;
  22. require DBI; # for looks_like_number()
  23. use vars qw( $VERSION $versions );
  24. BEGIN {
  25.     $VERSION = '0.01';
  26.     $versions->{nano_version} = $VERSION;
  27.     eval { require "SQL/Statement.pm" } unless $ENV{DBI_SQL_NANO};
  28.     if ($@ or $ENV{DBI_SQL_NANO}) {
  29.         @DBI::SQL::Nano::Statement::ISA = qw(DBI::SQL::Nano::Statement_);
  30.         @DBI::SQL::Nano::Table::ISA     = qw(DBI::SQL::Nano::Table_);
  31.     }
  32.     else {
  33.         @DBI::SQL::Nano::Statement::ISA = qw( SQL::Statement );
  34.         @DBI::SQL::Nano::Table::ISA     = qw( SQL::Eval::Table);
  35.         $versions->{statement_version}  = $SQL::Statement::VERSION;
  36.     }
  37. }
  38.  
  39. ###################################
  40. package DBI::SQL::Nano::Statement_;
  41. ###################################
  42.  
  43. sub new {
  44.     my($class,$sql) = @_;
  45.     my $self = {};
  46.     bless $self, $class;
  47.     return $self->prepare($sql);
  48. }
  49.  
  50. #####################################################################
  51. # PREPARE
  52. #####################################################################
  53. sub prepare {
  54.     my($self,$sql) = @_;
  55.     for ($sql) {
  56.         /^\s*CREATE\s+TABLE\s+(.*?)\s*\((.+)\)\s*$/is
  57.             &&do{
  58.                 $self->{command}      = 'CREATE';
  59.                 $self->{table_name}   = $1;
  60.                 $self->{column_names} = parse_coldef_list($2) if $2;
  61.                 die "Can't find columns!" unless $self->{column_names};
  62.             };
  63.         /^\s*DROP\s+TABLE\s+(IF\s+EXISTS\s+)?(.*?)\s*$/is
  64.             &&do{
  65.                 $self->{command}      = 'DROP';
  66.                 $self->{table_name}   = $2;
  67.                 $self->{ignore_missing_table} = 1 if $1;
  68.             };
  69.         /^\s*SELECT\s+(.*?)\s+FROM\s+(\S+)((.*))?/is
  70.             &&do{
  71.                 $self->{command}      = 'SELECT';
  72.                 $self->{column_names} = parse_comma_list($1) if $1;
  73.                 die "Can't find columns!\n" unless $self->{column_names};
  74.                 $self->{table_name}   = $2;
  75.                 if ( my $clauses = $4) {
  76.             if ($clauses =~ /^(.*)\s+ORDER\s+BY\s+(.*)$/is) {
  77.                         $clauses = $1;
  78.                         $self->{order_clause} = $self->parse_order_clause($2);
  79.             }
  80.                     $self->{where_clause}=$self->parse_where_clause($clauses)
  81.                         if $clauses;
  82.         }
  83.             };
  84.         /^\s*INSERT\s+INTO\s+(\S+)\s*(\((.*?)\))?\s*VALUES\s*\((.+)\)/is
  85.             &&do{
  86.                 $self->{command}      = 'INSERT';
  87.                 $self->{table_name}   = $1;
  88.                 $self->{column_names} = parse_comma_list($2) if $2;
  89.                 $self->{values}       = $self->parse_values_list($4) if $4;
  90.                 die "Can't parse values!\n" unless $self->{values};
  91.             };
  92.         /DELETE\s+FROM\s+(\S+)((.*))?/is
  93.             &&do{
  94.                 $self->{command}      = 'DELETE';
  95.                 $self->{table_name}   = $1;
  96.                 $self->{where_clause} = $self->parse_where_clause($3) if $3;
  97.             };
  98.         /UPDATE\s+(\S+)\s+SET\s+(.+)(\s+WHERE\s+.+)/is
  99.             &&do{
  100.                 $self->{command}      = 'UPDATE';
  101.                 $self->{table_name}   = $1;
  102.                 $self->parse_set_clause($2) if $2;
  103.                 $self->{where_clause} = $self->parse_where_clause($3) if $3;
  104.             };
  105.     }
  106.     die " Couldn't parse!\n  <$sql>\n" unless $self->{command}
  107.                                        and $self->{table_name};
  108.     return $self;
  109. }
  110. sub parse_order_clause {
  111.     my($self,$str) = @_;
  112.     my @clause = split /\s+/,$str;
  113.     return { $clause[0] => 'ASC' } if @clause == 1;
  114.     die "Bad ORDER BY clause '$str'!\n" if @clause > 2;
  115.     $clause[1] ||= '';
  116.     return { $clause[0] => uc $clause[1] } if $clause[1] =~ /^ASC$/i
  117.                                            or $clause[1] =~ /^DESC$/i;
  118.     die "Bad ORDER BY clause '$clause[1]'!\n";
  119. }
  120. sub parse_coldef_list  {                # check column definitions
  121.     my @col_defs;
  122.     for ( split',',shift ) {
  123.         my $col = clean_parse_str($_);
  124.         if ( $col =~ /^(\S+?)\s+.+/ ) { # doesn't check what it is
  125.             $col = $1;                  # just checks if it exists
  126.     }
  127.         else {
  128.          die "No column definition for '$_'!\n";
  129.     }
  130.         push @col_defs,$col;
  131.     }
  132.     return \@col_defs;
  133. }
  134. sub parse_comma_list  {[map{clean_parse_str($_)} split(',',shift)]}
  135. sub clean_parse_str { $_ = shift; s/\(//;s/\)//;s/^\s+//; s/\s+$//; $_; }
  136. sub parse_values_list {
  137.     my($self,$str) = @_;
  138.     [map{$self->parse_value(clean_parse_str($_))}split(',',$str)]
  139. }
  140. sub parse_set_clause {
  141.     my $self = shift;
  142.     my @cols = split /,/, shift;
  143.     my $set_clause;
  144.     for my $col(@cols) {
  145.         my($col_name,$value)= $col =~ /^\s*(.+?)\s*=\s*(.+?)\s*$/s;
  146.         push @{$self->{column_names}}, $col_name;
  147.         push @{$self->{values}}, $self->parse_value($value);
  148.     }
  149.     die "Can't parse set clause!\n"
  150.         unless $self->{column_names}
  151.            and $self->{values};
  152. }
  153. sub parse_value {
  154.     my($self,$str) = @_;
  155.     return undef unless defined $str;
  156.     if ($str =~ /^\?$/) {
  157.         push @{$self->{params}},'?';
  158.         return { value=>'?'  ,type=> 'placeholder' };
  159.     }
  160.     return { value=>undef,type=> 'NULL'   } if $str =~ /^NULL$/i;
  161.     return { value=>$1   ,type=> 'string' } if $str =~ /^'(.+)'$/s;
  162.     return { value=>$str ,type=> 'number' } if DBI::looks_like_number($str);
  163.     return { value=>$str ,type=> 'column' };
  164. }
  165. sub parse_where_clause {
  166.     my($self,$str) = @_;
  167.     $str =~ s/\s+$//;
  168.     if ($str =~ /^\s+WHERE\s+(.*)/i) {
  169.         $str = $1;
  170.     }
  171.     else {
  172.         die "Couldn't parse WHERE clause!!\n";
  173.     }
  174.     my($neg) = $str =~ s/^\s*(NOT)\s+//is;
  175.     my $opexp = '=|<>|<=|>=|<|>|LIKE|CLIKE|IS';
  176.     my($val1,$op,$val2) = $str =~ /(\S+?)\s*($opexp)\s*(\S+)/is;
  177.     die "Couldn't parse WHERE clause!\n"
  178.        unless defined $val1 and defined $op and defined $val2;
  179.     return {
  180.         arg1 => $self->parse_value($val1),
  181.         arg2 => $self->parse_value($val2),
  182.         op   => $op,
  183.         neg  => $neg,
  184.     }
  185. }
  186.  
  187. #####################################################################
  188. # EXECUTE
  189. #####################################################################
  190. sub execute {
  191.     my($self, $data, $params) = @_;
  192.     my $num_placeholders = $self->params;
  193.     my $num_params       = scalar @$params || 0;
  194.     die "Number of params '$num_params' does not match "
  195.       . "number of placeholders '$num_placeholders'!\n"
  196.       unless $num_placeholders == $num_params;
  197.     if (scalar @$params) {
  198.         for my $i(0..$#{$self->{values}}) {
  199.             if ($self->{values}->[$i]->{type} eq 'placeholder') {
  200.                 $self->{values}->[$i]->{value} = shift @$params;
  201.             }
  202.         }
  203.         if ($self->{where_clause}) {
  204.             if ($self->{where_clause}->{arg1}->{type} eq 'placeholder') {
  205.                 $self->{where_clause}->{arg1}->{value} = shift @$params;
  206.             }
  207.             if ($self->{where_clause}->{arg2}->{type} eq 'placeholder') {
  208.                 $self->{where_clause}->{arg2}->{value} = shift @$params;
  209.             }
  210.         }
  211.     }
  212.     my $command = $self->{command};
  213.     ( $self->{'NUM_OF_ROWS'},
  214.       $self->{'NUM_OF_FIELDS'},
  215.       $self->{'data'},
  216.     ) = $self->$command($data, $params);
  217.     $self->{NAME} ||= $self->{column_names};
  218.     $self->{'NUM_OF_ROWS'} || '0E0';
  219. }
  220. sub DROP ($$$) {
  221.     my($self, $data, $params) = @_;
  222.     my $table = $self->open_tables($data, 0, 0);
  223.     $table->drop($data);
  224.     (-1, 0);
  225. }
  226. sub CREATE ($$$) {
  227.     my($self, $data, $params) = @_;
  228.     my $table = $self->open_tables($data, 1, 1);
  229.     $table->push_names($data, $self->{column_names});
  230.     (0, 0);
  231. }
  232. sub INSERT ($$$) {
  233.     my($self, $data, $params) = @_;
  234.     my $table = $self->open_tables($data, 0, 1);
  235.     $self->verify_columns($table);
  236.     $table->seek($data, 0, 2);
  237.     my($array) = [];
  238.     my($val, $col, $i);
  239.     $self->{column_names}=$table->{col_names} unless $self->{column_names};
  240.     my $cNum = scalar(@{$self->{column_names}}) if $self->{column_names};
  241.     my $param_num = 0;
  242.     if ($cNum) {
  243.         for ($i = 0;  $i < $cNum;  $i++) {
  244.             $col = $self->{column_names}->[$i];
  245.             $array->[$self->column_nums($table,$col)] = $self->row_values($i);
  246.         }
  247.     } else {
  248.         die "Bad col names in INSERT";
  249.     }
  250.     $table->push_row($data, $array);
  251.     (1, 0);
  252. }
  253. sub DELETE ($$$) {
  254.     my($self, $data, $params) = @_;
  255.     my $table = $self->open_tables($data, 0, 1);
  256.     $self->verify_columns($table);
  257.     my($affected) = 0;
  258.     my(@rows, $array);
  259.     if ( $table->can('delete_one_row') ) {
  260.         while (my $array = $table->fetch_row($data)) {
  261.             if ($self->eval_where($table,$array)) {
  262.                 ++$affected;
  263.                 $array = $self->{fetched_value} if $self->{fetched_from_key};
  264.                 $table->delete_one_row($data,$array);
  265.                 return ($affected, 0) if $self->{fetched_from_key};
  266.             }
  267.         }
  268.         return ($affected, 0);
  269.     }
  270.     while ($array = $table->fetch_row($data)) {
  271.         if ($self->eval_where($table,$array)) {
  272.             ++$affected;
  273.         } else {
  274.             push(@rows, $array);
  275.         }
  276.     }
  277.     $table->seek($data, 0, 0);
  278.     foreach $array (@rows) {
  279.         $table->push_row($data, $array);
  280.     }
  281.     $table->truncate($data);
  282.     return ($affected, 0);
  283. }
  284. sub SELECT ($$$) {
  285.     my($self, $data, $params) = @_;
  286.     my $table = $self->open_tables($data, 0, 0);
  287.     $self->verify_columns($table);
  288.     my $tname = $self->{table_name};
  289.     my($affected) = 0;
  290.     my(@rows, $array, $val, $col, $i);
  291.     while ($array = $table->fetch_row($data)) {
  292.         if ($self->eval_where($table,$array)) {
  293.             $array = $self->{fetched_value} if $self->{fetched_from_key};
  294.             my $col_nums = $self->column_nums($table);
  295.             my %cols   = reverse %{ $col_nums };
  296.             my $rowhash;
  297.             for (sort keys %cols) {
  298.                 $rowhash->{$cols{$_}} = $array->[$_];
  299.             }
  300.             my @newarray;
  301.             for ($i = 0;  $i < @{$self->{column_names}};  $i++) {
  302.                $col = $self->{column_names}->[$i];
  303.                push @newarray,$rowhash->{$col};
  304.             }
  305.             push(@rows, \@newarray);
  306.             return (scalar(@rows),scalar @{$self->{column_names}},\@rows)
  307.              if $self->{fetched_from_key};
  308.         }
  309.     }
  310.     if ( $self->{order_clause} ) {
  311.         my( $sort_col, $desc ) = each %{$self->{order_clause}};
  312.         undef $desc unless $desc eq 'DESC';
  313.         my @sortCols = ( $self->column_nums($table,$sort_col,1) );
  314.         my($c, $d, $colNum);
  315.         my $sortFunc = sub {
  316.             my $result;
  317.             $i = 0;
  318.             do {
  319.                 $colNum = $sortCols[$i++];
  320.                 # $desc = $sortCols[$i++];
  321.                 $c = $a->[$colNum];
  322.                 $d = $b->[$colNum];
  323.                 if (!defined($c)) {
  324.                     $result = defined $d ? -1 : 0;
  325.                 } elsif (!defined($d)) {
  326.                     $result = 1;
  327.             } elsif ( DBI::looks_like_number($c,$d) ) {
  328.                     $result = ($c <=> $d);
  329.                 } else {
  330.               if ($self->{"case_fold"}) {
  331.                         $result = lc $c cmp lc $d || $c cmp $d;
  332.             }
  333.                     else {
  334.                         $result = $c cmp $d;
  335.             }
  336.                 }
  337.                 if ($desc) {
  338.                     $result = -$result;
  339.                 }
  340.             } while (!$result  &&  $i < @sortCols);
  341.             $result;
  342.         };
  343.         @rows = (sort $sortFunc @rows);
  344.     }
  345.     (scalar(@rows), scalar @{$self->{column_names}}, \@rows);
  346. }
  347. sub UPDATE ($$$) {
  348.     my($self, $data, $params) = @_;
  349.     my $table = $self->open_tables($data, 0, 1);
  350.     $self->verify_columns($table);
  351.     return undef unless $table;
  352.     my($affected) = 0;
  353.     my(@rows, $array, $f_array, $val, $col, $i);
  354.     while ($array = $table->fetch_row($data)) {
  355.         if ($self->eval_where($table,$array)) {
  356.             $array = $self->{fetched_value} if $self->{fetched_from_key}
  357.                                              and $table->can('update_one_row');
  358.             my $col_nums = $self->column_nums($table);
  359.             my %cols   = reverse %{ $col_nums };
  360.             my $rowhash;
  361.             for (sort keys %cols) {
  362.                 $rowhash->{$cols{$_}} = $array->[$_];
  363.             }
  364.             for ($i = 0;  $i < @{$self->{column_names}};  $i++) {
  365.                $col = $self->{column_names}->[$i];
  366.                $array->[$self->column_nums($table,$col)]=$self->row_values($i);
  367.             }
  368.             $affected++;
  369.             if ($self->{fetched_from_key}){
  370.                 $table->update_one_row($data,$array);
  371.                 return ($affected, 0);
  372.         }
  373.             push(@rows, $array);
  374.     }
  375.         else {
  376.             push(@rows, $array);
  377.         }
  378.     }
  379.     $table->seek($data, 0, 0);
  380.     foreach my $array (@rows) {
  381.         $table->push_row($data, $array);
  382.     }
  383.     $table->truncate($data);
  384.     ($affected, 0);
  385. }
  386. sub verify_columns {
  387.    my($self,$table) = @_;
  388.    my @cols = @{$self->{column_names}};
  389.    if ($self->{where_clause}) {
  390.       if (my $col = $self->{where_clause}->{arg1}) {
  391.           push @cols, $col->{value} if $col->{type} eq 'column';
  392.       }
  393.       if (my $col = $self->{where_clause}->{arg2}) {
  394.           push @cols, $col->{value} if $col->{type} eq 'column';
  395.       }
  396.    }
  397.    for (@cols) {
  398.        $self->column_nums($table,$_);
  399.    }
  400. }
  401. sub column_nums {
  402.     my($self,$table,$stmt_col_name,$find_in_stmt)=@_;
  403.     my %dbd_nums = %{ $table->{col_nums} };
  404.     my @dbd_cols = @{ $table->{col_names} };
  405.     my %stmt_nums;
  406.     if ($stmt_col_name and !$find_in_stmt) {
  407.         while(my($k,$v)=each %dbd_nums) {
  408.             return $v if uc $k eq uc $stmt_col_name;
  409.         }
  410.         die "No such column '$stmt_col_name'\n";
  411.     }
  412.     if ($stmt_col_name and $find_in_stmt) {
  413.         for my $i(0..@{$self->{column_names}}) {
  414.             return $i if uc $stmt_col_name eq uc $self->{column_names}->[$i];
  415.         }
  416.         die "No such column '$stmt_col_name'\n";
  417.     }
  418.     for my $i(0 .. $#dbd_cols) {
  419.         for my $stmt_col(@{$self->{column_names}}) {
  420.             $stmt_nums{$stmt_col} = $i if uc $dbd_cols[$i] eq uc $stmt_col;
  421.         }
  422.     }
  423.     return \%stmt_nums;
  424. }
  425. sub eval_where {
  426.     my $self   = shift;
  427.     my $table  = shift;
  428.     my $rowary = shift;
  429.     my $where = $self->{"where_clause"} || return 1;
  430.     my $col_nums = $table->{"col_nums"} ;
  431.     my %cols   = reverse %{ $col_nums };
  432.     my $rowhash;
  433.     for (sort keys %cols) {
  434.         $rowhash->{uc $cols{$_}} = $rowary->[$_];
  435.     }
  436.     return $self->process_predicate($where,$table,$rowhash);
  437. }
  438. sub process_predicate {
  439.     my($self,$pred,$table,$rowhash) = @_;
  440.     my $val1 = $pred->{arg1};
  441.     if ($val1->{type} eq 'column') {
  442.         $val1 = $rowhash->{ uc $val1->{value}};
  443.     }
  444.     else {
  445.         $val1 = $val1->{value};
  446.     }
  447.     my $val2 = $pred->{arg2};
  448.     if ($val2->{type}eq 'column') {
  449.         $val2 = $rowhash->{uc $val2->{value}};
  450.     }
  451.     else {
  452.         $val2 = $val2->{value};
  453.     }
  454.     my $op   = $pred->{op};
  455.     my $neg  = $pred->{neg};
  456.     my $match;
  457.     if ( $op eq '=' and !$neg and $table->can('fetch_one_row')
  458.        ) {
  459.         my $key_col = $table->fetch_one_row(1,1);
  460.         if ($pred->{arg1}->{value} =~ /^$key_col$/i) {
  461.             $self->{fetched_from_key}=1;
  462.             $self->{fetched_value} = $table->fetch_one_row(
  463.                 0,$pred->{arg2}->{value}
  464.             );
  465.             return 1;
  466.     }
  467.     }
  468.     $match = $self->is_matched($val1,$op,$val2) || 0;
  469.     if ($neg) { $match = $match ? 0 : 1; }
  470.     return $match;
  471. }
  472. sub is_matched {
  473.     my($self,$val1,$op,$val2)=@_;
  474.     if ($op eq 'IS') {
  475.         return 1 if (!defined $val1 or $val1 eq '');
  476.         return 0;
  477.     }
  478.     $val1 = '' unless defined $val1;
  479.     $val2 = '' unless defined $val2;
  480.     if ($op =~ /LIKE|CLIKE/i) {
  481.         $val2 = quotemeta($val2);
  482.         $val2 =~ s/\\%/.*/g;
  483.         $val2 =~ s/_/./g;
  484.     }
  485.     if ($op eq 'LIKE' )  { return $val1 =~ /^$val2$/s;  }
  486.     if ($op eq 'CLIKE' ) { return $val1 =~ /^$val2$/si; }
  487.     if ( DBI::looks_like_number($val1,$val2) ) {
  488.         if ($op eq '<'  ) { return $val1 <  $val2; }
  489.         if ($op eq '>'  ) { return $val1 >  $val2; }
  490.         if ($op eq '='  ) { return $val1 == $val2; }
  491.         if ($op eq '<>' ) { return $val1 != $val2; }
  492.         if ($op eq '<=' ) { return $val1 <= $val2; }
  493.         if ($op eq '>=' ) { return $val1 >= $val2; }
  494.     }
  495.     else {
  496.         if ($op eq '<'  ) { return $val1 lt $val2; }
  497.         if ($op eq '>'  ) { return $val1 gt $val2; }
  498.         if ($op eq '='  ) { return $val1 eq $val2; }
  499.         if ($op eq '<>' ) { return $val1 ne $val2; }
  500.         if ($op eq '<=' ) { return $val1 ge $val2; }
  501.         if ($op eq '>=' ) { return $val1 le $val2; }
  502.     }
  503. }
  504. sub params {
  505.     my $self = shift;
  506.     my $val_num = shift;
  507.     if (!$self->{"params"}) { return 0; }
  508.     if (defined $val_num) {
  509.         return $self->{"params"}->[$val_num];
  510.     }
  511.     if (wantarray) {
  512.         return @{$self->{"params"}};
  513.     }
  514.     else {
  515.         return scalar @{ $self->{"params"} };
  516.     }
  517.  
  518. }
  519. sub open_tables {
  520.     my($self, $data, $createMode, $lockMode) = @_;
  521.     my $table_name = $self->{table_name};
  522.     my $table;
  523.     eval{$table = $self->open_table($data,$table_name,$createMode,$lockMode)};
  524.     die $@ if $@;
  525.     die "Couldn't open table '$table_name'!" unless $table;
  526.     if (!$self->{column_names} or $self->{column_names}->[0] eq '*') {
  527.         $self->{column_names} = $table->{col_names};
  528.     }
  529.     return $table;
  530. }
  531. sub row_values {
  532.     my $self = shift;
  533.     my $val_num = shift;
  534.     if (!$self->{"values"}) { return 0; }
  535.     if (defined $val_num) {
  536.         return $self->{"values"}->[$val_num]->{value};
  537.     }
  538.     if (wantarray) {
  539.         return map{$_->{"value"} } @{$self->{"values"}};
  540.     }
  541.     else {
  542.         return scalar @{ $self->{"values"} };
  543.     }
  544. }
  545.  
  546. ###############################
  547. package DBI::SQL::Nano::Table_;
  548. ###############################
  549. sub new ($$) {
  550.     my($proto, $attr) = @_;
  551.     my($self) = { %$attr };
  552.     bless($self, (ref($proto) || $proto));
  553.     $self;
  554. }
  555.  
  556. 1;
  557. __END__
  558.  
  559. =pod
  560.  
  561. =head1 NAME
  562.  
  563. DBI::SQL::Nano - a very tiny SQL engine
  564.  
  565. =head1 SYNOPSIS
  566.  
  567.  BEGIN { $ENV{DBI_SQL_NANO}=1 } # forces use of Nano rather than SQL::Statement
  568.  use DBI::SQL::Nano;
  569.  use Data::Dumper;
  570.  my $stmt = DBI::SQL::Nano::Statement->new(
  571.      "SELECT bar,baz FROM foo WHERE qux = 1"
  572.  ) or die "Couldn't parse!";
  573.  print Dumper $stmt;
  574.  
  575. =head1 DESCRIPTION
  576.  
  577. DBI::SQL::Nano is meant as a *very* minimal SQL engine for use in situations where SQL::Statement is not available.  In most situations you are better off installing SQL::Statement although DBI::SQL::Nano may be faster for some very simple tasks.
  578.  
  579. DBI::SQL::Nano, like SQL::Statement is primarily intended to provide a SQL engine for use with some pure perl DBDs including DBD::DBM, DBD::CSV, DBD::AnyData, and DBD::Excel.  It isn't of much use in and of itself.  You can dump out the structure of a parsed SQL statement, but that's about it.
  580.  
  581. =head1 USAGE
  582.  
  583. =head2 Setting the DBI_SQL_NANO flag
  584.  
  585. By default, when a DBD uses DBI::SQL::Nano, the module will look to see if SQL::Statement is installed.  If it is, SQL::Statement objects are used.  If SQL::Statement is not available, DBI::SQL::Nano objects are used.
  586.  
  587. In some cases, you may wish to use DBI::SQL::Nano objects even if SQL::Statement is available.  To force usage of DBI::SQL::Nano objects regardless of the availability of SQL::Statement, set the environment variable DBI_SQL_NANO to 1.
  588.  
  589. You can set the environment variable in your shell prior to running your script (with SET or EXPORT or whatever), or else you can set it in your script by putting this at the top of the script:
  590.  
  591.  BEGIN { $ENV{DBI_SQL_NANO} = 1 }
  592.  
  593. =head2 Supported SQL syntax
  594.  
  595.  Here's a pseudo-BNF.  Square brackets [] indicate optional items;
  596.  Angle brackets <> indicate items defined elsewhere in the BNF.
  597.  
  598.   statement ::=
  599.       DROP TABLE [IF EXISTS] <table_name>
  600.     | CREATE TABLE <table_name> <col_def_list>
  601.     | INSERT INTO <table_name> [<insert_col_list>] VALUES <val_list>
  602.     | DELETE FROM <table_name> [<where_clause>]
  603.     | UPDATE <table_name> SET <set_clause> <where_clause>
  604.     | SELECT <select_col_list> FROM <table_name> [<where_clause>]
  605.                                                  [<order_clause>]
  606.  
  607.   the optional IF EXISTS clause ::=
  608.     * similar to MySQL - prevents errors when trying to drop
  609.       a table that doesn't exist
  610.  
  611.   identifiers ::=
  612.     * table and column names should be valid SQL identifiers
  613.     * especially avoid using spaces and commas in identifiers
  614.     * note: there is no error checking for invalid names, some
  615.       will be accepted, others will cause parse failures
  616.  
  617.   table_name ::=
  618.     * only one table (no multiple table operations)
  619.     * see identifier for valid table names
  620.  
  621.   col_def_list ::=
  622.     * a parens delimited, comma-separated list of column names
  623.     * see identifier for valid column names
  624.     * column types and column constraints may be included but are ignored
  625.       e.g. these are all the same:
  626.         (id,phrase)
  627.         (id INT, phrase VARCHAR(40))
  628.         (id INT PRIMARY KEY, phrase VARCHAR(40) NOT NULL)
  629.     * you are *strongly* advised to put in column types even though
  630.       they are ignored ... it increases portability
  631.  
  632.   insert_col_list ::=
  633.     * a parens delimited, comma-separated list of column names
  634.     * as in standard SQL, this is optional
  635.  
  636.   select_col_list ::=
  637.     * a comma-separated list of column names
  638.     * or an asterisk denoting all columns
  639.  
  640.   val_list ::=
  641.     * a parens delimited, comma-separated list of values which can be:
  642.        * placeholders (an unquoted question mark)
  643.        * numbers (unquoted numbers)
  644.        * column names (unquoted strings)
  645.        * nulls (unquoted word NULL)
  646.        * strings (delimited with single quote marks);
  647.        * note: leading and trailing percent mark (%) and underscore (_)
  648.          can be used as wildcards in quoted strings for use with
  649.          the LIKE and CLIKE operators
  650.        * note: escaped single quote marks within strings are not
  651.          supported, neither are embedded commas, use placeholders instead
  652.  
  653.   set_clause ::=
  654.     * a comma-separated list of column = value pairs
  655.     * see val_list for acceptable value formats
  656.  
  657.   where_clause ::=
  658.     * a single "column/value <op> column/value" predicate, optionally
  659.       preceded by "NOT"
  660.     * note: multiple predicates combined with ORs or ANDs are not supported
  661.     * see val_list for acceptable value formats
  662.     * op may be one of:
  663.          < > >= <= = <> LIKE CLIKE IS
  664.     * CLIKE is a case insensitive LIKE
  665.  
  666.   order_clause ::= column_name [ASC|DESC]
  667.     * a single column optional ORDER BY clause is supported
  668.     * as in standard SQL, if neither ASC (ascending) nor
  669.       DESC (descending) is specified, ASC becomes the default
  670.  
  671. =head1 ACKNOWLEDGEMENTS
  672.  
  673. Tim Bunce provided the original idea for this module, helped me out of the tangled trap of namespace, and provided help and advice all along the way.  Although I wrote it from the ground up, it is based on Jochen Weidmann's orignal design of SQL::Statement, so much of the credit for the API goes to him.
  674.  
  675. =head1 AUTHOR AND COPYRIGHT
  676.  
  677. This module is written and maintained by
  678.  
  679. Jeff Zucker < jzucker AT cpan.org >
  680.  
  681. Copyright (C) 2004 by Jeff Zucker, all rights reserved.
  682.  
  683. You may freely distribute and/or modify this module under the terms of either the GNU General Public License (GPL) or the Artistic License, as specified in
  684. the Perl README file.
  685.  
  686. =cut
  687.  
  688.  
  689.  
  690.