#                     TOP
#                      |
#       .--------------+--------------.
#       |              |              |
#       N              N              N
#       |              |              |
#   .---+---.      .---+---.      .---+---.
#   |   |   |      |   |   |      |   |   |
#   N   N   N      N   N   N      N   N   N
#           |
#         .-+-.  
#         |   | 
#         N   N


while(1)
	{
	if ascending
		if back at top node 
			quit
	else
		perform action on this node

	if you can go down
		go down
	else if you can go right
		go right
	else
		go up
	}

[slitt@mydesk Node]$ ./example_hello.pl

::: myname ::: mytype ::: myvalue :::
[slitt@mydesk Node]$

#!/usr/bin/perl -w

# Copyright (C) 2004 by Steve Litt
# Licensed with the GNU General Public License, Version 2
# ABSOLUTELY NO WARRANTY, USE AT YOUR OWN RISK
# See http://www.gnu.org/licenses/gpl.txt

use strict;	# prevent hard to find errors
use Node;	

my $topNode = Node->new("myname", "mytype", "myvalue");
print "\n::: ";
print $topNode->getName(), " ::: ";
print $topNode->getType(), " ::: ";
print $topNode->getValue(), " :::\n";

[slitt@mydesk slitt]$ ./hello.pl
Can't locate Node.pm in @INC (@INC contains: 
/usr/lib/perl5/5.8.1/i386-linux-thread-multi 
/usr/lib/perl5/5.8.1 
/usr/lib/perl5/site_perl/5.8.1/i386-linux-thread-multi 
/usr/lib/perl5/site_perl/5.8.1 
/usr/lib/perl5/site_perl 
/usr/lib/perl5/vendor_perl/5.8.1/i386-linux-thread-multi 
/usr/lib/perl5/vendor_perl/5.8.1 
/usr/lib/perl5/vendor_perl/5.8.0 
/usr/lib/perl5/vendor_perl .) at ./hello.pl line 9.
BEGIN failed--compilation aborted at ./hello.pl line 9.
[slitt@mydesk slitt]$

#!/bin/sh
perl -w -I$HOME/Node $@

[slitt@mydesk slitt]$ ./run hello.pl

::: myname ::: mytype ::: myvalue :::
[slitt@mydesk slitt]$

#                     TOP
#                      |
#       .--------------+--------------.
#       |              |              |
#       N              N              N
#       |              |              |
#   .---+---.      .---+---.      .---+---.
#   |   |   |      |   |   |      |   |   |
#   N   N   N      N   N   N      N   N   N
#           |
#         .-+-.  
#         |   | 
#         N   N


while(1)
	{
	if ascending
		if back at top node 
			quit
	else
		perform action on this node

	if you can go down
		go down
	else if you can go right
		go right
	else
		go up
	}

package Callbacks;
sub cbPrintNode()
	{
	my($self, $checker, $level) = @_;
	unless (defined($checker)) {return;}
	print $level, " ::: ";
	print $checker->getValue();
	print "\n";
	}

#!/usr/bin/perl -w

# Copyright (C) 2004 by Steve Litt
# Licensed with the GNU General Public License, Version 2
# ABSOLUTELY NO WARRANTY, USE AT YOUR OWN RISK
# See http://www.gnu.org/licenses/gpl.txt

use strict;

use Node;

package Callbacks;
sub new()
	{
	my($type) = $_[0];
	my($self) = {};
	bless($self, $type);
	return($self);
	}


sub cbPrintNode()
	{
	my($self, $checker, $level) = @_;
	unless (defined($checker)) {return;}
	print $level, " ::: ";
	print $checker->getValue();
	print "\n";
	}

package Main;

sub main()
	{
	#### PARSE FROM FILE README.otl
	my $parser = OutlineParser->new();
	$parser->setCommentChar("#");
	$parser->fromFile();
	my $topNode=$parser->parse("Node/README.otl");

	#### INSTANTIATE THE Callbacks OBJECT
	my $callbacks = Callbacks->new();

	#### WALK THE NODE TREE,
	#### OUTPUTTING LEVEL AND TEXT
	my $walker = Walker->new
		(
		$topNode,
		[\&Callbacks::cbPrintNode, $callbacks]
		);
	$walker->walk();
	}

main();

./run test.pl | less
0 ::: Inserted by OutlineParser
1 ::: MANUAL FOR THE Node.pm Tool
2 ::: Version 0.2.0 released 5/13/2004
1 ::: License
2 ::: Litt Perl Development Tools License, version 1
3 ::: See COPYING file
3 ::: This license is the GNU GPL with an exception
4 ::: See COPYING.GPL
2 ::: NO WARRANTY!!!!! See COPYING.GPL
1 ::: Purpose
2 ::: Handling hierarchies in Perl
2 ::: Implements a tree of nodes
2 ::: Each node has a name, a type, a value, and optionally attributes
2 ::: Each node can have zero, one or many attributes
2 ::: Each attribute has a name and a value
2 ::: Especially made to handle tab indented outlines in memory
1 ::: Learning Node.pm
2 ::: Learn from the example programs: Study them in this order:
3 ::: example_hello.pl
3 ::: example_parse.pl
3 ::: example_otl2markup.pl
3 ::: example_attribs.pl
3 ::: example_bylevel.pl

#!/usr/bin/perl -w

# Copyright (C) 2004 by Steve Litt
# Licensed with the GNU General Public License, Version 2
# ABSOLUTELY NO WARRANTY, USE AT YOUR OWN RISK
# See http://www.gnu.org/licenses/gpl.txt

use strict;

use Node;

package Callbacks;
sub new()
	{
	my($type) = $_[0];
	my($self) = {};
	bless($self, $type);
	return($self);
	}

sub cbPrintTag()
	{
	my($self, $checker, $level) = @_;
	unless (defined($checker)) {return;}
	
	#### PRINT START TAG AND CONTENT
	for(my $n = 0; $n < $level; $n++) {print "\t";}
	print "<node level=", $level, ">";
	print $checker->getValue() if $checker->hasValue();

	#### IF THIS IS A LEAF LEVEL ITEM, PRINT THE
	#### END TAG IMMEDIATELY. OTHERWISE, THE
	#### RETURN CALLBACK WILL TAKE CARE OF THE END TAG.
	unless($checker->hasFirstChild())
		{
		print "</node>";
		}

	#### PRINT NEWLINE
	print "\n";
	}

sub cbPrintEndTag()
	{
	my($self, $checker, $level) = @_;
	unless (defined($checker)) {return;}
	
	#### PRINT END TAG FOR PARENT
	for(my $n = 0; $n < $level; $n++) {print "\t";}
	print "</node>";
	print "\n";
	}

package Main;

sub main()
	{
	#### PARSE FROM FILE README.otl
	my $parser = OutlineParser->new();
	$parser->setCommentChar("#");
	$parser->fromFile();	
	my $topNode=$parser->parse("Node/README.otl");

	#### INSTANTIATE THE Callbacks OBJECT
	my $callbacks = Callbacks->new();

	#### WALK THE NODE TREE,
	#### OUTPUTTING TAG, VALUE, AND END TAG
	my $walker = Walker->new
		(
		$topNode,
		[\&Callbacks::cbPrintTag, $callbacks],
		[\&Callbacks::cbPrintEndTag, $callbacks]
		);
	$walker->walk();
	}

main();

./run test.pl | less
<node level=0>Inserted by OutlineParser
        <node level=1>MANUAL FOR THE Node.pm Tool
                <node level=2>Version 0.2.0 released 5/13/2004</node>
        </node>
        <node level=1>License
                <node level=2>Litt Perl Development Tools License, version 1
                        <node level=3>See COPYING file</node>
                        <node level=3>This license is the GNU GPL with an exception
                                <node level=4>See COPYING.GPL</node>
                        </node>
                </node>
                <node level=2>NO WARRANTY!!!!! See COPYING.GPL</node>
        </node>
        <node level=1>Purpose
                <node level=2>Handling hierarchies in Perl</node>
                <node level=2>Implements a tree of nodes</node>
                <node level=2>Each node has a name, a type, a value, and optionally attributes</node>
                <node level=2>Each node can have zero, one or many attributes</node>
                <node level=2>Each attribute has a name and a value</node>
                <node level=2>Especially made to handle tab indented outlines in memory</node>
        </node>
        <node level=1>Learning Node.pm
                <node level=2>Learn from the example programs: Study them in this order:
                        <node level=3>example_hello.pl</node>
                        <node level=3>example_parse.pl</node>
                        <node level=3>example_otl2markup.pl</node>
                        <node level=3>example_attribs.pl</node>
                        <node level=3>example_bylevel.pl</node>
                        <node level=3>example_delete.pl</node>
                        <node level=3>example_insert.pl</node>
                        <node level=3>example_nodepath.pl</node>
                </node>

my $walker = Walker->new
		(
		$topNode,
		[\&Callbacks::cbPrintTag, $callbacks],
		[\&Callbacks::cbPrintEndTag, $callbacks]
		);

#!/usr/bin/perl -w

# Copyright (C) 2004 by Steve Litt
# Licensed with the GNU General Public License, Version 2
# ABSOLUTELY NO WARRANTY, USE AT YOUR OWN RISK
# See http://www.gnu.org/licenses/gpl.txt

use strict;

use Node;

package Callbacks;
sub new()
	{
	my($type) = $_[0];
	my($self) = {};
	bless($self, $type);
	return($self);
	}

sub cbCountChildren()
	{
	my($self, $checker, $level) = @_;
	unless (defined($checker)) {return;}
	
	my $childCount=0;
	if($checker->hasFirstChild())
		{
		$childCount++;
		my $checker2 = $checker->getFirstChild();
		while($checker2->hasNextSibling())
			{
			$childCount++;
			$checker2 = $checker2->getNextSibling();
			}
		$checker->setAttribute("children", $childCount);
		}
	}

sub cbPrintNode()
	{
	my($self, $checker, $level) = @_;
	unless (defined($checker)) {return;}

	#### PRINT NODE'S VALUE
	for(my $n=0; $n < $level; $n++) {print "\t";}
	print "* ";
	print $checker->getValue();
	print "\n";

	#### PRINT NODE'S ATTRIBUTES
	for(my $n=0; $n <= $level; $n++) {print "\t";}
	print "(";

	my %attribs = ();
	%attribs = $checker->getAttributes() if $checker->hasAttributes();

	my @keys = keys(%attribs);
	foreach my $key (sort @keys)
		{
		print $key, "=", $attribs{$key}, "; ";
		}

	print ")\n";

	#### PRINT SPECIAL MESSAGE ABOUT CHILDREN IF IT HAS ANY
	if($checker->hasAttribute("children"))
		{
		for(my $n=0; $n <= $level; $n++) {print "\t";}
		print "This node has ";
		print $checker->getAttribute("children");
		print " children.\n";
		}
	}

package Main;

sub main()
	{
	#### PARSE FROM FILE README.otl
	my $parser = OutlineParser->new();
	$parser->setCommentChar("#");
	$parser->fromFile();
	my $topNode=$parser->parse("Node/README.otl");


	#### INSTANTIATE THE Callbacks OBJECT
	my $callbacks = Callbacks->new();

	#### WALK THE NODE TREE,
	#### COUNTING EACH NODE'S CHILDREN
	my $walker = Walker->new
		(
		$topNode,				
		[\&Callbacks::cbCountChildren, $callbacks]
		);
	$walker->walk();

	#### WALK THE NODE TREE,
	#### PRINTING EACH NODE'S VALUE, ATTRIBUTE LIST AND CHILD MESSAGE
	$walker = Walker->new
		(
		$topNode,				
		[\&Callbacks::cbPrintNode, $callbacks]
		);
	$walker->walk();
	}

main();

[slitt@mydesk slitt]$ ./run test.pl | head -n20
* Inserted by OutlineParser
        (children=7; )
        This node has 7 children.
        * MANUAL FOR THE Node.pm Tool
                (_lineno=1; children=1; )
                This node has 1 children.
                * Version 0.2.0 released 5/13/2004
                        (_lineno=2; )
        * License
                (_lineno=3; children=2; )
                This node has 2 children.
                * Litt Perl Development Tools License, version 1
                        (_lineno=4; children=2; )
                        This node has 2 children.
                        * See COPYING file
                                (_lineno=5; )
                        * This license is the GNU GPL with an exception
                                (_lineno=6; children=1; )
                                This node has 1 children.
                                * See COPYING.GPL
./run: line 2: 15281 Broken pipe             perl -w -I$HOME/Node $@
[slitt@mydesk slitt]$

#!/usr/bin/perl -w

# Copyright (C) 2004 by Steve Litt
# Licensed with the GNU General Public License, Version 2
# ABSOLUTELY NO WARRANTY, USE AT YOUR OWN RISK
# See http://www.gnu.org/licenses/gpl.txt

use strict;

use Node;


package Callbacks;
sub new()
	{
	my($type) = $_[0];
	my($self) = {};
	bless($self, $type);
	$self->{'childrenatlevel'} = 0;
	$self->{'currentlevel'} = 0;
	$self->{'previousparentfullpath'} = "initialize";
	return($self);
	}

sub getChildrenAtLevel(){return $_[0]->{'childrenatlevel'};}
sub setChildrenAtLevel(){$_[0]->{'childrenatlevel'} = $_[1];}
sub incChildrenAtLevel(){$_[0]->{'childrenatlevel'}++;}

sub getCurrentLevel(){return $_[0]->{'currentlevel'};}
sub setCurrentLevel(){$_[0]->{'currentlevel'} = $_[1];}

sub cbCalculateFullPath()
	{
	my($self, $checker, $level) = @_;
	unless (defined($checker)) {return;} # don't process undef node

	if($checker->hasParent)
		{
		my $fullpath = $checker->getParent()->getAttribute("fullpath");
		$fullpath .= "/";
		$fullpath .= $checker->getValue();
		$checker->setAttribute("fullpath", $fullpath);
		}
	else
		{
		$checker->setAttribute("fullpath", $checker->getValue());
		}
	}

sub cbPrintNode()
	{
	my($self, $checker, $level) = @_;
	unless (defined($checker)) {return;} # don't process undef node

	#### DO NOTHING UNLESS THIS NODE IS AT THE CURRENTLY SOUGHT LEVEL
	return unless $level == $self->getCurrentLevel();

	#### DO NOTHING UNLESS THIS NODE HAS CHILDREN
	return unless $checker->hasFirstChild();

	#### PRINT HEADER
	print "\n", $checker->getAttribute("fullpath"), "\n";
	
	#### PRINT CHILDREN AND COUNT CHILDREN AT LEVEL
	my $checker2 = $checker->getFirstChild();
	print "\t", $checker2->getValue(), "\n";
	$self->incChildrenAtLevel();

	while($checker2->hasNextSibling())
		{
		$checker2 = $checker2->getNextSibling();
		print "\t", $checker2->getValue(), "\n";
		$self->incChildrenAtLevel();
		}
	}


package Main;

sub main()
	{
	#### PARSE FROM FILE README.otl
	my $parser = OutlineParser->new();
	$parser->setCommentChar("#");
	$parser->fromFile();
	my $topNode=$parser->parse("Node/README.otl");


	#### INSTANTIATE THE Callbacks OBJECT
	my $callbacks = Callbacks->new();

	#### WALK THE NODE TREE,
	#### CALCULATING FULL PATHS AND PUTTING THEM IN AN ATTRIBUTE
	my $walker = Walker->new
		(
		$topNode,
		[\&Callbacks::cbCalculateFullPath, $callbacks]
		);
	$walker->walk();

	#### PRINT LEVEL 0
	print "\n\n********** BEGIN LEVEL ", "0", "\n";
	print "\t", $topNode->getValue(), "\n";

	#### SET STARTING PARENT LEVEL,
	#### AND SET $childCount SO THE LOOP WILL FIRE THE FIRST TIME
	my $level=0;
	my $childCount=9999;

	#### LOOP THROUGH EACH LEVEL, QUIT WHEN NO MORE CHILDREN
	while($childCount > 0)
		{
		print "\n\n********** BEGIN LEVEL ", $level + 1, "\n";
		$callbacks->setChildrenAtLevel(0);
		$callbacks->setCurrentLevel($level);
		my $walker = Walker->new
			(
			$topNode,
			[\&Callbacks::cbPrintNode, $callbacks]
			);
		$walker->walk();
		$childCount = $callbacks->getChildrenAtLevel();
		$level++;
		}
	}

main();

./run ./test.pl | head -n70

********** BEGIN LEVEL 0
	Inserted by OutlineParser


********** BEGIN LEVEL 1

Inserted by OutlineParser
	MANUAL FOR THE Node.pm Tool
	License
	Purpose
	Learning Node.pm
	File manifest
	Objects
	Installation


********** BEGIN LEVEL 2

Inserted by OutlineParser/MANUAL FOR THE Node.pm Tool
	Version 0.2.0 released 5/13/2004

Inserted by OutlineParser/License
	Litt Perl Development Tools License, version 1
	NO WARRANTY!!!!! See COPYING.GPL

Inserted by OutlineParser/Purpose
	Handling hierarchies in Perl
	Implements a tree of nodes
	Each node has a name, a type, a value, and optionally attributes
	Each node can have zero, one or many attributes
	Each attribute has a name and a value
	Especially made to handle tab indented outlines in memory

Inserted by OutlineParser/Learning Node.pm
	Learn from the example programs: Study them in this order:
	That's the only way to learn this tool
	Do each example program in order
	Example programs

Inserted by OutlineParser/File manifest
	Documentation
	Licensing
	Node.pm file
	Example Programs
	Sample node path config file (for example_nodepath.pl)
	Sample outline (used for example_delete.pl)

Inserted by OutlineParser/Objects
	Node.pm implements three object types:
	Node
	OutlineParser
	Walker

Inserted by OutlineParser/Installation
	See INSTALL file


********** BEGIN LEVEL 3

Inserted by OutlineParser/License/Litt Perl Development Tools License, version 1
	See COPYING file
	This license is the GNU GPL with an exception

Inserted by OutlineParser/Learning Node.pm/Learn from the example programs: Study them in this order:
	example_hello.pl
	example_parse.pl
	example_otl2markup.pl
	example_attribs.pl

[slitt@mydesk slitt]$ cat Node/deletetest.otl
Top
        Level2
        Level2b
                Level3
                        deleteme
                                gone
                                gone
                        deleteme
                                gone
                                gone
                        this should stay
                                deleteme
                        deleteme
                                gone
                                gone
                Level3b
        2level2
Top2
[slitt@mydesk slitt]$

[slitt@mydesk slitt]$ ./run ./test.pl
Inserted by OutlineParser
        Top
                Level2
                Level2b
                        Level3
                                this should stay
                        Level3b
                2level2
        Top2
[slitt@mydesk slitt]$

#!/usr/bin/perl -w

# Copyright (C) 2004 by Steve Litt
# Licensed with the GNU General Public License, Version 2
# ABSOLUTELY NO WARRANTY, USE AT YOUR OWN RISK
# See http://www.gnu.org/licenses/gpl.txt

use strict;

use Node;

package Callbacks;
sub new()
	{
	my($type) = $_[0];
	my($self) = {};
	bless($self, $type);
	return($self);
	}

sub cbDelete()
	{
	my($self, $checker, $level) = @_;
	unless (defined($checker)) {return;}

	#### DELETE THIS NODE IF ITS VALUE CONTAINS deleteme
	my $text = "init";
	$text = $checker->getValue() if $checker->hasValue();
	if($text =~ m/deleteme/)
		{
		$checker->deleteSelf();
		}
	}

sub cbPrintNode()
	{
	my($self, $checker, $level) = @_;
	unless (defined($checker)) {return -999;}

	for(my $n=0; $n < $level; $n++) {print "\t";}
	print $checker->getValue(), "\n";
	}

package Main;

sub main()
	{
	#### PARSE FROM FILE deletetest.otl
	my $parser = OutlineParser->new();
	$parser->setCommentChar("#");
	$parser->fromFile();
	my $topNode=$parser->parse("Node/deletetest.otl");

	#### INSTANTIATE THE Callbacks OBJECT
	my $callbacks = Callbacks->new();

	#### WALK THE NODE TREE,
	#### DELETING NODES WITH "deleteme" IN THEM
	my $walker = Walker->new
		(
		$topNode,
		[\&Callbacks::cbDelete, $callbacks]
		);
	$walker->walk();

	#### WALK THE NODE TREE,
	#### OUTPUTTING INDENTED VALUE
	$walker = Walker->new
		(
		$topNode,
		[\&Callbacks::cbPrintNode, $callbacks]
		);
	$walker->walk();
	}

main();

#!/usr/bin/perl -w

# Copyright (C) 2004 by Steve Litt
# Licensed with the GNU General Public License, Version 2
# ABSOLUTELY NO WARRANTY, USE AT YOUR OWN RISK
# See http://www.gnu.org/licenses/gpl.txt

use strict;	# prevent hard to find errors

use Node;	# Use Node.pm tool

package Callbacks;
sub new()
	{
	my($type) = $_[0];
	my($self) = {};
	bless($self, $type);
	return($self);
	}

#=================================================================
# This callback places asterisks in the value of years, months and
# days whose anscestors have appointments, one asterisk per appointment
#=================================================================
sub cbMakeMarks()
	{
	my($self, $checker, $level) = @_;
	return unless defined($checker); # don't process undef node

	#### PROCESS ONLY DAY, MONTH OR YEAR NODES
	return unless	(
			$checker->getType() eq "Day" ||
			$checker->getType() eq "Month" ||
			$checker->getType() eq "Year"
			);

	#### COUNT APPOINTMENTS IN DESCENDENTS
	my $count = 0;
	my $childNode = $checker->getFirstChild();
	while(defined($childNode))
		{
		if($checker->getType() eq "Day")
			{
			if(defined($childNode->getValue()))
				{
				$count++;
				}
			}
		else
			{
			if($childNode->hasAttribute("appointments"))
				{
				$count += $childNode->getAttribute("appointments");
				}
			}
		$childNode = $childNode->getNextSibling();
		}

	#### PLACE COUNT IN ATTRIBUTE
	$checker->setAttribute("appointments", $count);

	#### MARK STARS, ONE FOR EACH APPOINTMENT IN DESCENDENTS
	if($count > 0)
		{
		my $string;
		for(my $n=0; $n < $count; $n++){$string .= '*';}
		$checker->setValue($string);
		}
	}

#=================================================================
# This callback operates ONLY on day nodes. When
# called from a day node, it inserts hourlong appointment slots
# starting at 8am and ending at 5pm. The code is pretty 
# straightforward.
#=================================================================
sub cbInsertHours()
	{
	my($self, $checker, $level) = @_;
	unless (defined($checker)) {return -999;} # don't process undef node


	return unless $checker->getType() eq "Day"; # Insert hours under days only

	my $checker2;
	for(my $n=8; $n <= 16; $n++)
		{
		my $startHour = "$n:00";
		my $n2 = $n + 1;
		my $endHour = "$n2:00";
		my $node = Node->new("$startHour" . "-" . "$endHour", "Hour", undef);
		if($checker->hasFirstChild())
			{
			$checker2 = $checker2->insertSiblingAfterYou($node);
			}
		else
			{
			$checker2 = $checker->insertFirstChild($node);
			}
		}
	}

#=================================================================
# The cbPrintNode() callback prints the name of the node,
# and its value if a value is defined. It's very straighforward.
#=================================================================
sub cbPrintNode()
	{
	my($self, $checker, $level) = @_;
	unless (defined($checker)) {return -999;} # don't process undef node

	#### DON'T PRINT LEVEL 0 (CALENDER)
	return if $level == 0;

	for(my $n=1; $n < $level; $n++) { print "\t";}

	print $checker->getName() if $checker->hasName();
	print ":   ";

	print $checker->getValue() if $checker->hasValue();
	print "\n";
	}


package Main;

###########################################################################
# The makeAppointments() subroutine manually makes several appointments
# To facilitate a later demonstration of node swapping, the June 22
# and Sept 22 appoinments are accidentally switched
###########################################################################
sub makeAppointments($)
	{
	my $yearNode = shift;

	#### MARCH 22  AT 8AM
	my $monthNode = $yearNode->getFirstChild() ->		#January
			getNextSibling() ->			#February
			getNextSibling();			#March
	my $dayNode = $monthNode->getFirstChild();
	while($dayNode->getName() != 22)
		{
		$dayNode = $dayNode->getNextSibling();
		unless(defined($dayNode))
			{
			die "No March 22\n";
			}
		}
	my $hourNode = $dayNode->getFirstChild();
	$hourNode->setValue("Spring Cleaning");

	#### JUNE 22  AT 9AM
	#### WRONGLY LABELED AS FALL FESTIVAL
	#### INSTEAD OF SUMMER BREAK
	$monthNode = $monthNode->getNextSibling() ->		# April
			getNextSibling() ->			# May
			getNextSibling();			# June
	$dayNode = $monthNode->getFirstChild();
	while($dayNode->getName() != 22)
		{
		$dayNode = $dayNode->getNextSibling();
		unless(defined($dayNode))
			{
			die "No June 22\n";
			}
		}
	$hourNode = $dayNode->getFirstChild()->getNextSibling();
	$hourNode->setValue("Fall Festival");

	#### SEPTEMBER 22  AT 10AM
	#### WRONGLY LABELED AS FALL FESTIVAL
	#### INSTEAD OF SUMMER BREAK
	$monthNode = $monthNode->getNextSibling() ->		# July
			getNextSibling() ->			# August
			getNextSibling();			# September
	$dayNode = $monthNode->getFirstChild();
	while($dayNode->getName() != 22)
		{
		$dayNode = $dayNode->getNextSibling();
		unless(defined($dayNode))
			{
			die "No September 22\n";
			}
		}
	$hourNode = $dayNode -> getFirstChild() ->		#8-9
				getNextSibling() ->		# 9-10
				getNextSibling();		# 10-11
	$hourNode->setValue("Summer Break");

	#### DECEMBER 22 FROM 3PM TO 5PM (2 TIMESLOTS)
	#### HAPPY HOLIDAYS PARTY
	$monthNode = $monthNode->getNextSibling() ->		# October
			getNextSibling() ->			# November
			getNextSibling();			# December
	$dayNode = $monthNode->getFirstChild();
	while($dayNode->getName() != 22)
		{
		$dayNode = $dayNode->getNextSibling();
		unless(defined($dayNode))
			{
			die "No December 22\n";
			}
		}
	$hourNode = $dayNode->getFirstChild();
	while($hourNode->getName() ne "15:00-16:00")
		{
		$hourNode = $hourNode->getNextSibling();
		unless(defined($hourNode))
			{
			die "No 4pm slot\n";
			}
		}
	$hourNode->setValue("Happy Holidays Party");
	$hourNode = $hourNode->getNextSibling();
	$hourNode->setValue("Happy Holidays Party");

	#### DECEMBER 30 AT 9AM BUY PARTY SUPPLIES
	while($dayNode->getName() != 30)
		{
		$dayNode = $dayNode->getNextSibling();
		unless(defined($dayNode))
			{
			die "No December 30\n";
			}
		}
	$hourNode = $dayNode->getFirstChild()->getNextSibling();
	$hourNode->setValue("Buy Party Supplies");
	}

###########################################################################
# The insertMonthsAndDays() iterates through @monthNames. For each, it
# creates a month node, and then under than node iterates days from 1 to
# that month's entry in the @monthLengths array.
#
# Note that we could have avoided using a nested loop by using a Walker
# and associated callback to install the days under every month. In such
# a case the array of month lengths would have been placed in the Callback
# object. However, for the sake of variety, we chose to use a nested loop
# to load the months and days.
###########################################################################
sub insertMonthsAndDays($)
	{
	my $yearNode = shift;
	my $checker = $yearNode;
	my $checker2;
	my @monthNames=("January", "February", "March", "April", "May",
		"June", "July", "August", "September", "October",
		"November", "December");
	my @monthLengths=(31, 29, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
	my $monthSS = 0;
	foreach my $monthName (@monthNames)
		{
		my $node = Node->new($monthName, "Month", undef);
		$node->setAttribute("days", $monthLengths[$monthSS]);
		if($yearNode->hasFirstChild())
			{
			$checker = $checker->insertSiblingAfterYou($node);
			}
		else
			{
			$checker = $yearNode->insertFirstChild($node);
			}
		for(my $n=1; $n <= $monthLengths[$monthSS]; $n++)
			{
			$node = Node->new($n, "Day", undef);
			if($checker->hasFirstChild())
				{
				$checker2 = $checker2->insertSiblingAfterYou($node);
				}
			else
				{
				$checker2 = $checker->insertFirstChild($node);
				}
			}
		$monthSS++;
		}
	}

###########################################################################
# This subroutine switches the June 22 9am appointment and the
# September 22 10am appointment. In each case, both the appointment
# text and the time needed switching.
#
# The sane way to accomplish this task would have been to modify
# the nodes in place. However, this subroutine was created solely to 
# demonstrate the movement of nodes, so that's what we did.
#
# Note that the fact that the two are at different times complicates the
# situation. It's not enough to just trade nodes -- the Sept 9am node
# must be placed after the existing June 10am node, which itself is after
# the erroneous June 9am node containing what should be September's 
# appointment. After such placement, the original June 9am node must
# have its name updated so that it is a 10am node. A similar process
# takes place for September. The original nodes are also deleted.
#
# Please follow the (convoluted and contrived) logic:
#   1. Store the June hour node in $juneNode
#   2. Store the September hour node in $septNode
#   3. After the existing June 10am, place a CLONE of the Sept appointment
#   4. Before the existing Sept 9am,  place a CLONE of the June appointment
#   5. Delete the original June appointment
#   6. Delete the original September appointment
#   7. On the original June 10am node, make it 9am
#   8. On the original September 9am node, make it 10am
###########################################################################
sub switchJuneAndSeptemberAppointments($)
	{
	my $yearNode = shift;

	#### FIND NODE FOR JUNE 22 9AM APPOINTMENT
	my $juneNode = $yearNode->getFirstChild();
	while(defined($juneNode))
		{
		last if $juneNode->getName() eq "June";
		$juneNode = $juneNode->getNextSibling();
		}
	die "Cannot find month of June\n" unless defined($juneNode);

	$juneNode = $juneNode->getFirstChild();
	while(defined($juneNode))
		{
		last if $juneNode->getName() eq "22";
		$juneNode = $juneNode->getNextSibling();
		}
	die "Cannot find June 22\n" unless defined($juneNode);

	$juneNode = $juneNode->getFirstChild();
	while(defined($juneNode))
		{
		last if $juneNode->getName() eq "9:00-10:00";
		$juneNode = $juneNode->getNextSibling();
		}
	die "Cannot find June 22 at 9am\n" unless defined($juneNode);

	#### FIND NODE FOR SEPTEMBER 22 10AM APPOINTMENT
	my $septNode = $yearNode->getFirstChild();
	while(defined($septNode))
		{
		last if $septNode->getName() eq "September";
		$septNode = $septNode->getNextSibling();
		}
	die "Cannot find month of September\n" unless defined($septNode);

	$septNode = $septNode->getFirstChild();
	while(defined($septNode))
		{
		last if $septNode->getName() eq "22";
		$septNode = $septNode->getNextSibling();
		}
	die "Cannot find September 22\n" unless defined($septNode);

	$septNode = $septNode->getFirstChild();
	while(defined($septNode))
		{
		last if $septNode->getName() eq "10:00-11:00";
		$septNode = $septNode->getNextSibling();
		}
	die "Cannot find September 22 at 9am\n" unless defined($septNode);

	#### SWITCH THE NODES
	my $newJune = $juneNode->getNextSibling()->insertSiblingAfterYou($septNode->clone());
	my $newSept = $septNode->getPrevSibling()->insertSiblingBeforeYou($juneNode->clone());
	$juneNode->deleteSelf();
	$septNode->deleteSelf();

	#### FIX NAMES OF SURROUNDING CLONES
	$newJune->getPrevSibling()->setName("9:00-10:00");
	$newSept->getNextSibling()->setName("10:00-11:00");

	return;
	}


###########################################################################
# In the main routine, you carry out or delegate the following tasks
# in order to create an appointment calendar:
#   1. Insert single level 0 and 1 nodes
#   2. Instantiate the Callbacks object
#   3. Insert all month and day nodes
#   4. Insert all hour nodes
#   5. Make appointments
#         erroneously switching the june 22 & Sept 22 appointments
#   6. Mark days, months and years containing appointments
#   7. Output the calendar
#   8. Switch back June22 and Sept22
#   9. Re mark days, months and years
#   10. Output a separator between bad and good calendars
#   11. Re output the calendar
#
###########################################################################
sub main()
	{
	#### INSERT SINGLE LEVEL 0 AND 1 NODES
	my $topNode=Node->new("Calender", "Calender", "Calender");
	my $yearNode=$topNode->insertFirstChild(Node->new("2004", "Year", undef));

	#### INSTANTIATE THE Callbacks OBJECT
	my $callbacks = Callbacks->new();

	#### INSERT MONTH AND DAY NODES
	insertMonthsAndDays($yearNode);

	#### INSERT THE HOURS USING A Walker
	my $walker = Walker->new
		(
		$topNode,
		[\&Callbacks::cbInsertHours, $callbacks]
		);
	$walker->walk();


	#### MAKE A FEW APPOINTMENTS
	#### ACCIDENTALLY SWITCHING SUMMER AND FALL
	makeAppointments($yearNode);

	#### MARK DAYS, MONTHS AND YEAR THAT HAVE APPOINTMENTS
	#### USING A WALKER WITH ONLY A RETURN CALLBACK
	$walker = Walker->new
		(
		$topNode,
		undef,
		[\&Callbacks::cbMakeMarks, $callbacks]
		);
	$walker->walk();

	#### WALK THE NODE TREE,
	#### OUTPUTTING THE CALENDER
	$walker = Walker->new
		(
		$topNode,
		[\&Callbacks::cbPrintNode, $callbacks]
		);
	$walker->walk();

	#### CORRECT THE MISTAKE
	#### SWITCH JUNE 22 AND SEPT 22
	switchJuneAndSeptemberAppointments($yearNode);

	#### RE-MARK DAYS, MONTHS AND YEAR THAT HAVE APPOINTMENTS
	#### USING A WALKER WITH ONLY A RETURN CALLBACK
	$walker = Walker->new
		(
		$topNode,
		undef,
		[\&Callbacks::cbMakeMarks, $callbacks]
		);
	$walker->walk();

	#### OUTPUT A SEPARATOR BETWEEN ORIGINAL AND CORRECTED CALENDARS
	for (my $n=0; $n<5; $n++)
		{
		print "######################################################\n";
		}

	#### RE-WALK THE NODE TREE,
	#### RE-OUTPUTTING THE CALENDER
	$walker = Walker->new
		(
		$topNode,				# start with this node
		[\&Callbacks::cbPrintNode, $callbacks]	# do this on entry to each node
		);
	$walker->walk();
	}

main();

for(my $n=8; $n <= 16; $n++)
	{
	# ...
	my $node = Node->new($range, "Hour", undef);

	if($checker->hasFirstChild())
		{
		$checker2 = $checker2->insertSiblingAfterYou($node);
		}
	else
		{
		$checker2 = $checker->insertFirstChild($node);
		}
	}

$juneNode = $juneNode->getFirstChild();
while(defined($juneNode))
	{
	last if $juneNode->getName() eq "22";
	$juneNode = $juneNode->getNextSibling();
	}
die "Cannot find June 22\n" unless defined($juneNode);

sub cbMakeMarks()
	{
	my($self, $checker, $level) = @_;
	return unless defined($checker); # don't process undef node

	#### PROCESS ONLY DAY, MONTH OR YEAR NODES
	return unless	(
			$checker->getType() eq "Day" ||
			$checker->getType() eq "Month" ||
			$checker->getType() eq "Year"
			);
	
	#Perform callback code on anything that makes it to this point
	

#!/usr/bin/perl -w

# Copyright (C) 2004 by Steve Litt
# Licensed with the GNU General Public License, Version 2
# ABSOLUTELY NO WARRANTY, USE AT YOUR OWN RISK
# See http://www.gnu.org/licenses/gpl.txt

use strict;
use lib "$ENV{'HOME'}/Node";
use Node;	

my $topNode = Node->new("myname", "mytype", "myvalue");
print "\n::: ";
print $topNode->getName(), " ::: ";
print $topNode->getType(), " ::: ";
print $topNode->getValue(), " :::\n";

[slitt@mydesk slitt]$ ./test.pl

::: myname ::: mytype ::: myvalue :::
[slitt@mydesk slitt]$

#!/bin/sh

# Copyright (C) 2004 by Steve Litt, all rights reserved.
# Licensed under version 2 of the GNU General Public License
# See the COPYING file
# NO WARRANTY!!!!

################################################################
# To use emdl in the easiest possible way, change the following
# variables to reflect the locations of their respective files.
################################################################

EMDL_DIRECTORY=/data/perl/emdl		#LOCATION OF emdlparser.pl
UMENU_DIRECTORY=~/.umenu		#TOP OF UMENU TREE
NODE_DIRECTORY=/data/perl/Node		#LOCATION OF Node.pm

EMDL_CONFIG=$EMDL_DIRECTORY/emdl.cfg	#FULL PATH OF emdlparser.pl config file
UMENU_MENUDIR=$UMENU_DIRECTORY/menudir	#LOCATION OF UMENU MENU DEF FILES
UMENU_PROGRAMDIR=$UMENU_DIRECTORY/program	#LOCATION OF UMENU.PL
EMDL_TEMP=$EMDL_DIRECTORY/temp		#WRITEABLE TEMP DIR FOR COMPILED .mnu FILES

export EMDL_DIRECTORY EMDL_CONFIG UMENU_DIRECTORY NODE_DIRECTORY UMENU_MENUDIR UMENU_PROGRAMDIR EMDL_TEMP

cd $EMDL_DIRECTORY

$1 $2 $3 $4 $5 $6 $7 $8 $9

#!/usr/bin/perl -w

# Copyright (C) 2004 by Steve Litt
# Licensed with the GNU General Public License, Version 2
# ABSOLUTELY NO WARRANTY, USE AT YOUR OWN RISK
# See http://www.gnu.org/licenses/gpl.txt

use strict;

#####################################################################
# The loadNodeModule() subroutine is a complete substitute for:
#    use Node
# 
# It includes:
#	require Node;
#	import Node;
# 
# The preceding two calls completely replace a use Node statement,
# and better still, unlike the use statement, they happen at 
# runtime instead of compile time. Therefore, this subroutine reads
# the directory from a config file, then executes that directory
# with the proper require and import statements. Obviously, the
# loadNodeModule() subroutine must be executed before any code depending
# on the Node.pm module is executed.
#####################################################################
sub loadNodeModule()
	{
	#### CHANGE THE FOLLOWING TO CHANGE THE DEFAULT APP FILENAME
	my $defaultConfFileName = "./myapp.cfg";

	#### CHANGE THE FOLLOWING TO CHANGE APP FILENAME ENVIRONMENT VAR
	my $envVarName = "MY_APP_CONFIG";

	my($conffile) = $ENV{$envVarName};
	print $conffile, "\n" if defined $conffile;
	$conffile = $defaultConfFileName unless defined($conffile);
	print "Using config file $conffile.\n";

	open CONF, '<' . $conffile or die "FATAL ERROR: Could not open config file $conffile.";
	my @lines = <CONF>;
	close CONF;

	my @nodedirs;
	foreach my $line (@lines)
		{
		chomp $line;
		if($line =~ m/^\s*nodedir\s*=\s*([^\s]*)/)
			{
			my $dir = $1;
			if($dir =~ m/(.*)\$HOME(.*)/)
				{
				$dir = $1 . $ENV{'HOME'} . $2;
				}
			push @nodedirs, ($dir);
			}
		}

	if(@nodedirs)
		{
		unshift @INC, @nodedirs;
		}

	require Node;
	import Node;
	}

#####################################################################
# The main() routine calls loadNodeModule to include Node.pm,
# and then runs a few lines of code to conclusively prove that
# Node.pm is loaded. It also prints out the @INC array to show that
# directory in which Node.pm resides is now in the @INC path.
#
# Note that in the absense of any change to the environment variable
# defined in loadNodeModule(), the configuration file will be ./myapp.cfg.
#####################################################################
sub main()
	{
	loadNodeModule();
	my $topNode = Node->new("myname", "mytype", "myvalue");
	print "\n::: ";
	print $topNode->getName(), " ::: ";
	print $topNode->getType(), " ::: ";
	print $topNode->getValue(), " :::\n";
	foreach my $line (@INC)
		{
		print $line, "\n";
		}
	}

main();

[slitt@mydesk slitt]$ ./test.pl
Using config file ./myapp.cfg.

::: myname ::: mytype ::: myvalue :::
/path/to/nodemodule
/data/perl/Node
/usr/lib/perl5/5.8.1/i386-linux-thread-multi
/usr/lib/perl5/5.8.1
/usr/lib/perl5/site_perl/5.8.1/i386-linux-thread-multi
/usr/lib/perl5/site_perl/5.8.1
/usr/lib/perl5/site_perl
/usr/lib/perl5/vendor_perl/5.8.1/i386-linux-thread-multi
/usr/lib/perl5/vendor_perl/5.8.1
/usr/lib/perl5/vendor_perl/5.8.0
/usr/lib/perl5/vendor_perl
.
[slitt@mydesk slitt]$ 

• For Construction
• sub new()
• Arguments
• 0: typeOfClass
• 1: Name of Node
• 2: Type of Node
• 3: Value of Node
• Returns
• The newly created Node object
• For single attributes
• sub setAttribute()
• Arguments
• 0: $self
• 1: Attribute name
• 2: Attribute Value
• Returns
• Nothing
• sub removeAttribute()
• Arguments
• 0: $self
• 1: Name of attribute to be removed
• Returns
• Nothing
• sub getAttribute()
• Arguments
• 0: $self
• 1: Name of attribute to be retrieved
• Returns
• Value of requested attribute, or undef if it doesn't exist
• sub hasAttribute()
• Arguments
• 0: $self
• 1: Name of queried attribute
• Returns
• 1 if there is an attribute with that name, 0 otherwise
• For attribute array
• sub hasAttributes()
• Arguments
• 0: $self
• Returns
• 1 if the $self node has attributes, 0 if it does not
• sub getAttributes()
• Arguments
• 0: $self
• Returns
• The attribute hash (not a reference, but an actual hash)
• sub setAttributes()
• Arguments
• 0: $self
• 1: A reference to a hash of intended attributes
• Returns
• Nothing
• For Navigation
• Has routines
• sub hasFirstChild()
• Arguments
• 0: $self
• Returns
• 1 if the $self node has a first child, 0 otherwise
• sub hasLastChild()
• Arguments
• 0: $self
• Returns
• 1 if the $self node has a last child, 0 otherwise
• : Probably unnecessary, because normally if a node has
• : a first child, it will also have a last child even
• : if they're the same node.
• sub hasNextSibling()
• Arguments
• 0: $self
• Returns
• 1 if the $self node has a next sibling, 0 otherwise
• sub hasPrevSibling()
• Arguments
• 0: $self
• Returns
• 1 if the $self node has a next sibling, 0 otherwise
• sub hasParent()
• Arguments
• 0: $self
• Returns
• 1 if the $self node has a parent, 0 otherwise
• Get routines
• sub getFirstChild()
• Arguments
• 0: $self
• Returns
• The first child of the $self node, undef if there is none
• sub getLastChild()
• Arguments
• 0: $self
• Returns
• The last child of the $self node, undef if there is none
• sub getNextSibling()
• Arguments
• 0: $self
• Returns
• The next sibling of the $self node, undef if there is none
• sub getPrevSibling()
• Arguments
• 0: $self
• Returns
• The previous sibling of the $self node, undef if there is none
• sub getParent()
• Arguments
• 0: $self
• Returns
• The parent of the $self node, undef if there is none
• Set routines
• sub setFirstChild()
• Arguments
• 0: $self
• 1: Node to be assigned as first child of $self
• Returns
• Nothing
• sub setLastChild()
• Arguments
• 0: $self
• 1: Node to be assigned as last child of $self
• Returns
• Nothing
• sub setNextSibling()
• Arguments
• 0: $self
• 1: Node to be assigned as next sibling of $self
• Returns
• Nothing
• sub setPrevSibling()
• Arguments
• 0: $self
• 1: Node to be assigned as previous sibling of $self
• Returns
• Nothing
• sub setParent()
• Arguments
• 0: $self
• 1: Node to be assigned as parent of $self
• Returns
• Nothing
• For content
• Has routines
• sub hasName()
• Arguments
• 0: $self
• Returns
• 1 if the $self node has a defined name, 0 otherwise
• sub hasType()
• Arguments
• 0: $self
• Returns
• 1 if the $self node has a defined type, 0 otherwise
• sub hasValue()
• Arguments
• 0: $self
• Returns
• 1 if the $self node has a defined value, 0 otherwise
• Get routines
• sub getName()
• Arguments
• 0: $self
• Returns
• The name of the $self node,
• undef if the node's value is undefined
• sub getType()
• Arguments
• 0: $self
• Returns
• The type of the $self node,
• undef if the node's value is undefined
• sub getValue()
• Arguments
• 0: $self
• Returns
• The value of the $self node,
• undef if the node's value is undefined
• Set routines
• sub setName()
• Arguments
• 0: $self
• 1: The name of the $self node
• Returns
• Nothing
• sub setType()
• Arguments
• 0: $self
• 1: The type of the $self node
• Returns
• Nothing
• sub setValue()
• Arguments
• 0: $self
• 1: The value of the $self node
• Returns
• Nothing
• For Insertion
• sub insertSiblingBeforeYou()
• Arguments
• 0: $self
• 1: The node to be inserted before $self
• Returns
• The newly inserted node
• sub insertSiblingAfterYou()
• Arguments
• 0: $self
• 1: The node to be inserted after $self
• Returns
• The newly inserted node
• sub insertFirstChild()
• Arguments
• 0: $self
• 1: The node to be inserted as the first child of $self
• Returns
• The newly inserted node
• sub insertLastChild()
• Arguments
• 0: $self
• 1: The node to be inserted as the last child of $self
• Returns
• The newly inserted node
• For deletion
• sub deleteSelf()
• Arguments
• 0: $self
• Returns
• Nothing
• For cloning
• sub clone()
• Arguments
• 0: $self
• Returns
• A new node with the same content and pointers as $self

• For Creation
• sub new()
• Arguments
• 0: Type of class
• Returns
• A new OutlineParser object
• Defaults
• head: Node->new("Header Node", "Head", "Inserted by OutlineParser");
• fromstdin = 1;
• zapblanks = 1;
• For setting parser properties
• sub setCommentChar()
• Arguments
• 0: $self
• 1: Intended comment character for this parser
• Returns
• Nothing
• sub getCommentChar()
• Arguments
• 0: $self
• Returns
• Comment character for this parser
• sub hasCommentChar()
• Arguments
• 0: $self
• Returns
• 1 if parser has comment character, 0 otherwise
• sub fromStdin()
• Arguments
• 0: $self
• Returns
• Nothing
• Action
• Sets parser to accept input from a file instead of stdin
• sub fromFile()
• Arguments
• 0: $self
• Returns
• Nothing
• Action
• Sets parser to accept input from stdin instead of a file
• sub zapBlanks()
• Arguments
• 0: $self
• Returns
• Nothing
• Action
• Sets parser to ignore whitespace-only lines
• sub dontZapBlanks()
• Arguments
• 0: $self
• Returns
• Nothing
• Action
• Sets parser to process whitespace-only lines
• Other routines
• sub getHead()
• Arguments
• 0: $self
• Returns
• Head node of node tree
• sub getFirstNonBlankChar()
• Arguments
• 0: $self
• 1: line in which to find first nonblank
• Returns
• Single character: First non whitespace character on the line
• Comment
• Primarily used internally
• sub parse()
• Arguments
• 0: $self
• 1: Name of file to parse (if parsing from file)
• Returns
• The top level node in the newly created node tree

• sub new()
• Arguments
• 0: Type of class
• 1: Node whose tree to walk
• 2: Reference to entry callback routine (undef if none)
• 3: Reference to return callback routine (optional)
• Returns
• A new Walker object
• sub walk()
• Arguments
• 0: $self
• Returns
• Nothing
• Action
• Walks the tree headed by $self->getHead()
• At each node executes the entry callback routine
• At every node reentered from its children,
• executes the return callback routine

#!/usr/bin/perl -w

# Copyright (C) 2004 by Steve Litt
# Licensed with the GNU General Public License, Version 2
# ABSOLUTELY NO WARRANTY, USE AT YOUR OWN RISK
# See http://www.gnu.org/licenses/gpl.txt

use strict;

use lib "$ENV{'HOME'}/Node";

use Node;

package Callbacks;
sub new()
	{
	my($type) = $_[0];
	my($self) = {};
	bless($self, $type);
	return($self);
	}


sub cbPrintNode()
	{
	my($self, $checker, $level) = @_;
	return unless defined $checker;
	return if $level == 0; #### Don't print the contrived first node

	my $bulletMod = ($level - 1) % 3;
	my $colorMod = ($level - 1) % 7;
	my @bulletTypes = ("disc", "circle", "square");
	my @levelColors = ("000000", "990000", "006600", "000099",
		"663300", "660066", "003366");

	print "<li type=\"";
	print $bulletTypes[$bulletMod];
	print "\">";

	print "<font color=\"#";
	print $levelColors[$colorMod];
	print "\">";

	print $checker->getValue() if $checker->hasValue();
	print "<\/font>";
	print "<\/li>\n";
	print "<ul>\n" if $checker->hasFirstChild();
	}

sub cbFinishList()
	{
	my($self, $checker, $level) = @_;
	return unless defined $checker;
	return if $level == 0; #### Don't print the contrived first node

	print "</ul>\n";
	}

package Main;

sub main()
	{
	#### START HTML
	print "<html><head>\n";
	print "<title>CREATED BY otl2htmloutline.pl<\/title>\n";
	print "<\/head><body>\n";
	print "<ul>";

	#### PARSE FROM STDIN
	my $parser = OutlineParser->new();
	$parser->setCommentChar("#");
	$parser->fromStdin();
	my $topNode=$parser->parse();

	#### INSTANTIATE THE Callbacks OBJECT
	my $callbacks = Callbacks->new();

	#### WALK THE NODE TREE,
	#### OUTPUTTING AN HTML FILE WITH NESTED UNORDERED LIST
	my $walker = Walker->new
		(
		$topNode,
		[\&Callbacks::cbPrintNode, $callbacks],
		[\&Callbacks::cbFinishList, $callbacks]
		);
	$walker->walk();

	#### FINISH HTML
	print "<\/ul>";
	print "\n<\/body><\/html>\n";
	}

main();

#                            12 
#                             |
#             .---------------`-------------------.
#             |                                   |
#             4                                  16
#             |                                   |
#      .------`--------.                   .------`--------.
#      |               |                   |               |
#      2               6                  14              20
#      |               |                   |               |
#  .---`---.       .---`---.           .---`---.       .---`---.
#  |       |       |       |           |       |       |       |
#  1       3       5       7          13      15      19      21
#                          `--.                        |
#                             |                    .---`
#                             8                    |
#                             |                   18
#                             `--.                 |
#                                |             .---`
#                               10             |
#                                |            17
#                            .---`---.
#                            |       |
#                            9      11

#!/usr/bin/perl -w

# Copyright (C) 2004 by Steve Litt
# Licensed with the GNU General Public License, Version 2
# ABSOLUTELY NO WARRANTY, USE AT YOUR OWN RISK
# See http://www.gnu.org/licenses/gpl.txt

use strict;

use lib "$ENV{'HOME'}/Node";

use Node;

package Callbacks;
sub new()
	{
	my($type) = $_[0];
	my($self) = {};
	bless($self, $type);
	return($self);
	}


sub cbPrintNode()
	{
	my($self, $checker, $level) = @_;
	return unless defined $checker;

	for(my $i=0; $i < $level; $i++){print "\t";}
	print $checker->getValue();
	print " (", $checker->getType(), ")";
	print " (", $checker->getName(), ")";
	if($checker->hasAttribute("_lineno"))
		{
		print " (Line ", $checker->getAttribute("_lineno"), ")";
		}
	print "\n";
	}

sub cbPrintSortedEntry()
	{
	my($self, $checker, $level) = @_;
	return unless defined $checker;

	if(($checker->getType() eq 'R'))
		{
		if($checker->hasParent())
			{
			print $checker->getParent->getValue();
			print " (", $checker->getParent->getType(), ")\n";
			}
		}
	if($checker->hasFirstChild() == 0)
		{
		print $checker->getValue();
		print " (", $checker->getType(), ")\n";
		}
	}

sub cbPrintSortedReturn()
	{
	my($self, $checker, $level) = @_;
	return unless defined $checker;
	return unless defined $checker->getLastChild();

	if($checker->getLastChild()->getType eq 'L')
		{
		if($checker->hasParent())
			{
			print $checker->getValue();
			print " (", $checker->getType(), ")\n";
			}
		}
	}

package Main;

sub howManyChildren($)
	{
	my $node = shift;
	return 0 unless $node->hasFirstChild();
	return 1 unless $node->getFirstChild()->hasNextSibling();
	return 2;
	}

sub insertOneNodeIntoBtree($$)
	{
	my $btreeHead = shift;
	my $flattreeNode = shift;

	return "undefined_btreeHead" unless defined $btreeHead;
	return "undefined_flattreeNode" unless defined $flattreeNode;
	return "undefined_flattreeNode_value" unless $flattreeNode;
	
	my $value = $flattreeNode->getValue();

	my $newNode = Node->new("","",$value);
	$newNode->setAttribute("_lineno", $flattreeNode->getAttribute("_lineno"));
	return "could_not_create_new_node" unless defined $newNode;

	my $returnString;
	my $btreeChecker = $btreeHead;
	my $inserted = 0;

	while(! $inserted)
		{
		my $comparison = ($value cmp $btreeChecker->getValue());
		my $children = howManyChildren($btreeChecker);
		if($comparison == 0)
			{
			$returnString = "duplicate_" . $value;
			$inserted = -1;
			}
		elsif($children == 0)
			{
			if($comparison == 1)
				{
				$newNode->setType('R');
				}
			else
				{
				$newNode->setType('L');
				}
			$newNode->setName('0');
			$btreeChecker->insertFirstChild($newNode);
			$returnString = "inserted";
			$inserted = 1;
			}
		elsif($children == 2)
			{
			if($comparison == 1)
				{
				$btreeChecker = $btreeChecker->getLastChild();
				}
			else
				{
				$btreeChecker = $btreeChecker->getFirstChild();
				}
			}
		elsif($children == 1)
			{
			if($comparison == 1)
				{
				if($btreeChecker->getFirstChild()->getType() eq 'L')
					{
					$newNode->setType('R');
					$newNode->setName('1R');
					$btreeChecker->insertLastChild($newNode);
					$returnString = "inserted";
					$inserted = 1;
					}
				else
					{
					$btreeChecker = $btreeChecker->getFirstChild();
					}
				}
			else
				{
				if($btreeChecker->getFirstChild()->getType() eq 'R')
					{
					$newNode->setType('L');
					$newNode->setName('1L');
					$btreeChecker->insertFirstChild($newNode);
					$returnString = "inserted";
					$inserted = 1;
					}
				else
					{
					$btreeChecker = $btreeChecker->getFirstChild();
					}
				}
			}
		}
	return $returnString;
	}


sub buildBtree($)
	{
	my $flattreeNode = shift;
	return undef unless defined $flattreeNode;
	return unless $flattreeNode->hasFirstChild();

	my $result;
	my $btreeChecker;

	my $flatChecker = $flattreeNode->getFirstChild();
	my $btreeHead =  Node->new("top", "T", $flatChecker->getValue());
	$flatChecker = $flatChecker->getNextSibling();
	while(defined($flatChecker))
		{
		$result = insertOneNodeIntoBtree($btreeHead, $flatChecker);
		$flatChecker = $flatChecker->getNextSibling();
		}
	return $btreeHead;
	}

sub displayTree($)
	{
	my $topNode = shift;
	
	my $callbacks = Callbacks->new();
	my $walker = Walker->new
		(
		$topNode,
		[\&Callbacks::cbPrintNode, $callbacks]
		);
	$walker->walk();
	}

sub printSortedList($)
	{
	my $topNode = shift;
	my $callbacks = Callbacks->new();
	my $walker = Walker->new
		(
		$topNode,
		[\&Callbacks::cbPrintSortedEntry, $callbacks],
		[\&Callbacks::cbPrintSortedReturn, $callbacks]
		);
	$walker->walk();
	}

sub stdin2flattree()
	{
	my $parser = OutlineParser->new();
	$parser->setCommentChar("#");
	$parser->fromStdin(); my $topNode=$parser->parse();
	return $topNode;
	}

sub findNode($$)
	{
	my $btreeTopNode = shift;
	my $value = shift;
	my $found = 0;
	my $tests = 0;


	my $checker = $btreeTopNode;
	while(! $found)
		{
		$tests++;
		my $comparison = ($value cmp $checker->getValue());
		if($comparison == 0)
			{
			$found = 1;
			last;
			}
		elsif(!$checker->hasFirstChild())
			{
			$found = -1;
			last;
			}
		if(! $found)
			{
			if($comparison == -1)
				{
				$checker = $checker->getFirstChild();
				if($checker->getType() ne 'L')
					{
					$found = -1;
					}
				}
			else
				{
				$checker = $checker->getLastChild();
				if($checker->getType() ne 'R')
					{
					$found = -1;
					}
				}
			}
		}

	if($found == 1)
		{
		print "$value found, line number ";
		print $checker->getAttribute('_lineno');
		print " $tests nodes tested.\n";
		return $checker;
		}
	else
		{
		print "$value not found, $tests nodes tested.\n";
		return undef;
		}
	}

sub main()
	{
	my $flattreeTopNode = stdin2flattree();
	my $btreeTopNode = buildBtree($flattreeTopNode);

	print "########## ORIGINAL WORDS FOLLOW...\n";
	displayTree($flattreeTopNode);

	print "\n\n########## BINARY TREE FOLLOWS...\n";
	displayTree($btreeTopNode);


	print "\n\n########## SORTED LIST FOLLOWS...\n";
	printSortedList($btreeTopNode);


	print "\n\n########## FINDING CARTER...\n";
	findNode($btreeTopNode, "Carter");

	print "\n\n########## FINDING ULLMAN...\n";
	findNode($btreeTopNode, "Ullman");

	print "\n\n########## FINDING WASHINGTON...\n";
	findNode($btreeTopNode, "Washington");

	print "\n\n########## FINDING NoSuch...\n";
	findNode($btreeTopNode, "NoSuch");
	}

main();

#                            12 
#                             |
#             .---------------`-------------------.
#             |                                   |
#             4                                  16
#             |                                   |
#      .------`--------.                   .------`--------.
#      |               |                   |               |
#      2               6                  14              20
#      |               |                   |               |
#  .---`---.       .---`---.           .---`---.       .---`---.
#  |       |       |       |           |       |       |       |
#  1       3       5       7          13      15      19      21
#                          `--.                        |
#                             |                    .---`
#                             8                    |
#                             |                   18
#                             `--.                 |
#                                |             .---`
#                               10             |
#                                |            17
#                            .---`---.
#                            |       |
#                            9      11