Index: openacs-4/packages/new-portal/tcl/datasource-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/new-portal/tcl/datasource-procs.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/new-portal/tcl/datasource-procs.tcl 29 Sep 2001 18:01:44 -0000 1.1
@@ -0,0 +1,109 @@
+# tcl/datasource-procs.tcl
+
+ad_library {
+ Private procs that evaluate specific content- and data-types for datasources.
+
+ @author Ian Baker (ibaker@arsdigita.com)
+ @creation-date 12/6/2000
+ @cvs-id $Id: datasource-procs.tcl,v 1.1 2001/09/29 18:01:44 oracle Exp $
+}
+
+
+ad_proc -private portal_render_datasource_raw { ds cf } {
+ Accepts no parameters.
+} {
+ array set src $ds
+
+ if { [empty_string_p $src(content) ] } {
+ return -code error "No content for raw datasource '$src(name)'"
+ }
+
+ return $src(content)
+}
+
+ad_proc -private portal_render_datasource_tcl_proc { ds cf } {
+ Accepts params.
+} {
+ array set src $ds
+
+ if [catch {set output [ eval "$src(content) { $cf }" ] } errmsg ] {
+ return -code error "Error processing datasource '$src(name)': $errmsg"
+ }
+
+ # in case the data feed code didn't explicitly return.
+ return $output
+}
+
+ad_proc -private eval_raw {input} {
+ A helper proc for portal_render_datasource_tcl_raw. It's there because
+ return doesn't work right with eval from within a catch.
+} {
+ return [eval $input]
+}
+
+ad_proc -private portal_render_datasource_tcl_raw { ds cf } {
+ Accepts no params.
+} {
+ array set src $ds
+
+ if [catch {set output [ eval_raw $src(content) ] } errmsg ] {
+ return -code error "Error processing datasource '$src(name)': $errmsg"
+ }
+
+ # in case the data feed code didn't explicitly return.
+ return $output
+}
+
+ad_proc -private portal_render_datasource_url { ds cf } {
+ Accepts params.
+} {
+ array set conf $cf
+ array set src $ds
+
+ # this is complicated. There's argument processing and caching and stuff.
+ return -code error "URL data_type not currently implemented. Sorry...
+ Your URL was: $src(content)
"
+}
+
+ad_proc -private portal_render_datasource_adp { ds cf } {
+ Accepts no params.
+} {
+ array set src $ds
+
+ # this should actually "compile" the ADP into Tcl, and cache the
+ # compiled code.
+ return [ ns_adp_parse $src(content) ]
+}
+
+
+ad_proc -public portal_export { exports } {
+ Exports the same variables as where received by this connection,
+ but with variables in exports added or overridden.
+
+ @author Lee Denison (lee@arsdigita.com)
+ @return the export list
+ @param exports the values to be exported
+} {
+ set output [list]
+ set form_set [ns_getform]
+
+ if {![empty_string_p $form_set]} {
+ set form_set [ns_set copy $form_set]
+ } else {
+ set form_set [ns_set new]
+ }
+
+ foreach {name value} $exports {
+ ns_set update $form_set $name $value
+ }
+
+ set size [ns_set size $form_set]
+ for {set i 0} {$i < $size} {incr i} {
+ set name [ns_set key $form_set $i]
+ set value [ns_set value $form_set $i]
+
+ lappend output [ad_export_vars [list [list $name $value]]]
+ }
+
+ return [join $output "&"]
+}
Index: openacs-4/packages/new-portal/tcl/filter-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/new-portal/tcl/Attic/filter-procs.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/new-portal/tcl/filter-procs.tcl 29 Sep 2001 18:01:44 -0000 1.1
@@ -0,0 +1,62 @@
+# tcl/filter-procs.tcl
+
+ad_library {
+ ad_page_contract filters specific to portal.
+
+ @author Ian Baker (ibaker@arsdigita.com)
+ @creation-date 12/13/2000
+ @cvs-id $Id: filter-procs.tcl,v 1.1 2001/09/29 18:01:44 oracle Exp $
+}
+
+ad_page_contract_filter permission { name value permission } {
+ Checks whether the current user has the specified permission on the object indicated by $value.
+ If $value is the empty string, return true.
+
+ @param name
+ @param value
+ @param permission
+} {
+ # don't use ad_require_permission, since it prohibits inclusion of any other
+ # complaints.
+ if { ![empty_string_p $value] && ![ad_permission_p $value read] } {
+ ad_complain "You don't have $permission permission on $name, or the object doesn't exist."
+ return 0
+ }
+ return 1
+}
+
+
+ad_page_contract_filter object_read { name value } {
+ The value is an ACS Object. Checks whether the current user can read it.
+} {
+ ns_log Notice "*****************deprecated"
+ if { ! [ad_permission_p $value read] } {
+ ad_complain "You don't have permission to read $name, or it doesn't exist."
+ return 0
+ }
+ return 1
+}
+
+ad_page_contract_filter object_write { name value } {
+ The value is an ACS Object. Checks whether the current user can write it.
+} {
+ ns_log Notice "*****************deprecated"
+
+ if { ! [ad_permission_p $value write] } {
+ ad_complain "You don't have permission to write $name, or it doesn't exist."
+ return 0
+ }
+ return 1
+}
+
+ad_page_contract_filter object_admin { name value } {
+ The value is an ACS Object. Checks whether the current user can admin it.
+} {
+ ns_log Notice "*****************deprecated"
+
+ if { ! [ad_permission_p $value admin] } {
+ ad_complain "You don't have permission to administer $name, or it doesn't exist."
+ return 0
+ }
+ return 1
+}
Index: openacs-4/packages/new-portal/tcl/portal-init.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/new-portal/tcl/portal-init.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/new-portal/tcl/portal-init.tcl 29 Sep 2001 18:01:44 -0000 1.1
@@ -0,0 +1 @@
\ No newline at end of file
Index: openacs-4/packages/new-portal/tcl/portal-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/new-portal/tcl/portal-procs.tcl,v
diff -u -r1.3 -r1.4
--- openacs-4/packages/new-portal/tcl/portal-procs.tcl 29 Sep 2001 17:18:18 -0000 1.3
+++ openacs-4/packages/new-portal/tcl/portal-procs.tcl 29 Sep 2001 18:01:44 -0000 1.4
@@ -58,6 +58,7 @@
@creation-date 9/28/2001
} {
+set portal_id 2317
set user_id [ad_conn user_id]
@@ -82,7 +83,7 @@
}
# is there an automatic way to determine this path?
-set element_src "[portal_path]/www/render-element"
+set element_src "[portal_path]/www/render_element"
set element_list [array get element_ids]
@@ -94,14 +95,49 @@
ad_script_abort
}
-ad_return_template
+ad_return_template [portal_path]/www/index
}
+ad_proc -public portal_render_element { element_id region_id } {
+ Wrapper for the below proc
+ @return
+ @param element_id
+ @param region_id
+ @author Arjun Sanyal
+ @creation-date Sept 2001
+} {
+
+# get the complete, evaluated element.
+# if there's an error, report it.
+if { [catch {set element_data [portal_evaluate_element $element_id] } errmsg ] } {
+ if { [ad_parameter log_datasource_errors_p] } {
+ ns_log Error "portal: $errmsg"
+ }
+
+ if { [ad_parameter show_datasource_errors_p] } {
+ set element(content) "$errmsg
"
+ set element(mime_type) "text/html"
+ } else {
+ return
+ }
+} else {
+ array set element $element_data
+}
+
+# consistency is good.
+set element(region) $region
+
+# return the appropriate template for that element.
+ad_return_template "layouts/mime-types/$element(mime_type_noslash)"
+
+}
+
+
ad_proc -public portal_evaluate_element { element_id } {
Get an element. Combine the datasource, template, etc. Return a suitable
chunk of HTML.
Index: openacs-4/packages/new-portal/tcl/template-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/new-portal/tcl/Attic/template-procs.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/new-portal/tcl/template-procs.tcl 29 Sep 2001 18:01:44 -0000 1.1
@@ -0,0 +1,33 @@
+# www/tcl/template-procs.tcl
+
+ad_library {
+ Procs for use in presentation.
+
+ @author Ian Baker (ibaker@arsdigita.com)
+ @creation-date 12/11/2000
+ @cvs-id $Id: template-procs.tcl,v 1.1 2001/09/29 18:01:44 oracle Exp $
+}
+
+ad_proc -public portal_layout_elements { element_list {var_stub "element_ids"} } {
+ Split a list up into a bunch of variables for inserting into a layout
+ template. This seems pretty kludgy (probably because it is), but a
+ template::multirow isn't really well suited to data of this shape. It'll setup a set
+ of variables, $var_stub_1 - $var_stub_8 and $var_stub_i1 - $var_stub_i8, each
+ contining the portal_ids that belong in that region.
+
+ @creation-date 12/11/2000
+ @param element_id_list An [array get]'d array, keys are regions, values are lists of element_ids.
+ @param var_stub A name upon which to graft the bits that will be passed to the template.
+} {
+ array set elements $element_list
+
+ foreach idx [list 1 2 3 4 5 6 7 8 9 i1 i2 i3 i4 i5 i6 i7 i8 i9 ] {
+ upvar [join [list $var_stub "_" $idx] ""] group
+ if { [info exists elements($idx) ] } {
+ set group $elements($idx)
+ } else {
+ set group {}
+ }
+ }
+}
+