Index: openacs-4/packages/acs-tcl/tcl/community-core-procs-oracle.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/community-core-procs-oracle.xql,v diff -u -r1.21 -r1.22 --- openacs-4/packages/acs-tcl/tcl/community-core-procs-oracle.xql 21 Feb 2018 14:00:55 -0000 1.21 +++ openacs-4/packages/acs-tcl/tcl/community-core-procs-oracle.xql 28 Jun 2018 09:10:14 -0000 1.22 @@ -35,5 +35,51 @@ - + + + + (object_type = 'group' or object_type = 'person') + + + + + + object_type = :start_with + + + + + + + select + types.pretty_name, + types.object_type, + types.tree_level, + types.indent, + case when valid_types.object_type = null then 0 else 1 end as valid_p + from + (select + t.pretty_name, t.object_type, level as tree_level, + replace(lpad(' ', (level - 1) * 4), + ' ', ' ') as indent, + rownum as tree_rownum + from + acs_object_types t + connect by + prior t.object_type = t.supertype + start with + $start_with_clause ) types, + (select + object_type + from + rel_types_valid_obj_two_types + where + rel_type = :rel_type ) valid_types + where + types.object_type = valid_types.object_type(+) + order by tree_rownum + + + + Index: openacs-4/packages/acs-tcl/tcl/community-core-procs-postgresql.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/community-core-procs-postgresql.xql,v diff -u -r1.22 -r1.23 --- openacs-4/packages/acs-tcl/tcl/community-core-procs-postgresql.xql 21 Feb 2018 14:00:55 -0000 1.22 +++ openacs-4/packages/acs-tcl/tcl/community-core-procs-postgresql.xql 28 Jun 2018 09:10:14 -0000 1.23 @@ -32,5 +32,44 @@ - + + + + (t1.object_type = 'group' or t1.object_type = 'person') + + + + + + t1.object_type = :start_with + + + + + + + select types.pretty_name, + types.object_type, + types.tree_level, + types.indent, + case when valid_types.object_type = null then 0 else 1 end as valid_p + from (select t2.pretty_name, + t2.object_type, + tree_level(t2.tree_sortkey) - tree_level(t1.tree_sortkey) as tree_level, + repeat(' ', (tree_level(t2.tree_sortkey) - tree_level(t1.tree_sortkey)) * 4) as indent, + t2.tree_sortkey + from acs_object_types t1, + acs_object_types t2 + where t2.tree_sortkey between t1.tree_sortkey and tree_right(t1.tree_sortkey) + and $start_with_clause ) types + left outer join + (select object_type + from rel_types_valid_obj_two_types + where rel_type = :rel_type ) valid_types + using (object_type) + order by types.tree_sortkey + + + + Index: openacs-4/packages/acs-tcl/tcl/community-core-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/community-core-procs.tcl,v diff -u -r1.86 -r1.87 --- openacs-4/packages/acs-tcl/tcl/community-core-procs.tcl 27 Jun 2018 15:54:21 -0000 1.86 +++ openacs-4/packages/acs-tcl/tcl/community-core-procs.tcl 28 Jun 2018 09:10:14 -0000 1.87 @@ -805,6 +805,20 @@ } } +ad_proc -public party::party_p { + -object_id:required +} { + + @author Malte Sussdorff + @creation-date 2007-01-26 + + @param object_id object_id which is checked if it is a party + @return true if object_id is a party + +} { + return [llength [party::get -party_id $object_id] != 0] +} + ad_proc -public party::flush_cache { {-party_id:required} } { @@ -822,6 +836,205 @@ } } +ad_proc party::types_valid_for_rel_type_multirow { + {-datasource_name object_types} + {-start_with party} + {-rel_type "membership_rel"} +} { + creates multirow datasource containing party types starting with + the $start_with party type. The datasource has columns that are + identical to the relation_types_allowed_to_group_multirow, which is why + the columns are broadly named "object_*" instead of "party_*". A + common template can be used for generating select widgets etc. for + both this datasource and the relation_types_allowed_to_groups_multirow + datasource. + + All subtypes of $start_with are returned, but the "valid_p" column in + the datasource indicates whether the type is a valid one for $group_id. + + Includes fields that are useful for + presentation in a hierarchical select widget: + + + @author Oumi Mehrotra (oumi@arsdigita.com) + @creation-date 2000-02-07 + + @param datasource_name + @param start_with + @param rel_type - if unspecified, then membership_rel is used +} { + + template::multirow create $datasource_name \ + object_type object_type_enc indent pretty_name valid_p + + # Special case "party" because we don't want to display "party" itself + # as an option, and we don't want to display "rel_segment" as an + # option. + if {$start_with eq "party"} { + set start_with_clause [db_map start_with_clause_party] + } else { + set start_with_clause [db_map start_with_clause] + } + + db_foreach select_sub_rel_types {} { + template::multirow append $datasource_name $object_type \ + [ad_urlencode $object_type] $indent $pretty_name $valid_p + } + +} + +ad_proc -public party::name { + {-party_id ""} + {-email ""} +} { + Gets the party name of the provided party_id + + @author Miguel Marin (miguelmarin@viaro.net) + @author Viaro Networks www.viaro.net + + @author Malte Sussdorff (malte.sussdorff@cognovis.de) + + @param party_id The party_id to get the name from. + @param email The email of the party + + @return The party name +} { + if {$party_id eq "" && $email eq ""} { + error "You need to provide either party_id or email" + } elseif {"" ne $party_id && "" ne $email } { + error "Only provide party_id OR email, not both" + } + + if {$party_id eq ""} { + set party_id [party::get_by_email -email $email] + } + + if {[person::person_p -party_id $party_id]} { + set name [person::name -person_id $party_id] + } else { + set name "" + + if { [apm_package_installed_p "organizations"] } { + set name [db_string get_org_name {} -default ""] + } + + if { $name eq "" } { + set name [db_string get_group_name {} -default ""] + } + + if { $name eq "" } { + set name [db_string get_party_name {} -default ""] + } + + } + return $name +} + +ad_proc party::new { + { -form_id "" } + { -variable_prefix "" } + { -creation_user "" } + { -creation_ip "" } + { -party_id "" } + { -context_id "" } + { -email "" } + party_type +} { + Creates a party of this type by calling the .new function for + the package associated with the given party_type. This + function will fail if there is no package. + +

+ There are now several ways to create a party of a given + type. You can use this Tcl API with or without a form from the form + system, or you can directly use the PL/SQL API for the party type. + +

Examples: + 

+
+    # OPTION 1: Create the party using the Tcl Procedure. Useful if the
+    # only attribute you need to specify is the party name
+
+    db_transaction {
+        set party_id [party::new -email "joe@foo.com" $party_type]
+    }
+
+
+    # OPTION 2: Create the party using the Tcl API with a templating
+    # form. Useful when there are multiple attributes to specify for the
+    # party
+
+    template::form create add_party
+    template::element create add_party email -value "joe@foo.com"
+
+    db_transaction {
+        set party_id [party::new -form_id add_party $party_type ]
+    }
+
+    # OPTION 3: Create the party using the PL/SQL package automatically
+    # created for it
+
+    # creating the new party
+    set party_id [db_exec_plsql add_party "
+      begin
+        :1 := ${party_type}.new (email => 'joe@foo.com');
+      end;
+    "]
+
+
+ + @author Oumi Mehrotra (oumi@arsdigita.com) + @creation-date 2001-02-08 + + @return party_id of the newly created party + + @param form_id The form id from templating form system (see + example above) + + @param email The email of this party. Note that if + email is specified explicitly, this value will be used even if + there is a email attribute in the form specified by + form_id. + + @param party_type The type of party we are creating + +} { + + # We select out the name of the primary key. Note that the + # primary key is equivalent to party_id as this is a subtype of + # acs_party + + if { ![db_0or1row package_select { + select t.package_name, lower(t.id_column) as id_column + from acs_object_types t + where t.object_type = :party_type + }] } { + error "Object type \"$party_type\" does not exist" + } + + set var_list [list \ + [list context_id $context_id] \ + [list $id_column $party_id] \ + [list "email" $email]] + + return [package_instantiate_object \ + -creation_user $creation_user \ + -creation_ip $creation_ip \ + -package_name $package_name \ + -start_with "party" \ + -var_list $var_list \ + -form_id $form_id \ + -variable_prefix $variable_prefix \ + $party_type] + +} + ad_proc -public party::update { {-party_id:required} {-email} Index: openacs-4/packages/acs-tcl/tcl/community-core-procs.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/community-core-procs.xql,v diff -u -r1.32 -r1.33 --- openacs-4/packages/acs-tcl/tcl/community-core-procs.xql 26 Jun 2018 13:45:52 -0000 1.32 +++ openacs-4/packages/acs-tcl/tcl/community-core-procs.xql 28 Jun 2018 09:10:14 -0000 1.33 @@ -82,7 +82,6 @@ - @@ -93,6 +92,39 @@ + + + select + name + from + organizations + where + organization_id = :party_id + + + + + + select + group_name + from + groups + where + group_id = :party_id + + + + + + select + party_name + from + party_names + where + party_id = :party_id + + + Index: openacs-4/packages/acs-tcl/tcl/deprecated-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/deprecated-procs.tcl,v diff -u -r1.19 -r1.20 --- openacs-4/packages/acs-tcl/tcl/deprecated-procs.tcl 17 May 2018 14:42:03 -0000 1.19 +++ openacs-4/packages/acs-tcl/tcl/deprecated-procs.tcl 28 Jun 2018 09:10:14 -0000 1.20 @@ -3177,7 +3177,33 @@ # deprecated site-nodes-procs.tcl ######################################################################## +######################################################################## +# deprecated party-procs.tcl +######################################################################## +namespace eval party { + + ad_proc -deprecated -public permission_p { + { -user_id "" } + { -privilege "read" } + party_id + } { + Wrapper for ad_permission to allow us to bypass having to + specify the read privilege + + Deprecated: just another wrapper for permission::permission_p + + @author Michael Bryzek (mbryzek@arsdigita.com) + @creation-date 10/2000 + + @see permission::permission_p + + } { + return [permission::permission_p -party_id $user_id -object_id $party_id -privilege $privilege] + } + +} + # Local variables: # mode: tcl # tcl-indent-level: 4