package Tree::Simple::View::DHTML; use strict; use warnings; our $VERSION = '0.13'; use base 'Tree::Simple::View::HTML'; use Tree::Simple::View::Exceptions; use constant OPEN_TAG => 1; use constant CLOSE_TAG => 2; use constant EXPANDED => 3; ## private methods sub _init { my ($self, @args) = @_; $self->SUPER::_init(@args); $self->{list_counter_id} = 0; ($self->{obj_id}) = ("$self" =~ /\((.*?)\)$/); } sub _createUID { my ($self, $tree) = @_; return $tree->getUID() if $self->{config}->{use_tree_uids}; $self->{list_counter_id}++; return join "_" => ($self->{obj_id}, $self->{list_counter_id}); } ## public methods sub expandPathSimple { my ($self, $tree, $current_path, @path) = @_; my @results = ("" x ($last_depth - $current_depth)) if ($last_depth > $current_depth); unless ($t->isLeaf()) { my $uid = $self->_createUID($t); push @results => ("
  • " . $t->getNodeValue() . "
  • "); push @results => "" x ($last_depth + 1)); return (join "\n" => @results); } sub expandPathComplex { my ($self, $tree, $config, $current_path, @path) = @_; my ($list_func, $list_item_func) = $self->_processConfig($config); my @results = $list_func->(OPEN_TAG); my $root_depth = $tree->getDepth() + 1; my $last_depth = -1; my $traversal_sub = sub { my ($t) = @_; my $display_style = "none"; if (defined $current_path && $self->_compareNodeToPath($current_path, $t)) { $display_style = "block"; $current_path = shift @path; } my $current_depth = $t->getDepth(); push @results => ($list_func->(CLOSE_TAG) x ($last_depth - $current_depth)) if ($last_depth > $current_depth); unless ($t->isLeaf()) { my $uid = $self->_createUID($t); push @results => ($list_item_func->($t, EXPANDED, $uid)); push @results => $list_func->(OPEN_TAG, $uid, $display_style); } else { push @results => ($list_item_func->($t)); } $last_depth = $current_depth; }; $traversal_sub->($self->{tree}) if $self->{include_trunk}; $self->{tree}->traverse($traversal_sub); $last_depth -= $root_depth; $last_depth++ if $self->{include_trunk}; push @results => ($list_func->(CLOSE_TAG) x ($last_depth + 1)); return (join "\n" => @results); } sub expandAllSimple { my ($self) = @_; my @results = ("" x ($last_depth - $current_depth)) if ($last_depth > $current_depth); unless ($t->isLeaf()) { my $uid = $self->_createUID($t); push @results => ("
  • " . $t->getNodeValue() . "
  • "); push @results => "" x ($last_depth + 1)); return (join "\n" => @results); } sub expandAllComplex { my ($self, $config) = @_; my ($list_func, $list_item_func) = $self->_processConfig($config); my @results = $list_func->(OPEN_TAG); my $root_depth = $self->{tree}->getDepth() + 1; my $last_depth = -1; my $traversal_sub = sub { my ($t) = @_; my $current_depth = $t->getDepth(); push @results => ($list_func->(CLOSE_TAG) x ($last_depth - $current_depth)) if ($last_depth > $current_depth); unless ($t->isLeaf()) { my $uid = $self->_createUID($t); push @results => ($list_item_func->($t, EXPANDED, $uid)); push @results => $list_func->(OPEN_TAG, $uid); } else { push @results => ($list_item_func->($t)); } $last_depth = $current_depth; }; $traversal_sub->($self->{tree}) if $self->{include_trunk}; $self->{tree}->traverse($traversal_sub); $last_depth -= $root_depth; $last_depth++ if $self->{include_trunk}; push @results => ($list_func->(CLOSE_TAG) x ($last_depth + 1)); return (join "\n" => @results); } # code strings use constant LIST_FUNCTION_CODE_STRING => q| sub { my ($tag_type, $list_id, $display_style) = @_; # allow this to be found quickly return "" if ($tag_type == CLOSE_TAG); # test the most functional first if ($tag_type == OPEN_TAG && $list_id && $display_style) { my $temp_list_css; if ($list_css && $list_css !~ /CLASS/) { # in case someone has already set the list_css # property, we need to add out display property # to it, so we need to do a little text mangling $temp_list_css = $list_css; chop($temp_list_css); $temp_list_css .= " display: $display_style;'"; } elsif ($list_css) { $temp_list_css = "${list_css} STYLE='display: $display_style;'" } else { $temp_list_css = " STYLE='display: $display_style;'" } return "<${list_type}${temp_list_css} ID='${list_id}'>" } # next... return "<${list_type}${list_css} ID='${list_id}'>" if ($tag_type == OPEN_TAG && $list_id); # and finally, something that does nothing really return "<${list_type}${list_css}>" if ($tag_type == OPEN_TAG); } |; sub _buildListItemFunction { my ($self, %config) = @_; # process the configuration directives my ($list_item_css, $expanded_item_css, $node_formatter) = $self->_processListItemConfig(%config); my $link_css = ""; if (exists $config{link_css}) { $link_css = " STYLE='" . $config{link_css}. "'"; } elsif (exists $config{link_css_class}) { $link_css = " CLASS='" . $config{link_css_class} . "'"; } my $form_element_formatter; if (exists $config{form_element_formatter}) { $form_element_formatter = $config{form_element_formatter}; } else { if (exists $config{radio_button}) { $form_element_formatter = $self->_makeRadioButtonFormatter($config{radio_button}); } elsif (exists $config{checkbox}) { $form_element_formatter = $self->_makeCheckBoxFormatter($config{checkbox}); } } # now compile the subroutine in the current environment return eval $self->LIST_ITEM_FUNCTION_CODE_STRING; } sub _makeRadioButtonFormatter { my ($self, $radio_button_id) = @_; return sub { my ($t) = @_; return ""; } } sub _makeCheckBoxFormatter { my ($self, $checkbox_id) = @_; return sub { my ($t) = @_; return ""; } } use constant LIST_ITEM_FUNCTION_CODE_STRING => q|; sub { my ($t, $is_expanded, $tree_id) = @_; my $item_css = $list_item_css; if ($is_expanded) { $item_css = $expanded_item_css if $expanded_item_css; return "" . (($form_element_formatter) ? $form_element_formatter->($t) : "") . "" . (($node_formatter) ? $node_formatter->($t) : $t->getNodeValue()) . ""; } return "" . (($form_element_formatter) ? $form_element_formatter->($t) : "") . (($node_formatter) ? $node_formatter->($t) : $t->getNodeValue()) . ""; } |; use constant javascript => q| |; 1; __END__ =pod =head1 NAME Tree::Simple::View::DHTML - A class for viewing Tree::Simple hierarchies in DHTML =head1 SYNOPSIS use Tree::Simple::View::DHTML; ## a simple example # use the defaults (an unordered list with no CSS) my $tree_view = Tree::Simple::View::DHTML->new($tree); ## more complex examples # using the CSS properties my $tree_view = Tree::Simple::View::DHTML->new($tree => ( list_type => "ordered", list_css => "list-style: circle;", list_item_css => "font-family: courier;", expanded_item_css => "font-family: courier; font-weight: bold", link_css => "text-decoration: none;" )); # using the CSS classes my $tree_view = Tree::Simple::View::DHTML->new($tree => ( list_css_class => "myListClass", list_item_css_class => "myListItemClass", expanded_item_css_class => "myExpandedListItemClass", link_css_class => "myListItemLinkClass" )); # mixing the CSS properties and CSS classes my $tree_view = Tree::Simple::View::DHTML->new($tree => ( list_css => "list-style: circle;", list_item_css => "font-family: courier;", expanded_item_css_class => "myExpandedListItemClass", link_css_class => "myListItemLinkClass" # format complex nodes with a function node_formatter => sub { my ($tree) = @_; return "" . $tree->getNodeValue()->description() . ""; }, # add a radio button element to the tree # with the name of 'tree_id' radio_button => 'tree_id' )); # print out the javascript nessecary for the DHTML # functionality of this tree print $tree_view->javascript(); # print out the tree fully expanded print $tree_view->expandAll(); # print out the tree expanded along a given path (see below for details) print $tree_view->expandPath("Root", "Child", "GrandChild"); =head1 DESCRIPTION This is a class for use with Tree::Simple object hierarchies to serve as a means of displaying them in DHTML. It is the "View", while the Tree::Simple object hierarchy would be the "Model" in your standard Model-View-Controller paradigm. This class outputs fairly vanilla HTML, which is augmented with CSS and javascript to produce an expanding and collapsing tree widget. The javascript code used is intentionally very simple, and makes no attempt to do anything but expand and collapse the tree. The javascript code is output seperately from the actual tree, and so it can be overridden to implement more complex behaviors if you like. see the documentation for the C method for more details. It should be noted that each expandable/collapsable level is tagged with a unique ID which is constructed from the object instances hex-address and a counter. This means if you call C and/or C on the same object in the same output, you will have generated two totally different trees, which just happend to look exactly alike, but will behave independently of one another. However, abuse of this "feature" is not recommended, as I am cannot guarentee it will always be this way. =head1 METHODS =over 4 =item B Accepts a C<$tree> argument of a Tree::Simple object (or one derived from Tree::Simple), if C<$tree> is not a Tree::Simple object, and exception is thrown. This C<$tree> object does not need to be a ROOT, you can start at any level of the tree you desire. The options in the C<%config> argument are as follows: =over 4 =item I This can be either 'ordered' or 'unordered', which will produce ordered and unordered lists respectively. The default is 'unordered'. =item I This can be a string of CSS to be applied to the list tag (C