view release on metacpan or  search on metacpan

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

package Tk::Tree::JSON;

# Tk::Tree::JSON - JSON tree widget

# Copyright (c) 2008-2015 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 JSON;
	require Tk::Derived;
	$VERSION	= '0.04';
	@ISA		= qw(Tk::Derived Tk::Tree);
}

Construct Tk::Widget 'JSON';

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

my $json_parser = undef;	# singleton JSON parser

# ConfigSpecs default values
my $VALUE_MAX_LENGTH = 80;

sub Populate {
	my ($myself, $args) = @_;
	$myself->SUPER::Populate($args);
	$myself->ConfigSpecs(
		-arraysymbol		=> ["PASSIVE", "arraySymbol", 
								"ArraySymbol", '[]'],
		-objectsymbol		=> ["PASSIVE", "objectSymbol", 
								"ObjectSymbol", '{}'],
		-namevaluesep		=> ["PASSIVE", "nameValueSep", 
								"NameValueSep", ': '],
		-valuemaxlength		=> ["METHOD", "valueMaxLength", 
								"VALUEMaxLength", $VALUE_MAX_LENGTH],
		-valuelongsymbol	=> ["PASSIVE", "valueLongSymbol", 
								"VALUELongSymbol", '...'],
		-itemtype			=> ["SELF", "itemType", "ItemType", 'text']
	);
}

# ConfigSpecs methods

# get/set max number of characters for displaying of JSON text values
sub valuemaxlength {
	my ($myself, $args) = @_;
	if (@_ > 1) {
		$myself->_configure(-valuemaxlength => &_value_max_length($args));
	}
	return $myself->_cget('-valuemaxlength');
}

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

# application programming interface

sub load_json_file {	# load_json_file($json_filename)
	my ($myself, $json_file) = @_;
	if (!$myself->info('exists', '0')) {
		local $/ = undef;
		open FILE, $json_file or die "Could not open file $json_file: $!";
		my $json_string = <FILE>;