From: Pat Thoyts Date: Mon, 6 Sep 2010 20:38:08 +0000 (+0100) Subject: version 3.01 X-Git-Tag: v3.01 X-Git-Url: http://privyetmir.co.uk/gitweb.cgi?a=commitdiff_plain;h=073cfdebacadfa6e544e0ad1fb863a8bf8fb4c78;p=mysqltcl version 3.01 Signed-off-by: Pat Thoyts --- diff --git a/ChangeLog b/ChangeLog index 07ea312..a245629 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,10 @@ +Release 3.01 +-- bug in mysql::nextresult fixed +-- bug in man format doc fixed +-- new command mysql::encoding +-- new ssl connection options -sslkey -sslcert -sslca -sslcapath -sslciphers using of mysql_ssl_set +-- new command option mysq::info state +-- removed c-header installation section from Makefile.in Release 3.00 -- all comands are defined in ::mysql namespace -- commands are renamed after pattern mysqlconnect mysql::connect diff --git a/Makefile.in b/Makefile.in index 99cc7e7..99ce00d 100644 --- a/Makefile.in +++ b/Makefile.in @@ -196,7 +196,8 @@ libraries: doc: @echo "user manual doc is as nroff (man) file mysqltcl.n" -install: all install-binaries install-libraries install-doc +#install: all install-binaries install-libraries install-doc +install: all install-binaries install-doc install-binaries: binaries install-lib-binaries install-bin-binaries if test "x$(SHARED_BUILD)" = "x1"; then \ @@ -207,13 +208,14 @@ install-binaries: binaries install-lib-binaries install-bin-binaries # This rule installs platform-independent files, such as header files. #======================================================================== -install-libraries: libraries - @mkdir -p $(DESTDIR)$(includedir) - @echo "Installing header files in $(DESTDIR)$(includedir)" - @for i in $(GENERIC_HDRS) ; do \ - echo "Installing $$i" ; \ - $(INSTALL_DATA) $$i $(DESTDIR)$(includedir) ; \ - done; +# no headerfiles by mysqltcl +#install-libraries: libraries +# @mkdir -p $(DESTDIR)$(includedir) +# @echo "Installing header files in $(DESTDIR)$(includedir)" +# @for i in $(GENERIC_HDRS) ; do \ +# echo "Installing $$i" ; \ +# $(INSTALL_DATA) $$i $(DESTDIR)$(includedir) ; \ +# done; #======================================================================== # Install documentation. Unix manpages should go in the $(mandir) diff --git a/configure b/configure index e896fa8..04b0bb3 100755 --- a/configure +++ b/configure @@ -1313,7 +1313,7 @@ PACKAGE=mysqltcl MAJOR_VERSION=3 MINOR_VERSION=0 -PATCHLEVEL=0 +PATCHLEVEL=1 VERSION=${MAJOR_VERSION}.${MINOR_VERSION}${PATCHLEVEL} NODOT_VERSION=${MAJOR_VERSION}${MINOR_VERSION} @@ -8222,14 +8222,14 @@ echo "$as_me:$LINENO: checking for libmysqlclient lib" >&5 echo $ECHO_N "checking for libmysqlclient lib... $ECHO_C" >&6 if test "$tcl_ok" = "yes"; then if test ! -f ${MYSQL_LIB_DIR}/libmysqlclient.a ; then - { { echo "$as_me:$LINENO: error: Cannot find libmysqlclient.a in $MYSQL_LIB_DIR use -with-mysql-lib=?" >&5 -echo "$as_me: error: Cannot find libmysqlclient.a in $MYSQL_LIB_DIR use -with-mysql-lib=?" >&2;} + { { echo "$as_me:$LINENO: error: Cannot find libmysqlclient.a in $MYSQL_LIB_DIR use --with-mysql-lib=?" >&5 +echo "$as_me: error: Cannot find libmysqlclient.a in $MYSQL_LIB_DIR use --with-mysql-lib=?" >&2;} { (exit 1); exit 1; }; } fi else if test ! -f ${MYSQL_LIB_DIR}/libmysqlclient${SHLIB_SUFFIX} ; then - { { echo "$as_me:$LINENO: error: Cannot find libmysqlclient${SHLIB_SUFFIX} in $MYSQL_LIB_DIR use -with-mysql-lib=?" >&5 -echo "$as_me: error: Cannot find libmysqlclient${SHLIB_SUFFIX} in $MYSQL_LIB_DIR use -with-mysql-lib=?" >&2;} + { { echo "$as_me:$LINENO: error: Cannot find libmysqlclient${SHLIB_SUFFIX} in $MYSQL_LIB_DIR use --with-mysql-lib=?" >&5 +echo "$as_me: error: Cannot find libmysqlclient${SHLIB_SUFFIX} in $MYSQL_LIB_DIR use --with-mysql-lib=?" >&2;} { (exit 1); exit 1; }; } fi fi diff --git a/configure.in b/configure.in index 418208a..fc3668c 100755 --- a/configure.in +++ b/configure.in @@ -37,7 +37,7 @@ PACKAGE=mysqltcl MAJOR_VERSION=3 MINOR_VERSION=0 -PATCHLEVEL=0 +PATCHLEVEL=1 VERSION=${MAJOR_VERSION}.${MINOR_VERSION}${PATCHLEVEL} NODOT_VERSION=${MAJOR_VERSION}${MINOR_VERSION} @@ -222,11 +222,11 @@ AC_MSG_RESULT([yes]) AC_MSG_CHECKING([for libmysqlclient lib]) if test "$tcl_ok" = "yes"; then if test ! -f ${MYSQL_LIB_DIR}/libmysqlclient.a ; then - AC_MSG_ERROR(Cannot find libmysqlclient.a in $MYSQL_LIB_DIR use -with-mysql-lib=?) + AC_MSG_ERROR(Cannot find libmysqlclient.a in $MYSQL_LIB_DIR use --with-mysql-lib=?) fi else if test ! -f ${MYSQL_LIB_DIR}/libmysqlclient${SHLIB_SUFFIX} ; then - AC_MSG_ERROR(Cannot find libmysqlclient${SHLIB_SUFFIX} in $MYSQL_LIB_DIR use -with-mysql-lib=?) + AC_MSG_ERROR(Cannot find libmysqlclient${SHLIB_SUFFIX} in $MYSQL_LIB_DIR use --with-mysql-lib=?) fi fi AC_MSG_RESULT([yes]) diff --git a/doc/man.macros b/doc/man.macros new file mode 100644 index 0000000..ae66ef9 --- /dev/null +++ b/doc/man.macros @@ -0,0 +1,236 @@ +'\" The definitions below are for supplemental macros used in Tcl/Tk +'\" manual entries. +'\" +'\" .AP type name in/out ?indent? +'\" Start paragraph describing an argument to a library procedure. +'\" type is type of argument (int, etc.), in/out is either "in", "out", +'\" or "in/out" to describe whether procedure reads or modifies arg, +'\" and indent is equivalent to second arg of .IP (shouldn't ever be +'\" needed; use .AS below instead) +'\" +'\" .AS ?type? ?name? +'\" Give maximum sizes of arguments for setting tab stops. Type and +'\" name are examples of largest possible arguments that will be passed +'\" to .AP later. If args are omitted, default tab stops are used. +'\" +'\" .BS +'\" Start box enclosure. From here until next .BE, everything will be +'\" enclosed in one large box. +'\" +'\" .BE +'\" End of box enclosure. +'\" +'\" .CS +'\" Begin code excerpt. +'\" +'\" .CE +'\" End code excerpt. +'\" +'\" .VS ?version? ?br? +'\" Begin vertical sidebar, for use in marking newly-changed parts +'\" of man pages. The first argument is ignored and used for recording +'\" the version when the .VS was added, so that the sidebars can be +'\" found and removed when they reach a certain age. If another argument +'\" is present, then a line break is forced before starting the sidebar. +'\" +'\" .VE +'\" End of vertical sidebar. +'\" +'\" .DS +'\" Begin an indented unfilled display. +'\" +'\" .DE +'\" End of indented unfilled display. +'\" +'\" .SO +'\" Start of list of standard options for a Tk widget. The +'\" options follow on successive lines, in four columns separated +'\" by tabs. +'\" +'\" .SE +'\" End of list of standard options for a Tk widget. +'\" +'\" .OP cmdName dbName dbClass +'\" Start of description of a specific option. cmdName gives the +'\" option's name as specified in the class command, dbName gives +'\" the option's name in the option database, and dbClass gives +'\" the option's class in the option database. +'\" +'\" .UL arg1 arg2 +'\" Print arg1 underlined, then print arg2 normally. +'\" +'\" RCS: @(#) $Id$ +'\" +'\" # Set up traps and other miscellaneous stuff for Tcl/Tk man pages. +.if t .wh -1.3i ^B +.nr ^l \n(.l +.ad b +'\" # Start an argument description +.de AP +.ie !"\\$4"" .TP \\$4 +.el \{\ +. ie !"\\$2"" .TP \\n()Cu +. el .TP 15 +.\} +.ta \\n()Au \\n()Bu +.ie !"\\$3"" \{\ +\&\\$1 \\fI\\$2\\fP (\\$3) +.\".b +.\} +.el \{\ +.br +.ie !"\\$2"" \{\ +\&\\$1 \\fI\\$2\\fP +.\} +.el \{\ +\&\\fI\\$1\\fP +.\} +.\} +.. +'\" # define tabbing values for .AP +.de AS +.nr )A 10n +.if !"\\$1"" .nr )A \\w'\\$1'u+3n +.nr )B \\n()Au+15n +.\" +.if !"\\$2"" .nr )B \\w'\\$2'u+\\n()Au+3n +.nr )C \\n()Bu+\\w'(in/out)'u+2n +.. +.AS Tcl_Interp Tcl_CreateInterp in/out +'\" # BS - start boxed text +'\" # ^y = starting y location +'\" # ^b = 1 +.de BS +.br +.mk ^y +.nr ^b 1u +.if n .nf +.if n .ti 0 +.if n \l'\\n(.lu\(ul' +.if n .fi +.. +'\" # BE - end boxed text (draw box now) +.de BE +.nf +.ti 0 +.mk ^t +.ie n \l'\\n(^lu\(ul' +.el \{\ +.\" Draw four-sided box normally, but don't draw top of +.\" box if the box started on an earlier page. +.ie !\\n(^b-1 \{\ +\h'-1.5n'\L'|\\n(^yu-1v'\l'\\n(^lu+3n\(ul'\L'\\n(^tu+1v-\\n(^yu'\l'|0u-1.5n\(ul' +.\} +.el \}\ +\h'-1.5n'\L'|\\n(^yu-1v'\h'\\n(^lu+3n'\L'\\n(^tu+1v-\\n(^yu'\l'|0u-1.5n\(ul' +.\} +.\} +.fi +.br +.nr ^b 0 +.. +'\" # VS - start vertical sidebar +'\" # ^Y = starting y location +'\" # ^v = 1 (for troff; for nroff this doesn't matter) +.de VS +.if !"\\$2"" .br +.mk ^Y +.ie n 'mc \s12\(br\s0 +.el .nr ^v 1u +.. +'\" # VE - end of vertical sidebar +.de VE +.ie n 'mc +.el \{\ +.ev 2 +.nf +.ti 0 +.mk ^t +\h'|\\n(^lu+3n'\L'|\\n(^Yu-1v\(bv'\v'\\n(^tu+1v-\\n(^Yu'\h'-|\\n(^lu+3n' +.sp -1 +.fi +.ev +.\} +.nr ^v 0 +.. +'\" # Special macro to handle page bottom: finish off current +'\" # box/sidebar if in box/sidebar mode, then invoked standard +'\" # page bottom macro. +.de ^B +.ev 2 +'ti 0 +'nf +.mk ^t +.if \\n(^b \{\ +.\" Draw three-sided box if this is the box's first page, +.\" draw two sides but no top otherwise. +.ie !\\n(^b-1 \h'-1.5n'\L'|\\n(^yu-1v'\l'\\n(^lu+3n\(ul'\L'\\n(^tu+1v-\\n(^yu'\h'|0u'\c +.el \h'-1.5n'\L'|\\n(^yu-1v'\h'\\n(^lu+3n'\L'\\n(^tu+1v-\\n(^yu'\h'|0u'\c +.\} +.if \\n(^v \{\ +.nr ^x \\n(^tu+1v-\\n(^Yu +\kx\h'-\\nxu'\h'|\\n(^lu+3n'\ky\L'-\\n(^xu'\v'\\n(^xu'\h'|0u'\c +.\} +.bp +'fi +.ev +.if \\n(^b \{\ +.mk ^y +.nr ^b 2 +.\} +.if \\n(^v \{\ +.mk ^Y +.\} +.. +'\" # DS - begin display +.de DS +.RS +.nf +.sp +.. +'\" # DE - end display +.de DE +.fi +.RE +.sp +.. +'\" # SO - start of list of standard options +.de SO +.SH "STANDARD OPTIONS" +.LP +.nf +.ta 4c 8c 12c +.ft B +.. +'\" # SE - end of list of standard options +.de SE +.fi +.ft R +.LP +See the \\fBoptions\\fR manual entry for details on the standard options. +.. +'\" # OP - start of full description for a single option +.de OP +.LP +.nf +.ta 4c +Command-Line Name: \\fB\\$1\\fR +Database Name: \\fB\\$2\\fR +Database Class: \\fB\\$3\\fR +.fi +.IP +.. +'\" # CS - begin code excerpt +.de CS +.RS +.nf +.ta .25i .5i .75i 1i +.. +'\" # CE - end code excerpt +.de CE +.fi +.RE +.. +.de UL +\\$1\l'|0\(ul'\\$2 +.. diff --git a/doc/man.tcl b/doc/man.tcl index 0217e85..09dc12d 100644 --- a/doc/man.tcl +++ b/doc/man.tcl @@ -10,10 +10,16 @@ puts $file [dl format [read $filein]] close $filein close $file +set file [open man.macros r] +set manmacros [string trim [read $file]] +close $file + ::doctools::new dl2 -file mysqltcl.man -format nroff set file [open mysqltcl.n w] set filein [open mysqltcl.man] -puts $file [dl2 format [read $filein]] +set data [dl2 format [read $filein]] +set data [string map [list {.so man.macros} $manmacros] $data] +puts $file $data close $filein close $file diff --git a/doc/mysqltcl.html b/doc/mysqltcl.html index 380e3fb..4cc948b 100644 --- a/doc/mysqltcl.html +++ b/doc/mysqltcl.html @@ -65,6 +65,7 @@ package require mysqltcl 3.0
::mysql::newnull ::mysql::setserveroption handle option ::mysql::shutdown handle +::mysql::encoding handle ?encoding?

DESCRIPTION

@@ -138,10 +139,6 @@ special encoding that you want to use in your database. Consider what another sy database and what encoding they expect. It can useful to use -encoding utf-8. That is standard encoding in some linux distributions and newer systems. -

-

-ssl boolean
-Switch to SSL after handshake. Default is false -

-compress boolean
Use compression protocol. Default is false @@ -179,6 +176,35 @@ Allow interactive_timeout seconds (instead of wait_timeout seconds) of inactivit The client's session wait_timeout variable will be set to the value of the session interactive_timeout variable. Default is false. +

+
-ssl boolean
+Switch to SSL after handshake. Default is false + +

+
-sslkey string
+is the pathname to the key file. +Used if -ssl is true + +

+
-sslcert string
+is the pathname to the certificate file. +Used if -ssl is true + +

+
-sslca string
+is the pathname to the certificate authority file. +Used if -ssl is true + +

+
-sslcapath string
+is the pathname to a directory that contains trusted SSL CA certificates in pem format. +Used if -ssl is true + +

+
-sslcipher string
+is a list of allowable ciphers to use for SSL encryption. +Used if -ssl is true +
::mysql::use handle database
@@ -235,7 +261,7 @@ Example: {1 Joe 2 Phil 3 John}

-Note that both list syntaxes are faster than something like\fB +Note that both list syntaxes are faster than something like

 
 % ::mysql::sel $db "SELECT ID, NAME FROM FRIENDS"
@@ -293,12 +319,12 @@ freed with ::mysql::endquery query-hanlde command.
 

Example:

 
-set query1 [::mysql::query \$db {SELECT ID, NAME FROM FRIENDS}\]
-while {[set row [::mysql::fetch \$query1]]!=""} {
-    set id [lindex \$row 0]
-    set query2 [::mysql::query \$db "SELECT ADDRESS FROM ADDRESS WHERE FRIENDID=$ID"]
-    ::mysql::map \$query2 address { puts "address = $address" }
-    ::mysql::endquery \$query2
+set query1 [::mysql::query $db {SELECT ID, NAME FROM FRIENDS}\]
+while {[set row [::mysql::fetch $query1]]!=""} {
+    set id [lindex $row 0]
+    set query2 [::mysql::query $db "SELECT ADDRESS FROM ADDRESS WHERE FRIENDID=$ID"]
+    ::mysql::map $query2 address { puts "address = $address" }
+    ::mysql::endquery $query2
 }
 ::mysql::endquery $query1
 

@@ -356,17 +382,17 @@ The binding list variables retain their last values after the command has completed.

A simple example follows. -Assume $db is a handle in use.\fB +Assume $db is a handle in use.

 
-::mysql::sel \$db {
+::mysql::sel $db {
     select lname, fname, area, phone from friends order by lname, fname
 }
-::mysql::map \$db {ln fn - phone} {
-   if {\$phone == {}} continue
-   puts [format "%16s %-8s %s" \$ln \$fn \$phone]
+::mysql::map $db {ln fn - phone} {
+   if {$phone == {}} continue
+   puts [format "%16s %-8s %s" $ln $fn $phone]
 }
 

-The ::mysql::sel command gets and sorts all rows from table \fIfriends]. +The ::mysql::sel command gets and sorts all rows from table friends. The ::mysql::map command is used to format and print the result in a way suitable for a phone list. For demonstration purposes one of the columns (area) is not used. @@ -504,7 +530,7 @@ value for each column. The following is a sample interactive session containing all forms of the ::mysql::col command and their results. The last command uses the -current option. -It could alternatively specify the table name explicitly.\fB +It could alternatively specify the table name explicitly.

 
 %::mysql::col $db friends name
 name lname area phone
@@ -560,6 +586,29 @@ string if the handle is not valid.
 Return a list of all table names in the database with which the handle
 is associated.
 The handle must be in use.
+
+

+
serverversion
+Returns the version number of the server as a string. + +

+
serverversionid
+Returns the version number of the server as an integer. + +

+
sqlstate
+Returns a string containing the SQLSTATE error code for the last error. +The error code consists of five characters. '00000' means ``no error.'' +The values are specified by ANSI SQL and ODBC. + +Note that not all MySQL errors are yet mapped to SQLSTATE's. +The value 'HY000' (general error) is used for unmapped errors. + +

+
state
+Returns a character string containing information similar to that provided by the mysqladmin status command. +This includes uptime in seconds and the number of running threads, questions, reloads, and open tables. +
::mysql::baseinfo option
@@ -641,7 +690,7 @@ Return the number of rows that can be read sequentially from the current position in the pending result; an empty string if no result is pending.

-[::mysql::result \$db current] + [::mysql::result \$db rows] +[::mysql::result $db current] + [::mysql::result $db rows] always equals the total number of rows in the pending result. @@ -740,22 +789,22 @@ Returns the number of warnings generated during execution of the previous SQL st

::mysql::isnull value
-Null handling is known problem by Tcl to DB interfaces. -Mysql varchar type known 2 valid values NULL and empty string. -There is no way to difference it in core Tcl because of it strong string based -philosophy. +Null handling is a known problem with Tcl, especially with DB interaction. +The mysql "varchar" type has two valid blank values, NULL and an empty +string. This is where the problem arises; Tcl is not able to differentiate +between the two because of the way it handles strings. Mysql has new internal Tcl type for null that string representation is stored in global array mysqltcl(nullvalue) and as default empty string. mysql::isnull can be used for safe check for null value. Warning mysql::isnull works only reliable if there are no type conversation on returned rows. -Consider row is always Tcl list even when there are only on column in the row. +Consider row is always Tcl list even when there are only one column in the row.

 
-set row [::mysql::next \$handle]
-if {[mysql::isnull [lindex \$row 1]]} {
+set row [::mysql::next $handle]
+if {[mysql::isnull [lindex $row 1]]} {
    puts "2. column of $row is null"
 }
-if {[mysql::isnull \$row]} {
+if {[mysql::isnull $row]} {
    puts "this does not work, because of type conversation list to string"
 }
 

@@ -775,6 +824,12 @@ there are only 2 options now: -multi_statment_on and -multi_statment_off Asks the database server to shut down. The connected user must have SHUTDOWN privileges. +

+
::mysql::encoding handle ?encoding?
+ +Ask or change a encoding of connection. +There are special encoding "binary" for binary data transfers. +

STATUS INFORMATION

@@ -839,6 +894,7 @@ Paolo Brutti

  • Artur Trzewik (mail@xdobry.de) - active maintainer + MySQLTcl is derived from a patch of msql by Hakan Soderstrom, Soderstrom Programvaruverkstad, diff --git a/doc/mysqltcl.man b/doc/mysqltcl.man index bca7c6e..196a3d8 100644 --- a/doc/mysqltcl.man +++ b/doc/mysqltcl.man @@ -104,9 +104,6 @@ special encoding that you want to use in your database. Consider what another sy database and what encoding they expect. It can useful to use -encoding utf-8. That is standard encoding in some linux distributions and newer systems. -[opt_def -ssl [arg boolean]] -Switch to SSL after handshake. Default is false - [opt_def -compress [arg boolean]] Use compression protocol. Default is false @@ -136,6 +133,29 @@ Allow interactive_timeout seconds (instead of wait_timeout seconds) of inactivit The client's session wait_timeout variable will be set to the value of the session interactive_timeout variable. Default is false. +[opt_def -ssl [arg boolean]] +Switch to SSL after handshake. Default is false + +[opt_def -sslkey [arg string]] +is the pathname to the key file. +Used if -ssl is true + +[opt_def -sslcert [arg string]] +is the pathname to the certificate file. +Used if -ssl is true + +[opt_def -sslca [arg string]] +is the pathname to the certificate authority file. +Used if -ssl is true + +[opt_def -sslcapath [arg string]] +is the pathname to a directory that contains trusted SSL CA certificates in pem format. +Used if -ssl is true + +[opt_def -sslcipher [arg string]] +is a list of allowable ciphers to use for SSL encryption. +Used if -ssl is true + [list_end] [call [cmd ::mysql::use] [arg handle] [arg database]] @@ -187,7 +207,7 @@ Example: {1 Joe 2 Phil 3 John} [example_end] -Note that both list syntaxes are faster than something like\fB +Note that both list syntaxes are faster than something like [example_begin] % ::mysql::sel $db "SELECT ID, NAME FROM FRIENDS" @@ -239,12 +259,12 @@ freed with [emph "::mysql::endquery query-hanlde"] command. [nl] Example: [example_begin] -set query1 [lb]::mysql::query \$db {SELECT ID, NAME FROM FRIENDS}\[rb] -while {[lb]set row [lb]::mysql::fetch \$query1[rb][rb]!=""} { - set id [lb]lindex \$row 0[rb] - set query2 [lb]::mysql::query \$db "SELECT ADDRESS FROM ADDRESS WHERE FRIENDID=$ID"[rb] - ::mysql::map \$query2 address { puts "address = $address" } - ::mysql::endquery \$query2 +set query1 [lb]::mysql::query $db {SELECT ID, NAME FROM FRIENDS}\[rb] +while {[lb]set row [lb]::mysql::fetch $query1[rb][rb]!=""} { + set id [lb]lindex $row 0[rb] + set query2 [lb]::mysql::query $db "SELECT ADDRESS FROM ADDRESS WHERE FRIENDID=$ID"[rb] + ::mysql::map $query2 address { puts "address = $address" } + ::mysql::endquery $query2 } ::mysql::endquery $query1 [example_end] @@ -298,17 +318,17 @@ The binding list variables retain their last values after the command has completed. [nl] A simple example follows. -Assume $db is a handle in use.\fB +Assume $db is a handle in use. [example_begin] -::mysql::sel \$db { +::mysql::sel $db { select lname, fname, area, phone from friends order by lname, fname } -::mysql::map \$db {ln fn - phone} { - if {\$phone == {}} continue - puts [lb]format "%16s %-8s %s" \$ln \$fn \$phone[rb] +::mysql::map $db {ln fn - phone} { + if {$phone == {}} continue + puts [lb]format "%16s %-8s %s" $ln $fn $phone[rb] } [example_end] -The ::mysql::sel command gets and sorts all rows from table \fIfriends]. +The ::mysql::sel command gets and sorts all rows from table friends. The ::mysql::map command is used to format and print the result in a way suitable for a phone list. For demonstration purposes one of the columns (area) is not used. @@ -427,7 +447,7 @@ value for each column. The following is a sample interactive session containing all forms of the ::mysql::col command and their results. The last command uses the [emph -current] option. -It could alternatively specify the table name explicitly.\fB +It could alternatively specify the table name explicitly. [example_begin] %::mysql::col $db friends name name lname area phone @@ -474,6 +494,25 @@ string if the handle is not valid. Return a list of all table names in the database with which the handle is associated. The handle must be in use. + +[opt_def serverversion] +Returns the version number of the server as a string. + +[opt_def serverversionid] +Returns the version number of the server as an integer. + +[opt_def sqlstate] +Returns a string containing the SQLSTATE error code for the last error. +The error code consists of five characters. '00000' means ``no error.'' +The values are specified by ANSI SQL and ODBC. + +Note that not all MySQL errors are yet mapped to SQLSTATE's. +The value 'HY000' (general error) is used for unmapped errors. + +[opt_def state] +Returns a character string containing information similar to that provided by the mysqladmin status command. +This includes uptime in seconds and the number of running threads, questions, reloads, and open tables. + [list_end] [call [cmd ::mysql::baseinfo] [arg option]] @@ -541,7 +580,7 @@ Return the number of rows that can be read sequentially from the current position in the pending result; an empty string if no result is pending. [nl] -[lb]::mysql::result \$db current[rb] + [lb]::mysql::result \$db rows[rb] +[lb]::mysql::result $db current[rb] + [lb]::mysql::result $db rows[rb] always equals the total number of rows in the pending result. [list_end] @@ -615,10 +654,10 @@ Returns the number of warnings generated during execution of the previous SQL st [call [cmd ::mysql::isnull] [arg value]] -Null handling is known problem by Tcl to DB interfaces. -Mysql varchar type known 2 valid values NULL and empty string. -There is no way to difference it in core Tcl because of it strong string based -philosophy. +Null handling is a known problem with Tcl, especially with DB interaction. +The mysql "varchar" type has two valid blank values, NULL and an empty +string. This is where the problem arises; Tcl is not able to differentiate +between the two because of the way it handles strings. Mysql has new internal Tcl type for null that string representation is stored in global array mysqltcl(nullvalue) and as default empty string. mysql::isnull can be used for safe check for null value. @@ -626,11 +665,11 @@ Warning mysql::isnull works only reliable if there are no type conversation on returned rows. Consider row is always Tcl list even when there are only one column in the row. [example_begin] -set row [lb]::mysql::next \$handle[rb] -if {[lb]mysql::isnull [lb]lindex \$row 1[rb]]} { +set row [lb]::mysql::next $handle[rb] +if {[lb]mysql::isnull [lb]lindex $row 1[rb]]} { puts "2. column of $row is null" } -if {[lb]mysql::isnull \$row[rb]} { +if {[lb]mysql::isnull $row[rb]} { puts "this does not work, because of type conversation list to string" } [example_end] @@ -644,6 +683,10 @@ there are only 2 options now: -multi_statment_on and -multi_statment_off [call [cmd ::mysql::shutdown] [arg handle]] Asks the database server to shut down. The connected user must have SHUTDOWN privileges. +[call [cmd ::mysql::encoding] [arg handle] [opt encoding]] +Ask or change a encoding of connection. +There are special encoding "binary" for binary data transfers. + [list_end] [section "STATUS INFORMATION"] @@ -699,6 +742,7 @@ Tobias Ritzau Paolo Brutti [bullet] Artur Trzewik (mail@xdobry.de) - active maintainer + [list_end] MySQLTcl is derived from a patch of msql by Hakan Soderstrom, Soderstrom Programvaruverkstad, diff --git a/doc/mysqltcl.n b/doc/mysqltcl.n index b4d8b9e..45640f9 100644 --- a/doc/mysqltcl.n +++ b/doc/mysqltcl.n @@ -2,7 +2,242 @@ '\" Generated from file 'mysqltcl.man' by tcllib/doctools with format 'nroff' '\" '\" -*- tcl -*- mysqltcl manpage -.so man.macros +'\" The definitions below are for supplemental macros used in Tcl/Tk +'\" manual entries. +'\" +'\" .AP type name in/out ?indent? +'\" Start paragraph describing an argument to a library procedure. +'\" type is type of argument (int, etc.), in/out is either "in", "out", +'\" or "in/out" to describe whether procedure reads or modifies arg, +'\" and indent is equivalent to second arg of .IP (shouldn't ever be +'\" needed; use .AS below instead) +'\" +'\" .AS ?type? ?name? +'\" Give maximum sizes of arguments for setting tab stops. Type and +'\" name are examples of largest possible arguments that will be passed +'\" to .AP later. If args are omitted, default tab stops are used. +'\" +'\" .BS +'\" Start box enclosure. From here until next .BE, everything will be +'\" enclosed in one large box. +'\" +'\" .BE +'\" End of box enclosure. +'\" +'\" .CS +'\" Begin code excerpt. +'\" +'\" .CE +'\" End code excerpt. +'\" +'\" .VS ?version? ?br? +'\" Begin vertical sidebar, for use in marking newly-changed parts +'\" of man pages. The first argument is ignored and used for recording +'\" the version when the .VS was added, so that the sidebars can be +'\" found and removed when they reach a certain age. If another argument +'\" is present, then a line break is forced before starting the sidebar. +'\" +'\" .VE +'\" End of vertical sidebar. +'\" +'\" .DS +'\" Begin an indented unfilled display. +'\" +'\" .DE +'\" End of indented unfilled display. +'\" +'\" .SO +'\" Start of list of standard options for a Tk widget. The +'\" options follow on successive lines, in four columns separated +'\" by tabs. +'\" +'\" .SE +'\" End of list of standard options for a Tk widget. +'\" +'\" .OP cmdName dbName dbClass +'\" Start of description of a specific option. cmdName gives the +'\" option's name as specified in the class command, dbName gives +'\" the option's name in the option database, and dbClass gives +'\" the option's class in the option database. +'\" +'\" .UL arg1 arg2 +'\" Print arg1 underlined, then print arg2 normally. +'\" +'\" RCS: @(#) $Id$ +'\" +'\" # Set up traps and other miscellaneous stuff for Tcl/Tk man pages. +.if t .wh -1.3i ^B +.nr ^l \n(.l +.ad b +'\" # Start an argument description +.de AP +.ie !"\\$4"" .TP \\$4 +.el \{\ +. ie !"\\$2"" .TP \\n()Cu +. el .TP 15 +.\} +.ta \\n()Au \\n()Bu +.ie !"\\$3"" \{\ +\&\\$1 \\fI\\$2\\fP (\\$3) +.\".b +.\} +.el \{\ +.br +.ie !"\\$2"" \{\ +\&\\$1 \\fI\\$2\\fP +.\} +.el \{\ +\&\\fI\\$1\\fP +.\} +.\} +.. +'\" # define tabbing values for .AP +.de AS +.nr )A 10n +.if !"\\$1"" .nr )A \\w'\\$1'u+3n +.nr )B \\n()Au+15n +.\" +.if !"\\$2"" .nr )B \\w'\\$2'u+\\n()Au+3n +.nr )C \\n()Bu+\\w'(in/out)'u+2n +.. +.AS Tcl_Interp Tcl_CreateInterp in/out +'\" # BS - start boxed text +'\" # ^y = starting y location +'\" # ^b = 1 +.de BS +.br +.mk ^y +.nr ^b 1u +.if n .nf +.if n .ti 0 +.if n \l'\\n(.lu\(ul' +.if n .fi +.. +'\" # BE - end boxed text (draw box now) +.de BE +.nf +.ti 0 +.mk ^t +.ie n \l'\\n(^lu\(ul' +.el \{\ +.\" Draw four-sided box normally, but don't draw top of +.\" box if the box started on an earlier page. +.ie !\\n(^b-1 \{\ +\h'-1.5n'\L'|\\n(^yu-1v'\l'\\n(^lu+3n\(ul'\L'\\n(^tu+1v-\\n(^yu'\l'|0u-1.5n\(ul' +.\} +.el \}\ +\h'-1.5n'\L'|\\n(^yu-1v'\h'\\n(^lu+3n'\L'\\n(^tu+1v-\\n(^yu'\l'|0u-1.5n\(ul' +.\} +.\} +.fi +.br +.nr ^b 0 +.. +'\" # VS - start vertical sidebar +'\" # ^Y = starting y location +'\" # ^v = 1 (for troff; for nroff this doesn't matter) +.de VS +.if !"\\$2"" .br +.mk ^Y +.ie n 'mc \s12\(br\s0 +.el .nr ^v 1u +.. +'\" # VE - end of vertical sidebar +.de VE +.ie n 'mc +.el \{\ +.ev 2 +.nf +.ti 0 +.mk ^t +\h'|\\n(^lu+3n'\L'|\\n(^Yu-1v\(bv'\v'\\n(^tu+1v-\\n(^Yu'\h'-|\\n(^lu+3n' +.sp -1 +.fi +.ev +.\} +.nr ^v 0 +.. +'\" # Special macro to handle page bottom: finish off current +'\" # box/sidebar if in box/sidebar mode, then invoked standard +'\" # page bottom macro. +.de ^B +.ev 2 +'ti 0 +'nf +.mk ^t +.if \\n(^b \{\ +.\" Draw three-sided box if this is the box's first page, +.\" draw two sides but no top otherwise. +.ie !\\n(^b-1 \h'-1.5n'\L'|\\n(^yu-1v'\l'\\n(^lu+3n\(ul'\L'\\n(^tu+1v-\\n(^yu'\h'|0u'\c +.el \h'-1.5n'\L'|\\n(^yu-1v'\h'\\n(^lu+3n'\L'\\n(^tu+1v-\\n(^yu'\h'|0u'\c +.\} +.if \\n(^v \{\ +.nr ^x \\n(^tu+1v-\\n(^Yu +\kx\h'-\\nxu'\h'|\\n(^lu+3n'\ky\L'-\\n(^xu'\v'\\n(^xu'\h'|0u'\c +.\} +.bp +'fi +.ev +.if \\n(^b \{\ +.mk ^y +.nr ^b 2 +.\} +.if \\n(^v \{\ +.mk ^Y +.\} +.. +'\" # DS - begin display +.de DS +.RS +.nf +.sp +.. +'\" # DE - end display +.de DE +.fi +.RE +.sp +.. +'\" # SO - start of list of standard options +.de SO +.SH "STANDARD OPTIONS" +.LP +.nf +.ta 4c 8c 12c +.ft B +.. +'\" # SE - end of list of standard options +.de SE +.fi +.ft R +.LP +See the \\fBoptions\\fR manual entry for details on the standard options. +.. +'\" # OP - start of full description for a single option +.de OP +.LP +.nf +.ta 4c +Command-Line Name: \\fB\\$1\\fR +Database Name: \\fB\\$2\\fR +Database Class: \\fB\\$3\\fR +.fi +.IP +.. +'\" # CS - begin code excerpt +.de CS +.RS +.nf +.ta .25i .5i .75i 1i +.. +'\" # CE - end code excerpt +.de CE +.fi +.RE +.. +.de UL +\\$1\l'|0\(ul'\\$2 +.. .TH "mysqltcl" n 3.0 "" .BS .SH "NAME" @@ -113,6 +348,8 @@ package require \fBmysqltcl 3.0\fR .sp \fB::mysql::shutdown\fR \fIhandle\fR .sp +\fB::mysql::encoding\fR \fIhandle\fR ?encoding? +.sp .BE .SH "DESCRIPTION" MySQLTcl is a collection of Tcl commands and a Tcl global array that @@ -171,9 +408,6 @@ special encoding that you want to use in your database. Consider what another sy database and what encoding they expect. It can useful to use -encoding utf-8. That is standard encoding in some linux distributions and newer systems. .TP -\fB-ssl\fR \fIboolean\fR -Switch to SSL after handshake. Default is false -.TP \fB-compress\fR \fIboolean\fR Use compression protocol. Default is false .TP @@ -202,6 +436,29 @@ Default is false. Allow interactive_timeout seconds (instead of wait_timeout seconds) of inactivity before closing the connection. The client's session wait_timeout variable will be set to the value of the session interactive_timeout variable. Default is false. +.TP +\fB-ssl\fR \fIboolean\fR +Switch to SSL after handshake. Default is false +.TP +\fB-sslkey\fR \fIstring\fR +is the pathname to the key file. +Used if -ssl is true +.TP +\fB-sslcert\fR \fIstring\fR +is the pathname to the certificate file. +Used if -ssl is true +.TP +\fB-sslca\fR \fIstring\fR +is the pathname to the certificate authority file. +Used if -ssl is true +.TP +\fB-sslcapath\fR \fIstring\fR +is the pathname to a directory that contains trusted SSL CA certificates in pem format. +Used if -ssl is true +.TP +\fB-sslcipher\fR \fIstring\fR +is a list of allowable ciphers to use for SSL encryption. +Used if -ssl is true .RE .TP \fB::mysql::use\fR \fIhandle\fR \fIdatabase\fR @@ -246,7 +503,7 @@ Example: % ::mysql::sel $db "SELECT ID, NAME FROM FRIENDS" -flatlist {1 Joe 2 Phil 3 John} .fi -Note that both list syntaxes are faster than something like\\fB +Note that both list syntaxes are faster than something like .nf % ::mysql::sel $db "SELECT ID, NAME FROM FRIENDS" % ::mysql::map $db {id name} {lappend result $id $name} @@ -293,12 +550,12 @@ freed with \fI::mysql::endquery query-hanlde\fR command. .sp Example: .nf -set query1 [::mysql::query \\$db {SELECT ID, NAME FROM FRIENDS}\\] -while {[set row [::mysql::fetch \\$query1]]!=""} { - set id [lindex \\$row 0] - set query2 [::mysql::query \\$db "SELECT ADDRESS FROM ADDRESS WHERE FRIENDID=$ID"] - ::mysql::map \\$query2 address { puts "address = $address" } - ::mysql::endquery \\$query2 +set query1 [::mysql::query $db {SELECT ID, NAME FROM FRIENDS}\\] +while {[set row [::mysql::fetch $query1]]!=""} { + set id [lindex $row 0] + set query2 [::mysql::query $db "SELECT ADDRESS FROM ADDRESS WHERE FRIENDID=$ID"] + ::mysql::map $query2 address { puts "address = $address" } + ::mysql::endquery $query2 } ::mysql::endquery $query1 .fi @@ -349,17 +606,17 @@ The binding list variables retain their last values after the command has completed. .sp A simple example follows. -Assume $db is a handle in use.\\fB +Assume $db is a handle in use. .nf -::mysql::sel \\$db { +::mysql::sel $db { select lname, fname, area, phone from friends order by lname, fname } -::mysql::map \\$db {ln fn - phone} { - if {\\$phone == {}} continue - puts [format "%16s %-8s %s" \\$ln \\$fn \\$phone] +::mysql::map $db {ln fn - phone} { + if {$phone == {}} continue + puts [format "%16s %-8s %s" $ln $fn $phone] } .fi -The ::mysql::sel command gets and sorts all rows from table \\fIfriends]. +The ::mysql::sel command gets and sorts all rows from table friends. The ::mysql::map command is used to format and print the result in a way suitable for a phone list. For demonstration purposes one of the columns (area) is not used. @@ -475,7 +732,7 @@ value for each column. The following is a sample interactive session containing all forms of the ::mysql::col command and their results. The last command uses the \fI-current\fR option. -It could alternatively specify the table name explicitly.\\fB +It could alternatively specify the table name explicitly. .nf %::mysql::col $db friends name name lname area phone @@ -521,6 +778,23 @@ string if the handle is not valid. Return a list of all table names in the database with which the handle is associated. The handle must be in use. +.TP +\fBserverversion\fR +Returns the version number of the server as a string. +.TP +\fBserverversionid\fR +Returns the version number of the server as an integer. +.TP +\fBsqlstate\fR +Returns a string containing the SQLSTATE error code for the last error. +The error code consists of five characters. '00000' means ``no error.'' +The values are specified by ANSI SQL and ODBC. +Note that not all MySQL errors are yet mapped to SQLSTATE's. +The value 'HY000' (general error) is used for unmapped errors. +.TP +\fBstate\fR +Returns a character string containing information similar to that provided by the mysqladmin status command. +This includes uptime in seconds and the number of running threads, questions, reloads, and open tables. .RE .TP \fB::mysql::baseinfo\fR \fIoption\fR @@ -583,7 +857,7 @@ Return the number of rows that can be read sequentially from the current position in the pending result; an empty string if no result is pending. .sp -[::mysql::result \\$db current] + [::mysql::result \\$db rows] +[::mysql::result $db current] + [::mysql::result $db rows] always equals the total number of rows in the pending result. .RE .TP @@ -652,22 +926,22 @@ Returns true if more results exist from the currently executed query, and the ap Returns the number of warnings generated during execution of the previous SQL statement. .TP \fB::mysql::isnull\fR \fIvalue\fR -Null handling is known problem by Tcl to DB interfaces. -Mysql varchar type known 2 valid values NULL and empty string. -There is no way to difference it in core Tcl because of it strong string based -philosophy. +Null handling is a known problem with Tcl, especially with DB interaction. +The mysql "varchar" type has two valid blank values, NULL and an empty +string. This is where the problem arises; Tcl is not able to differentiate +between the two because of the way it handles strings. Mysql has new internal Tcl type for null that string representation is stored in global array mysqltcl(nullvalue) and as default empty string. mysql::isnull can be used for safe check for null value. Warning mysql::isnull works only reliable if there are no type conversation on returned rows. -Consider row is always Tcl list even when there are only on column in the row. +Consider row is always Tcl list even when there are only one column in the row. .nf -set row [::mysql::next \\$handle] -if {[mysql::isnull [lindex \\$row 1]]} { +set row [::mysql::next $handle] +if {[mysql::isnull [lindex $row 1]]} { puts "2. column of $row is null" } -if {[mysql::isnull \\$row]} { +if {[mysql::isnull $row]} { puts "this does not work, because of type conversation list to string" } .fi @@ -680,6 +954,10 @@ there are only 2 options now: -multi_statment_on and -multi_statment_off .TP \fB::mysql::shutdown\fR \fIhandle\fR Asks the database server to shut down. The connected user must have SHUTDOWN privileges. +.TP +\fB::mysql::encoding\fR \fIhandle\fR ?encoding? +Ask or change a encoding of connection. +There are special encoding "binary" for binary data transfers. .SH "STATUS INFORMATION" Mysqltcl creates and maintains a Tcl global array to provide status information. diff --git a/generic/mysqltcl.c b/generic/mysqltcl.c index dbeb777..d89b2ca 100644 --- a/generic/mysqltcl.c +++ b/generic/mysqltcl.c @@ -36,7 +36,7 @@ #ifdef _WINDOWS #include #define PACKAGE "mysqltcl" - #define VERSION "3.00" + #define VERSION "3.01" #endif #include @@ -710,8 +710,8 @@ static CONST char* MysqlConnectOpt[] = { "-host", "-user", "-password", "-db", "-port", "-socket","-encoding", "-ssl", "-compress", "-noschema","-odbc","-multistatement","-multiresult", - "-localfiles","-ignorespace","-foundrows","-interactive", - NULL + "-localfiles","-ignorespace","-foundrows","-interactive","-sslkey","-sslcert", + "-sslca","-sslcapath","-sslciphers",NULL }; static int Mysqltcl_Connect(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) @@ -725,6 +725,14 @@ static int Mysqltcl_Connect(ClientData clientData, Tcl_Interp *interp, int objc, int port = 0, flags = 0, booleanflag; char *socket = NULL; char *encodingname = NULL; + + int isSSL = 0; + char *sslkey = NULL; + char *sslcert = NULL; + char *sslca = NULL; + char *sslcapath = NULL; + char *sslcipher = NULL; + MysqlTclHandle *handle; const char *groupname = "mysqltcl"; @@ -734,7 +742,8 @@ static int Mysqltcl_Connect(ClientData clientData, Tcl_Interp *interp, int objc, MYSQL_CONNDB_OPT, MYSQL_CONNPORT_OPT, MYSQL_CONNSOCKET_OPT, MYSQL_CONNENCODING_OPT, MYSQL_CONNSSL_OPT, MYSQL_CONNCOMPRESS_OPT, MYSQL_CONNNOSCHEMA_OPT, MYSQL_CONNODBC_OPT, MYSQL_MULTISTATEMENT_OPT,MYSQL_MULTIRESULT_OPT,MYSQL_LOCALFILES_OPT,MYSQL_IGNORESPACE_OPT, - MYSQL_FOUNDROWS_OPT,MYSQL_INTERACTIVE_OPT + MYSQL_FOUNDROWS_OPT,MYSQL_INTERACTIVE_OPT,MYSQL_SSLKEY_OPT,MYSQL_SSLCERT_OPT, + MYSQL_SSLCA_OPT,MYSQL_SSLCAPATH_OPT,MYSQL_SSLCIPHERS_OPT }; if (!(objc & 1) || @@ -773,10 +782,8 @@ static int Mysqltcl_Connect(ClientData clientData, Tcl_Interp *interp, int objc, encodingname = Tcl_GetStringFromObj(objv[++i],NULL); break; case MYSQL_CONNSSL_OPT: - if (Tcl_GetBooleanFromObj(interp,objv[++i],&booleanflag) != TCL_OK ) + if (Tcl_GetBooleanFromObj(interp,objv[++i],&isSSL) != TCL_OK ) return TCL_ERROR; - if (booleanflag) - flags |= CLIENT_SSL; break; case MYSQL_CONNCOMPRESS_OPT: if (Tcl_GetBooleanFromObj(interp,objv[++i],&booleanflag) != TCL_OK ) @@ -801,6 +808,8 @@ static int Mysqltcl_Connect(ClientData clientData, Tcl_Interp *interp, int objc, return TCL_ERROR; if (booleanflag) flags |= CLIENT_MULTI_STATEMENTS; + + break; case MYSQL_MULTIRESULT_OPT: if (Tcl_GetBooleanFromObj(interp,objv[++i],&booleanflag) != TCL_OK ) @@ -833,6 +842,21 @@ static int Mysqltcl_Connect(ClientData clientData, Tcl_Interp *interp, int objc, if (booleanflag) flags |= CLIENT_INTERACTIVE; break; + case MYSQL_SSLKEY_OPT: + sslkey = Tcl_GetStringFromObj(objv[++i],NULL); + break; + case MYSQL_SSLCERT_OPT: + sslcert = Tcl_GetStringFromObj(objv[++i],NULL); + break; + case MYSQL_SSLCA_OPT: + sslca = Tcl_GetStringFromObj(objv[++i],NULL); + break; + case MYSQL_SSLCAPATH_OPT: + sslcapath = Tcl_GetStringFromObj(objv[++i],NULL); + break; + case MYSQL_SSLCIPHERS_OPT: + sslcipher = Tcl_GetStringFromObj(objv[++i],NULL); + break; default: return mysql_prim_confl(interp,objc,objv,"Weirdness in options"); } @@ -852,6 +876,9 @@ static int Mysqltcl_Connect(ClientData clientData, Tcl_Interp *interp, int objc, #if (MYSQL_VERSION_ID>=32350) mysql_options(handle->connection,MYSQL_READ_DEFAULT_GROUP,groupname); #endif + if (isSSL) { + mysql_ssl_set(handle->connection,sslkey,sslcert, sslca, sslcapath, sslcipher); + } if (!mysql_real_connect(handle->connection, hostname, user, password, db, port, socket, flags)) { @@ -903,12 +930,15 @@ static int Mysqltcl_Use(ClientData clientData, Tcl_Interp *interp, int objc, Tcl return TCL_ERROR; db=Tcl_GetStringFromObj(objv[2], &len); - if (len >= MYSQL_NAME_LEN) - return mysql_prim_confl(interp,objc,objv,"database name too long") ; - if (mysql_select_db(handle->connection, db) < 0) - return mysql_server_confl(interp,objc,objv,handle->connection) ; + if (len >= MYSQL_NAME_LEN) { + mysql_prim_confl(interp,objc,objv,"database name too long"); + return TCL_ERROR; + } - strcpy(handle->database, db) ; + if (mysql_select_db(handle->connection, db)!=0) { + return mysql_server_confl(interp,objc,objv,handle->connection); + } + strcpy(handle->database, db); return TCL_OK; } @@ -977,6 +1007,7 @@ static int Mysqltcl_Sel(ClientData clientData, Tcl_Interp *interp, int objc, Tcl MysqlTclHandle *handle; unsigned long *lengths; + static CONST char* selOptions[] = {"-list", "-flatlist", NULL}; /* Warning !! no option number */ int i,selOption=2,colCount; @@ -1054,6 +1085,7 @@ static int Mysqltcl_Query(ClientData clientData, Tcl_Interp *interp, int objc, T MysqlTclHandle *handle, *qhandle; if ((handle = mysql_prologue(interp, objc, objv, 3, 3, CL_CONN, + "handle sqlstatement")) == 0) return TCL_ERROR; @@ -1069,6 +1101,7 @@ static int Mysqltcl_Query(ClientData clientData, Tcl_Interp *interp, int objc, T qhandle->result = result; qhandle->col_count = mysql_num_fields(qhandle->result) ; + qhandle->res_count = mysql_num_rows(qhandle->result); Tcl_SetObjResult(interp, Tcl_NewHandleObj(statePtr,qhandle)); return TCL_OK; @@ -1145,6 +1178,7 @@ static int Mysqltcl_Exec(ClientData clientData, Tcl_Interp *interp, int objc, Tc } + /* *---------------------------------------------------------------------- * @@ -1329,6 +1363,7 @@ static int Mysqltcl_Map(ClientData clientData, Tcl_Interp *interp, int objc, Tcl } Tcl_Free((char *)val); return TCL_OK ; + } /* @@ -1452,6 +1487,7 @@ static int Mysqltcl_Receive(ClientData clientData, Tcl_Interp *interp, int objc, * usage: mysqlinfo handle option * + */ static int Mysqltcl_Info(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) @@ -1467,12 +1503,12 @@ static int Mysqltcl_Info(ClientData clientData, Tcl_Interp *interp, int objc, Tc static CONST char* MysqlDbOpt[] = { "dbname", "dbname?", "tables", "host", "host?", "databases", - "info","serverversion","serverversionid","sqlstate",NULL + "info","serverversion","serverversionid","sqlstate","state",NULL }; enum dboption { MYSQL_INFNAME_OPT, MYSQL_INFNAMEQ_OPT, MYSQL_INFTABLES_OPT, MYSQL_INFHOST_OPT, MYSQL_INFHOSTQ_OPT, MYSQL_INFLIST_OPT, MYSQL_INFO, - MYSQL_INF_SERVERVERSION,MYSQL_INFO_SERVERVERSION_ID,MYSQL_INFO_SQLSTATE + MYSQL_INF_SERVERVERSION,MYSQL_INFO_SERVERVERSION_ID,MYSQL_INFO_SQLSTATE,MYSQL_INFO_STATE }; /* We can't fully check the handle at this stage. */ @@ -1503,7 +1539,9 @@ static int Mysqltcl_Info(ClientData clientData, Tcl_Interp *interp, int objc, Tc case MYSQL_INF_SERVERVERSION: case MYSQL_INFO_SERVERVERSION_ID: case MYSQL_INFO_SQLSTATE: + case MYSQL_INFO_STATE: break; + case MYSQL_INFHOSTQ_OPT: if (handle->connection == 0) return TCL_OK ; /* Return empty string if not connected. */ @@ -1532,6 +1570,7 @@ static int Mysqltcl_Info(ClientData clientData, Tcl_Interp *interp, int objc, Tc mysql_free_result(list) ; break ; case MYSQL_INFHOST_OPT: + case MYSQL_INFHOSTQ_OPT: Tcl_SetObjResult(interp, Tcl_NewStringObj(mysql_get_host_info(handle->connection), -1)); break ; @@ -1562,6 +1601,9 @@ static int Mysqltcl_Info(ClientData clientData, Tcl_Interp *interp, int objc, Tc case MYSQL_INFO_SQLSTATE: Tcl_SetObjResult(interp, Tcl_NewStringObj(mysql_sqlstate(handle->connection),-1)); break; + case MYSQL_INFO_STATE: + Tcl_SetObjResult(interp, Tcl_NewStringObj(mysql_stat(handle->connection),-1)); + break; default: /* should never happen */ return mysql_prim_confl(interp,objc,objv,"weirdness in Mysqltcl_Info") ; } @@ -1780,6 +1822,7 @@ static int Mysqltcl_Col(ClientData clientData, Tcl_Interp *interp, int objc, Tcl mysql_field_seek(result, 0) ; while ((fld = mysql_fetch_field(result)) != NULL) if ((colinfo = mysql_colinfo(interp,objc,objv,fld, objv[idx])) != NULL) { + Tcl_ListObjAppendElement(interp, resSubList, colinfo); } else { goto conflict; @@ -1802,6 +1845,7 @@ static int Mysqltcl_Col(ClientData clientData, Tcl_Interp *interp, int objc, Tcl * Mysqltcl_State * Implements the mysqlstate command: * usage: mysqlstate handle ?-numeric? + * */ @@ -1818,6 +1862,7 @@ static int Mysqltcl_State(ClientData clientData, Tcl_Interp *interp, int objc, T if (strcmp(Tcl_GetStringFromObj(objv[2],NULL), "-numeric")) return mysql_prim_confl(interp,objc,objv,"last parameter should be -numeric"); else + numeric=1; } @@ -1849,6 +1894,7 @@ static int Mysqltcl_State(ClientData clientData, Tcl_Interp *interp, int objc, T static int Mysqltcl_InsertId(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { + MysqlTclHandle *handle; if ((handle = mysql_prologue(interp, objc, objv, 2, 2, CL_CONN, @@ -1869,6 +1915,7 @@ static int Mysqltcl_InsertId(ClientData clientData, Tcl_Interp *interp, int objc * Returns 0 if connection is OK */ + static int Mysqltcl_Ping(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { MysqlTclHandle *handle; @@ -1893,6 +1940,7 @@ static int Mysqltcl_Ping(ClientData clientData, Tcl_Interp *interp, int objc, Tc static int Mysqltcl_ChangeUser(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { MysqlTclHandle *handle; + int len; char *user,*password,*database=NULL; if ((handle = mysql_prologue(interp, objc, objv, 4, 5, CL_CONN, @@ -1902,12 +1950,18 @@ static int Mysqltcl_ChangeUser(ClientData clientData, Tcl_Interp *interp, int ob user = Tcl_GetStringFromObj(objv[2],NULL); password = Tcl_GetStringFromObj(objv[3],NULL); if (objc==5) { - database = Tcl_GetStringFromObj(objv[4],NULL); - + database = Tcl_GetStringFromObj(objv[4],&len); + if (len >= MYSQL_NAME_LEN) { + mysql_prim_confl(interp,objc,objv,"database name too long"); + return TCL_ERROR; + } } if (mysql_change_user(handle->connection, user, password, database)!=0) { - return mysql_server_confl(interp,objc,objv,handle->connection); + mysql_server_confl(interp,objc,objv,handle->connection); + return TCL_ERROR; } + if (database!=NULL) + strcpy(handle->database, database); return TCL_OK; } /* @@ -2012,12 +2066,11 @@ static int Mysqltcl_NextResult(ClientData clientData, Tcl_Interp *interp, int ob "handle")) == 0) return TCL_ERROR; if (handle->result != NULL) { - mysql_free_result(handle->result) ; handle->result = NULL ; } result = mysql_next_result(handle->connection); - if (result==0) { + if (result==-1) { Tcl_SetObjResult(interp, Tcl_NewIntObj(0)); return TCL_OK; } @@ -2159,22 +2212,69 @@ static int Mysqltcl_SetServerOption(ClientData clientData, Tcl_Interp *interp, i static int Mysqltcl_ShutDown(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { MysqlTclHandle *handle; - int idx; - enum enum_mysql_set_option mysqlServerOption; - - enum serveroption { - MYSQL_MSTATMENT_ON_SOPT, MYSQL_MSTATMENT_OFF_SOPT - }; if ((handle = mysql_prologue(interp, objc, objv, 2, 2, CL_CONN, "handle")) == 0) return TCL_ERROR; - if (mysql_shutdown(handle->connection,SHUTDOWN_DEFAULT)!=0) { mysql_server_confl(interp,objc,objv,handle->connection); } return TCL_OK; } +/* + *---------------------------------------------------------------------- + * + * Mysqltcl_Encoding + * usage: mysql::encoding handle ?encoding|binary? + * + */ +static int Mysqltcl_Encoding(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) +{ + MysqltclState *statePtr = (MysqltclState *)clientData; + Tcl_HashSearch search; + Tcl_HashEntry *entryPtr; + MysqlTclHandle *handle,*qhandle; + char *encodingname; + Tcl_Encoding encoding; + + if ((handle = mysql_prologue(interp, objc, objv, 2, 3, CL_CONN, + "handle")) == 0) + return TCL_ERROR; + if (objc==2) { + if (handle->encoding == NULL) + Tcl_SetObjResult(interp, Tcl_NewStringObj("binary",-1)); + else + Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_GetEncodingName(handle->encoding),-1)); + } else { + if (handle->type!=HT_CONNECTION) { + Tcl_SetObjResult(interp, Tcl_NewStringObj("encoding set can be used only on connection handle",-1)); + return TCL_ERROR; + } + encodingname = Tcl_GetStringFromObj(objv[2],NULL); + if (strcmp(encodingname, "binary") == 0) { + encoding = NULL; + } else { + encoding = Tcl_GetEncoding(interp, encodingname); + if (encoding == NULL) + return TCL_ERROR; + } + if (handle->encoding!=NULL) + Tcl_FreeEncoding(handle->encoding); + handle->encoding = encoding; + + /* change encoding of all subqueries */ + for (entryPtr=Tcl_FirstHashEntry(&statePtr->hash,&search); + entryPtr!=NULL; + entryPtr=Tcl_NextHashEntry(&search)) { + qhandle=(MysqlTclHandle *)Tcl_GetHashValue(entryPtr); + if (qhandle->type==HT_QUERY && handle->connection==qhandle->connection) { + qhandle->encoding = encoding; + } + } + + } + return TCL_OK; +} /* *---------------------------------------------------------------------- * @@ -2187,6 +2287,7 @@ static int Mysqltcl_ShutDown(ClientData clientData, Tcl_Interp *interp, int objc */ static int Mysqltcl_Close(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) + { MysqltclState *statePtr = (MysqltclState *)clientData; MysqlTclHandle *handle,*thandle; @@ -2255,6 +2356,7 @@ static int Mysqltcl_Close(ClientData clientData, Tcl_Interp *interp, int objc, T static int Mysqltcl_Prepare(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { MysqltclState *statePtr = (MysqltclState *)clientData; + MysqlTclHandle *handle; MysqlTclHandle *shandle; MYSQL_STMT *statement; @@ -2273,6 +2375,7 @@ static int Mysqltcl_Prepare(ClientData clientData, Tcl_Interp *interp, int objc, } query = (char *)Tcl_GetByteArrayFromObj(objv[2], &queryLen); if (mysql_stmt_prepare(statement,query,queryLen)) { + mysql_stmt_close(statement); return mysql_server_confl(interp,objc,objv,handle->connection); } @@ -2450,6 +2553,7 @@ int Mysqltcl_Init(interp) if (Tcl_PkgProvide(interp, "mysqltcl" , VERSION) != TCL_OK) return TCL_ERROR; /* + * Initialize the new Tcl commands. * Deleting any command will close all connections. */ @@ -2510,6 +2614,7 @@ int Mysqltcl_Init(interp) Tcl_CreateObjCommand(interp,"::mysql::newnull", Mysqltcl_NewNull,(ClientData)statePtr, NULL); Tcl_CreateObjCommand(interp,"::mysql::setserveroption", Mysqltcl_SetServerOption,(ClientData)statePtr, NULL); Tcl_CreateObjCommand(interp,"::mysql::shutdown", Mysqltcl_ShutDown,(ClientData)statePtr, NULL); + Tcl_CreateObjCommand(interp,"::mysql::encoding", Mysqltcl_Encoding,(ClientData)statePtr, NULL); /* prepared statements */ #ifdef PREPARED_STATEMENT @@ -2520,6 +2625,7 @@ int Mysqltcl_Init(interp) Tcl_CreateObjCommand(interp,"::mysql::pexecute", Mysqltcl_PExecute,(ClientData)statePtr, NULL); #endif + /* Initialize mysqlstatus global array. */ diff --git a/tests/libload.tcl b/tests/libload.tcl index ba993fd..15bf8a0 100644 --- a/tests/libload.tcl +++ b/tests/libload.tcl @@ -1,4 +1,4 @@ -set file libmysqltcl3.00 +set file libmysqltcl3.01 if {[file exists ./${file}[info sharedlibextension]]} { load ./${file}[info sharedlibextension] diff --git a/tests/test.tcl b/tests/test.tcl index a93f618..0a8e0b5 100755 --- a/tests/test.tcl +++ b/tests/test.tcl @@ -42,19 +42,17 @@ proc prepareTestDB {} { mysqlexec $handle "CREATE DATABASE $dbank" } mysqluse $handle $dbank - if {[lsearch [mysqlinfo $handle tables] Student]<0} { - puts "Test Table Student does not exist. Create it" - mysqlexec $handle { - CREATE TABLE Student ( - MatrNr int NOT NULL auto_increment, - Name varchar(20), - Semester int, - PRIMARY KEY (MatrNr) - ) - } + + catch {mysqlexec $handle {drop table Student}} + + mysqlexec $handle { + CREATE TABLE Student ( + MatrNr int NOT NULL auto_increment, + Name varchar(20), + Semester int, + PRIMARY KEY (MatrNr) + ) } - # clean test table - mysqlexec $handle "delete from Student" mysqlexec $handle "INSERT INTO Student VALUES (1,'Sojka',4)" mysqlexec $handle "INSERT INTO Student VALUES (2,'Preisner',2)" mysqlexec $handle "INSERT INTO Student VALUES (3,'Killar',2)" @@ -138,6 +136,11 @@ tcltest::test {select-1.0} {use implicit database notation} -body { set handle [getConnection] +tcltest::test {use-1.0} {false use} -body { + mysqluse $handle notdb2 +} -returnCodes error -match glob -result "mysqluse/db server: Unknown database 'notdb2'" + + tcltest::test {select-1.1} {Test sel and next functions} -body { mysqluse $handle uni set allrows [mysqlsel $handle {select * from Student}] @@ -361,7 +364,7 @@ tcltest::test {handle-1.2} {open 20 connection, close all} -body { } tcltest::test {handle-1.3} {10 queries, close all} -body { - set handle [mysqlconnect -user root -db uni] + set handle [getConnection] for {set x 0} {$x<10} {incr x} { lappend queries [mysqlquery $handle {select * from Student}] } @@ -373,7 +376,7 @@ tcltest::test {handle-1.3} {10 queries, close all} -body { } -returnCodes error -match glob -result "*handle already closed*" tcltest::test {handle-1.4} {10 queries, close all} -body { - set handle [mysqlconnect -user root -db uni] + set handle [getConnection] mysqlquery $handle {select * from Student} mysqlclose return @@ -404,19 +407,17 @@ tcltest::test {changeuser-1.0} {escaping} -body { } # does not work for mysql4.1 -if 0 { tcltest::test {changeuser-1.1} {no such user} -body { - mysqlchangeuser $handle nonuser {} uni + mysqlchangeuser $handle root {} nodb } -returnCodes error -match glob -result "*Unknown database*" -} tcltest::test {interpreter-1.0} {mysqltcl in slave interpreter} -body { - set handle [mysqlconnect -user root -db uni] + set handle [getConnection] set i1 [interp create] - $i1 eval { + $i1 eval " package require mysqltcl - set hdl [mysqlconnect -user root -db uni] - } + set hdl [mysqlconnect -user $dbuser -db $dbank] + " interp delete $i1 mysqlinfo $handle databases mysqlclose $handle diff --git a/tests/test41.tcl b/tests/test41.tcl index 1426808..241d9d1 100644 --- a/tests/test41.tcl +++ b/tests/test41.tcl @@ -15,28 +15,68 @@ if {[file exists libload.tcl]} { source [file join [file dirname [info script]] libload.tcl] } +# global connect variables +set dbuser root +set dbpassword "" +set dbank mysqltcltest + package require tcltest variable SETUP {#common setup code} variable CLEANUP {#common cleanup code} tcltest::configure -verbose bet -proc setConnect {} { - global conn - set conn [mysqlconnect -user root -db uni -multistatement 1] +proc getConnection {{addOptions {}} {withDB 1}} { + global dbuser dbpassword dbank + if {$withDB} { + append addOptions " -db $dbank" + } + if {$dbpassword ne ""} { + append addOptions " -password $dbpassword" + } + return [eval mysqlconnect -user $dbuser $addOptions] } -# Create Table suitable for transaction tests -proc initTestTable {} { - global conn - # drop table if exists - catch {mysql::exec $conn {drop table transtest}} - mysql::exec $conn { +proc prepareTestDB {} { + global dbank + set handle [getConnection {} 0] + if {[lsearch [mysqlinfo $handle databases] $dbank]<0} { + puts "Testdatabase $dbank does not exist. Create it" + mysqlexec $handle "CREATE DATABASE $dbank" + } + mysqluse $handle $dbank + + catch {mysql::exec $handle {drop table transtest}} + mysql::exec $handle { create table transtest ( id int, name varchar(20) ) ENGINE=INNODB - } + } + + catch {mysql::exec $handle {drop table Student}} + mysql::exec $handle { + CREATE TABLE Student ( + MatrNr int NOT NULL auto_increment, + Name varchar(20), + Semester int, + PRIMARY KEY (MatrNr) + ) + } + mysql::exec $handle "INSERT INTO Student VALUES (1,'Sojka',4)" + mysql::exec $handle "INSERT INTO Student VALUES (2,'Preisner',2)" + mysql::exec $handle "INSERT INTO Student VALUES (3,'Killar',2)" + mysql::exec $handle "INSERT INTO Student VALUES (4,'Penderecki',10)" + mysql::exec $handle "INSERT INTO Student VALUES (5,'Turnau',2)" + mysql::exec $handle "INSERT INTO Student VALUES (6,'Grechuta',3)" + mysql::exec $handle "INSERT INTO Student VALUES (7,'Gorniak',1)" + mysql::exec $handle "INSERT INTO Student VALUES (8,'Niemen',3)" + mysql::exec $handle "INSERT INTO Student VALUES (9,'Bem',5)" + mysql::close $handle } +prepareTestDB +set conn [getConnection {-multistatement 1}] + + tcltest::test {null-1.0} {creating of null} { set null [mysql::newnull] mysql::isnull $null @@ -58,9 +98,6 @@ tcltest::test {null-1.4} {null checking} { mysql::isnull [lindex [list [mysql::newnull]] 0] } {1} -# We need connection for folowing tests -setConnect -initTestTable tcltest::test {autocommit} {setting autocommit} -body { mysql::autocommit $conn 0 @@ -187,6 +224,11 @@ tcltest::test {info-1.2} {sqlstate} -body { return } +tcltest::test {info-1.3} {sqlstate} -body { + mysql::info $conn state + return +} + tcltest::test {state-1.0} {reported bug in 3.51} -body { mysql::state nothandle -numeric } -result 0 @@ -213,6 +255,72 @@ tcltest::test {baseinfo-1.0} {clientversionid} -body { expr {[mysql::baseinfo clientversionid]>0} } -result 1 +tcltest::test {encoding-1.0} {read system encoding} -body { + mysql::encoding $conn +} -result [encoding system] + +tcltest::test {encoding-1.1} {change to binary} -body { + mysql::encoding $conn binary + mysql::exec $conn "INSERT INTO Student (Name,Semester) VALUES ('Test',4)" + mysql::encoding $conn +} -result binary + +tcltest::test {encoding-1.2} {change to binary} -body { + mysql::encoding $conn [encoding system] + mysql::exec $conn "INSERT INTO Student (Name,Semester) VALUES ('Test',4)" + mysql::encoding $conn +} -result [encoding system] + +tcltest::test {encoding-1.3} {change to binary} -body { + mysql::encoding $conn iso8859-1 + mysql::exec $conn "INSERT INTO Student (Name,Semester) VALUES ('Test',4)" + mysql::encoding $conn +} -result iso8859-1 + +tcltest::test {encoding-1.4} {unknown encoding} -body { + mysql::encoding $conn unknown +} -returnCodes error -match glob -result "unknown encoding*" + +tcltest::test {encoding-1.5} {changing encoding of query handle} -body { + set q [mysql::query $conn "select * from Student"] + mysql::encoding $q iso8859-1 +} -cleanup { + mysql::endquery $q +} -returnCodes error -result "encoding set can be used only on connection handle" + +tcltest::test {encoding-1.6} {changing encoding of handle} -body { + mysql::encoding $conn iso8859-1 + set q [mysql::query $conn "select * from Student"] + mysql::encoding $q +} -cleanup { + mysql::endquery $q +} -result iso8859-1 + +tcltest::test {encoding-1.7} {changing encoding of handle} -body { + set q [mysql::query $conn "select * from Student"] + mysql::encoding $conn iso8859-1 + mysql::encoding $q +} -cleanup { + mysql::endquery $q +} -result iso8859-1 + +tcltest::test {encoding-1.8} {changing encoding of handle} -body { + mysql::encoding $conn utf-8 + set q [mysql::query $conn "select * from Student"] + mysql::encoding $conn iso8859-1 + mysql::encoding $q +} -cleanup { + mysql::endquery $q +} -result iso8859-1 + +tcltest::test {encoding-1.8} {changing encoding of handle} -body { + mysql::encoding $conn iso8859-5 + set q [mysql::query $conn "select Name from Student"] + mysql::encoding $conn utf-8 + mysql::fetch $q + mysql::endquery $q + return +} # no prepared statements in this version if 0 {