view release on metacpan or  search on metacpan

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

package Tk::Tree::XML;

# Tk::Tree::XML - XML tree widget

# Copyright (c) 2008 José Santos. All rights reserved.
# This program is free software. It can be redistributed and/or modified under 
# the same terms as Perl itself.

use strict;
use warnings;
use Carp;

BEGIN {
	use vars qw($VERSION @ISA);
	require Tk::Tree;
	require XML::Parser;
	require Tk::Derived;
	$VERSION	= '0.01';
	@ISA		= qw(Tk::Derived Tk::Tree);
}

Construct Tk::Widget 'XML';

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) = @_;
	my @array = (1, 2, 3);
	if (!$myself->info('exists', '0')) {
		$myself->_load_xml('', &_xml_parser->parsefile($xmlfile));
		$myself->autosetmode;# set up automatic handling of open/close events
	} else {
		carp "An XML document has already been loaded into the tree." .
			" XML file $xmlfile will not be loaded.";
	}
}