ad_category_parentage_list

one of the documented procedures in this installation of the ACS
Usage:
ad_category_parentage_list   db   category_id
What it does:
Returns a list of lists, where each sublist is one line of parentage up from the specified category to the hierarchy root. In turn, each parentage line list consists of two-item lists: category_id and category. A list of lists is needed since a category can have multiple parents. If this category has no parents, then return the empty list.
Defined in: /web/philip/tcl/ad-categories.tcl

Source code:



    set n_parents [database_to_tcl_string $db "select count(*) from category_hierarchy where child_category_id = $category_id and parent_category_id is not null"]

    if { $n_parents == 0 } {
	return [list]
    }

    # (2000-04-05 Seb) Note that we have one big problem:  suppose that
    # we have 1 parent for this category.  But its parent has 2 parents.
    # That leads us to question: how many parentage lines does this
    # category actually have?  My vote is 1.  But then the UI is
    # misleading, because we don't know which parentage line to
    # display ... but what if we replace all above ill-behaving parent
    # with ellipsis?

    #   OK, seems like a good idea.  So, we should build parentage tree
    # for category and follow the changes of LEVEL.  If equal to 1, we
    # have direct parent.  Check if the LEVEL is increasing until it
    # drops to 1 again.  If it was increasing all the time until next
    # level==1 is reached, we have 'direct' parentage line (no-problem).
    # Otherwise, print only the portion up to the line with the highest
    # non-repeating value of LEVEL.

    set category_name [database_to_tcl_string $db "select c.category from categories c where c.category_id='$category_id'"]

    set selection [ns_db select $db "
SELECT c.category_id AS parent_id, c.category AS parent_category, hc.level_col
FROM categories c,
(SELECT h.parent_category_id, LEVEL AS level_col, ROWNUM AS row_col
 FROM category_hierarchy h
 START WITH h.child_category_id = $category_id
 CONNECT BY h.child_category_id = PRIOR h.parent_category_id) hc
WHERE c.category_id = hc.parent_category_id
ORDER BY hc.row_col"]

    set parentage_list [list]
    set parentage_line [list [list $category_id $category_name]]
    set prior_level 0
    set forking_level 9999
    while {[ns_db getrow $db $selection]} {
	set_variables_after_query

	if {$level_col <= $prior_level} {
	    if {$level_col == 1} {
		# Parent line is now completed, flush it:
		# Take only up to the last non-forking parent
		#   (level increases from right to left)
		lappend parentage_list [lrange $parentage_line [expr  [llength $parentage_line] - $forking_level] end]
		set parentage_line [list [list $category_id $category_name]]
		set forking_level 9999
	    } else {
		# We have problematic parent (i.e. that is itself
		# multi-parented)
		if {$level_col < $forking_level} {
		    set forking_level $level_col
		    #  Add (...) in front of category name at $level_col - 1
		    set last_nonforking_level [expr  [llength $parentage_line] - $forking_level]
		    set problematic_category [lindex $parentage_line  $last_nonforking_level]
		    set probl_cat_id [lindex $problematic_category 0]
		    set probl_cat_name "(...) [lindex $problematic_category 1]"
		    #  Put it back
		    set parentage_line [lreplace $parentage_line  $last_nonforking_level $last_nonforking_level  [list $probl_cat_id $probl_cat_name]]
		}
	    }
	}

	set prior_level $level_col

	# We're moving up the hierarchy so put this category at
	# the beginning of the parentage line.
	#
	set parentage_line [concat [list [list $parent_id $parent_category]] $parentage_line]
    }

    # Don't forget the last parentage line
    lappend parentage_list [lrange $parentage_line [expr  [llength $parentage_line] - $forking_level] end]


philg@mit.edu