- more or less working - maybe I'd have to refactor the routines

  to include an encapsulated "auth_info" to avoid having to add
  more parameters to the routines if that should change...

tcl/intranet-xmlrpc-procs.tcl

@@ -38,7 +38,59 @@ ad_proc -private im_package_xmlrpc_id_helper {} {
 # ----------------------------------------------------------------------
 
 
-ad_proc -public sqlapi.select { user_id timestamp token object_type object_id } {
+ad_proc -public sqlapi.select { authinfo object_type } {
+    Retreives all information for an object of a given object type
+    Returns:
+    1. Status ("ok" or anything else indicating an error)
+    2. A key-value list with information about the object
+} {
+    ns_log Notice "sqlapi.select: user_id=$user_id, timestamp=$timestamp, token=$token, object_type=$object_type, object_id=$object_id"
+
+    set login_p [im_valid_auto_login_p -user_id $user_id -auto_login $token]
+    if {!$login_p} { 
+	ns_log Notice "sqlapi.select: Bad login info: user_id=$user_id, timestamp=$timestamp, token=$token"
+	return [list -string "invalid_auth_token"] 
+    }
+
+    set object_table [db_string object_table "select table_name from acs_object_types where object_type=:object_type" -default ""]
+    set id_column [db_string id_column "select id_column from acs_object_types where object_type=:object_type" -default ""]
+
+    set query "select * from $object_table where $id_column = $object_id"
+    ns_log Notice "sqlapi.select: object_table=$object_table, id_column=$id_column, sql=$query"
+
+    db_with_handle db {
+	set selection [ns_db select $db $query]
+	if {[ns_db getrow $db $selection]} {
+
+	    set result [list]
+	    for {set i 0} {$i < [ns_set size $selection]} {incr i} {
+		set column [ns_set key $selection $i]
+		set value [ns_set value $selection $i]
+		ns_log Notice "sqlapi.select: i=$i, column=$column, value=$value"
+		
+		lappend result $column
+		lappend result [list -string $value]
+	    }
+
+	    # Skip any possibly remaining records
+	    ns_db flush $db
+	    
+	    # Return the key-value list as a "struct"
+            return [list -array [list \
+		[list -string "ok"] \
+		[list -struct $result] \
+	    ]]
+
+	} else {
+
+	    return [list -string no_records_found]
+
+	}
+    }
+}
+
+
+ad_proc -public sqlapi.get_object { user_id timestamp token object_type object_id } {
     Retreives all information for an object of a given object type
     Returns:
     1. Status ("ok" or anything else indicating an error)

www/select-test-2.adp

@@ -4,23 +4,38 @@
 
 <h1>@page_title@</h1>
 
+<form action="select-test-2" method=POST>
+<%= [export_form_vars url token timestamp user_id] %>
+<table cellpadding=2 cellspacing=0 border=0>
+<tr class=roweven>
+  <td valign=top>URL:</td>
+  <td>@url@</td>
+</tr>
+<tr class=rowodd>
+  <td valign=top>User ID:</td>
+  <td>@user_id@</td>
+</tr>
+<tr class=roweven>
+  <td valign=top>Timestamp:</td>
+  <td>@timestamp@</td>
+</tr>
+<tr class=rowodd>
+  <td valign=top>Token:</td>
+  <td>@token@</td>
+</tr>
 
-<table cellpadding=1 cellspacing=0 border=0>
+<tr class=roweven>
+  <td valign=top>Object Type:</td>
+  <td><input type=text name=object_type value="im_project" size=20></td>
+</tr>
+<tr class=rowodd>
+  <td valign=top>Object ID:</td>
+  <td><input type=text name=object_id value="9718" size=20></td>
+</tr>
 <tr>
-  <td>Status:</td>
-  <td>@status@</td>
+  <td></td>
+  <td><input type=submit></td>
 </tr>
-<if "" ne @error@>
-	<tr>
-	  <td>Error:</td>
-	  <td>@error@</td>
-	</tr>
-</if>
-<else>
-	<tr>
-	  <td>Object Info:</td>
-	  <td>@result;noquote@</td>
-	</tr>
-</else>
 </table>
+</form>
 

www/select-test.adp

@@ -26,11 +26,11 @@
 
 <tr class=roweven>
   <td valign=top>Object Type:</td>
-  <td><input type=text name=object_type value="im_project" size=20></td>
-</tr>
-<tr class=rowodd>
-  <td valign=top>Object ID:</td>
-  <td><input type=text name=object_id value="9718" size=20></td>
+  <td>
+    <select name=object_type>
+    @select_options;noquoteq@
+    </select>
+  </td>
 </tr>
 <tr>
   <td></td>

www/select-test.tcl

@@ -4,10 +4,10 @@ ad_page_contract {
     
     @author Frank Bergmann (frank.bergmann@project-open.com)
 } {
-    { url ""}
-    { user_id ""}
-    { timestamp ""}
-    { token ""}
+    user_id
+    timestamp
+    token
+    {url "/RPC2/" }
 }
 
 
@@ -27,5 +27,41 @@ if {!$user_is_admin_p} {
 }
 
 # ------------------------------------------------------------
-# 
+# Get the list of object types from the target system
 # ------------------------------------------------------------
+
+set error ""
+set query_results [list]
+if {[catch {
+
+    set query_results [xmlrpc::remote_call http://172.26.0.3:30038/RPC2 sqlapi.select \
+                  -string $user_id \
+                  -string $timestamp \
+                  -string $token \
+                  -string "object_type"
+    ]
+
+} err_msg]} {
+    append error $err_msg
+}
+
+set status [lindex $query_results 0]
+if {"ok" != $status} {
+
+    set error "$status "
+    append error [lindex $query_results 1]
+
+} else {
+
+    set object_fields [lindex $query_results 1]
+    array set ovars $object_fields
+    set keys [array names ovars]
+
+    set result "<table>\n"
+    foreach key $keys {
+	append result "<tr><td>$key</td><td>$ovars($key)</td></tr>\n"
+    }
+    append result "</table>\n"
+}
+
+