Graphical Hierarchical Tree

[yojimbo]

I wrote a project a while ago, to allow web-based discussions with threading of user comments. It was deficient in more ways than I care to list, and I'm thinking of a major rewrite/overhaul. For the threading, I used this code (it links to a MySQL database which stored the discussions):

sub getarticles {                                                     
+                                                                
        my $article = shift;                                          
+                                                                
        my $query = qq(SELECT reply FROM replies WHERE article=$articl
+e ORDER BY reply);                                              
        my $sth = $dbh->prepare($query);                              
+                                                                
        $sth->execute;                                                
+                                                                
        $sth->rows or return 0;                                       
+                                                                
        while (my $reply = $sth->fetchrow) {                          
+                                                                
                my $query = qq(SELECT timestamp, subject, author FROM 
+article WHERE id=$reply);                                       
                my $sth = $dbh->prepare($query);                      
+                                                                
                $sth->execute;                                        
+                                                                
                my ($timestamp, $subject, $author) = $sth->fetchrow;  
+                                                                
                $sth->finish;                                         
+                                                                
                ( code to show the retrieved items as html, snipped )
                $indent++;                                            
+                                                                
                &getarticles($reply);                                 
+                                                                
                $indent--;                                            
+                                                                
        }                                                             
+                                                                
        $sth->finish;                                                 
+                                                                
        return;                                                       
+                                                                
}

This produces output like this:

First comment
        First reply
        Second reply
                First reply to Second reply above
                Second reply to Second reply above
        Third reply

I would like to know how I could produce output similar to the unix "tree" program, ie with lines to indicate relationships between nodes:

First comment
`-------First reply
`-------Second reply
|       `-------First reply to Second reply above
|       `-------Second reply to Second reply above
`-------Third reply

And any other observations you might care to make. TIA.

2001-03-04 Edited by Corion : Changed <PRE> tags to <CODE> tags.

[fundflow]

You should print something like:

    print '--'x$indent, $subject;

[dfog]

Having done this sort of tree before, I know it is tougher to code than it first sounds. The following code prints out appoximately what you asked for in the command line, and should be fairly easily be tweaked to your needs. The hash is just there to emulate the database I don't have.

The main thing that is done is that all the replies at any given level are queried before getting their children. This allows us to check whether to make the pipes downward, or just leave whitespace. HTH Dave

#!perl 
use strict;


my @RootArticles = ("ArtA", "ArtB", "ArtC");
my %Children = (
        "ArtA" => "ArtD|ArtE|ArtF",
        "ArtE" => "ArtG|ArtH",
        "ArtC" => "ArtI|ArtJ",
        "ArtI" => "ArtK",
        "ArtK" => "ArtL",
           );
foreach (@RootArticles) {
    &Printout ("", $_);
    &getarticles("", $_);
}

sub getarticles {
    my $IndentString = shift;
        my $article = shift;
    my @Replies = ();
        foreach (split(/\|/, $Children{$article})) {
        push (@Replies, $_);
        }
    while (my $reply = pop(@Replies)) {
        &Printout($IndentString . '`---', $reply);
        my $NewIndent = (@Replies)?"|   ":"    ";
        &getarticles( $NewIndent . $IndentString, $reply);
    }
        return 1;
}

sub Printout {
    my ($IndentString, $String) = @_;
    print "$IndentString$String\n";
}

[yojimbo]

Thanks for that - it made sense after I stepped through it "the old-fashioned way", on paper :-)

[yojimbo]

More than two years since I was here :-) I had a reason to use this code again, and in going through it I found a small bug. As it stands, the code produces output like this, for a particular database app I'm writing:

86
87
`---90
|   `---91
    |   `---92
        |   `---93
`---88
    `---89
94

If you change &getarticles( $NewIndent . $IndentString, $reply); to &getarticles( $IndentString . $NewIndent, $reply); it works OK:

87
`---90
|   `---91
|       `---92
|           `---93
`---88
    `---89
94

YMMV, I've had no time to test this thoroughly.

[Sisyphus]

++nice. However, after adding the -w switch I got lots of uninitialized value warnings. They can be avoided by including an early check in the getarticles subroutine:


sub getarticles {
    my $IndentString = shift;
         my $article = shift;
    return unless $Children{$article};
    ...
}



Granted, not a big deal, but I like it better now, with strictures on.




-- Ricardo

use MacPerl;

[redmist]

I noticed that you declared $quote and $sth twice, once in the main block of your subroutine, and again in the while loop. Not a big deal.

redmist
Silicon Cowboy

[voyager]

Since you asked for any other comments: if you set up the database so that every row has the key of the root ($article in your case, I think), then you can grab all of the replies with one sql statement.

Do the sorting out of the hierarchy on the returned results set. Your response time on an application like this is almost always > 90% a function of your sql. The time taken in the procedural (Perl) code is noise. You stand to gain substantially.

[Yohimbe]

And in the spirit of TIMTOWTDI: This is from UF's soon to be overhauled forum system.

That being said, this code is linear to the number of posts, and does not suffer from problems from extra deeply nested structures.

It also handles moderation and some other things. Please understand, it has some serious issues, and it is being re-vamped.

sub getThreads {
        # main code section for comment display
        # here's where all the deep magic happens.
        # The algorithm is simple, but has a speed issue.
        # 1. select all comments from the db
        # 2. store the comment contents in  %text, keyed by ID
        # 3. Put the id of the parent posting of a given posting in %p
+arent, keyed by ID
        # By nature of the way comments are entered, 
        # we know that a given reply to a comment will always 
        # have a larger ID than its parent,
        # 4. read %parent in reverse order
        #       take the current posting and append it to the parent
        #       since we're in reverse order, parent will always exist
+. and the 
        #       text will appear after the parent, with the newest rep
+lies first on the page
        #       if parent is this post, leave alone -> is a top level 
+post
        #       reply comments are thus added to the top level post

        # 5. read %text in reverse order as well
        #       append the text to the output data
        #       this will give a reverse order thread, but with the ra
+ther
        #       cool side effect of putting the latest thread at the t
+op.
        #       so the latest discussion comes first on the page.
        #       so less scrolling for most posters.
        #
        my ($table,$id,$mode,$dirc,$type,$path,$modmode) = @_;
        if($id !~ /^\d{1,10}$/) {
                return &readfile("$doc_root/templates/badvar.html");
        }
        my ($output,$comment,$thread, $indent, $full, $sort, $cursor);
        if($mode eq 'flat') {
                $indent = 0;
                $full = 1;
        } elsif($mode eq 'thread') {
                $indent = 1;
                $full = 0;
        } elsif($mode eq 'nested') {
                $indent = 1;
                $full = 1;
        } elsif($mode eq 'in-order') {
                $indent = 0;
                $full = 0;
                $sort = "ID $dirc";
        } elsif($mode eq 'indexed' || $mode eq '') {
                $indent = 1;
                $full = 1;
        }
        # select all from the table
        my ($c) = &sqlSelectMany("$table.ID,$table.USERNAME,$table.SUB
+JECT,$table.MESSAGE,$table.TIMESTAMP,$table.STATUS,$table.PARENT,$tab
+le.SUB_PARENT,$table.LEVEL,USERS.EMAIL as EMAIL",
                "$table,USERS",
                "ITEM='$id' && STATUS != 'dead' && USERS.USERNAME=$tab
+le.USERNAME",
                "order by ID");
        my %parent;
        my %text;
        if($c->rows >= 1) {
                while($cursor=$c->fetchrow_hashref) {
                        my $tid         = $cursor->{'ID'};
                        my $username    = $cursor->{'USERNAME'};
                        my $subject     = $cursor->{'SUBJECT'};
                        my $message     = $cursor->{'MESSAGE'};
                        $message =~ s/\n/<br>/g;
                        my $timestamp   = &post_date($cursor->{'TIMEST
+AMP'});
                        my $status      = $cursor->{'STATUS'};
                        my $parent      = $cursor->{'PARENT'};
                        my $sub_parent  = $cursor->{'SUB_PARENT'};
                        my $level       = $cursor->{'LEVEL'};
                        my $email       = $cursor->{'EMAIL'};
                        $parent{$tid}=$sub_parent;
                        if($status eq "active" || ($modmode eq 'yes' &
+& $status ne 'kthread')) {
                                if($modmode eq 'yes' && $status ne 'ac
+tive') {
                                        $subject .= "   &lt;MODERATED&
+gt;";
                                }
                                if(length($email) <= 4) { $email=""; }
                                # parent is hash containing the parent
+ of this posting
                        }
                        elsif ($status eq 'dthread') {
                                $subject = "&lt;Deleted&gt;";
                                $message = "This message has been mode
+rated down, score -1 :)";
                                $username = "&lt;Deleted&gt;";
                                $email = "";
                        }
                        elsif($status eq 'inactive' || $status eq 'kth
+read') {
                                my ($leafchk) = &sqlSelectMany("PARENT
+,ID", $table,
                                        "PARENT = $tid");
                                my $leafrows = $leafchk->rows;

                                my $lfr = $leafchk->fetchrow_hashref;
                                $leafchk->finish;

                                if($leafrows > 1 ||
                                        ($leafrows == 1 &&
                                         $lfr->{'PARENT'} == $lfr->{'I
+D'})) {
                                        $subject = "&lt;Deleted&gt;";
                                        $message = "This message has b
+een moderated down, score -1";
                                        $username = "&lt;Deleted&gt;";
                                        $email = "";
                                }
                                else {
                                        next;
                                }
                        }
                        else {
                                $subject = "&lt;Error&gt;";
                                $message = "This is an Error and is be
+ing looked into.";
                                $username = "lt;Error&gt;";
                                $email = "";
                        }

                        $text{$tid}=&posting($indent,$full,$level,$mod
+e,
                                $id,$tid,$level,$subject,$message,'Yes
+',
                                $email,$username,$timestamp,$type,$pat
+h);
                        # $message is the comment text of this posting
                }

                foreach $node (sort reverse_number (keys (%text)) ) {

                        # for every posting numbered $node
                        # start at the last posting
                        # and go backwards

                        if ( $node == $parent{$node}) {
                                # this is parented by itself. 
                                # leave it alone, because its a top le
+vel posting
                        }
                        else {
                                $text{$parent{$node}}.=$text{$node};
                                $text{$node}="";
                                # attach this text to its parent's tex
+t
                                # delete it from the text hash
                                # so that we can just run thru the has
+h to display
                                # the entire posting contents
                        }

                }
                foreach $node ( sort reverse_number (keys %text )) {

                        $output.=$text{$node};

                        # finally , add all the output reverse sequent
+ially

                }

        } else {
                $output = qq| <tr bgcolor="#FFFFFF"> <td align=\"cente
+r\">
                        <font face="Verdana, Arial, Helvetica, sans-se
+rif">
                        <br><br> <b>No threads are currently available
+.</b><br><br>|;
        }
        $c->finish;
        $output .= qq|</font></td></tr>|;
        return($output);
}


--
Jay "Yohimbe" Thorne, alpha geek for UserFriendly

[markjugg]

I solved this problem when I wrote Cascade, which uses a Postgres backend to manage an index of resources. The issue is the same-- you have a tree of categories that you want to organize. You can download the source code here. I recommend version 1.3.7 at the moment for your purposes. (although it's not to be considered "stable").

In short, I used a different data model which made things easier for me. It's basically a adaptation of what Phillip Greenspun describes here. It allows you to select all your messages in threaded ordered with one select statement, which I like.

To save you a bit of looking, here's my routine that creates a list much like what you are doing above. This of course depends on having your data model set up as mine is.

# used for selecting a new category to attach this item to. 
sub _new_category_id_box {
    my $item = shift;
    my $name = shift;

    my $tbl = $Cascade::DBH->selectall_arrayref("
        SELECT id, name, (length(sort_key)-2) as level 
            FROM category 
            ORDER BY sort_key");

    my %parents;    
    my $q = new CGI;
    my @p_ids;
    foreach my $row (@$tbl) {
        my ($id,$name,$level) = @$row;
        $parents{$id} = ' 'x$level.CGI::escapeHTML($name);
        push @p_ids, $id; # we keep the ids in a seperate array to pre
+serve sorting
    }        

    $q->autoEscape(undef); # we need to turn this off for the spaces i
+n the list to show up correctly. 
    
    return $q->scrolling_list(
        -name=>$name,
        -values=>[@p_ids],
        -labels=>\%parents,
        -default=>$item->category_id,
        -multiple=>0,
        -size=>1,
    );
}

-mark

[princepawn]

The oracle database has a CONNECT statement which allows for easy traversing of hierarchically coded info:

SELECT LEVEL, SUB, SUPER
FROM   PARTS
CONNECT WITH PRIOR SUPER = SUB

LEVEL is a builtin Oracle variable which tells you current depth of traversal. SUB and SUPER are table columns which show which parts are subordinate to others.

And of course, you can use LPAD():

SELECT, LEVEL, LPAD('   ', LEVEL, SUB), SUPER;

to "tab over" each degree of recursion. Or write your own function to create display as needed.

Perl is nice, but server side database preprocessing can be faster and more definitional.