Tk-Tree-XML

 view release on metacpan or  search on metacpan

examples/tkxmlview.pl  view on Meta::CPAN

use strict;

use Tk;
use Tk::Table;
use Tk::Tree::XML;

die "Syntax: $0 <file.xml>\n" unless (scalar @ARGV == 1);

my $xml_filename = shift;
my ($FOREGROUND, $BACKGROUND) = ("black", "#FFFFFF");
my ($attrs_table, $pcdata_textarea);

my $top = MainWindow->new;

my $xml_tree = $top->ScrolledXML(
	-background => $BACKGROUND, -foreground => $FOREGROUND, -height => 20, 
);
$xml_tree->configure(-browsecmd => sub {
	if ($xml_tree->is_mixed()) {
		# mixed element => update attrs table and clear/disable pcdata text
		update_table($attrs_table, $xml_tree->get_attrs);
		$pcdata_textarea->delete("1.0", "end");
		$pcdata_textarea->configure(-state => "disable");
	} else {
		# pcdata element => clear attrs table and enable/update pcdata text
		update_table($attrs_table, ());
		$pcdata_textarea->configure(-state => "normal");
		$pcdata_textarea->delete("1.0", "end");
		$pcdata_textarea->insert("end", $xml_tree->get_text);
	}
});
$xml_tree->load_xml_file($xml_filename);

# XML attributes (name/value) table (for currently selected element in tree)
$attrs_table = $top->Table(
	-columns => 2, -rows => 3, -scrollbars => 'ne', 
	-background => $BACKGROUND, -foreground => $FOREGROUND, 
);
$attrs_table->put(0, 0, ' ' x 40 . 'Name' . ' ' x 40);
$attrs_table->put(0, 1, ' ' x 40 . 'Value' . ' ' x 40);

# PCDATA text area (for currently selected element in tree if PCDATA)
$pcdata_textarea = $top->Text(
	-height => 10, -background => $BACKGROUND, -foreground => $FOREGROUND, 
);

# bottom area containing the exit button
my $bottom_area = $top->Frame;

# exit button
my $exit_button	= $top->Button(
	-text => 'Exit', #-command => \&exit, 
	-command => sub {exit;}, 
	-background => $BACKGROUND, -foreground => $FOREGROUND, 
);

# pack gui components
$xml_tree->pack(-side => 'top', -fill => 'x', -expand => 1);
$attrs_table->pack(-side => 'top', -fill => 'both', -expand => 0);
$pcdata_textarea->pack(-side => 'top', -fill => 'x', -expand => 0);
$bottom_area->pack(-side => 'top', -fill => 'x', -expand => 0);
$exit_button -> pack(-side => 'right', -in => $bottom_area->parent, 
	-fill => 'none', -expand => 0
);

MainLoop;

sub update_table {	# clear and update table with data
	my ($table, %data) = @_;
	my $row = 0;

lib/Tk/Tree/XML.pm  view on Meta::CPAN

sub Tk::Widget::ScrolledXML { shift->Scrolled('XML' => @_) }

# ConfigSpecs default values
my $PCDATA_MAX_LENGTH = 80;

sub Populate {
	my ($myself, $args) = @_;
	$myself->SUPER::Populate($args);
	$myself->ConfigSpecs(
		-pcdatamaxlength		=> ["METHOD", "pcdataMaxLength", 
									"PCDATAMaxLength", $PCDATA_MAX_LENGTH],
		-pcdatalongsymbol		=> ["PASSIVE", "pcdataLongSymbol", 
									"PCDATALongSymbol", '...'],
		-pcdatapreservespace	=> ["PASSIVE", "pcdataPreserveSpace", 
									"PCDATAPreserveSpace", 0],
		-itemtype				=> ["SELF", "itemType", "ItemType", 'text']
	);
}

# ConfigSpecs methods

# get/set maximum number of characters for visualization of pcdata contents
sub pcdatamaxlength {
	my ($myself, $args) = @_;
	if (@_ > 1) {
		$myself->_configure(-pcdatamaxlength => &_pcdata_max_length($args));
	}
	return $myself->_cget('-pcdatamaxlength');
}

# validate given max number of characters for visualization of pcdata contents
# return given number if it is valid, $PCDATA_MAX_LENGTH otherwise
sub _pcdata_max_length {
	$_ = shift;
	/^\+?\d+$/ ? $& : &{ sub {
		carp "Attempt to assign an invalid value to -pcdatamaxlength: '$_' is" .
			" not a positive integer. Default value ($PCDATA_MAX_LENGTH)" . 
			" will be used instead.\n";
		$PCDATA_MAX_LENGTH
	}};
}

# application programming interface

sub load_xml_file {	# load_xml_file($xml_filename)
	my ($myself, $xmlfile) = @_;

lib/Tk/Tree/XML.pm  view on Meta::CPAN

	my $myself = shift;
	my $text = $myself->entrycget($myself->selectionGet(), '-data');
	ref($text) ? undef : $text;
}

sub is_mixed {	# is_mixed()
	my $myself = shift;
	'HASH' eq ref($myself->entrycget($myself->selectionGet(), '-data'));
}

sub is_pcdata {	# is_pcdata()
	my $myself = shift;
	!$myself->is_mixed();
}

# helper methods

sub _xml_parser {	# _xml_parser(): get an XML::Parser instance.
	new XML::Parser(Style => 'Tree', ErrorContext => 2)
}

# _load_xml($parent_path, @children): load XML elems under entry at $parent_path
# @children is a list of tag/content pairs where each pair is such as:
# - ($element_tag, [%element_attrs, @element_children])	<= element is mixed
# - 0, 'pcdata contents'								<= element is PCDATA
# for each entry, XML -data and -text are set, respectively, to:
# attributes and element tag							<= element is mixed
# pcdata content and formatted pcdata content			<= element is PCDATA
sub _load_xml {
	my ($myself, $parent_path, @children) = ($_[0], $_[1], @{$_[2]});
	my $entry_path;
	while (@children) {
		my ($elem_tag, $elem_content) = (shift @children, shift @children);
		if (!ref $elem_content) {	# element is #PCDATA
			$elem_content =~ s/[\n\t ]*(.*)[\n\t ]*/$1/	# trim spacing
				unless $myself->cget('-pcdatapreservespace') eq 1;
			if ('' ne $elem_content) {
				$entry_path = $myself->addchild(
					$parent_path, -data => $elem_content, 
					-text => $myself->_format_pcdata($elem_content), 
				);
			}
		} else {	# element is not pcdata
			$entry_path = $myself->addchild($parent_path, 
				-data => $elem_content->[0], -text => $elem_tag
			);
			shift(@$elem_content);	# shift element attributes off
			$myself->_load_xml($entry_path, $elem_content) 
				unless !scalar @$elem_content; # recursively process children
		}
	}
}

sub _format_pcdata { # _format_pcdata($pcdata): format/return pcdata accordingly
	my ($myself, $pcdata) = @_;
	my $pcdata_max_length = $myself->cget('-pcdatamaxlength');
	length($pcdata) > $pcdata_max_length 
		? substr($pcdata, 0, $pcdata_max_length) . 
			$myself->cget('-pcdatalongsymbol')
		: $pcdata;
}

1;

__END__

=head1 NAME

Tk::Tree::XML - XML tree widget

lib/Tk/Tree/XML.pm  view on Meta::CPAN

B<XML> is a subclass of L<Tk::Tree> and therefore inherits all of its 
standard options. 

Details on standard widget options can be found at L<Tk::options>.

=head1 WIDGET-SPECIFIC OPTIONS

=over 4

=item Name:		B<pcdataMaxLength>

=item Class:		B<PCDATAMaxLength>

=item Switch:		B<-pcdatamaxlength>

Set the maximum number of characters to be displayed for PCDATA elements. 
Content of such elements is trimmed to a length of B<pcdataMaxLength> characters.

Default value: C<80>. 

=item Name:		B<pcdataLongSymbol>

=item Class:		B<PCDATALongSymbol>

=item Switch:		B<-pcdatalongsymbol>

Set the symbol to append to PCDATA content with length greater than 
B<pcdataMaxLength> characters.

Default value: C<...>. 

=item Name:		B<pcdataPreserveSpace>

=item Class:		B<PCDATAPreserveSpace>

=item Switch:		B<-pcdatapreservespace>

Specify whether space characters surrounding PCDATA elements should be 
preserved or not. Such characters are preserved if this option is set to 1 and 
not preserved if set to 0. 

Default value: 0.

=back

=head1 WIDGET METHODS

lib/Tk/Tree/XML.pm  view on Meta::CPAN

Example(s):

 # determine if selected element is mixed or not
 print "element is " . ($xml_tree->is_mixed() ? 'mixed' : 'PCDATA');

=back

=over 4

=item $xml_tree->B<is_pcdata>()

Indicate whether the currently selected element is PCDATA or not. If the 
element is not PCDATA then it is mixed. 

Return value: TRUE if the currently selected element is PCDATA, FALSE if it is 
mixed.

Example(s):

 # determine if selected element is PCDATA or not
 print "element is " . ($xml_tree->is_pcdata() ? 'PCDATA' : 'mixed');

=back

=head1 EXAMPLES

An XML viewer using B<Tk::Tree::XML> can be found in the F<examples> directory 
included with this module. 

=head1 VERSION

t/pod-coverage.t  view on Meta::CPAN

plan skip_all => "Test::Pod::Coverage $min_tpc required for testing POD coverage"
    if $@;

# Test::Pod::Coverage doesn't require a minimum Pod::Coverage version,
# but older versions don't recognize some common documentation styles
my $min_pc = 0.18;
eval "use Pod::Coverage $min_pc";
plan skip_all => "Pod::Coverage $min_pc required for testing POD coverage"
    if $@;

all_pod_coverage_ok({also_private => [qw/Populate pcdatamaxlength/]});