#!/usr/bin/perl
# dbipg_test_conf
#    $Id: dbipg_test_conf,v 1.1.1.1 2002/12/26 04:37:47 nakahira Exp $
#    Last updated: 12/22/2002
#
# Copyright (C) 2002 The Nagoya University Consumers' Co-operative Association
#   Written by K.Nakahira
#
#  This program is licensed under the GNU GPL.
#  See the following URL for more details:
#    http://www.gnu.org/licenses/gpl.txt
#

use strict;
use File::Basename;
use File::Copy;

use DBIPgSystem;
use DBIPgSystem::Passwd;

my $VERSION = '0.0.10';

# 
my $init = { basename => basename($0),
		   };

sub usage {
  my $ver = "(version $VERSION)" if($VERSION);
  print <<USAGE;
$init->{basename} $ver
Usage: $init->{basename} basefile
ARGS:
  basefile   ե
USAGE
  exit;
}

{
  &usage if(@ARGV != 1 or $ARGV[0] =~ m/^--?h(elp)?$/i);
  my $basefile = shift;

  $| = 1;

  # եΥѥ
  my $retval = system("perl -wc $basefile");
  die "'$basefile' is invalid (retval: $retval)" if($retval & 0xffff);
  require $basefile;
  my $baseconf = &baseconf;
  my $conffile = $baseconf->{conffile};
  my $authconffile = $baseconf->{authconffile};

  $retval = system("perl -wc $conffile");
  die "'$conffile' is invalid (retval: $retval)" if($retval & 0xffff);
  print "\n";

  # 
  my $dbs = DBIPgSystem->new
	($conffile, 'staff', 'root', no_db => 1, test => 1);

  # ----- եΥƥ -----
  print "*** $basefile ***\n";
  print "Testing '$basefile' ... ";
  eval { &test_baseconf($baseconf, $dbs) };
  die "Failed.\n  $@\n" if($@);
  print "Ok.\n\n";

  my ($error, $warn, $wmsg, $dbpass);

  print "*** $conffile ***\n";
  my $groups = $dbs->{global}{groups};
  $SIG{__WARN__} = sub { push(@$wmsg, $_[0]); };
  foreach my $group (keys %$groups) {
	next unless($groups->{$group});
	($error, $warn) = (0, 0);
	$wmsg = [ ];

	print "Group: $group\n";
	$dbs = DBIPgSystem->new($conffile, $group, 'root', no_db => 1, test => 1);

	# ----- ǡեΥƥ -----
	# DBIPgSystem.pm Υƥ
	my $test_dbs = [ "test_conf", "test_errcode" ];
	foreach my $t (@$test_dbs) {
	  print "Testing 'DBIPgSystem::$t' ... ";
	  eval { $dbs->$t() };
	  print ($@ ? "Failed.\n  $@\n" : "Ok.\n");
	  $error++ if($@);
	  if(@$wmsg) {
		$warn += @$wmsg;
		foreach my $w (@$wmsg) { chomp($w);   print "Warning: $w\n"; }
		print "\n";
		$wmsg = [ ];
	  }
	}
	# DBIPgSystem::Passwd.pm Υƥ
	if(defined $authconffile) {
	  $dbpass = DBIPgSystem::Passwd->new($dbs, $authconffile, test => 1);
	  my $test_dbpass = [ "test_conf", "test_errcode" ];
	  foreach my $t (@$test_dbpass) {
		print "Testing 'DBIPgSystem::Passwd::$t' ... ";
		eval { $dbpass->$t() };
		print ($@ ? "Failed.\n  $@\n" : "Ok.\n");
		$error++ if($@);
		if(@$wmsg) {
		  $warn += @$wmsg;
		  foreach my $w (@$wmsg) { chomp($w);   print "Warning: $w\n"; }
		  print "\n";
		  $wmsg = [ ];
		}
	  }
	}
	# $baseconf->{errcode} Υƥ
	if($baseconf->{errcode}) {
	  print "Testing '\$baseconf->{errcode}' ... ";
	  eval {
		foreach my $c (@{ $baseconf->{errcode} }) {
		  $dbs->get_errmsg($c);
		}
	  };
	  print ($@ ? "Failed.\n  $@\n" : "Ok.\n");
	  $error++ if($@);
	}
	print "$error errors, $warn warnings.\n\n";
  }
  undef $SIG{__WARN__};
}
exit;

# եΥƥ
sub test_baseconf {
  my ($conf, $dbs) = @_;

  # $conf->{conffile}
  die "\$conf->{conffile} must represent a absolute pathname"
	if($conf->{conffile} !~ m!^/!);
  die "\$conf->{conffile} doesn't exist" unless(exists $conf->{conffile});
  # $conf->{authconffile}
  if(defined $conf->{authconffile}) {
	die "\$conf->{authconffile} must represent a absolute pathname"
	  if($conf->{authconffile} !~ m!^/!);
  }
  # $conf->{errcode}
  die "\$conf->{errcode} is invalid" if(ref($conf->{errcode}) ne 'ARRAY');
  # $conf->{group}
  die "\$conf->{group} is invalid" if(ref($conf->{group}) ne 'HASH');
  die "\$conf->{group}{staff} doesn't exist"
	unless(exists $conf->{group}{staff});
  foreach my $group (keys %{ $conf->{group} }) {
	die "Groupname $group doesn't exist in $conf->{conffile}"
	  unless(exists $dbs->{global}{groups}{$group});
	my $grpconf = $conf->{group}{$group};
	# $grpconf->{cgifromdir}
	die "\$conf->{group}{$group}{cgifromdir} is invalid"
	  unless($grpconf->{cgifromdir} =~ m!^[/\w.%~+-]+$!);
	die "\$conf->{group}{$group}{cgifromdir} must end without a slash"
	  if($grpconf->{cgifromdir} =~ m!/$!);
	die "\$conf->{group}{$group}{cgifromdir} "
	  . "must represent a relative pathname"
		if($grpconf->{cgifromdir} =~ m!^/!);
	# $grpconf->{cgitodir}
	die "\$conf->{group}{$group}{cgitodir} is invalid"
	  unless($grpconf->{cgitodir} =~ m!^[/\w.%~+-]+$!);
	die "\$conf->{group}{$group}{cgitodir} must end without a slash"
	  if($grpconf->{cgitodir} =~ m!/$!);
	die "\$conf->{group}{$group}{cgitodir} must represent a absolute pathname"
	  if($grpconf->{cgitodir} !~ m!^/!);
	# $grpconf->{template_notest}
	die "\$conf->{group}{$group}{template_notest} is invalid"
	  unless(defined $grpconf->{template_notest});
	# $grpconf->{template_static_dir}
	die "\$conf->{group}{$group}{template_static_dir} is invalid"
	  unless($grpconf->{template_static_dir} =~ m!^[/\w.%~+-]+$!);
	die "\$conf->{group}{$group}{template_static_dir} must end without a slash"
	  if($grpconf->{template_static_dir} =~ m!/$!);
	die "\$conf->{group}{$group}{template_static_dir} "
	  . "must represent a relative pathname"
		if($grpconf->{template_static_dir} =~ m!^/!);
	# $grpconf->{template_fromdir}
	die "\$conf->{group}{$group}{template_fromdir} is invalid"
	  unless($grpconf->{template_fromdir} =~ m!^[/\w.%~+-]+$!);
	die "\$conf->{group}{$group}{template_fromdir} must end without a slash"
	  if($grpconf->{template_fromdir} =~ m!/$!);
	die "\$conf->{group}{$group}{template_fromdir} "
	  . "must represent a relative pathname"
		if($grpconf->{template_fromdir} =~ m!^/!);
  }
}

__END__

=for html
<div class="header">
<div class="bar">
<a href="../index.html">Top</a>
<a href="index.html">ޥ˥奢</a>
</div>
<h1>dbipg_test_conf</h1></div>

=for html
<div class="pod">

=head1 NAME

dbipg_test_conf - եΥƥȤԤ

=head1 DESCRIPTION

  $ dbipg_test_conf basefile

եʹե, ǡե,
顼åե, 桼ե
εҤ˴ְ㤤ʤƥȤԤ
ѥ륨顼ʤȤǧ塢
եˤĤƺ٤ʥƥȤԤ
ǡեˤĤƤϡݡȤƤ桼
ƥѤΥ᥽åɤƤӽФ
ޤ$baseconf->{errcode} ͤС
б륨顼ɤƤ뤫Τ롣

=head1 SEE ALSO

F<DBIPgSystem>, F<DBIPgSystem::DB>

=head1 COPYRIGHT

Copyright (C) 2002 The Nagoya University Consumers' Co-operative Association

This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.

See the following URL for more details:
  http://www.gnu.org/licenses/gpl.txt

Written by Kenji Nakahira <nakahira@coop.nagoya-u.ac.jp>

=for html
</div>

=cut

