#!/usr/bin/perl

use strict;
use warnings;

use Glib qw(TRUE FALSE);
use Gtk2 '-init';
use XML::LibXML;


my $NODE_POS  = 0;
my $NODE_DATA = $NODE_POS++;
my $NODE_NAME = $NODE_POS++;


exit main() unless caller;


sub main {
	local $| = 1;
	my ($xml) = @ARGV;
	$xml = \"<doc><a><a1/><a2/></a><b><b1/><b2/><b3/></b></doc>" unless $xml;
	my $document = parse_xml($xml);

	my $model = my::DomTreeModel->new($document);

	my $window = Gtk2::Window->new();
	$window->set_size_request(200, 200);
	
	my $view = create_tree_view();
	$view->set_model($model);
	$window->add(scrollify($view));

	$window->signal_connect(destroy => sub {Gtk2->main_quit(); });	

	$window->show_all();
	Gtk2->main();

	return 0;
}


sub create_tree_view {
	my $view = Gtk2::TreeView->new();
	$view->set_fixed_height_mode(TRUE);

	my $cell = Gtk2::CellRendererText->new();
	my $column = Gtk2::TreeViewColumn->new();
	$column->pack_end($cell, TRUE);

	$column->set_title('Element');
	$column->set_resizable(TRUE);
	$column->set_sizing('fixed');
	$column->set_fixed_width(150);
	$column->set_attributes($cell, text => $NODE_NAME);

	$view->append_column($column);

	return $view;
}


sub scrollify {
	my ($widget, $width, $height) = @_;
	$width = -1 unless defined $width;
	$height = -1 unless defined $height;
	
	my $scroll = Gtk2::ScrolledWindow->new();
	$scroll->set_policy('automatic', 'automatic');
	$scroll->set_shadow_type('in');
	$scroll->set_size_request($width, $height);
	
	$scroll->add($widget);
	return $scroll;
}


sub parse_xml {
	my ($xml) = @_;

	my $parser = XML::LibXML->new();
	$parser->line_numbers(1);
	$parser->recover_silently(1);
	$parser->complete_attributes(0);
	$parser->expand_entities(0);

	if (ref $xml) {
		return $parser->parse_string($$xml);
	}
	return $parser->parse_file($xml);
}


package my::DomTreeModel;

use Glib qw(TRUE FALSE);
use Data::Dumper;
use Carp;
use Scalar::Util 'refaddr';


use Glib::Object::Subclass 'Glib::Object' =>
	interfaces => [ 'Gtk2::TreeModel' ]
;


sub new {
	my $class = shift;
	my ($node) = @_ or croak "Usage: ${class}->new(node)";

	my $self = $class->SUPER::new();
	$self->{stam} = 4; # Random value
	$self->{node} = $node;
	$self->{iters} = {};
	$self->{types} = [ 'Glib::Scalar', 'Glib::String' ];

	return $self;
}

sub GET_FLAGS { [ 'iters-persist' ] }
sub GET_N_COLUMNS { 2 }
sub GET_COLUMN_TYPE {
	my ($self, $index) = @_;
	return $self->{types}[$index];
}


sub GET_ITER {
	my ($self, $path) = @_;

	my $xpath = join '/', map { sprintf "*[%d]", $_ + 1 } split /:/, $path->to_string;

	# Adding a node here generates a segmentation fault
	my ($node) = $self->{node}->findnodes($xpath);
#	print "node: ", $node->nodeName, "\n";
	
	return $self->new_iter($node);
}


sub GET_PATH {
	my ($self, $iter) = @_;
	my $path = Gtk2::TreePath->new();
	
	my $node = $self->get_node($iter) or return undef;
	print "GET_PATH: \n";
	my @indexes;
	for (; $node; $node = $node->parent) {
		my $index = 0;
		for (my $inode = $node->prev; $inode; $inode = $inode->prev) {
			++$index;
			push @indexes, $index;
		}
	}
	
	foreach my $index (reverse @indexes) {
		print "Adding $index\n";
		$path->append_index($index);
	}
	
	return $path;
}


sub GET_VALUE {
	my ($self, $iter, $column) = @_;
	my $node = $self->get_node($iter) or return "broken iter?";
	print "====GET_VALUE ", iter_dumper($iter), " at $column\n";
	return $node->nodeName;
}


sub ITER_NEXT {
	my ($self, $iter) = @_;
	print "Called ITER_NEXT: ", iter_dumper($iter), "\n";
	my $node = $self->get_node($iter) or return undef;
	return $self->new_iter($node->nextSibling);
}


sub ITER_CHILDREN {
	my ($self, $iter) = @_;
	
	print "Called ITER_CHILDREN: ", iter_dumper($iter), "\n";
	if ($iter) {
		my $node = $self->get_node($iter) or return undef;
		return $self->new_iter($node->firstChild);
	}

	
	return $self->new_iter($self->{node});
}


sub ITER_HAS_CHILD {
	my ($self, $iter) = @_;
	print "Called ITER_HAS_CHILD: ", iter_dumper($iter), "\n";
	my $node = $self->get_node($iter) or return FALSE;
	return $node->hasChildNodes;
}


sub ITER_N_CHILDREN {
	my ($self, $iter) = @_;

	my $node = $iter ? $self->get_node($iter) : $self->{node};
	return undef unless $node;
	
	return $node->childNodes->size;
}


sub ITER_NTH_CHILD {
	my ($self, $iter, $n) = @_;

	# special case: if iter == NULL, return number of top-level rows
	my $node = $iter ? $self->get_node($iter) : $self->{node};
	return undef unless $node;
	
	for (my $i = 0; $i < $n; ++$i) {
		$node = $node->nextSibling or return undef;
	}
	
	return $self->new_iter($node);
}


sub ITER_PARENT {
	my ($self, $iter) = @_;
	my $node = $self->get_node($iter) or return undef;
	return $self->new_iter($node->parentNode);
}


sub get_node {
	my ($self, $iter) = @_;

	return if $iter->[0] == 0
		and $iter->[1] == 0
		and ! defined $iter->[2]
		and ! defined $iter->[3]
	;

	my $address = $iter->[1];
	if (! $address) {
		Carp::cluck "Iter has no address: ", iter_dumper($iter);
		return undef;
	}

	my $node = $self->{iters}{$address};
	if (! $node) {
		Carp::cluck "Iter has no node at address $address: ", iter_dumper($iter);
		return undef;
	}
	return $node;
}


sub new_iter {
	my ($self, $node) = @_;

	return undef unless $node;

	my $address = refaddr $node;
	$self->{iters}{$address} = $node;
	# The first slot is for the stamp, the second slot is assumed to be an int by
	# the perl bindings the other 2 slots are volatile nothing there survives.
	return [ $self->{stamp}, $address, undef, undef ];
}


sub iter_dumper {
	my ($iter) = @_;
	return Data::Dumper->new([$iter], ['iter'])->Indent(0)->Dump
}

