Below is the list of changes that have just been committed into a local
6.0 repository of acurtis. When acurtis does a push these changes
will be propagated to the main repository and, within 24 hours after the
push, to the public repository.
For information on how to access the public repository
see http://dev.mysql.com/doc/mysql/en/installing-source-tree.html
ChangeSet@stripped, 2008-02-14 22:28:31-08:00, acurtis@stripped +6 -0
test for simulated aggregate functions in perl
fix some perl parameter passing
mysql-test/r/plugin_psm_perl_group.result@stripped, 2008-02-14 22:28:28-08:00, acurtis@stripped +21 -0
New BitKeeper file ``mysql-test/r/plugin_psm_perl_group.result''
mysql-test/r/plugin_psm_perl_group.result@stripped, 2008-02-14 22:28:28-08:00, acurtis@stripped +0 -0
mysql-test/t/plugin_psm_perl_group-master.opt@stripped, 2008-02-14 22:28:28-08:00, acurtis@stripped +3 -0
New BitKeeper file ``mysql-test/t/plugin_psm_perl_group-master.opt''
mysql-test/t/plugin_psm_perl_group-master.opt@stripped, 2008-02-14 22:28:28-08:00, acurtis@stripped +0 -0
mysql-test/t/plugin_psm_perl_group.test@stripped, 2008-02-14 22:28:28-08:00, acurtis@stripped +26 -0
New BitKeeper file ``mysql-test/t/plugin_psm_perl_group.test''
mysql-test/t/plugin_psm_perl_group.test@stripped, 2008-02-14 22:28:28-08:00, acurtis@stripped +0 -0
plugin/perl_udf/MySQLUDF.pm@stripped, 2008-02-14 22:28:27-08:00, acurtis@stripped +17 -1
fix passing integers and double precision values as parameters to perl functions.
plugin/perl_udf/MyUDFExample.pm@stripped, 2008-02-14 22:28:27-08:00, acurtis@stripped +36 -0
new example for simulated aggregate perl functions
plugin/perl_udf/perl_udf.xs@stripped, 2008-02-14 22:28:28-08:00, acurtis@stripped +12 -0
new prototype for val_type() method
diff -Nrup a/mysql-test/r/plugin_psm_perl_group.result b/mysql-test/r/plugin_psm_perl_group.result
--- /dev/null Wed Dec 31 16:00:00 196900
+++ b/mysql-test/r/plugin_psm_perl_group.result 2008-02-14 22:28:28 -08:00
@@ -0,0 +1,21 @@
+CREATE TABLE t1 (grp INT, a DOUBLE);
+INSERT INTO t1 VALUES (1,1), (2,2), (2,3), (3,4), (3,5), (3,6);
+CREATE FUNCTION test.agg_result(value DOUBLE, grp INT) RETURNS CHAR(128)
+LANGUAGE Perl NO SQL
+EXTERNAL NAME 'MyUDFExample::testaggregate_result';
+CREATE FUNCTION test.agg_add(value DOUBLE, grp INT) RETURNS DOUBLE
+LANGUAGE Perl NO SQL
+EXTERNAL NAME 'MyUDFExample::testaggregate_add';
+SELECT COUNT(a),
+CAST(AVG(a) AS DECIMAL(7,3)) 'AVG',
+CAST(VARIANCE(a) AS DECIMAL(7,3)) 'VAR',
+CAST(STD(a) AS DECIMAL(7,3)) 'STD',
+test.agg_result(MAX(test.agg_add(a,grp)),grp) 'TEST'
+ FROM t1 GROUP BY grp;
+COUNT(a) AVG VAR STD TEST
+1 1.000 0.000 0.000 count=1 avg=1.000 var=0.000 std=0.000
+2 2.500 0.250 0.500 count=2 avg=2.500 var=0.250 std=0.500
+3 5.000 0.667 0.816 count=3 avg=5.000 var=0.667 std=0.816
+DROP FUNCTION test.agg_add;
+DROP FUNCTION test.agg_result;
+DROP TABLE t1;
diff -Nrup a/mysql-test/t/plugin_psm_perl_group-master.opt b/mysql-test/t/plugin_psm_perl_group-master.opt
--- /dev/null Wed Dec 31 16:00:00 196900
+++ b/mysql-test/t/plugin_psm_perl_group-master.opt 2008-02-14 22:28:28 -08:00
@@ -0,0 +1,3 @@
+$PSMPERL_PLUGIN_OPT
+--loose-plugin-load=perl=$PSMPERL_PLUGIN
+--loose-plugin-perl-module-path=$PSMPERL_PLUGIN_DIR
diff -Nrup a/mysql-test/t/plugin_psm_perl_group.test b/mysql-test/t/plugin_psm_perl_group.test
--- /dev/null Wed Dec 31 16:00:00 196900
+++ b/mysql-test/t/plugin_psm_perl_group.test 2008-02-14 22:28:28 -08:00
@@ -0,0 +1,26 @@
+--source include/have_psmperl_plugin.inc
+
+
+# Simple test for simulated aggregate functions
+#
+CREATE TABLE t1 (grp INT, a DOUBLE);
+INSERT INTO t1 VALUES (1,1), (2,2), (2,3), (3,4), (3,5), (3,6);
+
+CREATE FUNCTION test.agg_result(value DOUBLE, grp INT) RETURNS CHAR(128)
+ LANGUAGE Perl NO SQL
+ EXTERNAL NAME 'MyUDFExample::testaggregate_result';
+CREATE FUNCTION test.agg_add(value DOUBLE, grp INT) RETURNS DOUBLE
+ LANGUAGE Perl NO SQL
+ EXTERNAL NAME 'MyUDFExample::testaggregate_add';
+
+SELECT COUNT(a),
+ CAST(AVG(a) AS DECIMAL(7,3)) 'AVG',
+ CAST(VARIANCE(a) AS DECIMAL(7,3)) 'VAR',
+ CAST(STD(a) AS DECIMAL(7,3)) 'STD',
+ test.agg_result(MAX(test.agg_add(a,grp)),grp) 'TEST'
+ FROM t1 GROUP BY grp;
+
+DROP FUNCTION test.agg_add;
+DROP FUNCTION test.agg_result;
+
+DROP TABLE t1;
diff -Nrup a/plugin/perl_udf/MySQLUDF.pm b/plugin/perl_udf/MySQLUDF.pm
--- a/plugin/perl_udf/MySQLUDF.pm 2007-11-27 23:18:24 -08:00
+++ b/plugin/perl_udf/MySQLUDF.pm 2008-02-14 22:28:27 -08:00
@@ -94,7 +94,23 @@ sub get_args
for ($idx= 0; $idx < $arg_count; $idx++)
{
my $arg= undef;
- $arg= $context->val_string($idx) if !($context->val_null($idx));
+ if (!$context->val_null($idx))
+ {
+ my $type= $context->val_type($idx);
+ if (($type > 0 && $type < 4) ||
+ ($type > 6 && $type < 10))
+ {
+ $arg= $context->val_integer($idx);
+ }
+ elsif ($type > 3 && $type < 6)
+ {
+ $arg= $context->val_double($idx);
+ }
+ else
+ {
+ $arg= $context->val_string($idx);
+ }
+ }
push @values, $arg;
}
return @values;
diff -Nrup a/plugin/perl_udf/MyUDFExample.pm b/plugin/perl_udf/MyUDFExample.pm
--- a/plugin/perl_udf/MyUDFExample.pm 2007-11-27 16:18:15 -08:00
+++ b/plugin/perl_udf/MyUDFExample.pm 2008-02-14 22:28:27 -08:00
@@ -163,6 +163,42 @@ sub testmatrix($)
return \@resultset;
}
+
+our %testagg= ();
+
+sub testaggregate_add($$)
+{
+ my ($value, $group)= @_;
+ if (defined $value)
+ {
+ $testagg{$group}= {value=>0.0,value2=>0.0,count=>0}
+ if !defined $testagg{$group};
+
+ my $scalar= scalar $value;
+ $testagg{$group}{value}+= $scalar;
+ $testagg{$group}{value2}+= $scalar * $scalar;
+ $testagg{$group}{count}++;
+ }
+ return $value;
+}
+
+sub testaggregate_result($$)
+{
+ my ($value, $group)= @_;
+
+ print STDERR "foo\n";
+ return undef if !defined $testagg{$group};
+ my $count= $testagg{$group}{count};
+ my $avg= $testagg{$group}{value} / $count;
+ my $avg2= $testagg{$group}{value2} / $count;
+ my $var= $avg2 - ($avg * $avg);
+ my $std= sqrt $var;
+ undef $testagg{$group};
+ return sprintf("count=%d avg=%0.3f var=%0.3f std=%0.3f", $count, $avg, $var, $std);
+ #return "count=$count, avg=$avg, var=$var, std=$std";
+}
+
+
1;
__END__
# Below is stub documentation for your module. You'd better edit it!
diff -Nrup a/plugin/perl_udf/perl_udf.xs b/plugin/perl_udf/perl_udf.xs
--- a/plugin/perl_udf/perl_udf.xs 2008-01-07 05:04:34 -08:00
+++ b/plugin/perl_udf/perl_udf.xs 2008-02-14 22:28:28 -08:00
@@ -98,6 +98,15 @@ public:
{
return st_mysql_psmcontext::store_integer(idx, value, 0);
}
+
+ int val_type(int idx)
+ {
+ void *ptr;
+ int length, type;
+ if (st_mysql_psmcontext::field_ptr(idx, &type, &ptr, &length))
+ return -1;
+ return type;
+ }
};
@@ -648,6 +657,9 @@ MySQLCallback::val_integer( int idx )
double
MySQLCallback::val_double( int idx )
+
+int
+MySQLCallback::val_type( int idx )
int
MySQLCallback::row_field( const char *title, int type, int size=0, int precision=0 )
| Thread |
|---|
| • bk commit into 6.0 tree (acurtis:1.2528) | antony | 15 Feb |
