#!/usr/bin/perl -w
######################################################################
#
# $Id: WebJob-KvpRoutines.t,v 1.18 2012/01/07 07:56:13 mavrik Exp $
#
######################################################################
#
# Copyright 2007-2012 The WebJob Project, All Rights Reserved.
#
######################################################################
#
# Purpose: Tests for WebJob::KvpRoutines.
#
######################################################################

use 5.008;
use strict;
use Test;

BEGIN
{
  my %hPlan =
  (
    'tests' => 1 + 1 + 1 + 1 + 6 + 1 + 1 + 1 + 1 + 1 + 1 + 1,
  );
  plan(%hPlan);
};

######################################################################
#
# Tests
#
######################################################################

  ####################################################################
  #
  # Test: The target module must load without error.
  #
  ####################################################################

  use WebJob::KvpRoutines 1.033;
  ok(1);

  ####################################################################
  #
  # Test: Parse a simple config file.
  #
  ####################################################################

  my $sFile = "cfg";
  my %hProperties = ();
  if (open(FH, "> $sFile"))
  {
    print FH <<EOF;

# Comment starting at column zero.
 # Comment starting at column one.
# Alpha
a_a=a
a_b =b
a_c = c# Space before the value.
a_d = d # Space before and after the value.
 a_e=e
 a_f =f# Space before the value.
 a_g = g
 a_h = h # Space before and after the value.
# Digit
d_a=1
d_b =2
d_c = 3# Space before the value.
d_d = 4 # Space before and after the value.
 d_e=5
 d_f =6# Space before the value.
 d_g = 7
 d_h = 8 # Space before and after the value.
# Empty
e_a=
e_b =
e_c = # Space before the value.
e_d =  # Space and comment after the value.
 e_e=
 e_f =
 e_g = # Space before the value.
 e_h =  # Space and comment after the value.
# Other
o_a=foo
o_b=foo123
o_c=123
O_A=bar    # Case should be ignored for keys, and repeats are allowed.
O_B=bar456 # Case should be ignored for keys, and repeats are allowed.
O_C=456    # Case should be ignored for keys, and repeats are allowed.
# Boolean
b_a=Y
b_b=y
b_c=N
b_d=n
b_e=T
b_f=t
b_g=F
b_h=f
b_i=1
b_j=0
b_k=YES
b_l=Yes
b_m=yes
b_n=NO
b_o=No
b_p=no
b_q=TRUE
b_r=True
b_s=true
b_t=FALSE
b_u=False
b_v=false
# Comment (Note: The comments below are spaced so they line up in the config file.)
c_a=1#        # This value is supposed to be '1'.
c_b=1#2#      # This value is supposed to be '1'.
c_c=1#2#3#    # This value is supposed to be '1'.
c_d=1\\#       # This value is supposed to be '1#'.
c_e=1\\#2\\#    # This value is supposed to be '1#2#'.
c_f=1\\#2\\#3\\# # This value is supposed to be '1#2#3#'.
c_g=1\\\\#      # This value is supposed to be '1\\#'.
# Double Quotes
q_a=""
q_b=" "
q_c="  "
q_d="   "
q_e="foo"
q_f="foo"bar"    # KvpSetKvps() will not do this if value quoting is enabled (i.e., leave embedded quotes of the same kind unescaped).
q_g="foo""bar"   # KvpSetKvps() will not do this if value quoting is enabled (i.e., leave embedded quotes of the same kind unescaped).
q_h="foo\\"bar"   # KvpSetKvps() will do this if value quoting is enabled (i.e., escape embedded quotes of the same kind).
q_i="foo\\"\\"bar" # KvpSetKvps() will do this if value quoting is enabled (i.e., escape embedded quotes of the same kind).
q_j="foo'bar"
# Single Quotes
s_a=''
s_b=' '
s_c='  '
s_d='   '
s_e='foo'
s_f='foo'bar'    # KvpSetKvps() will not do this if value quoting is enabled (i.e., leave embedded quotes of the same kind unescaped).
s_g='foo''bar'   # KvpSetKvps() will not do this if value quoting is enabled (i.e., leave embedded quotes of the same kind unescaped).
s_h='foo\\'bar'   # KvpSetKvps() will do this if value quoting is enabled (i.e., escape embedded quotes of the same kind).
s_i='foo\\'\\'bar' # KvpSetKvps() will do this if value quoting is enabled (i.e., escape embedded quotes of the same kind).
s_j='foo"bar'
EOF
    close(FH);
  }
  my %hLArgs =
  (
    'File'           => $sFile,
    'Properties'     => \%hProperties,
    'RequireAllKeys' => 1,
    'Template'       =>
    {
      # Alpha
      'a_a'          => "[A-Za-z]",
      'a_b'          => "[A-Za-z]",
      'a_c'          => "[A-Za-z]",
      'a_d'          => "[A-Za-z]",
      'a_e'          => "[A-Za-z]",
      'a_f'          => "[A-Za-z]",
      'a_g'          => "[A-Za-z]",
      'a_h'          => "[A-Za-z]",
      # Boolean
      'b_a'          => "[10YyNnTtFf]",
      'b_b'          => "[10YyNnTtFf]",
      'b_c'          => "[10YyNnTtFf]",
      'b_d'          => "[10YyNnTtFf]",
      'b_e'          => "[10YyNnTtFf]",
      'b_f'          => "[10YyNnTtFf]",
      'b_g'          => "[10YyNnTtFf]",
      'b_h'          => "[10YyNnTtFf]",
      'b_i'          => "[10YyNnTtFf]",
      'b_j'          => "[10YyNnTtFf]",
      'b_k'          => "(?i)(?:false|no|true|yes|no)",
      'b_l'          => "(?i)(?:false|no|true|yes|no)",
      'b_m'          => "(?i)(?:false|no|true|yes|no)",
      'b_n'          => "(?i)(?:false|no|true|yes|no)",
      'b_o'          => "(?i)(?:false|no|true|yes|no)",
      'b_p'          => "(?i)(?:false|no|true|yes|no)",
      'b_q'          => "(?i)(?:false|no|true|yes|no)",
      'b_r'          => "(?i)(?:false|no|true|yes|no)",
      'b_s'          => "(?i)(?:false|no|true|yes|no)",
      'b_t'          => "(?i)(?:false|no|true|yes|no)",
      'b_u'          => "(?i)(?:false|no|true|yes|no)",
      'b_v'          => "(?i)(?:false|no|true|yes|no)",
      # Comment
      'c_a'          => "1",
      'c_b'          => "1",
      'c_c'          => "1",
      'c_d'          => "1#",
      'c_e'          => "1#2#",
      'c_f'          => "1#2#3#",
      'c_g'          => "1\\\\#", # This is supposed to match the literal value '1\#'.
      # Digit
      'd_a'          => "\\d",
      'd_b'          => "\\d",
      'd_c'          => "\\d",
      'd_d'          => "\\d",
      'd_e'          => "\\d",
      'd_f'          => "\\d",
      'd_g'          => "\\d",
      'd_h'          => "\\d",
      # Empty
      'e_a'          => "",
      'e_b'          => "",
      'e_c'          => "",
      'e_d'          => "",
      'e_e'          => "",
      'e_f'          => "",
      'e_g'          => "",
      'e_h'          => "",
      # Double Quotes
      'q_a'          => qq(""),
      'q_b'          => qq(" "),
      'q_c'          => qq("  "),
      'q_d'          => qq("   "),
      'q_e'          => qq("foo"),
      'q_f'          => qq("foo"bar"),
      'q_g'          => qq("foo""bar"),
      'q_h'          => qq("foo\\\\"bar"),
      'q_i'          => qq("foo\\\\"\\\\"bar"),
      'q_j'          => qq("foo'bar"),
      # Single Quotes
      's_a'          => qq(''),
      's_b'          => qq(' '),
      's_c'          => qq('  '),
      's_d'          => qq('   '),
      's_e'          => qq('foo'),
      's_f'          => qq('foo'bar'),
      's_g'          => qq('foo''bar'),
      's_h'          => qq('foo\\\\'bar'),
      's_i'          => qq('foo\\\\'\\\\'bar'),
      's_j'          => qq('foo"bar'),
      # Other
      'o_a'          => "[\\w-]+",
      'o_b'          => "[\\w\\d-]+",
      'o_c'          => "\\d+",
    },
    'VerifyValues'   => 1,
  );
  ok(KvpGetKvps(\%hLArgs));
# print STDERR "\n";
# foreach my $sKey (sort(keys(%hProperties)))
# {
#   print STDERR "$sKey=[$hProperties{$sKey}]\n";
# }

  ####################################################################
  #
  # Test: Unquote quoted values.
  #
  ####################################################################

  %hProperties = ();
  %hLArgs =
  (
    'File'           => $sFile,
    'MatchKeyCase'   => 1,
    'Properties'     => \%hProperties,
    'RequireAllKeys' => 1,
    'Template'       =>
    {
      'a_a'          => "[A-Za-z]",
      'b_a'          => "[10YyNnTtFf]",
      'c_a'          => "1",
      'd_a'          => "\\d",
      'e_a'          => "",
      'o_a'          => "[\\w-]+",
      'q_a'          => qq(),
      'q_b'          => qq( ),
      'q_c'          => qq(  ),
      'q_d'          => qq(   ),
      'q_e'          => qq(foo),
      'q_f'          => qq(foo"bar),
      'q_g'          => qq(foo""bar),
      'q_h'          => qq(foo"bar),
      'q_i'          => qq(foo""bar),
      'q_j'          => qq(foo'bar),
      's_a'          => qq(),
      's_b'          => qq( ),
      's_c'          => qq(  ),
      's_d'          => qq(   ),
      's_e'          => qq(foo),
      's_f'          => qq(foo'bar),
      's_g'          => qq(foo''bar),
      's_h'          => qq(foo'bar),
      's_i'          => qq(foo''bar),
      's_j'          => qq(foo"bar),
    },
    'UnquoteValues'  => 1,
    'VerifyValues'   => 1,
  );
  ok(KvpGetKvps(\%hLArgs));
# print STDERR "\n";
# foreach my $sKey (sort(keys(%hProperties)))
# {
#   print STDERR "$sKey=[$hProperties{$sKey}]\n";
# }

  ####################################################################
  #
  # Test: Case sensitive keys.
  #
  ####################################################################

  %hProperties = ();
  %hLArgs =
  (
    'File'           => $sFile,
    'MatchKeyCase'   => 1,
    'Properties'     => \%hProperties,
    'RequireAllKeys' => 1,
    'Template'       =>
    {
      'o_a'          => "[\\w-]+",
      'o_b'          => "[\\w\\d-]+",
      'o_c'          => "\\d+",
      'O_A'          => "[\\w-]+",
      'O_B'          => "[\\w\\d-]+",
      'O_C'          => "\\d+",
    },
    'VerifyValues'   => 1,
  );
  ok(KvpGetKvps(\%hLArgs));
# print STDERR "\n";
# foreach my $sKey (sort(keys(%hProperties)))
# {
#   print STDERR "$sKey=[$hProperties{$sKey}]\n";
# }

  ####################################################################
  #
  # Test: Various combinations of RequireAllKeys and RequiredKeys.
  #
  ####################################################################

  %hProperties = ();
  %hLArgs =
  (
    'File'           => $sFile,
    'MatchKeyCase'   => 1,
    'Properties'     => \%hProperties,
    'Template'       =>
    {
      'o_a'          => "[\\w-]+",
      'o_b'          => "[\\w\\d-]+",
      'o_c'          => "\\d+",
      'O_A'          => "[\\w-]+",
      'O_B'          => "[\\w\\d-]+",
      'O_C'          => "\\d+",
    },
    'VerifyValues'   => 1,
  );
  foreach my $sTuple ("1::1", "1:o_a,O_A:1", "1:unknown:1", "0::1", "0:o_a,O_A:1", "0:unknown:undef")
  {
    my ($sRequireAllKeys, $sRequiredKeys, $sExpectedResult) = split(/:/, $sTuple, -1);
    $hLArgs{'RequireAllKeys'} = $sRequireAllKeys; # This trumps RequiredKeys when set to 1.
    $hLArgs{'RequiredKeys'} = [split(",", $sRequiredKeys)] ;
    ok(KvpGetKvps(\%hLArgs), ($sExpectedResult eq "undef") ? undef : $sExpectedResult);
  }

  ####################################################################
  #
  # Test: Regular expression keys.
  #
  ####################################################################

  %hProperties = ();
  %hLArgs =
  (
    'File'           => $sFile,
    'MatchKeyCase'   => 1, # This option should set for regular expression keys, and the expression should deal with case.
    'Properties'     => \%hProperties,
    'RequireAllKeys' => 0, # This option should not be set for regular expression keys.
    'Template'       =>
    {
      'a_[a-h]'      => "[A-Za-z]",
      'b_[a-v]'      => "(?i)(?:false|no|true|yes|no|[10YNTF])",
      'c_[a-g]'      => "(?:1(?:#?(?:2#?(?:3#?)?)?)?|1\\\\#)",
      'd_[a-h]'      => "\\d",
      'e_[a-h]'      => "",
      'o_[a-c]'  => "[\\w\\d-]+", # This expression purposely excludes the 'O_[A-C]' keys.
    },
    'VerifyValues'   => 1,
  );
  ok(KvpGetKvps(\%hLArgs));
# print STDERR "\n";
# foreach my $sKey (sort(keys(%hProperties)))
# {
#   print STDERR "$sKey=[$hProperties{$sKey}]\n";
# }

  ####################################################################
  #
  # Test: Write a simple config file.
  #
  ####################################################################

  %hLArgs =
  (
    'Delimiter'      => "=",
    'File'           => $sFile,
    'Properties'     => \%hProperties,
    'Template'       =>
    {
      'a_[a-h]'      => "[A-Za-z]",
      'b_[a-v]'      => "(?i)(?:false|no|true|yes|no|[10YNTF])",
      'c_[a-g]'      => "(?:1(?:#?(?:2#?(?:3#?)?)?)?|1\\\\#)",
      'd_[a-h]'      => "\\d",
      'e_[a-h]'      => "",
      'o_[a-c]'  => "[\\w\\d-]+", # This expression purposely excludes the 'O_[A-C]' keys.
    },
    'VerifyValues'   => 1,
  );
  ok(KvpSetKvps(\%hLArgs));

  ####################################################################
  #
  # Test: Append to a config file.
  #
  ####################################################################

  %hLArgs =
  (
    'AppendToFile'   => 1,
    'Delimiter'      => "=",
    'File'           => $sFile,
    'Properties'     =>
    {
      'O_A'          => "bar",
      'O_B'          => "bar456",
      'O_C'          => "456",
    },
    'Template'       =>
    {
      'O_[A-C]'      => "[\\w\\d-]+",
    },
    'VerifyValues'   => 1,
  );
  ok(KvpSetKvps(\%hLArgs));

  unlink($sFile);

  ####################################################################
  #
  # Test: Parse a simple set of config files using recursion.
  #
  ####################################################################

  my $sFile1 = "cfg-1";
  my $sFile2 = "cfg-2";
  my $sFile3 = "cfg-3";
  %hProperties = ();
  if (open(FH, "> $sFile1"))
  {
    print FH <<EOF;
Import=$sFile2
Level1=1
EOF
    close(FH);
  }
  if (open(FH, "> $sFile2"))
  {
    print FH <<EOF;
Import=$sFile3
Level2=2
EOF
    close(FH);
  }
  if (open(FH, "> $sFile3"))
  {
    print FH <<EOF;
Level3=3
EOF
    close(FH);
  }
  %hLArgs =
  (
    'File'           => $sFile1,
    'Properties'     => \%hProperties,
    'RecursionKey'   => "Import",
    'RecursionLimit' => 3,
    'Template'       =>
    {
      'Import'       => ".+",
      'Level1'       => "\\d+",
      'Level2'       => "\\d+",
      'Level3'       => "\\d+",
    },
    'VerifyValues'   => 1,
  );
  ok(KvpGetKvps(\%hLArgs));
# print STDERR "\n";
# foreach my $sKey (sort(keys(%hProperties)))
# {
#   print STDERR "$sKey=[$hProperties{$sKey}]\n";
# }

  unlink($sFile1, $sFile2, $sFile3);

  ####################################################################
  #
  # Test: Multiple values per key.
  #
  ####################################################################

  my $sFile4 = "cfg-4";
  %hProperties = ();
  if (open(FH, "> $sFile4"))
  {
    print FH <<EOF;
key=a
key=b
key=c
key=D
key=E
key=F
EOF
    close(FH);
  }
  %hLArgs =
  (
    'AcceptMultipleValues' => 1,
    'File'           => $sFile4,
    'Properties'     => \%hProperties,
    'RequireAllKeys' => 1,
    'Template'       =>
    {
      'key'          => "[A-Za-z]",
    },
    'VerifyValues'   => 1,
  );
  ok(KvpGetKvps(\%hLArgs) && (join("", @{$hProperties{'key'}})) eq "abcDEF");
# print STDERR "\n";
# foreach my $sKey (sort(keys(%hProperties)))
# {
#   foreach my $sValue (@{$hProperties{$sKey}})
#   {
#     print STDERR "$sKey=[$sValue]\n";
#   }
# }

  unlink($sFile4);

  ####################################################################
  #
  # Test: Single-value singleton format.
  #
  ####################################################################

  my $sFile5 = "cfg-5";
  %hProperties = ();
  if (open(FH, "> $sFile5"))
  {
    print FH <<EOF;

# Comment at the beginning of the line.
 # Comment after one space.
	# Comment after one tab.
  # Comment after two spaces.
		# Comment after two tabs.
a# Comment to the right of the singleton.
b # Comment to the right of the singleton separated by one space.
c	# Comment to the right of the singleton separated by one tab.
d  # Comment to the right of the singleton separated by two spaces.
e		# Comment to the right of the singleton separated by two tabs.
= # The singleton format has no delimiter, so the template determines whether a given value is valid or not.
EOF
    close(FH);
  }
  %hLArgs =
  (
    'AcceptMultipleValues'   => 0,
    'File'                   => $sFile5,
    'FileFormat'             => "singleton",
    'MatchKeyCase'           => 1,
    'Properties'             => \%hProperties,
    'RequireKnownKeys'       => 1,
    'Template'               =>
    {
      'a'                    => "a",
      'b'                    => "b",
      'c'                    => "c",
      'd'                    => "d",
      'e'                    => "e",
      '='                    => "=",
    },
    'VerifyValues'           => 1,
  );
  ok(KvpGetKvps(\%hLArgs) && (join("", sort(keys(%hProperties))) eq "=abcde"));

  unlink($sFile5);

  ####################################################################
  #
  # Test: Multi-value singleton format.
  #
  ####################################################################

  my $sFile6 = "cfg-6";
  %hProperties = ();
  if (open(FH, "> $sFile6"))
  {
    print FH <<EOF;
a
 b# Space before the value.
b # Space after the value
 b # Space before and after the value.
	c# Tab before the value.
c	# Tab after the value
	c	# Tab before and after the value.
d\\## This value is supposed to be 'd#'.
d\\## This value is supposed to be 'd#'.
EOF
    close(FH);
  }
  %hLArgs =
  (
    'AcceptMultipleValues'   => 1,
    'File'                   => $sFile6,
    'FileFormat'             => "singleton",
    'MatchKeyCase'           => 1,
    'Properties'             => \%hProperties,
    'RequireKnownKeys'       => 1,
    'Template'               =>
    {
      'a'                    => "a",
      'b'                    => "b",
      'c'                    => "c",
      'd#'                   => "d#",
    },
    'VerifyValues'           => 1,
  );
  ok
  (
    KvpGetKvps(\%hLArgs)
    && (join("", @{$hProperties{'a'}}) eq "a")
    && (join("", @{$hProperties{'b'}}) eq "bbb")
    && (join("", @{$hProperties{'c'}}) eq "ccc")
    && (join("", @{$hProperties{'d#'}}) eq "d#d#")
  );

  unlink($sFile6);
