pkgsrc-Bugs archive
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index][Old Index]
pkg/39225: [PATCH] databases/p5-SQL-Parser
>Number: 39225
>Category: pkg
>Synopsis: [PATCH] databases/p5-SQL-Parser
>Confidential: no
>Severity: non-critical
>Priority: low
>Responsible: pkg-manager
>State: open
>Class: change-request
>Submitter-Id: net
>Arrival-Date: Sun Jul 27 22:50:00 +0000 2008
>Originator: Jens Rehsack
>Release: -
>Organization:
Bayer Business Services
>Environment:
AIX 5.3.0.0, RHEL4.5, FreeBSD7
>Description:
Patch: databases/p5-SQL-Parser
This patch solves 3 problems we discovered through our development using
p5-SQL-Parser. The CPAN maintainer has got the patches but seems have no time
to apply them.
>How-To-Repeat:
>Fix:
Index: distinfo
===================================================================
RCS file: /cvsroot/pkgsrc/databases/p5-SQL-Statement/distinfo,v
retrieving revision 1.9
diff -u -r1.9 distinfo
--- distinfo 23 Jul 2008 22:57:11 -0000 1.9
+++ distinfo 27 Jul 2008 22:03:18 -0000
@@ -4,3 +4,4 @@
RMD160 (SQL-Statement-1.15.tar.gz) = 684abd84e27969c57299c85fd2d80f80cfa8271b
Size (SQL-Statement-1.15.tar.gz) = 87237 bytes
SHA1 (patch-aa) = c8ff44669e45201262d042612fbce32bc430efbc
+SHA1 (patch-ab) = a4029237244c0bc729134d8ecebef57ce5fcc285
Index: patches/patch-ab
===================================================================
--- /dev/null 2008-07-27 22:04:41.000000000 +0000
+++ patches/patch-ab 2008-07-02 11:38:45.000000000 +0000
@@ -0,0 +1,380 @@
+--- lib/SQL/Statement.pm.orig 2008-07-02 13:32:43.000000000 +0200
++++ lib/SQL/Statement.pm 2008-07-02 13:34:00.000000000 +0200
+@@ -11,6 +11,7 @@
+ use SQL::Parser;
+ use SQL::Eval;
+ use SQL::Statement::RAM;
++use Data::Dumper;
+ use vars qw($VERSION $new_execute $numexp $s2pops $arg_num $dlm $warg_num
$HAS_DBI $DEBUG);
+ BEGIN {
+ eval { require 'Data/Dumper.pm'; $Data::Dumper::Indent=1};
+@@ -384,77 +385,100 @@
+ ($affected, 0);
+ }
+
+-sub UPDATE ($$$) {
+- my($self, $data, $params) = @_;
++sub UPDATE ($$$)
++{
++ my ( $self, $data, $params ) = @_;
++
+ my $valnum = $self->{num_val_placeholders};
+ my @val_params;
+- if ($valnum) {
+- @val_params = splice @$params, 0,$valnum;
+-# @$params = (@$params,@val_params);
++ @val_params = splice( @$params, 0, $valnum ) if $valnum;
++
++ my ( $eval, $all_cols ) = $self->open_tables( $data, 0, 1 );
++ return unless $eval;
+
+-# my @where_params = $params->[$valnum+1..scalar @$params-1];
+-# @$params = (@where_params,@val_params);
+- }
+- my($eval,$all_cols) = $self->open_tables($data, 0, 1);
+- return undef unless $eval;
+ $eval->params($params);
+- $self->verify_columns($data,$eval, $all_cols);
+- my($table) = $eval->table($self->tables(0)->name());
+- my $tname = $self->tables(0)->name();
+- my($affected) = 0;
+- my(@rows, $array, $f_array, $val, $col, $i);
+- while ($array = $table->fetch_row($data)) {
+- if ($self->eval_where($eval,$tname,$array)) {
+- if( $self->{fetched_from_key} and $table->can('update_one_row') ){
++ $self->verify_columns( $data, $eval, $all_cols );
++
++ my $table = $eval->table( $self->tables(0)->name() );
++ my $tname = $self->tables(0)->name();
++ my $affected = 0;
++
++ my @rows = ();
++ FETCH_ROW: while ( my $array = $table->fetch_row($data) )
++ {
++
++ if ( $self->eval_where( $eval, $tname, $array ) )
++ {
++ my @arrayOriginalValues = @$array;
++
++ if ( $self->{fetched_from_key} and $table->can('update_one_row') )
++ {
+ $array = $self->{fetched_value};
+ }
+- my $param_num =$arg_num;
+- my $col_nums = $eval->{"tables"}->{"$tname"}->{"col_nums"} ;
+- my $cols;
+- %$cols = reverse %{ $col_nums };
+- my $rowhash;
+- ####################################
+- # Dan Wright
+- ####################################
+- # for (keys %$cols) {
+- # $rowhash->{$cols->{$_}} = $array->[$_];
+- # }
+- while (my($name, $number) = each %$col_nums ) {
+- $rowhash->{$name} = $array->[$number];
+- }
+- ####################################
+
+- for ($i = 0; $i < $self->columns(); $i++) {
+- $col = $self->columns($i);
+- $val = $self->row_values($i);
+- if (ref($val) eq 'SQL::Statement::Param') {
+-# $val = $eval->param($val->num());
++ my $param_num = $SQL::Statement::arg_num;
++ my $col_nums = $eval->{tables}->{$tname}->{col_nums};
++ my $cols;
++ %$cols = reverse %{$col_nums};
++ my $rowhash;
++ while ( my ( $name, $number ) = each %$col_nums )
++ {
++ $rowhash->{$name} = $array->[$number];
++ }
++
++ for ( my $i = 0; $i < $self->columns(); $i++ )
++ {
++ my $col = $self->columns($i);
++ my $val = $self->row_values($i);
++
++ if ( ref($val) eq 'SQL::Statement::Param' )
++ {
+ $val = shift @val_params;
+ }
+- elsif ($val->{type} eq 'placeholder') {
+-# $val = $eval->param($param_num++);
++ elsif ( $val->{type} eq 'placeholder' )
++ {
+ $val = shift @val_params;
+- }
+- else {
+- $val = $self->get_row_value($val,$eval,$rowhash);
+- }
+- $array->[$table->column_num($col->name())] = $val;
++ }
++ else
++ {
++
++ # FIXME: Problem STATE=undef: is a bug in SQL::Statement;
here is the work-around
++ $val = $self->get_row_value( $val, $eval, $rowhash );
++ }
++ $array->[ $table->column_num( $col->name() ) ] = $val;
+ }
+ ++$affected;
++
++ # the following block is the most important enhancement to
SQL::Statement::UPDATE
++ if ( not( $self->{fetched_from_key} )
++ and $table->can('update_one_row') )
++ {
++ $table->update_one_row( $data, $array, \@arrayOriginalValues
);
++ next FETCH_ROW;
++ } # unless
++
++ } # if eval_where
++
++ if ( $self->{fetched_from_key} )
++ {
++ $table->update_one_row( $data, $array );
++ return ( $affected, 0 );
++ }
++ push( @rows, $array );
++ }
++
++ unless ( $table->can('update_one_row') )
++ {
++ $table->seek( $data, 0, 0 );
++ foreach my $array (@rows)
++ {
++ $table->push_row( $data, $array );
+ }
+- if ($self->{fetched_from_key}){
+- $table->update_one_row($data,$array);
+- return ($affected, 0);
+- }
+- push(@rows, $array);
+- }
+- $table->seek($data, 0, 0);
+- foreach $array (@rows) {
+- $table->push_row($data, $array);
+- }
+- $table->truncate($data);
+- ($affected, 0);
+-}
++ $table->truncate($data);
++ } # unless
++
++ return ( $affected, 0 );
++} # UPDATE
+
+ sub find_join_columns {
+ my $self = shift;
+@@ -609,26 +633,24 @@
+ $join_type = 'FULL' if $self->{"join"}->{"type"} =~ /FULL/;
+ my @colsA = @{$tableAobj->col_names};
+ my @colsB = @{$tableBobj->col_names};
+- my %iscolA = map { $_=>1} @colsA;
+- my %iscolB = map { $_=>1} @colsB;
+- my %isunqualA = map { $_=>1} @colsA;
++ my %isunqualA;
+ my %isunqualB = map { $_=>1} @colsB;
+ my @shared_cols;
+ my %is_shared;
+ my @tmpshared = @{ $self->{"join"}->{"shared_cols"} };
+- if ($share_type eq 'ON' and $join_type eq 'RIGHT') {
+- @tmpshared = reverse @tmpshared;
++ if ($share_type eq 'ON' ) {
++ @tmpshared = reverse @tmpshared if $join_type eq 'RIGHT';
+ }
+- if ($share_type eq 'USING') {
++ elsif ($share_type eq 'USING') {
+ for (@tmpshared) {
+ push @shared_cols, $tableA . $dlm . $_;
+ push @shared_cols, $tableB . $dlm . $_;
+ }
+ }
+- if ($share_type eq 'NATURAL') {
++ elsif ($share_type eq 'NATURAL') {
+ for my $c(@colsA) {
+ $c =~ s/^[^$dlm]+$dlm(.+)$/$1/ if $tableA eq "${dlm}tmp";
+- if ($iscolB{$c}) {
++ if ($isunqualB{$c}) {
+ push @shared_cols, $tableA . $dlm . $c;
+ push @shared_cols, $tableB . $dlm . $c;
+ }
+@@ -638,34 +660,47 @@
+ @all_cols = ( @all_cols, map { $tableB . $dlm . $_ } @colsB);
+ @all_cols = map { s/${dlm}tmp$dlm//; $_; } @all_cols;
+ if ($tableA eq "${dlm}tmp") {
++ %isunqualA = map { $_=>1} map { my ($t,$c) = $_ =~
/^([^$dlm]+)$dlm(.+)$/; $c } @colsA;
+ #@colsA = map {s/^[^_]+_(.+)$/$1/; $_; } @colsA;
+ }
+ else {
++ %isunqualA = map { $_=>1} @colsA;
+ @colsA = map { $tableA . $dlm . $_ } @colsA;
+ }
+ @colsB = map { $tableB . $dlm . $_ } @colsB;
+ my %isa;
+ my $i=0;
+- my $col_numsA = { map { $_=>$i++} @colsA };
++ my $col_numsA = { map { $_=>$i++} @colsA };
+ $i=0;
+ my $col_numsB = { map { $_=>$i++} @colsB };
+- %iscolA = map { $_=>1} @colsA;
+- %iscolB = map { $_=>1} @colsB;
++ my %iscolA = map { $_=>1} @colsA;
++ my %iscolB = map { $_=>1} @colsB;
++ my %whichqual = map { my ($t,$c) = $_ =~ /^([^$dlm]+)$dlm(.+)$/; $c => $_
} (@colsA, @colsB);
+ my @blankA = map {undef} @colsA;
+ my @blankB = map {undef} @colsB;
+ if ($share_type =~/^(ON|IMPLICIT)$/ ) {
+ while (@tmpshared) {
+ my $k1 = shift @tmpshared;
+ my $k2 = shift @tmpshared;
+- next unless ($iscolA{$k1} or $iscolB{$k1});
+- next unless ($iscolA{$k2} or $iscolB{$k2});
+- next if !$iscolB{$k1} and !$iscolB{$k2};
+- my($t,$c) = $k1 =~ /^([^$dlm]+)$dlm(.+)$/;
+- next if !$isunqualA{$c};
+- push @shared_cols, $k1 unless $is_shared{$k1}++;
+- ($t,$c) = $k2 =~ /^([^$dlm]+)$dlm(.+)$/;
+- next if !$isunqualB{$c};
+- push @shared_cols, $k2 if !$is_shared{$k2}++;
++ # if both keys are in one table, bail out - FIXME: errmsg?
++ next if( $isunqualA{$k1} && $isunqualA{$k2} );
++ next if( $isunqualB{$k1} && $isunqualB{$k2} );
++
++ $k1 = $whichqual{$k1} if( $whichqual{$k1} );
++ $k2 = $whichqual{$k2} if( $whichqual{$k2} );
++
++ push @shared_cols, $k1, $k2 if( $iscolA{$k1} && $iscolB{$k2} );
++ push @shared_cols, $k2, $k1 if( $iscolA{$k2} && $iscolB{$k1} );
++
++ #next unless ($iscolA{$k1} or $iscolB{$k1});
++ #next unless ($iscolA{$k2} or $iscolB{$k2});
++ #next if !$iscolB{$k1} and !$iscolB{$k2};
++ #my($t,$c) = $k1 =~ /^([^$dlm]+)$dlm(.+)$/;
++ #next if (!$isunqualA{$c}) && (!$isunqualA{$k1});
++ #push @shared_cols, $k1 unless $is_shared{$k1}++;
++ #($t,$c) = $k2 =~ /^([^$dlm]+)$dlm(.+)$/;
++ #next if (!$isunqualB{$c}) && (!$isunqualB{$k2});
++ #push @shared_cols, $k2 if !$is_shared{$k2}++;
+ }
+ }
+ %is_shared = map {$_=>1} @shared_cols;
+@@ -679,6 +714,7 @@
+ push @$posA, $col_numsA->{$f} if $iscolA{$f};
+ push @$posB, $col_numsB->{$f} if $iscolB{$f};
+ }
++
+ #use mylibs; zwarn $self->{join};
+ # CYCLE THROUGH TABLE B, CREATING A HASH OF ITS VALUES
+ #
+@@ -693,7 +729,7 @@
+ }
+ # CYCLE THROUGH TABLE A
+ #
+- my $joined_table;
++ my $joined_table = [];
+ my %visited;
+ while (my $arrayA = $tableAobj->fetch_row($data)) {
+ my $has_null_key = 0;
+@@ -967,7 +1003,7 @@
+ $result = defined $d ? -1 : 0;
+ } elsif (!defined($d)) {
+ $result = 1;
+- } elsif ( is_number($c,$d) ) {
++ } elsif ( is_number($c) && is_number($d) ) {
+ # } elsif ( $c =~ $numexp && $d =~ $numexp ) {
+ $result = ($c <=> $d);
+ } else {
+@@ -1201,24 +1237,18 @@
+ $a = '' unless defined $a;
+ $b = '' unless defined $b;
+ # return ($a =~ $numexp && $b =~ $numexp)
+- return ( is_number($a,$b) )
++ return ( is_number($a) && is_number($b) )
+ ? ($a <=> $b)
+ : ($a cmp $b);
+ }
+
+ sub eval_where {
+- my $self = shift;
+- my $eval = shift;
+- my $tname = shift;
+- my $rowary = shift;
+- my $funcs = shift || ();
++ my ( $self, $eval, $tname, $rowary ) = @_;
++ my $funcs = $_[4] || ();
+ $tname ||= $self->tables(0)->name();
+- my $cols;
+- my $col_nums;
+- $col_nums = $self->{join} ? $eval->{col_nums}
+- : $eval->{tables}->{$tname}->{col_nums} ;
++ my $col_nums = $self->{join} ? $eval->{col_nums}
++ : $eval->{tables}->{$tname}->{col_nums} ;
+
+- %$cols = reverse %{ $col_nums };
+ ####################################
+ # Dan Wright
+ ####################################
+@@ -1227,12 +1257,13 @@
+ $rowhash->{$name} = $rowary->[$number];
+ }
+ ####################################
+- my($f,$fval);
+- $rowhash->{$f} = $self->{func_vals}->{$f}
+- = $self->get_row_value( $fval, $eval, $rowhash )
+- while ( ($f,$fval) = each %$funcs);
++ #my($f,$fval);
++ while ( my ($f,$fval) = each %$funcs)
++ {
++ $rowhash->{$f} = $self->{func_vals}->{$f} = $self->get_row_value(
$fval, $eval, $rowhash );
++ }
+
+- my @truths;
++ #my @truths;
+ $arg_num=0; # set placeholder start
+ my $where = $self->{"where_clause"} || return 1;
+ my $match = $self->process_predicate ($where,$eval,$rowhash);
+@@ -1400,19 +1431,19 @@
+ ($op eq 'le') ||
+ ($op eq 'ge')
+ ));
+- return ($op eq 'LIKE' ) ? ($val1 =~ /^$val2$/s) :
++ return ($op eq '==') ? ($val1 == $val2) :
++ ($op eq '!=') ? ($val1 != $val2) :
++ ($op eq 'eq') ? ($val1 eq $val2) :
++ ($op eq 'ne') ? ($val1 ne $val2) :
++ ($op eq 'LIKE' ) ? ($val1 =~ /^$val2$/s) :
+ ($op eq 'CLIKE' ) ? ($val1 =~ /^$val2$/si) :
+ ($op eq 'RLIKE' ) ? ($val1 =~ /$val2/is) :
+ ($op eq '<' ) ? ($val1 < $val2) :
+ ($op eq '>' ) ? ($val1 > $val2) :
+- ($op eq '==') ? ($val1 == $val2) :
+- ($op eq '!=') ? ($val1 != $val2) :
+ ($op eq '<=') ? ($val1 <= $val2) :
+ ($op eq '>=') ? ($val1 >= $val2) :
+ ($op eq 'lt') ? ($val1 lt $val2) :
+ ($op eq 'gt') ? ($val1 gt $val2) :
+- ($op eq 'eq') ? ($val1 eq $val2) :
+- ($op eq 'ne') ? ($val1 ne $val2) :
+ ($op eq 'le') ? ($val1 le $val2) :
+ ($op eq 'ge') ? ($val1 ge $val2) :
+ 0;
+@@ -2243,6 +2274,8 @@
+ col_nums => $col_nums,
+ table => $table,
+ NAME => $name,
++ rowpos => 0,
++ maxrow => scalar @$table
+ };
+ return bless $self, $class;
+ }
+@@ -2259,7 +2292,7 @@
+ }
+ return $new_col
+ }
+-sub fetch_row { my $s=shift; return shift @{ $s->{"table"} } }
++sub fetch_row { my $s=shift; return undef if( $s->{rowpos} >= $s->{"maxrow"}
); return $s->{"table"}->[$s->{rowpos}++] }
+
+ package SQL::Statement::Order;
+
Home |
Main Index |
Thread Index |
Old Index