#!/usr/bin/perl -w
#
# History
#
# 1.0.3a 19981128 - Fixed fatal bug when the bookmark file has a
#                   description set on the entire bookmark file.
#                   Problem brought to my attention by
#                   Oleg Broytmann <phd2@earthling.net>
#
# 1.0.3 19980630  - Added handling for variant bookmark
#                   files that inserts linebreaks in descriptions
#                   with multiple lines. Problem brought to my
#                   attention by Gordon Berkley 
#                   <gordonb@mcil.comm.mot.com>
#
# 1.0.2 19980610  - Fixed some lines that were generating
#                   warnings under perl 5.004_04 running under
#                   '-w', hybridized the object management code,
#                   and re-organized the primary loop to eliminate
#                   unnecessary tests and code.
#
#                   Net performance improvement is 11x over 1.0.1.
#                   (my test runs converted a ~1400 entry bookmark 
#                   file in 5 seconds on my P166 linux box)
#
# 1.0.1 19980601  - Unnoticable 'bug' fixes. Generated HTML
#                   should now be SGML valid to the W3C 3.2 level.
#
# 1.0   19980531  - First release.
#
# Version 1.0.3a
# Copyright 1998, Benjamin Franz
#
# You may freely copy, distribute and use this software so long
# as all documentation is left intact in the source, the software 
# identifing META tag is left in the generated web pages, and this 
# notice is included in the source code.
#
# If you wish to modify and distribute this software, feel free.
# You MAY NOT charge for distributing the software. If you modify it,
# please make sure you document it (and if it is a good hack
# let me know - I might include it in a future release).
#
# The most current release can always be found at
# <URL:http://www.nihongo.org/snowhare/utilities/>
#
# BookMarker requires Perl 5 or later to run. 
#
# THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS
# OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE
# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
# PARTICULAR PURPOSE.
#
# Use of this software in any way or in any form, source or binary,
# is not allowed in any country which prohibits disclaimers of any
# implied warranties of merchantability or fitness for a particular
# purpose or any disclaimers of a similar nature.
#
# IN NO EVENT SHALL I BE LIABLE TO ANY PARTY FOR DIRECT, INDIRECT,
# SPECIAL, INCIDENTAL,  OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE
# USE OF THIS SOFTWARE AND ITS DOCUMENTATION (INCLUDING, BUT NOT
# LIMITED TO, LOST PROFITS) EVEN IF I HAVE BEEN ADVISED OF THE
# POSSIBILITY OF SUCH DAMAGE

use strict;

umask ((022 & umask)|022);

my ($bookmark) = BookMarker->new;

# Location of bookmark file to generate tree from
$bookmark->set_bookmark_file ("/home/users/snowhare/.netscape/bookmarks.html");

# Format of bookmark file (you shouldn't have to change this)
$bookmark->set_bookmark_format ('NETSCAPE-Bookmark-file-1');

# Location of directory to construct bookmark tree in
$bookmark->set_output_dir ("/www/servers/foo/bookmarker");

# Root folder (The name of the top level bookmark folder that 
# is to be used as the top of the tree.
# If commented out, the entire bookmark file will be used)
#$bookmark->set_root_folder ("Public");

# Index file name
$bookmark->set_index_file ("index.html");

# Base '<title>' for pages
$bookmark->set_main_title ("Jerry's Bookmarks");

# Header text 
$bookmark->set_header ("<h1>BookMarker</h1>");

# Footer text
my ($version) = $bookmark->get_version;
$bookmark->set_footer ("<hr noshade>\nCreated using <a href=\"http://www.nihongo.org/snowhare/utilities/\">$version</a>");

# BGCOLOR
$bookmark->set_bgcolor('#ffffff');

# TEXT
$bookmark->set_textcolor('#000000');

# LINK
$bookmark->set_linkcolor('#0000cc');

# ALINK
$bookmark->set_alinkcolor('#cc0000');

# VLINK
$bookmark->set_vlinkcolor('#cc00cc');

# BACKGROUND
$bookmark->set_background('');

# Read the bookmark file
$bookmark->read_bookmarks;

# Output the HTML tree
$bookmark->make_tree;

######################################################################################

package BookMarker;

sub new {
	my ($class) = shift;

	my ($self)  = {};
	bless $self,$class;

	# BookMarker Version
	$self->set_version ("BookMarker/1.0.3a");

	return ($self);
}

sub make_tree {
	my ($self) = shift;

	my (@folder_key)      = ('Top');
	my ($starting_folder) = $self->get_root_folder;
	if ($starting_folder) {
		push (@folder_key,$starting_folder);
	}
	my ($output_dir) = $self->get_output_dir;
	$self->_build_folder($output_dir,@folder_key);
}

sub _build_folder {
	my ($self) = shift;

	my ($output_dir,@folder_key) = @_;

	if (! chdir ($output_dir)) {
		if (! -e $output_dir) {
			if (! mkdir ($output_dir,0755)) {
				die ("Directory '$output_dir' does not exist and could not be created\n$!");
			}
		} else {
			die ("Could not chdir to '$output_dir'.\n$!");
		}
	}
	my (@subfolder_list) = $self->get_folder_field(@folder_key,'folders');
	
	my ($split_at) = $#subfolder_list;
	if ($split_at > 5) {
		$split_at = int ($split_at/2);
	}
	my ($split_count)     = 0;
	my ($subfolder_links) = 0;
	my ($total_links)     = 0;
	my ($folder_display)  = "<table cellspacing=10 width=\"80%\">\n<tr valign=top align=left>\n<td>\n";
	$folder_display .= "<ul>\n" if ($#subfolder_list > -1);
	my ($subfolder);
	foreach $subfolder (sort {lc($a) cmp lc($b)} @subfolder_list) {
		my ($folder_path) = $self->flatten_name($subfolder);
		$subfolder_links = $self->_build_folder("$output_dir/$folder_path",@folder_key,$subfolder);
		$total_links += $subfolder_links;
		$folder_display .= "  <li><a href=\"$folder_path/\"><b>$subfolder ($subfolder_links)</b></a>";
		my ($desc) = $self->get_folder_field(@folder_key,$subfolder,'description');
		if ($desc) {
			$folder_display .= " - $desc";
		}
		$folder_display .= "</li>\n";
		if ($split_at == $split_count) {
			$folder_display .= "</ul></td>\n<td>\n<ul>\n";
		}
		$split_count++;
	}
	$folder_display .= "</ul>\n" if ($#subfolder_list > -1);
	$folder_display .= "</td>\n</tr>\n</table>\n";
	
	my (@links_list)     = $self->get_folder_field(@folder_key,'links');
	my ($links_display)  = '';
	$links_display       .= "<ul>\n" if (@links_list > -1);
	my ($link);
	foreach $link (sort {lc($a) cmp lc($b)} @links_list) {
		my ($url) = $self->get_folder_link_field(@folder_key,$link,'href');
		$links_display .= "  <li><a href=\"$url\">$link</a>";
		my ($desc) = $self->get_folder_link_field(@folder_key,$link,'description');
		if ($desc) {
			$links_display .= "- $desc";
		}
		$links_display .= "</li>\n";
		$total_links++;
	}
	$links_display .= "</ul>\n\n" if (@links_list > -1);

	my (@nav_history)      = @folder_key;
	if ($self->get_root_folder) {
		my ($top) = shift @nav_history;
		shift @nav_history;
		unshift (@nav_history,$top);
	}
	my ($page_name)        = pop @nav_history;
	my ($page_title)       = '';
	my ($tree_nav_display) = "$page_name</h3>";
	my ($nav_level);
	my ($nav_prefix) = "../";
	while ($nav_level  = pop @nav_history) {
		$tree_nav_display = "<a href=\"$nav_prefix\">$nav_level</a> -\&gt; $tree_nav_display";
		$nav_prefix       = "../$nav_prefix";
		if ($page_title) {
			$page_title       = "${nav_level}:$page_title";
		} else {
			$page_title       =$nav_level;
		}
	}
	if ($page_title) {
		$page_title = $self->get_main_title . ":$page_title:$page_name";
	} else {
		$page_title = $self->get_main_title  . ":$page_name";
	}
	$tree_nav_display = "<h3>$tree_nav_display";

	my ($body_tag) = $self->get_body_tag;
	my ($header)   = $self->get_header;
	my ($footer)   = $self->get_footer;

	my ($nlinks)   = $#links_list + 1;
	my ($nls)      = 's';
	if ($nlinks == 1) {
		$nls = '';
	}

	my ($nfolders) = $#subfolder_list + 1;
	my ($fls)      = 's';
	if ($nfolders == 1) {
		$fls = '';
	}
	
	my ($version)  = $self->get_version;

	my ($html) = <<"EOF";
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2 Final//EN">
<html>
<title>$page_title</title>
<meta name="generator" 
      content="$version http://www.nihongo.org/snowhare/utilities/">
</head>
$body_tag
$header
$tree_nav_display
<hr noshade>
<h2>$nfolders subfolder$fls</h2>
$folder_display
<hr noshade>
<h2>$nlinks link$nls</h2>
$links_display
$footer
</body>
</html>

EOF
	my ($index_file) = $self->get_index_file;
	$self->save_file("$output_dir/$index_file",$html);

	return ($total_links);
}

sub flatten_name {
	my ($self) = shift;

	my ($name) = @_;

	$name =~ s/[^-.A-Z0-9]/_/gois;

	$name;
}

sub read_file {
	my ($self) = shift;

        my ($filename)=@_;

        if (! open (FILEH,$filename)) {
                die ("$filename could not be opened for reading\n$!");
        }
	my ($temp) = $/;
	undef $/;
	my ($contents) = <FILEH>;
	$/ = $temp;
	close (FILEH);
	return ($contents);
}

sub save_file {
	my ($self) = shift;

        my ($filename,$image)=@_;

        if (! ($filename =~ m#^\s*[|><]#o)) {
                $filename=">$filename";
        }
        if (! open (NEWFILE,$filename)) {
                die ("$filename could not be opened for writing\n$!");
        }

        print NEWFILE $image; 
        close (NEWFILE);
        1;
}

sub read_bookmarks {
	my ($self) = shift;

	my ($bookmark_format) = $self->get_bookmark_format;

	if ($bookmark_format eq 'NETSCAPE-Bookmark-file-1') {
		$self->read_v1_netscape_bookmarks;
	}
}

sub read_v1_netscape_bookmarks {
	my ($self) = shift;

	my ($bookmark_file) = $self->get_bookmark_file;

	if (! -e $bookmark_file) {
		die ("Can not find bookmark file '$bookmark_file'\n");
	}
	if (! -r _) {
		die ("Can not read bookmark file '$bookmark_file'\n");
	}
	if (! -f _) {
		die ("Chosen bookmark file '$bookmark_file' does not appear to be a file\n");
	}

	my ($bookmark_text) = $self->read_file($bookmark_file);

	# change \r to \n (let's not be discriminatory against non-unix op systems)
	$bookmark_text =~ s/\r/\n/gos;
	
	# Unfold lines ending in <BR>\n
	$bookmark_text =~ s/<BR>\s*\n/ <BR>/gos;

	if (! ($bookmark_text =~ s/^<!DOCTYPE NETSCAPE-Bookmark-file-1>\n//o)) {
		die ("Chosen bookmark file format for file '$bookmark_file' does not appear to match the actual file\n");
	}

	# Discard HTML comments

	$bookmark_text =~ s/<!-- .*? -->//gos;

	# Discard blank lines and trailing white space
	$bookmark_text =~ s/\s+\n/\n/gos;
	
	# Break it down by line now that we have done some cleaning of the cruft
	my (@bookmark_lines) = split (/\n/,$bookmark_text);

	# Ready, Set, Go!!!
	my ($line,$last_link_title);
	my ($last_DT) = 'folder';
	my (@folder_key) = ('Top');
	my $line_count;
	for ($line_count=0;$line_count<=$#bookmark_lines;$line_count++) {
		$line = $bookmark_lines[$line_count];
		next if (! $line);

		# A line entry
		if ($line =~ m#\s*<DT><A HREF="(.*?)" [^>]*?ADD_DATE="(\d+)" LAST_VISIT="(\d+)" LAST_MODIFIED="(\d+)">(.*)</A>$#oi) {
			my ($href,$add_date,$last_visit,$last_modified,$link_title) = ($1,$2,$2,$4,$5);
			$self->set_folder_link_field(@folder_key,$link_title,'href',$href);
			
#			$self->set_folder_link_field(@folder_key,$link_title,'add_date',$add_date);
#			$self->set_folder_link_field(@folder_key,$link_title,'last_visit',$last_visit);
#			$self->set_folder_link_field(@folder_key,$link_title,'last_modified',$last_modified);
			$last_DT = 'link';
			$last_link_title = $link_title;
			next;
		}

		# Start of a folder
		if ($line =~ m#\s*<DT><H3 [^>]*?ADD_DATE="(\d+)">(.*)</H3>$#oi) {
			my ($add_date,$folder_title) = ($1,$2);
			push (@folder_key,$folder_title);
			$self->set_folder_field(@folder_key,'add_date',$add_date);
			$last_DT = 'folder';
			next;
		}

		# Start of a description
		if ($line =~ m#\s*<DD>(.*)#oi) {
			my ($desc) = $1;
			if ($last_DT eq 'folder') {
				$self->set_folder_field(@folder_key,'description',$desc);
			} elsif ($last_DT eq 'link') {
				$self->set_folder_link_field(@folder_key,$last_link_title,'description',$desc);
			} else {
				die ("Hmmmm...Something went wrong: $line\n");
			}
			next;
		}

		# End of a folder
		if ($line =~ m#^\s*</DL><p>$#oi) {
			last if ($#folder_key == 0);
			pop (@folder_key);
			next;
		}
		
		# Skip. We don't care.
		if ($line =~ m#^\s*<DL><p>$#oi) {
			next;
		}

		# Skip. We don't care.
		if ($line =~ m#^\s*<HR>$#oi) {
			next;
		}
		

		# The title of the bookmark file
		if ($line =~ m#^<TITLE>(.*)</TITLE>$#io) {
			my ($title) = $1;
			if ((! $self->get_root_folder) && (! $self->get_main_title)) {
				$self->set_main_title($title);
			}
			next;
		}

		# the 'kind of title'
		if ($line =~ m#^<H1>(.*)</H1>$#io) {
			my ($top_folder) = $1;
			if (! defined($self->get_header)) {
				$self->set_header($top_folder);
			}
			next;
		}

		die ("Uh oh. Whats going on?\n\n$line\n\n");
	}		
}

######################################################################################
		
sub set_folder_link_field {
	my ($self) = shift;

	my (@folder_key) = @_;

	my ($value) = pop @folder_key;
	my ($field) = pop @folder_key;
	my ($link)  = pop @folder_key;

	my (@two_layer_key) = ('bookmarker',map {('folders',$_)} @folder_key);
	$self->_set_object_field(@two_layer_key,'links',$link,$field,$value);
}

sub get_folder_link_field {
	my ($self) = shift;
	
	my (@folder_key) = @_;

	my ($field) = pop @folder_key;
	my ($link)  = pop @folder_key;

	my (@two_layer_key) = ('bookmarker',map {('folders',$_)} @folder_key);
	return ($self->_get_object_field(@two_layer_key,'links',$link,$field));
}

sub set_folder_field {
	my ($self) = shift;

	my (@folder_key,$field,$value) = @_;

	$value = pop @folder_key;
	$field = pop @folder_key;
	
	my (@two_layer_key) = ('bookmarker',map {('folders',$_)} @folder_key);
	$self->_set_object_field(@two_layer_key,$field,$value);
}

sub get_folder_field {
	my ($self) = shift;
	
	my (@folder_key) = @_;

	my ($field) = pop @folder_key;

	my (@two_layer_key) = ('bookmarker',map {('folders',$_)} @folder_key);
#	my (@two_layer_key) = ('bookmarker','folders',map {$_, 'folders'} @folder_key[0..$#folder_key-1]);
#	my (@two_layer_key) = ('bookmarker','folders');
#	for (my $count=0;$count <$#folder_key;$count++) {
#		push (@two_layer_key,$folder_key[$count],'folders');
#	}
#	push (@two_layer_key,$folder_key[$#folder_key]);

	return ($self->_get_object_field(@two_layer_key,$field));
}

sub set_version {
	my ($self) = shift;
	
	my ($version) = @_;

	$self->_set_object_field('bookmarker','version',$version);
}

sub get_version {
	my ($self) = shift;
	
	return ($self->_get_object_field('bookmarker','version'));
}

sub set_bookmark_file {
	my ($self) = shift;
	
	my ($bookmark_file) = @_;

	$self->_set_object_field('bookmarker','bookmark_file',$bookmark_file);
}

sub get_bookmark_file {
	my ($self) = shift;
	
	return ($self->_get_object_field('bookmarker','bookmark_file'));
}

sub set_bookmark_format {
	my ($self) = shift;
	
	my ($bookmark_format) = @_;

	$self->_set_object_field('bookmarker','bookmark_format',$bookmark_format);
}

sub get_bookmark_format {
	my ($self) = shift;
	
	return ($self->_get_object_field('bookmarker','bookmark_format'));
}

sub set_output_dir {
	my ($self) = shift;
	
	my ($output_dir) = @_;

	$self->_set_object_field('bookmarker','output_dir',$output_dir);
}

sub get_output_dir {
	my ($self) = shift;
	
	return ($self->_get_object_field('bookmarker','output_dir'));
}

sub set_root_folder {
	my ($self) = shift;
	
	my ($root_folder) = @_;

	$self->_set_object_field('bookmarker','root_folder',$root_folder);
}

sub get_root_folder {
	my ($self) = shift;
	
	return ($self->_get_object_field('bookmarker','root_folder'));
}

sub set_index_file {
	my ($self) = shift;
	
	my ($index_file) = @_;

	$self->_set_object_field('bookmarker','index_file',$index_file);
}

sub get_index_file {
	my ($self) = shift;
	
	return ($self->_get_object_field('bookmarker','index_file'));
}

sub set_main_title {
	my ($self) = shift;
	
	my ($main_title) = @_;

	$self->_set_object_field('bookmarker','main_title',$main_title);
}

sub get_main_title {
	my ($self) = shift;
	
	return ($self->_get_object_field('bookmarker','main_title'));
}

sub set_header {
	my ($self) = shift;
	
	my ($header) = @_;

	$self->_set_object_field('bookmarker','header',$header);
}

sub get_header {
	my ($self) = shift;
	
	return ($self->_get_object_field('bookmarker','header'));
}

sub set_footer {
	my ($self) = shift;
	
	my ($footer) = @_;

	$self->_set_object_field('bookmarker','footer',$footer);
}

sub get_footer {
	my ($self) = shift;
	
	return ($self->_get_object_field('bookmarker','footer'));
}

sub set_bgcolor {
	my ($self) = shift;
	
	my ($bgcolor) = @_;

	$self->_set_object_field('bookmarker','bgcolor',$bgcolor);
}

sub get_bgcolor {
	my ($self) = shift;
	
	return ($self->_get_object_field('bookmarker','bgcolor'));
}

sub set_textcolor {
	my ($self) = shift;
	
	my ($textcolor) = @_;

	$self->_set_object_field('bookmarker','textcolor',$textcolor);
}

sub get_textcolor {
	my ($self) = shift;
	
	return ($self->_get_object_field('bookmarker','textcolor'));
}

sub set_linkcolor {
	my ($self) = shift;
	
	my ($linkcolor) = @_;

	$self->_set_object_field('bookmarker','linkcolor',$linkcolor);
}

sub get_linkcolor {
	my ($self) = shift;
	
	return ($self->_get_object_field('bookmarker','linkcolor'));
}

sub set_vlinkcolor {
	my ($self) = shift;
	
	my ($vlinkcolor) = @_;

	$self->_set_object_field('bookmarker','vlinkcolor',$vlinkcolor);
}

sub get_vlinkcolor {
	my ($self) = shift;
	
	return ($self->_get_object_field('bookmarker','vlinkcolor'));
}

sub set_alinkcolor {
	my ($self) = shift;
	
	my ($alinkcolor) = @_;

	$self->_set_object_field('bookmarker','alinkcolor',$alinkcolor);
}

sub get_alinkcolor {
	my ($self) = shift;
	
	return ($self->_get_object_field('bookmarker','alinkcolor'));
}

sub set_background {
	my ($self) = shift;
	
	my ($background) = @_;

	$self->_set_object_field('bookmarker','background',$background);
}

sub get_background {
	my ($self) = shift;
	
	return ($self->_get_object_field('bookmarker','background'));
}

sub get_body_tag {
	my ($self) = shift;

	my ($body_tag) = "<body";

	my ($background) = $self->get_background;
	if ($background) {
		$body_tag .= " background=\"$background\"";
	}

	my ($bgcolor)    = $self->get_bgcolor;
	if ($bgcolor) {
		$body_tag .= " bgcolor=\"$bgcolor\"";
	}

	my ($textcolor)  = $self->get_textcolor;
	if ($textcolor) {
		$body_tag .= " text=\"$textcolor\"";
	}

	my ($linkcolor)  = $self->get_linkcolor;
	if ($linkcolor) {
		$body_tag .= " link=\"$linkcolor\"";
	}
	
	my ($alinkcolor) = $self->get_alinkcolor;
	if ($alinkcolor) {
		$body_tag .= " alink=\"$alinkcolor\"";
	}

	my ($vlinkcolor) = $self->get_vlinkcolor;
	if ($vlinkcolor) {
		$body_tag .= " vlink=\"$vlinkcolor\"";
	}
	
	$body_tag = "$body_tag>";
 
	return ($body_tag);
}

#################################################################
# get the named object field in the object structure            #
#                                                               #
# The $data[0..$#data-1] is the key, $data[$#data] is the value #
#################################################################

sub _get_object_field {
        my ($self) = shift;

        my (@data) = @_;

	my ($result);
        if ($#data == -1) {
                $result = $self;
        } elsif ($#data == 0) { 
                $result = $$self{$data[0]};
        } elsif ($#data == 1) { 
                $result = ${$$self{$data[0]}}{$data[1]};
        } elsif ($#data == 2) { 
                $result = ${${$$self{$data[0]}}{$data[1]}}{$data[2]};
        } elsif ($#data == 3) { 
                $result = ${${${$$self{$data[0]}}{$data[1]}}{$data[2]}}{$data[3]};
        } elsif ($#data == 4) { 
                $result = ${${${${$$self{$data[0]}}{$data[1]}}{$data[2]}}{$data[3]}}{$data[4]};
        } elsif ($#data == 5) { 
                $result = ${${${${${$$self{$data[0]}}{$data[1]}}{$data[2]}}{$data[3]}}{$data[4]}}{$data[5]};
        } elsif ($#data == 6) {
                $result = ${${${${${${$$self{$data[0]}}{$data[1]}}{$data[2]}}{$data[3]}}{$data[4]}}{$data[5]}}{$data[6]};
        } elsif ($#data == 7) {
                $result = ${${${${${${${$$self{$data[0]}}{$data[1]}}{$data[2]}}{$data[3]}}{$data[4]}}{$data[5]}}{$data[6]}}{$data[7]};
        } elsif ($#data == 8) {
                $result = ${${${${${${${${$$self{$data[0]}}{$data[1]}}{$data[2]}}{$data[3]}}{$data[4]}}{$data[5]}}{$data[6]}}{$data[7]}}{$data[8]};
        } elsif ($#data == 9) {
                $result = ${${${${${${${${${$$self{$data[0]}}{$data[1]}}{$data[2]}}{$data[3]}}{$data[4]}}{$data[5]}}{$data[6]}}{$data[7]}}{$data[8]}}{$data[9]};
        } elsif ($#data == 10) {
                $result = ${${${${${${${${${${$$self{$data[0]}}{$data[1]}}{$data[2]}}{$data[3]}}{$data[4]}}{$data[5]}}{$data[6]}}{$data[7]}}{$data[8]}}{$data[9]}}{$data[10]};
        } elsif ($#data == 11) {
                $result = ${${${${${${${${${${${$$self{$data[0]}}{$data[1]}}{$data[2]}}{$data[3]}}{$data[4]}}{$data[5]}}{$data[6]}}{$data[7]}}{$data[8]}}{$data[9]}}{$data[10]}}{$data[11]};
        } elsif ($#data == 12) {
                $result = ${${${${${${${${${${${${$$self{$data[0]}}{$data[1]}}{$data[2]}}{$data[3]}}{$data[4]}}{$data[5]}}{$data[6]}}{$data[7]}}{$data[8]}}{$data[9]}}{$data[10]}}{$data[11]}}{$data[12]};
        } elsif ($#data == 13) {
                $result = ${${${${${${${${${${${${${$$self{$data[0]}}{$data[1]}}{$data[2]}}{$data[3]}}{$data[4]}}{$data[5]}}{$data[6]}}{$data[7]}}{$data[8]}}{$data[9]}}{$data[10]}}{$data[11]}}{$data[12]}}{$data[13]};
        } elsif ($#data == 14) {
                $result = ${${${${${${${${${${${${${${$$self{$data[0]}}{$data[1]}}{$data[2]}}{$data[3]}}{$data[4]}}{$data[5]}}{$data[6]}}{$data[7]}}{$data[8]}}{$data[9]}}{$data[10]}}{$data[11]}}{$data[12]}}{$data[13]}}{$data[14]};
        } elsif ($#data == 15) {
                $result = ${${${${${${${${${${${${${${${$$self{$data[0]}}{$data[1]}}{$data[2]}}{$data[3]}}{$data[4]}}{$data[5]}}{$data[6]}}{$data[7]}}{$data[8]}}{$data[9]}}{$data[10]}}{$data[11]}}{$data[12]}}{$data[13]}}{$data[14]}}{$data[15]};
	} else { # This is for *REALLY* deep bookmarks. Considerably slower than the inline code above.
		my ($lookup) = $self->_get_field_lookup($#data);
		eval ("\$result = $lookup");
		if ($@) {
			die ("_get_object_field 'eval' failed: $@");
		}
	}

	if (! defined ($result)) {
		return ();
	}

	my ($ref) = ref $result;
	if (! defined ($ref)) {
		return();
	} elsif (! $ref) {
		return $result;
	} elsif ($ref eq 'HASH') {
		return (keys %$result);
	} elsif ($ref eq 'ARRAY') {
		return (@$result);
	} else {
        	return $result;
	}

}

#################################################################
# set the named object field in the object structure            #
#                                                               #
# The $data[0..$#data-1] is the key, $data[$#data] is the value #
#################################################################
sub _set_object_field {
        my ($self) = shift;
         
        my (@data)=@_;
	my ($value) = pop @data;

        if ($#data == -1) {
		die ("_set_object_field called without a valid key.\n");
        } elsif (! defined($value)) {
		die ("_set_object_field called without a value to set.\n");
	} elsif ($#data == 0) {
                $$self{$data[0]} = $value;
        } elsif ($#data == 1) {
                ${$$self{$data[0]}}{$data[1]} = $value;
        } elsif ($#data == 2) {
                ${${$$self{$data[0]}}{$data[1]}}{$data[2]} = $value;
	} elsif ($#data == 3) {
		${${${$$self{$data[0]}}{$data[1]}}{$data[2]}}{$data[3]} = $value;
	} elsif ($#data == 4) {
		${${${${$$self{$data[0]}}{$data[1]}}{$data[2]}}{$data[3]}}{$data[4]} = $value;
	} elsif ($#data == 5) {
		${${${${${$$self{$data[0]}}{$data[1]}}{$data[2]}}{$data[3]}}{$data[4]}}{$data[5]} = $value;
	} elsif ($#data == 6) {
		${${${${${${$$self{$data[0]}}{$data[1]}}{$data[2]}}{$data[3]}}{$data[4]}}{$data[5]}}{$data[6]} = $value;
	} elsif ($#data == 7) {
		${${${${${${${$$self{$data[0]}}{$data[1]}}{$data[2]}}{$data[3]}}{$data[4]}}{$data[5]}}{$data[6]}}{$data[7]} = $value;
	} elsif ($#data == 8) {
		${${${${${${${${$$self{$data[0]}}{$data[1]}}{$data[2]}}{$data[3]}}{$data[4]}}{$data[5]}}{$data[6]}}{$data[7]}}{$data[8]} = $value;
	} elsif ($#data == 9) {
		${${${${${${${${${$$self{$data[0]}}{$data[1]}}{$data[2]}}{$data[3]}}{$data[4]}}{$data[5]}}{$data[6]}}{$data[7]}}{$data[8]}}{$data[9]} = $value;
	} elsif ($#data == 10) {
		${${${${${${${${${${$$self{$data[0]}}{$data[1]}}{$data[2]}}{$data[3]}}{$data[4]}}{$data[5]}}{$data[6]}}{$data[7]}}{$data[8]}}{$data[9]}}{$data[10]} = $value;
	} elsif ($#data == 11) {
		${${${${${${${${${${${$$self{$data[0]}}{$data[1]}}{$data[2]}}{$data[3]}}{$data[4]}}{$data[5]}}{$data[6]}}{$data[7]}}{$data[8]}}{$data[9]}}{$data[10]}}{$data[11]} = $value;
	} elsif ($#data == 12) {
		${${${${${${${${${${${${$$self{$data[0]}}{$data[1]}}{$data[2]}}{$data[3]}}{$data[4]}}{$data[5]}}{$data[6]}}{$data[7]}}{$data[8]}}{$data[9]}}{$data[10]}}{$data[11]}}{$data[12]} = $value;
	} elsif ($#data == 13) {
		${${${${${${${${${${${${${$$self{$data[0]}}{$data[1]}}{$data[2]}}{$data[3]}}{$data[4]}}{$data[5]}}{$data[6]}}{$data[7]}}{$data[8]}}{$data[9]}}{$data[10]}}{$data[11]}}{$data[12]}}{$data[13]} = $value;
	} elsif ($#data == 14) {
		${${${${${${${${${${${${${${$$self{$data[0]}}{$data[1]}}{$data[2]}}{$data[3]}}{$data[4]}}{$data[5]}}{$data[6]}}{$data[7]}}{$data[8]}}{$data[9]}}{$data[10]}}{$data[11]}}{$data[12]}}{$data[13]}}{$data[14]} = $value;
	} elsif ($#data == 15) {
		${${${${${${${${${${${${${${${$$self{$data[0]}}{$data[1]}}{$data[2]}}{$data[3]}}{$data[4]}}{$data[5]}}{$data[6]}}{$data[7]}}{$data[8]}}{$data[9]}}{$data[10]}}{$data[11]}}{$data[12]}}{$data[13]}}{$data[14]}}{$data[15]} = $value;
        } else { # Slower than the inline code above but needed for exceptionally deep trees.
		my ($lookup) = $self->_get_field_lookup ($#data);
		my ($result) = eval ("$lookup = \$value");
		if ($@) {
			die ("_set_object_field 'eval' failed: $@");
		}
	}
}

##########################################################################
# clears the named object field in the template object structure         #
#                                                                        #
# $self is a pointer to a template type object in memory              #
# $key is the name of the named object.                                  #
##########################################################################
sub _clear_object_field {
	my ($self) = shift;

	my (@data) = @_;
	my ($treedepth) = $#data;

	if ($treedepth < 0) { # no parms means clear EVERYTHING
		die ("_clear object field called with no fields specified.\n",);
	}
	my ($lookup) = $self->_get_field_lookup ($#data);
	my ($result) = eval ("delete $lookup");
	if ($@) {
		die ("_clear_object_field 'eval' failed: $@");
	}
}

##########################################################################
# Returns a lookup string assuming 'data' as the magic variable          #
##########################################################################
sub _get_field_lookup {
	my ($self) = shift;

	my ($depth) = @_;

	my ($lookup);
	if (! ($lookup = $$self{'_object_field_index'}[$depth])) {
		$lookup = '$$self';
		my ($count);
		for ($count=0;$count<$depth;$count++) {
			$lookup = '${' . $lookup . '{$data[' . $count . ']}}';
		}
		$lookup .= '{$data[' . $depth . ']}';
		$$self{'_object_field_index'}[$depth] = $lookup;
	} 
	return ($lookup);
}

=head1 AUTHOR

Benjamin Franz

=head1 TODO

Everything.

=cut