#!/usr/bin/perl

=head1 NAME

xacobeo - Graphical interface for running XPath queries.

=head1 SYNOPSIS

xacobeo [OPTION]... [file [xpath]]

Options:

   -h, --help            brief help message

Where I<file> is a valid XML document and I<xpath> a valid XPath query.

=head1 OPTIONS

=over 8

=item B<--help>

Print a brief help message and exits.

=back

=head1 DESCRIPTION

This program provides a simple graphical user interface (GUI) for executing
XPath queries and seeing their results.

The GUI tries to provide all the elements that are needed in order to write,
test and execute XPath queries without too many troubles. It displays the
Document Object Model (DOM) and the namespaces used. The program registers the
namespaces automatically and each element is displayed with it's associated
namespaces. All is performed with the idea of being able of running an XPath
query as soon as possible without having to fight with the document's namespaces
and by seeing automatically under which namespace each element is.

This program is not an XML editor, at least not at this point, it's meant to be
used for constructing and executing XPath queries.

=head1 RATIONALE

The main idea behind this application is to provide a simple way for building
XPath queries that will be latter integrated in to a program or XSLT
transformation paths. Therefore, this program goal is to load an XML document
and to display it as an XML parser sees it. Thus each node element is prefixed
with it's namespace.

=head1 IMPLEMENTATION

This program uses L<XML::LibXML> (libxml2) for all XML manipulations and L<Gtk2>
for the graphical interface.

=head1 LIMITATIONS

For the moment, the program focuses only on XPath and doesn't allow the XML
document to be edited.

=head1 AUTHOR

Emmanuel Rodriguez E<lt>potyl@cpan.orgE<gt>.

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2008 by Emmanuel Rodriguez.

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.8.8 or,
at your option, any later version of Perl 5 you may have available.

=cut

use strict;
use warnings;
use 5.006;

our $VERSION = '0.01';

use Glib qw(TRUE FALSE);
use Gtk2 qw(-init);
use Gtk2::GladeXML;
use Gtk2::SimpleList;
use Gtk2::Pango;

use Pod::Usage;
use Getopt::Long qw(:config auto_help);
use Data::Dumper;
use Time::HiRes qw(time);
use XML::LibXML;
use File::Spec::Functions;
use FindBin;
use Carp;

use Xacobeo;
use Xacobeo::DomModel;
use Xacobeo::Document;

use base qw(Class::Accessor::Fast);
__PACKAGE__->mk_accessors(
	qw(
		glade 
		document 
		statusbar_context_id
		namespaces_view
	)
);


# Main entry point
exit main();


#
# Creates a new instance of the application
#
sub new {
	# Arguments
	my $class = shift;
	
	# Create an instance
	my $self = bless {}, ref($class) || $class;
	
	# Create the GUI
	$self->construct_gui();
	
	# Return the new instances
	return $self;
}


#
# This method constructs the GUI
#
sub construct_gui {
	# Arguments
	my $self = shift;

	my $folder = find_app_folder();
	
	# Load the GUI definition from the glade files
	my $glade = Gtk2::GladeXML->new(catfile($folder, 'share', 'xacobeo', 'xacobeo.glade'));
	$self->glade($glade);

	# Set the application's icon
	my $logo = Gtk2::Gdk::Pixbuf->new_from_file(catfile($folder, 'share', 'xacobeo', 'xacobeo.svg'));
	$self->glade->get_widget('window')->set_icon($logo);
	$self->glade->get_widget('about')->set_logo($logo);
	

	# Connect the signals to the callbacks
	$glade->signal_autoconnect_from_package($self);
	
	# Status bar context id
	my $statusbar = $self->glade->get_widget('statusbar');
	$self->statusbar_context_id(
		$statusbar->get_context_id('xpath-results')
	);
	
	# Create the tree model for the DOM view
	# See http://www.mail-archive.com/gtk-perl-list@gnome.org/msg03647.html	
	# and http://gtk2-perl.sourceforge.net/doc/pod/Gtk2/TreeViewColumn.html#_tree_column_set_cel
	$self->contruct_dom_tree_view();
	
	$self->prepare_textviews();
	
	# Create the list model for the Namespace view
	$self->contruct_namespaces_view();
}


#
# Creates the DOM tree view
#
sub contruct_dom_tree_view {
	# Arguments
	my $self = shift;

	# Create the model
	my $model = Xacobeo::DomModel::create_model();
	
	# Create the view
	my $treeview = $self->glade->get_widget('dom-tree-view');
	$treeview->set_model($model);
	
	Xacobeo::DomModel::add_columns($treeview);
	$treeview->signal_connect(row_activated =>
		sub {
			my ($treeview, $path, $column) = @_;
			#my $iter = $namespaces_view->get_iter($path);
			my $iter = $model->get_iter($path);
			#$model->set($iter, 0, $new_text);
			my $node = $model->get($iter, $Xacobeo::DomModel::NODE_DATA);
			print "Column $column\n";
			printf "Item %s = %s\n", $path->to_string, $node->localname;
		},
	);
}


#
# Creates the Namespaces view
#
sub contruct_namespaces_view {
	# Arguments
	my $self = shift;

	my $treeview = $self->glade->get_widget('namepsaces-view');
	my $namespaces_view = Gtk2::SimpleList->new_from_treeview(
		$treeview,
		'Prefix' => 'text',
		'URI'    => 'text',
	);
	
	
	# Try to get a handle on the celleditor for the namespaces
	$namespaces_view->set_column_editable(0, TRUE);
	my ($editor) = $namespaces_view->get_column(0)->get_cell_renderers();
	$editor->signal_connect(edited => 
		sub {
			my ($cell, $text_path, $new_text) = @_;
			printf "New text $text_path $new_text\n";
			my $path = Gtk2::TreePath->new_from_string($text_path);
			#my $iter = $namespaces_view->get_iter($path);
			#$namespaces_view->set($iter, 0, $new_text);
			printf "OLD[$text_path]  %s of $new_text\n", @{ $namespaces_view->{data}[$text_path] };
			return FALSE;
		}
	);
	
	$self->namespaces_view($namespaces_view);
}


#
# Main entry point of the program
#
sub main {

	# Parse the command line options
	parse_options();
	
	# Create a new instance of this application
	my $self = __PACKAGE__->new();

	if (@ARGV) {
		my ($source, $xpath) = @ARGV;
		$self->load_file($source);
		$self->glade->get_widget('xpath-entry')->set_text($xpath) if defined $xpath;
	}
	
	# Start the main loop
	Gtk2->main;
	
	return 0;
}


#
# Parses the command line options
#
sub parse_options {
	# Parse the options
	GetOptions() or pod2usage(2);
}


#
# Loads a file.
# This implies that the text widget showing the document
# will be reloaded with the contents of the file. 
#
sub load_file { 
	# Arguments
	my $self = shift;
	my ($file) = @_;
	
	# Parse the content
	my $start = time;
	my $document = Xacobeo::Document->new($file);
	$self->document($document);


	# Update the text widget
	my $glade = $self->glade;
	
	my $buffer = $glade->get_widget('xml-document')->get_buffer();
	$buffer->delete($buffer->get_start_iter, $buffer->get_end_iter);
	render_xml_into_buffer($buffer, $document->xml);

	# Populate the DOM view tree
	my $treeview = $self->glade->get_widget('dom-tree-view');
	my $model = $treeview->get_model();
	my $namespaces = {};
	my @namespaces = ();
	while (my ($prefix, $uri) = each %{ $self->document->namespaces }) {
		push @namespaces, [$prefix, $uri];
		$namespaces->{$uri} ||= $prefix;
	}
	Xacobeo::DomModel::populate($model, $document->xml, $namespaces);
	my $end = time;
	
	# Populate the Namespaces view
	@{ $self->namespaces_view->{data} } = @namespaces;

	$self->display_statusbar_message(
		sprintf "Document loaded in %.3f s", ($end - $start)
	);
	
	$glade->get_widget('xpath-entry')->set_sensitive(TRUE);
}

sub val {
	return defined $_[0] ? $_[0] : 'undef';
}

#
# Displays an XML node in a Gtk2::TextBuffer. The XML will be marked in the
# text buffer. If the buffer defines the proper tags then the text will
# automatically have syntax highlighting.
#
#
# TODO:
# Ideally this add makrs to the elements, this way it will be possible to jump
# to the elements from the DomViewer.
#
sub render_xml_into_buffer {
	my ($buffer, $node) = @_;
	croak "Must pass (Gtk2::TextBuffer, XML::LibXML::Node)" unless @_ == 2;
	croak "First parameter $buffer isn't a Gtk2::TextBuffer" unless $buffer->isa('Gtk2::TextBuffer');
	croak "Second parameter $node isn't a XML::LibXML::Node" unless isa_dom_node($node) or isa_dom_nodelist($node);

	# The main document
	if (isa_dom_document($node)) {
		# In concept a document has a single child the root element. In reality a
		# document is allowed to have a prolog (http://www.w3.org/TR/REC-xml/#NT-prolog).
		# The prolog is available in the child nodes of the document. The last node
		# being the root element
		my @children = $node->childNodes;
		my $count = @children;
		foreach my $child (@children) {
			render_xml_into_buffer($buffer, $child);
			# Add some new lines between the elements of the prolog. Libxml removes
			# the white spaces in the prolog.
			buffer_add($buffer, syntax => "\n") if --$count;
		}
	}
	
	# A node list
	elsif (isa_dom_nodelist($node)) {
		my @children = $node->get_nodelist;
		my $count = scalar @children;

		# Formatting using to indicate which result is being analyzed
		my $i = 0;
		my $format = sprintf " %%%dd. ", length($count);

		foreach my $child (@children) {
			my $result = sprintf $format, ++$i;
			buffer_add($buffer, result => $result);
			
			render_xml_into_buffer($buffer, $child);
			buffer_add($buffer, syntax => "\n") if --$count;
		}
	}

	# An element ex: <tag>...</tag>
	elsif (isa_dom_element($node)) {
		
		# Start of the element
		buffer_add($buffer, syntax => '<');
		buffer_add($buffer, element => $node->localname());

		# The element's attributes
		foreach my $attribute ($node->attributes) {
			buffer_add($buffer, syntax => ' ');
			buffer_add($buffer, attribute_name => $attribute->getName());
			buffer_add($buffer, syntax => '="');
			
			# Escape the quotes with entities
			my $value = $attribute->value();
			$value =~ s/"/&quot;/;
			buffer_add($buffer, attribute_value => $value);
			
			buffer_add($buffer, syntax => '"');
		}
		
		# Close the start of the element
		if (! $node->hasChildNodes()) {
			# Empty element, ex: <empty />
			# FIXME only elements defined as empty in the DTD shoud be empty. The
			#       others should be: <no-content></no-content>
			buffer_add($buffer, syntax => ' />');
			return;
		}
		buffer_add($buffer, syntax => '>');
		

		# Do the children
		foreach my $child ($node->childNodes) {
			render_xml_into_buffer($buffer, $child);
		}


		# Close the element		
		buffer_add($buffer, syntax => '</');
		buffer_add($buffer, element => $node->localname);
		buffer_add($buffer, syntax => '>');
	}

	# A text node, plain text in the document
	elsif (isa_dom_text($node)) {
		buffer_add($buffer, text => $node->nodeValue);
	}

	# A comment ex: <!-- comment -->
	elsif (isa_dom_comment($node)) {
		buffer_add($buffer, comment => '<!--' . $node->nodeValue . '-->');
	}

	# A PI (processing instruction) ex: <?stuff ?>
	elsif (isa_dom_pi($node)) {
		buffer_add($buffer, syntax => '<?');
		buffer_add($buffer, pi => $node->nodeName);
		
		# Add the data if there's one
		if (my $data = $node->getData) {
			$data =~ s/\s+$//;
			buffer_add($buffer, syntax => ' ');
			buffer_add($buffer, pi => $data);
		}
		
		buffer_add($buffer, syntax => '?>');
	}

	# A DTD definition ex: <!DOCTYPE ...
	elsif (isa_dom_dtd($node)) {
		buffer_add($buffer, dtd => $node->toString);
	}

	else {
		warn "=====node $node not implemented";
	}
}


#
# This widget prepares the text view widgets. It basically performs actions that
# can be done through glade. For the moment this method registers some tags used
# for syntax highlighting.
#
sub prepare_textviews {
	my $self = shift;
	
	# Build the styles for the syntax highlighting
	my $tag_table = Gtk2::TextTagTable->new();
	
	add_tag($tag_table, result =>
		family     => 'Courier 10 Pitch',
		background => '#EDE9E3',
		foreground => 'black',
		style      => 'italic',,
		weight     => PANGO_WEIGHT_LIGHT
	);
	
	add_tag($tag_table, attribute_name =>
		foreground => 'red',
	);

	add_tag($tag_table, attribute_value =>
		foreground => 'blue',
	);
	
	add_tag($tag_table, comment =>
		foreground => '#008000',
		style      => 'italic',
		weight     => PANGO_WEIGHT_BOLD,
	);
	
	add_tag($tag_table, dtd =>
		foreground => '#558CBA',
		style      => 'italic',
	);
	
	add_tag($tag_table, element =>
		foreground => '#800080',
		weight     => PANGO_WEIGHT_BOLD,
	);
	
	add_tag($tag_table, pi =>
		foreground => '#558CBA',
		style      => 'italic',
	);
	
	add_tag($tag_table, syntax =>
		foreground => 'black',
		weight     => PANGO_WEIGHT_BOLD,
	);
	
	add_tag($tag_table, text =>
		foreground => 'black',
	);


	# Register new text buffers with support syntaxt highlighting
	foreach my $name qw(xml-document xpath-results) {
		my $buffer = Gtk2::TextBuffer->new($tag_table);
		my $textview = $self->glade->get_widget($name);
		$textview->set_buffer($buffer);
	}
}



sub add_tag {
	my ($tag_table, $name, @properties) = @_;
	my $tag = Gtk2::TextTag->new($name);
	$tag->set(@properties);
	$tag_table->add($tag);
}


#
# Adds the given text at the end of the buffer.
#
sub buffer_add {
	my ($buffer, $type, $string) = @_;

	if ($buffer->get_tag_table->lookup($type)) {
		$buffer->insert_with_tags_by_name($buffer->get_end_iter, $string, $type);
	}
	else {
		$buffer->insert($buffer->get_end_iter, $string);
	}
}

#
# Called when the main window is closed
#
sub callback_window_close {
	Gtk2->main_quit;
}


#
# Called when the XPath expression must be runned.
#
sub callback_run_xpath {
	# Arguments
	my $self = shift;
	
	my $glade = $self->glade;

	my $button = $glade->get_widget('xpath-evaluate');
	return unless $button->is_sensitive;
	
	# Run the XPath expression
	my $xpath = $glade->get_widget('xpath-entry')->get_text;
	my $start = time;
	my $nodelist = $self->document->find_nodelist($xpath);
	my $end = time;
	
	$self->display_statusbar_message(
		sprintf "Found %d results in %0.3f s", $nodelist->size, $end - $start
	);
	
	# Display the results
	my $textview = $glade->get_widget('xpath-results');
	my $buffer = $textview->get_buffer();
	$buffer->delete($buffer->get_start_iter, $buffer->get_end_iter);
	render_xml_into_buffer($buffer, $nodelist);
	
	# Show the results
	$glade->get_widget('notebook')->set_current_page(0);
}


#
# Called when the XPath expression is changed, this will validate the expression.
#
# NOTE: There's no XPath compiler available, as a hack the XPath expression will
#       be runned againsts an empty document, this way the result will be 
#       instantaneous. Although, a better alternative will be to find a real 
#       XPath parser that can tell where the problem is.
#
sub callback_xpath_entry_changed {
	# Arguments
	my $self = shift;
	my ($widget) = @_;
	
	my $xpath = $widget->get_text;
	my $button = $self->glade->get_widget('xpath-evaluate');

	# Validate the XPath expression
	if (! $self->document->validate($xpath) ) {
		$button->set_sensitive(FALSE);
		return;
	}

	$button->set_sensitive(TRUE);
}


#
# Called when the file choser is requested (File > Open).
#
sub callback_file_open {
	my $self = shift;
	$self->glade->get_widget('file')->show_all();
}


#
# Called when the file choser has chosen a file (File > Open).
#
sub callback_file_selected {
	my $self = shift;
	my ($dialog, $response) = @_;
	
	# The open button send the response 'accept'
	if ($response eq 'accept') {
		my $file = $dialog->get_filename;
		$self->load_file($file);
	}
	
	$dialog->hide();
}


#
# Called when the about dialog has to be displayed (Help > About).
#
sub callback_about_show {
	my $self = shift;
	$self->glade->get_widget('about')->show_all();
}


#
# Called when the a dialog has to be hidden. It's important that the dialog is
# not destroyed because Glade will not recreate it. If the dialog is destroyed
# the next time that dialog will be requested this will cause an error and the
# dialog will not be displayed.
#
# This method will simply hide the dialog and request that the dialog is not
# destroyed by returning TRUE.
#
# This callback can be used for all dialogs.
#
sub callback_dialog_hide {
	my $self = shift;
	my ($dialog) = @_;
	$dialog->hide();
	return TRUE;
}


#
# Displays the given text in the statusbar
#
sub display_statusbar_message {
	my $self = shift;
	my ($message) = @_;
	
	my $statusbar = $self->glade->get_widget('statusbar');
	my $id = $self->statusbar_context_id;
	$statusbar->pop($id);
	$statusbar->push($id, $message);
}


# Return the root folder of the application once installed. The 'root' folder is
# the one where the installation is done, in other words the root folder
# hierarchy is as follows:
#
# (root)
# |-- bin
# |-- lib
# |   `-- perl5
# |       |-- Xacobeo
# |       `-- i486-linux-gnu-thread-multi
# |               `-- Xacobeo
# |           `-- auto
# |               `-- Xacobeo
# |-- man
# |   |-- man1
# |   `-- man3
# `-- share
#     |-- applications
#     |-- pixmaps
#     `-- xacobeo
sub find_app_folder {
	return catdir($FindBin::Bin, '..');
}


sub isa_dom_document {
	my ($node) = @_;
	return defined $node ? $node->isa('XML::LibXML::Document') : 0;
}


sub isa_dom_element {
	my ($node) = @_;
	return defined $node ? $node->isa('XML::LibXML::Element') : 0;
}


sub isa_dom_attr {
	my ($node) = @_;
	return defined $node ? $node->isa('XML::LibXML::Attr') : 0;
}


sub isa_dom_nodelist {
	my ($node) = @_;
	return defined $node ? $node->isa('XML::LibXML::NodeList') : 0;
}


#
# Return true if the node is a text as defined in the DOM. NOTE: XML::LibXML
# decided that Comment node is alsto a Text node. This method doesn't consider a
# Coment node as being a Text node.
#
sub isa_dom_text {
	my ($node) = @_;
	return unless defined $node;
	return if isa_dom_comment($node);
	return $node->isa('XML::LibXML::Text');
}


sub isa_dom_comment {
	my ($node) = @_;
	return unless defined $node;
	return defined $node ? $node->isa('XML::LibXML::Comment') : 0;
}


sub isa_dom_literal {
	my ($node) = @_;
	return defined $node ? $node->isa('XML::LibXML::Literal') : 0;
}


sub isa_dom_boolean {
	my ($node) = @_;
	return defined $node ? $node->isa('XML::LibXML::Boolean') : 0;
}


sub isa_dom_number {
	my ($node) = @_;
	return defined $node ?  $node->isa('XML::LibXML::Number') : 0;
}


sub isa_dom_node {
	my ($node) = @_;
	return defined $node ?  $node->isa('XML::LibXML::Node') : 0;
}


sub isa_dom_pi {
	my ($node) = @_;
	return defined $node ?  $node->isa('XML::LibXML::PI') : 0;
}


sub isa_dom_dtd {
	my ($node) = @_;
	return defined $node ?  $node->isa('XML::LibXML::Dtd') : 0;
}
