view release on metacpan or  search on metacpan

lib/App/Office/CMS/Database/Menu.pm  view on Meta::CPAN

} # End of get_node_by_name;

# --------------------------------------------------

sub pretty_print
{
	my($self, $message, $tree) = @_;

	$self -> log(debug => "traverse($message, ...)");

	$tree -> walk_down
		({
			callback => \&pretty_print_node,
			_depth   => 0,
			self     => $self,
		});

} # End of pretty_print.

# --------------------------------------------------
# Warning: Do not add $self.

sub pretty_print_node
{
	my($node, $opt) = @_;
	my($id) = ${$node -> attribute}{id} || '';

	$$opt{self} -> log(debug => ' ' x $$opt{_depth} . $node -> name . " ($id)");

	return 1;

} # End of pretty_print_node.

# --------------------------------------------------

sub save_menu_tree
{
	my($self, $context, $tree, $extra) = @_;

	$self -> log(debug => "save_menu_tree($context, ...)");

	my($manager) = Tree::DAG_Node::Persist -> new
		(
			context    => $self -> context, # Not $context.
			dbh        => $self -> db -> dbh,
			table_name => $self -> table_name,
		);

	$manager -> write($tree, $extra);

	$self -> log(debug => "Saved ($context) menu tree");

	# Return the tree so the nodes' ids are available to the caller.

	return $manager -> read;

} # End of save_menu_tree.

# --------------------------------------------------

sub update
{
	my($self, $design, $tree, $extra) = @_;

	$self -> log(debug => 'update(..., $tree, ...)');

	$self -> context($self -> db -> build_context($$design{site_id}, $$design{id}) );

	return $self -> save_menu_tree('update', $tree, $extra);

} # End of update.

# --------------------------------------------------

1;