#
# Copyright (c) 2000-2007 Thomas Linden <tlinden |AT| cpan.org>.
# All Rights Reserved. Std. disclaimer applies.
# Artificial License, same as perl itself. Have fun.
#
# namespace
package Config::General::Validate;

use strict;
use warnings;
use English '-no_match_vars';
use Carp;
use Exporter;
use Data::Dumper;

use constant FALSE => 0;
use constant TRUE  => 1;

$Config::General::Validate::VERSION = 1.00;

use vars  qw(@ISA);
use base qw(Exporter Config::General);

sub new {
  my( $this, $structure ) = @_;
  my $class = ref($this) || $this;

  my $self;
  $self->{structure} = $structure;
  $self->{types} = {
		    int   => qr(\d+),
		    word  => qw(\w+),
		    line  => qw([^\n]+),
		    text  => qw(.+)
		    };

  bless $self, $class;

  return $self;
}

sub validate {
  my($this, $config) = @_;

  if (ref($config) eq 'Config::General') {
    $config = { $config->getall() };
  }

  eval {
    $this->traverse($this->{structure}, $config);
  };
  if ($@) {
    $! = $@;
    return FALSE;
  }
  else {
    return TRUE;
  }
}


sub traverse {
  my($this, $a, $b) = @_;

  ###print Dumper($a, $b);

  foreach my $key (keys %{$a}) {

    ###print "REF $key: " . ref($a->{$key}) . "\n";

    if (ref($a->{$key}) eq 'ARRAY') {
      # just use the 1st one, more elements in array are expected to be the same
      foreach my $item (@{$b->{$key}}) {
	$this->traverse($a->{$key}->[0], $item);
      }
    }
    elsif (ref($a->{$key}) eq 'HASH') {
      $this->traverse($a->{$key}, $b->{$key});
    }
    elsif (grep {ref($a->{$key}) ne $_} qw(GLOB REF CODE LVALUE) ) {
      # check data type
      if (! exists $this->{types}->{$a->{$key}}) {
	croak qq(Invalid data type $a->{$key});
      }
      else {
	if (exists $b->{$key}) {
	  if ($b->{$key} !~ /^$this->{types}->{$a->{$key}}$/s) {
	    die "$key not ok ($b->{$key} !~ /$this->{types}->{$a->{$key}}/)\n";
	  }
	  else {
	    ###print "$key ok\n";
	  }
	}
	else {
	  die "$key doesn't exist\n";
	}
      }
    }
  }
}



1;


__END__

=head1 NAME

Config::General::Validate - Validate Config::General Configs

=head1 SYNOPSIS

 use Config::General::Validate;
 
 my $validator = new Config::General::Validate($reference);
 
 if ( $validator->validate($config_general_object) ) {
   print "valid\n";
 }
 else {
   print "invalid\n";
 }
 
 if ( $validator->validate($config_hash_reference) ) {
   print "valid\n";
 }
 else {
   print "invalid\n";
 }

=head1 DESCRIPTION

This module validates a config parsed by Config::General
against a given hash structure.

The following data types can be used:

 int  - an integer
 word - a single word
 line - a line of text
 text - a whole text(blob) including newlines.

Example validator structure:

 $reference = { user => 'word', uid => 'int' };

The following config would be validated successful:

 $config = { user => 'HansDampf',  uid => 92 };

this one not:

 $config = { user => 'Hans Dampf', uid => 'nine' };
                          ^                ^^^^
                          |                |
                          |                +----- is not a number
                          +---------------------- space not allowed

=head1 SUBROUTINES/METHODS

=over

=item B<validate($config)>

$config can be either a normal hash reference you'd like to
validate (which allows you to use the module for any hash, not
only the ones generated by Config::General) or a Config::General
object.

It returns a true value if the given structure looks valid.

If the return value is false (0), then the error message will
be written to the variable $!.

=back

=head1 ARRAY

Arrays must be handled in a special way, just define an array
with two elements and the second empty. The config will only
validated against the first element in the array.

We assume all elements in an array must have the same structure.

Example:

 $reference = {
                [
                  {
                     user => 'word',
                     uid => 'int'
                  },
                  {} # empty 2nd element
                ]
               };

=head1 CONFIGURATION AND ENVIRONMENT

No environment variables will be used.

=head1 SEE ALSO

I recommend you to read the following documentations, which are supplied with perl:

 perlreftut                     Perl references short introduction
 perlref                        Perl references, the rest of the story
 perldsc                        Perl data structures intro
 perllol                        Perl data structures: arrays of arrays

 Config::General::Extended      Object oriented interface to parsed configs
 Config::General::Interpolated  Allows to use variables inside config files

=head1 LICENSE AND COPYRIGHT

Copyright (c) 2007 Thomas Linden

This library is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.

=head1 BUGS AND LIMITATIONS

See rt.cpan.org for current bugs, if any.

=head1 INCOMPATIBILITIES

None known.

=head1 DIAGNOSTICS

To debug Config::General::Validate use the perl debugger, see L<perldebug>.

=head1 DEPENDENCIES

Config::General::Validate depends on the module L<Config::General>.

=head1 AUTHOR

Thomas Linden <tlinden |AT| cpan.org>

=head1 VERSION

1.00

=cut

