[ Index ]

PHP Cross Reference of Unnamed Project

title

Body

[close]

/se3-unattended/var/se3/unattended/install/linuxaux/opt/perl/lib/site_perl/5.10.0/i586-linux-thread-multi/DBI/SQL/ -> Nano.pm (source)

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


Generated: Tue Mar 17 22:47:18 2015 Cross-referenced by PHPXref 0.7.1