Merge branch 'master' of https://gitbox.apache.org/repos/asf/tcl-rivet
diff --git a/ChangeLog b/ChangeLog
index f6a1a6d..0858970 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,8 @@
+2021-07-30 Massimo Manghi <mxmanghi@apache.org>
+ * src/mod_rivet_ng/TclWebapache.c: integrating the current scant Tcl error info
+ returned by the various ::rivet::upload subcommands
+ * rivet/packages/dio/: Removing references to subversion's tags
+
2021-04-13 Massimo Manghi <mxmanghi@apache.org>
* src/mod_rivet_ng/rivetInspect.c: add server current loglevel. Removed
unneeded ref count management in the server array construction
diff --git a/rivet/packages/dio/aida.tcl b/rivet/packages/dio/aida.tcl
index 9bc1f61..4e0864b 100644
--- a/rivet/packages/dio/aida.tcl
+++ b/rivet/packages/dio/aida.tcl
@@ -14,8 +14,6 @@
# See the License for the specific language governing permissions and
# limitations under the License.
-# $Id$
-
package require Tcl 8.6
package require Itcl
@@ -61,7 +59,7 @@
}
::itcl::body Aida::build_select_query {args} {
- return [$sqlobj build_select_query {*}$args]
+ return [$sql build_select_query {*}$args]
}
diff --git a/rivet/packages/dio/dio.tcl b/rivet/packages/dio/dio.tcl
index 4aaa476..c6a27f2 100644
--- a/rivet/packages/dio/dio.tcl
+++ b/rivet/packages/dio/dio.tcl
@@ -14,8 +14,6 @@
# See the License for the specific language governing permissions and
# limitations under the License.
-# $Id$
-
catch {package require Tclx}
package require Itcl
##set auto_path [linsert $auto_path 0 [file dirname [info script]]]
@@ -618,7 +616,7 @@
method nextkey {args} {}
method lastkey {args} {}
method now {} {}
-
+ method last_inserted_rec {} {}
##
## Functions to get and set public variables.
##
diff --git a/rivet/packages/dio/dio_Mysql.tcl b/rivet/packages/dio/dio_Mysql.tcl
index aa1ca05..0c2ca7f 100644
--- a/rivet/packages/dio/dio_Mysql.tcl
+++ b/rivet/packages/dio/dio_Mysql.tcl
@@ -17,8 +17,7 @@
# specific language governing permissions and limitations
# under the License.
-# $Id$
-
+package require DIO
package provide dio_Mysql 0.4
namespace eval DIO {
@@ -26,9 +25,9 @@
inherit Database
constructor {args} {eval configure $args} {
- if { [catch {package require Mysqltcl}] \
- && [catch {package require mysqltcl}] \
- && [catch {package require mysql}] } {
+ if { [catch {package require Mysqltcl}] \
+ && [catch {package require mysqltcl}] \
+ && [catch {package require mysql}]} {
return -code error "No MySQL Tcl package available"
}
diff --git a/rivet/packages/dio/dio_Postgresql.tcl b/rivet/packages/dio/dio_Postgresql.tcl
index afeec1b..3dafcbf 100644
--- a/rivet/packages/dio/dio_Postgresql.tcl
+++ b/rivet/packages/dio/dio_Postgresql.tcl
@@ -14,8 +14,7 @@
# See the License for the specific language governing permissions and
# limitations under the License.
-# $Id$
-
+package require DIO
package provide dio_Postgresql 0.1
namespace eval DIO {
diff --git a/rivet/packages/dio/dio_Sqlite.tcl b/rivet/packages/dio/dio_Sqlite.tcl
index d5949a1..9379e90 100644
--- a/rivet/packages/dio/dio_Sqlite.tcl
+++ b/rivet/packages/dio/dio_Sqlite.tcl
@@ -14,8 +14,7 @@
# See the License for the specific language governing permissions and
# limitations under the License.
-# $Id$
-
+package require DIO
package provide dio_Sqlite 0.1
namespace eval DIO {
@@ -26,8 +25,8 @@
::itcl::class Sqlite {
inherit Database
- private variable dbcmd ""
- public variable interface "Sqlite"
+ private variable dbcmd ""
+ public variable interface "Sqlite"
constructor {args} {eval configure $args} {
if {[catch {package require sqlite}] && \
diff --git a/rivet/packages/dio/sql.tcl b/rivet/packages/dio/sql.tcl
index c66100b..f09d000 100644
--- a/rivet/packages/dio/sql.tcl
+++ b/rivet/packages/dio/sql.tcl
@@ -19,7 +19,6 @@
# different implementation in various backends for specific
# functionalities
#
-# $Id$
package require Itcl
diff --git a/src/mod_rivet_ng/TclWebapache.c b/src/mod_rivet_ng/TclWebapache.c
index ab87909..3f79c33 100644
--- a/src/mod_rivet_ng/TclWebapache.c
+++ b/src/mod_rivet_ng/TclWebapache.c
@@ -701,10 +701,22 @@
{
apr_status_t status;
- status = apr_file_copy(req->upload->tempname ,Tcl_GetString(filename),APR_FILE_SOURCE_PERMS,req->req->pool);
+ status = apr_file_copy(req->upload->tempname,Tcl_GetString(filename),APR_FILE_SOURCE_PERMS,req->req->pool);
if (status == APR_SUCCESS) {
return TCL_OK;
} else {
+
+ /* apr_strerror docs don't require a specific buffer size, we're just guessing it */
+
+ char error_msg[1024];
+ char* tcl_error_msg;
+ apr_strerror(status,error_msg,1024);
+
+ tcl_error_msg = apr_psprintf(req->req->pool,"Error copying upload '%s' to '%s' (%s)", req->upload->tempname,
+ Tcl_GetString(filename),
+ error_msg);
+
+ Tcl_AddErrorInfo(req->interp,tcl_error_msg);
return TCL_ERROR;
}
}
@@ -723,14 +735,31 @@
chan = Tcl_OpenFileChannel (req->interp, req->upload->tempname, "r", 0);
if (chan == NULL) {
+ char* tcl_error_msg;
+ int error_number = Tcl_GetErrno();
+
+ Tcl_AddErrorInfo(req->interp,"Error opening channel to uploaded data");
+ tcl_error_msg = apr_psprintf(req->req->pool,"Error setting channel option '%s': %s",
+ Tcl_ErrnoId(), Tcl_ErrnoMsg(error_number));
+ Tcl_AddErrorInfo(req->interp,tcl_error_msg);
return TCL_ERROR;
}
- if (Tcl_SetChannelOption(req->interp, chan,
- "-translation", "binary") == TCL_ERROR) {
+ if (Tcl_SetChannelOption(req->interp, chan, "-translation", "binary") == TCL_ERROR) {
+ char* tcl_error_msg;
+ int error_number = Tcl_GetErrno();
+
+ tcl_error_msg = apr_psprintf(req->req->pool,"Error setting channel option '%s': %s",
+ Tcl_ErrnoId(), Tcl_ErrnoMsg(error_number));
+ Tcl_AddErrorInfo(req->interp,tcl_error_msg);
return TCL_ERROR;
}
- if (Tcl_SetChannelOption(req->interp, chan,
- "-encoding", "binary") == TCL_ERROR) {
+ if (Tcl_SetChannelOption(req->interp, chan, "-encoding", "binary") == TCL_ERROR) {
+ char* tcl_error_msg;
+ int error_number = Tcl_GetErrno();
+
+ tcl_error_msg = apr_psprintf(req->req->pool,"Error setting channel option '%s': %s",
+ Tcl_ErrnoId(), Tcl_ErrnoMsg(error_number));
+ Tcl_AddErrorInfo(req->interp,tcl_error_msg);
return TCL_ERROR;
}
diff --git a/src/mod_rivet_ng/rivetCore.c b/src/mod_rivet_ng/rivetCore.c
index 6aa6a11..c7d4e21 100644
--- a/src/mod_rivet_ng/rivetCore.c
+++ b/src/mod_rivet_ng/rivetCore.c
@@ -101,7 +101,6 @@
Tcl_AppendObjToErrorInfo(interp,Tcl_NewStringObj(" outside a request processing",-1));
}
-
/*
*-----------------------------------------------------------------------------
*
@@ -1181,8 +1180,6 @@
* FILENAME : upload original filename
* TEMPNAME : temporary file where the upload is taking place
* NAMES : list of uploads
- *
- * the procedure shouldn't reach for the default case
*/
switch ((enum subcommand)subcommandindex)
