Skip to content

I
intranet-xmlrpc
Commit 684ed388 authored by Frank Bergmann's avatar Frank Bergmann
Browse files
Options

- added object_fields call to check for fields

parent dc8e5575
Hide whitespace changes
Inline Side-by-side
Showing with 196 additions and 69 deletions
tcl/intranet-xmlrpc-init.tcl
View file @ 684ed388
......@@ -8,6 +8,4 @@ xmlrpc::register_proc sqlapi.login
xmlrpc::register_proc sqlapi.select
xmlrpc::register_proc sqlapi.object_info
xmlrpc::register_proc sqlapi.object_types
xmlrpc::register_proc sqlapi.object_fields
tcl/intranet-xmlrpc-procs.tcl
View file @ 684ed388
......@@ -114,6 +114,71 @@ ad_proc -public sqlapi.object_types { authinfo } {
}
ad_proc -public sqlapi.object_fields { authinfo object_type } {
Retreives a list of all object fields, together with
their SQL datatype.
} {
ns_log Notice "sqlapi.object_fields: authinfo=$authinfo"
set auth_error [sqlapi.authenticate $authinfo]
if {[llength $auth_error] > 0} { return $auth_error }
ns_log Notice "sqlapi.object_fields: authentication successful"
set result [list]
set query "
select lower(column_name) as column_name,
lower(data_type) as data_type
from user_tab_columns
where lower(table_name) in (
select lower(table_name)
from acs_object_type_tables
where object_type = :object_type
UNION
select lower(table_name)
from acs_object_types
where object_type = :object_type
)
order by column_name
"
db_foreach object_fields $query {
lappend result [list -array [list \
[list -string $column_name] \
[list -string $data_type] \
]]
}
# Return {"ok", {<key-value list>}}
return [list -array [list \
[list -string "ok"] \
[list -array $result] \
]]
}
ad_proc -private sqlapi.select_where_clause { constraints } {
Convert a list of constraints into a where clause.
In the future we might want to check permissions here,
currently, everything goes.
} {
ns_log Notice "sqlapi.select_where_clause: constraints=$constraints"
set constrs [list]
foreach c $constraints {
# Expecting something like {project_name like 'Test%'} in c
set cc [join $c " "]
ns_log Notice "sqlapi.select_where_clause: cc=$cc"
lappend constrs $cc
}
set where_clause [join $constrs "\n\tand "]
ns_log Notice "sqlapi.select_where_clause: where_clause = $where_clause"
if {[llength $constrs] > 0} { set where_clause "and $where_clause" }
return $where_clause
}
ad_proc -public sqlapi.select { authinfo object_type constraints } {
Retreives all information for an object of a given object type
Returns:
......@@ -137,27 +202,46 @@ ad_proc -public sqlapi.select { authinfo object_type constraints } {
where object_type = :object_type
" -default ""]
set where_clause [sqlapi.select_where_clause $constraints]
set query "
select $id_column,
acs_object__name($id_column) as name
from $object_table
where 1=1
where 1=1 $where_clause
"
ns_log Notice "sqlapi.select: object_table=$object_table, id_column=$id_column, sql=$query"
set result [list]
db_foreach select_query $query {
lappend result [list -array [list [list -int [expr $$id_column]] [list -string $name]]]
set err_msg ""
catch {
db_foreach select_query $query {
lappend result [list -array \
[list [list -int [expr $$id_column]] \
[list -string $name]] \
]
}
} err_msg
ns_log Notice "sqlapi.select: err_msg=$err_msg"
if {"" != $err_msg} {
# Return an error structure
ns_log Notice "sqlapi.select: Return error structure: err_msg=$err_msg"
return [list -array [list \
[list -string "error_sql"] \
[list -string $err_msg] \
]]
} else {
# Return the key-value list as a "struct"
ns_log Notice "sqlapi.select: Return result=$result"
return [list -array [list \
[list -string "ok"] \
[list -array $result] \
]]
}
# Return the key-value list as a "struct"
return [list -array [list \
[list -string "ok"] \
[list -array $result] \
]]
}
......@@ -230,7 +314,7 @@ ad_proc -public sqlapi.object_info { authinfo object_id } {
}
ad_proc -public sqlapi.login {email password} {
ad_proc -public sqlapi.login {email timestamp password} {
Returns an authentication token of the user provides
us with a valid email/password
......
www/login-test-2.tcl
View file @ 684ed388
......@@ -5,6 +5,7 @@ ad_page_contract {
@author Frank Bergmann (frank.bergmann@project-open.com)
} {
email
timestamp
pass
url
{method "sqlapi.login"}
......@@ -25,13 +26,23 @@ set current_user_id [im_xmlrpc_get_user_id]
# ------------------------------------------------------------
set error ""
set result ""
set status "error"
set user_id ""
set timestamp ""
set token ""
set result ""
set info ""
set status "error"
if {[catch {
set login_result [xmlrpc::remote_call $url sqlapi.login -string $email -string $pass]
set login_result [xmlrpc::remote_call \
$url \
sqlapi.login \
-string $email \
-string $timestamp \
-string $pass \
]
set status [lindex $login_result 0]
set user_id [lindex $login_result 1]
set timestamp [lindex $login_result 2]
......
www/login-test.adp
View file @ 684ed388
......@@ -8,12 +8,14 @@
This form has already been set to a testing user.<br>
You just need to press Submit:
<ul>
<li>Server: <br>
<li>URL:<br>
Please use "http://172.26.0.3:30038/RPC2" to connect<br>
to our internal test server or choose your own XML-RPC server.
</li>
<li>Email: <br>
"ssales@tigerpond.com"</li>
<li>Timestamp: <br>
"" (leave empty for perpetual)</li>
<li>Passwd: <br>
"sally"</li>
</ul>
......@@ -30,6 +32,10 @@ You just need to press Submit:
<td valign=top>Email:</td>
<td><input type=text name=email value="ssales@tigerpond.com" size=30></td>
</tr>
<tr>
<td valign=top>Timestamp:</td>
<td><input type=text name=timestamp value="" size=30></td>
</tr>
<tr>
<td valign=top>Password:</td>
<td><input type=password name=pass value="sally" size=30></td>
......
www/select-test-2.adp
View file @ 684ed388
......@@ -4,43 +4,73 @@
<h1>@page_title@</h1>
<form action="select-test-4" method=POST>
<%= [export_form_vars url token timestamp user_id object_type] %>
<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>
<tr class=roweven>
<td valign=top>Object Type:</td>
<td><input type=text name=object_type value="@object_type@" size=20 disabled></td>
</tr>
<tr class=rowodd>
<td valign=top>Object ID:</td>
<td>
<select name=object_id>
@object_id_options;noquote@
</select>
</td>
</tr>
<tr>
<td></td>
<td><input type=submit></td>
</tr>
</table>
</form>
<if "ok" eq @status@>
<form action="select-test-3" method=POST>
<%= [export_form_vars url token timestamp user_id object_type] %>
<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>
<tr class=roweven>
<td valign=top>Object Type:</td>
<td><input type=text name=object_type value="@object_type@" size=20 disabled></td>
</tr>
<tr class=rowodd>
<td valign=top>Cond:</td>
<td>
<table><tr>
<td>
<select name=column_name>
@column_options;noquote@
</select>
</td>
<td>
<select name=column_operator>
<option value="=">=</option>
<option value=">">&gt;</option>
<option value="<">&lt;</option>
<option value="like">like</option>
<option value="is">is</option>
<option value="is not" selected>is not</option>
</select>
</td>
<td>
<input type=text name=column_value value="null" size=10>
</td>
</tr></table>
</td>
</tr>
<tr>
<td></td>
<td><input type=submit></td>
</tr>
</table>
</form>
</if>
<else>
<ul>
<li>Error: @error@
<li>Message:<br><pre>@error_msg@</pre>
</ul>
</else>
www/select-test-2.tcl
View file @ 684ed388
......@@ -44,11 +44,10 @@ if {[catch {
]
set query_results [xmlrpc::remote_call \
http://172.26.0.3:30038/RPC2 \
"sqlapi.select" \
$url \
"sqlapi.object_fields" \
-array $authinfo \
-string $object_type \
-array [list [list -string foo] [list -string "bar"]]
-string $object_type
]
} err_msg]} {
......@@ -57,21 +56,20 @@ if {[catch {
set status [lindex $query_results 0]
set object_id_options [list]
set column_options [list]
if {"ok" != $status} {
set error "$status "
append error [lindex $query_results 1]
set error_msg [lindex $query_results 1]
} else {
set object_ids [lindex $query_results 1]
foreach id $object_ids {
set object_id [lindex $id 0]
set object_name [lindex $id 1]
append object_id_options "<option value=\"$object_id\">$object_name</option>\n"
set columns [lindex $query_results 1]
foreach column $columns {
set column_name [lindex $column 0]
append column_options "<option value=\"$column_name\">$column_name</option>\n"
}
}
......
www/select-test.adp
View file @ 684ed388
......@@ -23,7 +23,6 @@
<td valign=top>Token:</td>
<td>@token@</td>
</tr>
<tr class=roweven>
<td valign=top>Object Type:</td>
<td>
......@@ -32,6 +31,7 @@
</select>
</td>
</tr>
<tr>
<td></td>
<td><input type=submit></td>
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment