Index: openacs-4/packages/acs-tcl/tcl/object-type-procs-oracle.xql
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/object-type-procs-oracle.xql,v
diff -u -N -r1.1 -r1.2
--- openacs-4/packages/acs-tcl/tcl/object-type-procs-oracle.xql	13 May 2001 05:24:27 -0000	1.1
+++ openacs-4/packages/acs-tcl/tcl/object-type-procs-oracle.xql	3 Apr 2005 09:33:55 -0000	1.2
@@ -28,4 +28,14 @@
       </querytext>
 </partialquery>
 
+<fullquery name="acs_object_type::supertype.supertypes">      
+      <querytext>
+          select object_type
+            from acs_object_types
+           start with object_type = :subtype
+      connect by prior supertype = object_type
+        order by level desc
+      </querytext>
+</fullquery>
+
 </queryset>
Index: openacs-4/packages/acs-tcl/tcl/object-type-procs-postgresql.xql
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/object-type-procs-postgresql.xql,v
diff -u -N -r1.5 -r1.6
--- openacs-4/packages/acs-tcl/tcl/object-type-procs-postgresql.xql	4 Dec 2001 00:20:47 -0000	1.5
+++ openacs-4/packages/acs-tcl/tcl/object-type-procs-postgresql.xql	3 Apr 2005 09:33:55 -0000	1.6
@@ -31,4 +31,17 @@
       </querytext>
 </partialquery>
 
+<fullquery name="acs_object_type::supertype.supertypes">      
+      <querytext>
+        select o2.object_type
+          from acs_object_types o1, 
+               acs_object_types o2
+         where o1.object_type = :subtype
+           and o2.tree_sortkey <= o1.tree_sortkey
+           and o1.tree_sortkey between o2.tree_sortkey 
+                                   and tree_right(o2.tree_sortkey)
+         order by tree_level(o2.tree_sortkey) desc
+      </querytext>
+</fullquery>
+ 
 </queryset>
Index: openacs-4/packages/acs-tcl/tcl/object-type-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/object-type-procs.tcl,v
diff -u -N -r1.4 -r1.5
--- openacs-4/packages/acs-tcl/tcl/object-type-procs.tcl	10 Nov 2003 12:35:13 -0000	1.4
+++ openacs-4/packages/acs-tcl/tcl/object-type-procs.tcl	3 Apr 2005 09:33:55 -0000	1.5
@@ -94,3 +94,41 @@
         where  object_type = :object_type
     } -column_array row
 }
+
+ad_proc -private acs_object_type::acs_object_instance_of {
+    {-object_id:required}
+    {-type:required}
+} {
+    Returns true if the specified object_id is a subtype of the specified type.
+    This is an inclusive check.
+
+    @author Lee Denison (lee@thaum.net)
+} {
+    acs_object::get -object_id $object_id -array obj
+
+    return [acs_object_type::supertype \
+        -supertype $type \
+        -subtype $obj(object_type)]
+}
+
+ad_proc -private acs_object_type::supertype {
+    {-supertype:required}
+    {-subtype:required}
+    {-no_cache:boolean}
+} {
+    Returns true if subtype is equal to, or a subtype of, supertype.
+
+    @author Lee Denison (lee@thaum.net)
+} {
+    if {$no_cache_p} {
+        set supertypes [db_list supertypes {}]
+
+        return [expr {[lsearch $supertypes $supertype] >= 0}]
+    } else {
+        return [util_memoize [list acs_object_type::supertype \
+            -supertype $supertype \
+            -subtype $subtype \
+            -no_cache]]
+    }
+}
+