use strict;
use warnings;

use Test::More 'no_plan';
use File::Temp 'tempfile';

my $Class   = 'Config::Auto';
my $Verbose = @ARGV ? 1 : 0;

use_ok( $Class );

my $Func = $Class->can('parse');

my $Map = {
    # format    # key = text, value = expected result
    colon   => {    
        qq[
test: foo=bar
test: baz
quux: zoop
] =>    { test => { foo => 'bar', baz => 1 }, quux => 'zoop' },
               
        qq[
# /etc/nsswitch.conf
#
# Example configuration of GNU Name Service Switch functionality.
# If you have the `glibc-doc' and `info' packages installed, try:
# `info libc "Name Service Switch"' for information about this file.

passwd:         compat
group:          compat

hosts:          files dns
] =>    { passwd => 'compat', group => 'compat', hosts => [qw|files dns|] },

        qq[
root:x:0:0:root:/root:/bin/bash
daemon:x:1:1:daemon:/usr/sbin:/bin/sh
bin:x:2:2:bin:/bin:/bin/sh
] =>    {   root    => [qw|x 0 0 root   /root       /bin/bash|],
            daemon  => [qw|x 1 1 daemon /usr/sbin   /bin/sh  |],
            bin     => [qw|x 2 2 bin    /bin        /bin/sh  |],
        },
    },
    

    equal => {
        qq[
# This file was generated by debconf automaticaly.
# Please use dpkg-reconfigure to edit.
# And you can copy this file to ~/.mozillarc to override.
MOZILLA_DSP=auto
USE_GDKXFT=false
] =>    { MOZILLA_DSP => 'auto', USE_GDKXFT => 'false' },
    },


    space => {
        qq[
set foo "bar, baby"
] =>    { set => ['foo', 'bar, baby'] },
        
        qq[
search oucs.ox.ac.uk ox.ac.uk
nameserver 163.1.2.1
nameserver 129.67.1.1
nameserver 129.67.1.180
] =>    {   search      => [qw|oucs.ox.ac.uk ox.ac.uk|],
            nameserver  => [qw|163.1.2.1 129.67.1.1 129.67.1.180|],
        },
    },
    
    xml => {
        qq[
<?xml version="1.0" encoding="UTF-8"?>
<config>
  <urlreader start="home.html" />
  <main>
    <title>test blocks</title>
    <url>http://www.example.com</url>
    <name>Tests &amp; Failures</name>
  </main>
</config>
] =>    { main      => { title => 'test blocks', 
                         url   => 'http://www.example.com',
                         name  => 'Tests & Failures' },
          urlreader => { start => 'home.html' },
        },     
    },                      

    yaml => {
        qq[
--- #YAML:1.0
test:
  foo: bar
] =>    { test => { foo => 'bar' } },
    },
    
    ini => {
        qq[
[group1]
host = proxy.some-domain-name.com
port = 80
username = blah
password = doubleblah
] =>    { group1 => {   host        => 'proxy.some-domain-name.com', 
                        port        => 80,
                        username    => 'blah',
                        password    => 'doubleblah' },
        },
    },  
    
    list => {
        ### don't leave an empty trailing newline, it'll create an 
        ### empty entry
        qq[
foo
+bar
-baz
] =>    [ qw|foo +bar -baz| ],
    },
    
    perl => {
        q[
#!/usr/bin/perl
{ foo => [ $$, $$ ] };
] =>    { foo => [ $$, $$ ] },
    },

};


### test parsing all formats
{   my %formats = map { $_ => $_ } $Class->formats;

    ### if we dont have xml support, don't try to test it.
    my $skip_xml = eval { require XML::Simple; 1 } ? 0 : 1;
    
    while( my($format,$href) = each %$Map ) { SKIP: {
        
        ok( 1,                  "Testing '$format' configs" );

        ### we tested this one, remove it from the list
        ### if anything's left at the end, we failed at testing
        delete $formats{$format} if $formats{$format};

        # 3 = amount of formats, 9 = amount of individual tests
        skip( "No XML::Simple installed", 3 * 9 * scalar(keys %$href) ) 
            if $format eq 'xml' and $skip_xml;
    
        while( my($text,$result) = each %$href ) {
            ### strip leading newline, we added it in the $Map for
            ### formatting purposes only.
            $text =~ s/^\n//;
            
            ### first line to display in the test header
            my ($header) = ($text =~ /^(.+?)\n/);
            
            ### 3 input mechanisms: text, fh and file
            ### create the latter 2 from the former
            my($fh,$file) = tempfile();
            
            ### write the file
            {   print $fh $text;
                $fh->close;
            
                ### reopen the FH for reading this time
                open $fh, $file or warn "Could not reopen $file: $!";
            }
            
            my %src = ( 
                text    => $text, 
                fh      => $fh, 
                file    => $file 
            );
            
            while( my($desc, $src) = each %src ) {
                ok( 1,          "   Passing '$desc' containing '$header'..." );

                ### using OO
                {   ### reset position if we're using a FH
                    seek $src, 0, 0 if ref $src;
                
                    my $obj = $Class->new( source => $src );
    
                    diag( "About to parse:\n$text" ) if $Verbose;
                    ok( $obj,   "       Object created" );
                    
                    my $rv = eval { $obj->parse };
        
                    ok( !$@,    "           No errors while parsing $@" );
                    ok( $obj->score,"           Scores assigned" );
                    is( $obj->format, $format,
                                "           Right format detected" );
                    ok( $rv,    "           Text parsed" );
                    is_deeply( $rv, $result,
                                "           Parsed correctly" );                               
                }
                
                ### using functional layer
                {   ### reset position if we're using a FH
                    seek $src, 0, 0 if ref $src;
                
                    my $rv = $Func->( $src );
                    ok( $rv,    "       Return value created from function call" );
                    is_deeply( $rv, $result,
                                "           Parsed correctly" );
                }
            }            
        }
    } }
    
    {   ### TODO implementations, so remove them from the list:
        for ( qw[bind irssi] ) {
            ok( delete $formats{$_},
                                "No '$_' support yet" );
        }
    
        my @left = keys %formats;
        ok( !scalar(@left),     "All formats tested (@left)" );
    }
}    

### try parsing perl with perl parsing disabled
{   while( my($text,$expect) = each %{$Map->{'perl'}} ) {
        ok( 1,                  "Testing DisablePerl = 1" );
    
        ### pesky warnings
        local $Config::Auto::DisablePerl = 1;
        local $Config::Auto::DisablePerl = 1;
        
        ### strip leading newline, we added it in the $Map for
        ### formatting purposes only.
        $text =~ s/^\n//;      
        
        my $rv = eval { $Func->( $text ) };
        
        ok(!$rv,                "   No return value" );
        ok( $@,                 "   Exception thrown" );
        like( $@, qr/Unparsable file format/,
                                "       No suitable parser found" );
    }
}