The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl
#
use strict ;
use Test::More;

use App::Framework '+Config' ;

# VERSION
our $VERSION = '1.00' ;

my $DEBUG=0;
my $VERBOSE=0;

	my $stdout="" ;
	my $stderr="" ;
	
	if (@ARGV)
	{
		$DEBUG = $ARGV[0] ;
		$VERBOSE = $ARGV[0] ;
		@ARGV = () ;
	}

	diag( "Testing config" );

my $read_dir = "t/config2" ;
my $write_dir = "t/config_wr" ;

my %expected = (
  'dbg-namestuff' => "config2 a name",
  debug => 56,
  default => "config2 default",
  default2 => "config2 b default",
  default3 => "a-new-value",
  log => "different log",
  name => "this-is-a-test",
  nomacro => 1,
) ;

my %expected_options = (
  config => "20-Feature-Config.conf",
  config_path => $read_dir,
  config_write => undef,
  config_writepath => $write_dir,
  %expected,
) ;

my %single_sections = (
	'server'	=> 1,
	'snmp-trap'	=> 1,
) ;
my %sections = (

	'server'	=> [
	{
		'port'		=> 32023,
		'tick'		=> 5,
	},
	],
	'snmp-trap'	=> [
	{
		'port'		=> 32161,
		'logfile'	=> '/tmp/ate_snmp.log',
	},
	],
	'tty'		=> [
	{
		name 		=> 'SC2-1', 		
		host 		=> 'tty-server2',
		port 		=> 2011, 
		prompt 		=> '/SC2-HWTC\s*>/i', 
		timeout		=> 90,
	},
	{
		name 		=> 'BBU-1',
		host 		=> 'tty-server2',
		port 		=> 2012, 
		prompt 		=> '/(RSS|\-)\s*>/i', 
		timeout		=> 90,
	},
	{
		name 		=> 'SC2-2', 		
		host 		=> 'tty-server2',
		port 		=> 2013, 
		prompt 		=> '/SC2-HWTC\s*>/i', 
		timeout		=> 90,
	},
	{
		name 		=> 'BBU-2', 		
		host 		=> 'tty-server2',
		port 		=> 2014, 
		prompt 		=> '/(RSS|\-)\s*>/i', 
		timeout		=> 90,
	},
	],
	'snmp'		=> [
	{
		name 		=> 'CTU4-1', 		
		host 		=> 'ctu4-1',
	},
	{
		name 		=> 'CTU4-2', 		
		host 		=> 'ctu4-2',
	},
	{
		name 		=> 'CTU4-3', 		
		host 		=> 'ctu4-3',
	},
	{
		name 		=> 'CTU4-4', 		
		host 		=> 'ctu4-4',
	},	
	],
) ;


	plan tests => 
		(scalar(keys %expected_options)) +
		(2*scalar(keys %expected)) + scalar(keys %sections) + scalar(keys %single_sections) + 
		(2*scalar(keys %expected)) + scalar(keys %sections) + scalar(keys %single_sections);

	## clear out write path
	if (-d $write_dir)
	{
		foreach my $f (glob("$write_dir"))
		{
			unlink $f ;
		}
		rmdir $write_dir ;
	}

	## no run tests
	my $app = App::Framework->new('exit_type'=>'die',
		'feature_config' => {
			'config' => {
				'debug' => $DEBUG,
			},
			'options' => {
				'debug' => $DEBUG,
			},
		},
	) ;

	@ARGV = (
		'-name',				'this-is-a-test',
		'-nomacro',
		'-default3',			'a-new-value',
		'-config_path',			't/config2',
		'-config_writepath',	't/config_wr',
	) ;
	eval {$app->go()} ;
	$@ =~ s/Died.*//m if $@ ;
	$@ =~ s/^\s+//gm if $@ ;
	$@ =~ s/\s+$//gm if $@ ;
	print "$@" if $@ ;



#=================================================================================
# SUBROUTINES EXECUTED BY APP
#=================================================================================

#----------------------------------------------------------------------
# Main execution
#
sub app
{
	my ($app, $opts_href, $args_href) = @_ ;

$app->prt_data("Opts:", $opts_href) ;

	## check simple configuration 
	my @global = $app->feature('Config')->get_array() ;
	my %global = $app->feature('Config')->get_hash() ;
$app->prt_data("Global: array=", \@global, " hash=", \%global) if $DEBUG ;

	foreach my $option (keys %expected_options)
	{
		is ($opts_href->{$option}, $expected_options{$option}, "Check option $option") ;
	}

	foreach my $option (keys %expected)
	{
		is ($global[0]{$option}, $expected{$option}, "Check configuration array for $option") ;
		is ($global{$option}, $expected{$option}, "Check configuration hash for $option") ;
	}

	## check sections
	my $cfg = $app->feature('Config') ;
	foreach my $section (keys %sections)
	{
		my @conf = $cfg->get_array($section) ;
$app->prt_data("Check Section: $section got=", \@conf, " expected=", $sections{$section}) if $DEBUG  ;
		is_deeply(\@conf, $sections{$section}, "Checking section array $section") ;
	}	
	foreach my $section (keys %single_sections)
	{
		my %conf = $cfg->get_hash($section) ;
$app->prt_data("Check Single Section: $section got=", \%conf, " expected=", $sections{$section}) if $DEBUG ;
		is_deeply(\%conf, $sections{$section}[0], "Checking section hash $section") ;
	}	

	
	## check write
	$cfg->write() ;
	
	my $new_cfg = $cfg->new(
		'filename'		=> $opts_href->{'config'},
		'path'			=> $opts_href->{'config_writepath'},
		'write_path'	=> $opts_href->{'config_writepath'},
	) ;
	$new_cfg->read() ;

$app->prt_data("Readback config=", $new_cfg->configuration) ;

	## check simple configuration 
	@global = $new_cfg->get_array() ;
	%global = $new_cfg->get_hash() ;
$app->prt_data("Global: array=", \@global, " hash=", \%global) if $DEBUG ;

	foreach my $option (keys %expected)
	{
		is ($global[0]{$option}, $expected{$option}, "Check read configuration array for $option") ;
		is ($global{$option}, $expected{$option}, "Check read configuration hash for $option") ;
	}

	## check sections
	foreach my $section (keys %sections)
	{
		my @conf = $new_cfg->get_array($section) ;
$app->prt_data("Check Section: $section got=", \@conf, " expected=", $sections{$section}) if $DEBUG ;
		is_deeply(\@conf, $sections{$section}, "Checking read section array $section") ;
	}	
	foreach my $section (keys %single_sections)
	{
		my %conf = $new_cfg->get_hash($section) ;
$app->prt_data("Check Single Section: $section got=", \%conf, " expected=", $sections{$section}) if $DEBUG ;
		is_deeply(\%conf, $sections{$section}[0], "Checking read section hash $section") ;
	}	
}

#=================================================================================
# SUBROUTINES
#=================================================================================



#=================================================================================
# SETUP
#=================================================================================
__DATA__

[SUMMARY]

Tests config file access

[DESCRIPTION]

B<$name> does some stuff.