#!/usr/bin/perl
# dbipg_install
#    $Id: dbipg_install,v 1.2 2002/12/29 08:11:41 nakahira Exp $
#    Last updated: 12/28/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 Getopt::Long;

use DBIPgSystem::DB;
use Template;

my $VERSION = '1.1.00';

# 
my $opt = { cvs => '',
		  };
my $optlist = [ 'help!', 'cvs!' ];
my $init = { basename => basename($0),
			 basedir => dirname($0),
			 dbipgsysdir => dirname($0) . "/..",
		   };

sub usage {
  my $ver = "(version $VERSION)" if($VERSION);
  print <<USAGE;
$init->{basename} $ver
Usage: $init->{basename} basefile [groupname]
ARGS:
  basefile   ե
  groupname  롼̾
Options:
  --cvs  true ʤ CVSǥ쥯ȥ̵뤷ʤ (default: '$opt->{cvs}')
USAGE
  exit;
}

{
  GetOptions($opt, @$optlist);
  &usage if(@ARGV != 1 and @ARGV != 2 or $opt->{help});
  my ($basefile, $grp) = @ARGV;

  die "new: Cannot open $basefile'" unless(-f $basefile and -r $basefile);
  require $basefile;
  my $baseconf = &baseconf;

  my $groups = $grp ? [ $grp ] : [ keys %{ $baseconf->{group} } ];
  foreach my $group (@$groups) {
	print "Group '$group' :\n";
	my $dbi = DBIPgSystem::DB->new
	  ($baseconf->{conffile}, $group, 'root', test => 1, no_db => 1);

	# basedir
	mkdir_or_warn($dbi->{global}{basedir}, $baseconf->{suexec} ? 0700 : 0755);

	my $dirhtmlmod = $baseconf->{suexec} ? 0755 : 0777;
	my $dirmod = $baseconf->{suexec} ? 0700 : 0777;

	# $dbi->{global}{tmpdir}
	mkdir_or_warn("$dbi->{global}{basedir}/$dbi->{global}{tmpdir}", $dirmod);

	# $dbi->{log}
	foreach my $k (keys %{ $dbi->{log} }) {
	  my $tmp = $dbi->{log}{$k};
	  $tmp =~ s!/[^/]+$!! or next;
	  mkdir_or_warn("$dbi->{global}{basedir}/$tmp", $dirmod);
	}

	# $dbi->{global}{export_file}
	if($dbi->{global}{export}{$group}) {
	  my $exportdir = $dbi->{global}{export_file}{$group};
	  $exportdir =~ s!/[^/]+$!!;
	  mkdir_or_warn($exportdir, $dirhtmlmod);
	}

	# $dbi->{global}{filetype}
	if(defined $dbi->{global}{filetype}) {
	  mkdir_or_warn($dbi->{global}{filetype}{dir}, $dirhtmlmod);
	  mkdir_or_warn($dbi->{global}{filetype}{pooldir}, $dirmod);
	  mkdir_or_warn($dbi->{global}{filetype}{tmpdir}, $dirhtmlmod);
	}

	&install_template($dbi, $baseconf, $group);
	&install_template_static($dbi, $baseconf, $group);
	&install_cgifile($dbi, $baseconf, $group);
  }
}
exit;

sub install_template {
  my ($dbi, $baseconf, $group) = @_;

  return unless($dbi->{template}{decoded});
  my $ans = &inputstr("Do you want to install template files (yes/no) ? ",
					  undef, pattern => qr{^(y|yes|n|no)$}i);
  unless($ans =~ m/^(y|yes)$/i) { print "Aborted.\n"; return; }

  my $grpconf = $baseconf->{group}{$group} or die;
  my $htmlfdir = $grpconf->{template_fromdir} or die;
  my $htmltodir = "$dbi->{global}{basedir}/$dbi->{template}{dir}{$group}";

  # $htmltodir
  my $dirhtmlmod = $baseconf->{suexec} ? 0755 : 0775;
  mkdir_or_warn($htmltodir, $dirhtmlmod);

  my $files = [ ];
  opendir(DIR, "$dbi->{global}{basedir}/$htmlfdir")
	or die "Cannot open directory $dbi->{global}{basedir}/$htmlfdir: $!";
  push(@$files, grep { ! m!\.\.?$! } readdir(DIR));
  closedir(DIR);

  my ($src, $tmpl);
  foreach my $file (@$files) {
	next if($file !~ m/\.html$/);
	# next if($file eq 'CVS' and not $opt->{cvs});
	next if($file =~ m/$baseconf->{group}{$group}{template_notest}/);
	$tmpl = Template->new
	  ("$htmlfdir/$file", escapecode => sub { CGI->escapeHTML($_[0]) });
	$src = $tmpl->out({ }, { }, decodeonly => 1);

	$file =~ s/\.html$//;
	open(OUT, "> $htmltodir/$file.pl")
	  or die "Cannot open $htmltodir/$file.pl: $!";
	print OUT $src;
	close(OUT);
	print "Install: $htmltodir/$file.pl\n";
  }
}

sub install_template_static {
  my ($dbi, $baseconf, $group) = @_;

  my $ans = &inputstr
	("Do you want to install static template files (yes/no) ? ",
	 undef, pattern => qr{^(y|yes|n|no)$}i);
  unless($ans =~ m/^(y|yes)$/i) { print "Aborted.\n"; return; }

  my $grpconf = $baseconf->{group}{$group} or die;
  my $htmlfdir = $grpconf->{template_static_dir};
  my $htmltodir = $grpconf->{cgitodir} or die;

  &_install_template_static($baseconf, $dbi, $htmlfdir, $htmltodir);
}

sub _install_template_static {
  my ($baseconf, $dbi, $htmlfdir, $htmltodir) = @_;

  my $htmlmod = 0644;

  # $htmltodir
  my $dirhtmlmod = $baseconf->{suexec} ? 0755 : 0775;
  mkdir_or_warn($htmltodir, $dirhtmlmod);

  my $files = [ ];
  opendir(DIR, $htmlfdir) or die "Cannot open directory $htmlfdir";
  push(@$files, grep { ! m!\.\.?$! } readdir(DIR));
  closedir(DIR);

  my $template;
  foreach my $file (@$files) {
	next if($file eq 'CVS' and not $opt->{cvs});
	if(-d "$dbi->{global}{basedir}/$htmlfdir/$file") {
	  &_install_template_static
		($baseconf, $dbi, "$htmlfdir/$file", "$htmltodir/$file");
	  next;
	}
	if($file !~ m!\.html$!i) {
	  # HTMLʳΥե򥳥ԡ
	  system('cp', "$htmlfdir/$file", "$htmltodir/$file");
	  print "Copy to: $htmltodir/$file (", sprintf("%.4o", $htmlmod), ")\n";
	  chmod($htmlmod, "$htmltodir/$file")
		or warn("Cannot change permissions: $htmltodir/$file");
	  next;
	}
	($template = $file) =~ s/\.html$//;
	unless(open(OUT, "> $htmltodir/$file")) {
	  warn "Cannot open $htmltodir/$file"; next; }
	$dbi->print_template($template, { }, noexit => 1, noheader => 1,
						 fh => \*OUT, dir => $htmlfdir, decode => 1);
	close(OUT);
	print "Install: $htmltodir/$file (", sprintf("%.4o", $htmlmod), ")\n";
	chmod($htmlmod, "$htmltodir/$file")
	  or warn("Cannot change permissions: $htmltodir/$file");
  }
}

sub install_cgifile {
  my ($dbi, $baseconf, $group) = @_;

  # DBIPgSystem.pm Хѥ
  my $dbipgsysdir;
  foreach my $path (@INC) {
	my $tmp = `pwd` . "/$path";
	$tmp =~ tr/\n//d;
	$tmp =~ s!^.*//!/!;
	1 while($tmp =~ s!/[^/]+/\.\.!!);
	if(-f "$tmp/DBIPgSystem.pm") { $dbipgsysdir = $tmp; last; }
  }
  die "Not found DBIPgSystem.pm" unless(defined $dbipgsysdir);

  my $cgifdir =
	"$dbi->{global}{basedir}/$baseconf->{group}{$group}{cgifromdir}" or die;
  my $cgitodir = $baseconf->{group}{$group}{cgitodir} or die;

  # cgi ե뤬֤Ƥǥ쥯ȥ
  die "Not found $cgifdir" unless(-d $cgifdir);
  my $ans = &inputstr("Do you want to install $cgifdir/*.cgi (yes/no) ? ",
					  undef, pattern => qr{^(y|yes|n|no)$}i);
  unless($ans =~ m/^(y|yes)$/i) { print "Aborted.\n"; return; }

  my $perlpath = `which perl`;
  $perlpath =~ tr/\n//d;

  # $cgitodir γƥեԽƥԡ
  my $cgikey =
	{ PERL_PATH => $perlpath,
	  LIBDIR => $dbipgsysdir,
	  CONFFILE => $baseconf->{conffile},
	  AUTHCONFFILE => $baseconf->{authconffile},
	  NPH => $baseconf->{nph},
	  GROUP => $group,
	  PRIMARYTABLE => $dbi->{global}{primary},
	  BASEURI => $dbi->{global}{baseuri}{$group},
	};
  &_copycgi($baseconf, $cgikey, $cgifdir, $cgitodir);
}

sub _copycgi {
  my ($baseconf, $cgikey, $cgifdir, $cgitodir) = @_;

  my ($ret, $comment);
  my $cgimod = $baseconf->{suexec} ? 0700 : 0755;
  my $htmlmod = 0644;
  my $nphstr = $baseconf->{nph} ? 'nph-' : '';

  # $cgitodir
  my $dirhtmlmod = $baseconf->{suexec} ? 0755 : 0775;
  mkdir_or_warn($cgitodir, $dirhtmlmod);

  my $files = [ ];
  opendir(DIR, $cgifdir) or die "Cannot open directory $cgifdir";
  push(@$files, grep { ! m!\.\.?$! } readdir(DIR));
  closedir(DIR);

  foreach my $file (@$files) {
	next if($file eq 'CVS' and not $opt->{cvs});
	if(-d "$cgifdir/$file") {
	  &_copycgi($baseconf, $cgikey, "$cgifdir/$file", "$cgitodir/$file");
	  next;
	}
	if($file !~ m!\.cgi$!i) {
	  # CGIʳΥե򥳥ԡ
	  print "Install: $cgitodir/$file (", sprintf("%.4o", $htmlmod), ")\n";
	  &_cgi_install_file("$cgifdir/$file", "$cgitodir/$file", $cgikey, undef);
	  chmod($htmlmod, "$cgitodir/$file")
		or warn("Cannot change permissions: $cgitodir/$file");
	  next;
	}
	$comment = "# Generated automatically from $cgifdir/$file by "
	  . "$init->{basename}.\n";
	print "Install: $cgitodir/$nphstr$file (", sprintf("%.4o", $cgimod), ")\n";
	&_cgi_install_file("$cgifdir/$file", "$cgitodir/$nphstr$file", $cgikey,
					   $comment);
	chmod($cgimod, "$cgitodir/$nphstr$file")
	  or warn("Cannot change permissions: $cgitodir/$nphstr$file");
	$ret = system('perl', '-wc', "$cgitodir/$nphstr$file");
	die "Compilation aborted: $cgitodir/$nphstr$file\n" if($ret);
  }
}

sub _cgi_install_file {
  my ($in, $out, $cgikey, $comment) = @_;

  unless(open(IN, $in)) {
	warn "Cannot open $in"; next; }
  unless(open(OUT, "> $out")) {
	warn "Cannot open $out"; next; }
  while(<IN>) {
	s/(\<\<(\w+)\>\>)/ exists($cgikey->{$2}) ? $cgikey->{$2} : $1 /ge;
	$_ = m/^#!/ ? "$_$comment" : "$comment$_" if($. == 1 and defined $comment);
	print OUT $_;
  }
  close(OUT);
  close(IN);
}

sub inputstr {
  my ($msg, $default, %opt) = @_;

  my $in;
  while(1) {
	print $msg;
	print "[$default] " if(defined $default);
	$in = <STDIN>;
	chomp($in);
	return $default if($in eq '' and defined($default));
	return $in if(not defined($opt{pattern}) or $in =~ m/$opt{pattern}/);
	print STDERR "Unrecognized string: $in\n\n";
  }
}

sub mkdir_or_warn {
  my ($dir, $mod, $nochmod) = @_;

  my $dir_and_mod = "$dir (" . sprintf("%.4o", $mod) . ")";
  if(-d $dir) {
	if(not $nochmod and ((stat $dir)[2] & 07777) != $mod) {
	  chmod($mod, $dir) or warn "Cannot change the permissions: $dir_and_mod";
	  print "Change Permission: $dir_and_mod\n";
	}
  } else {
	my $parent = $dir;
	$parent =~ s!/[^/]+/?$!!;
	mkdir_or_warn($parent, $mod, 1);
	mkdir($dir, $mod) or warn "Cannot create dir: $dir_and_mod";
	print "Create Directory: $dir_and_mod\n";
  }
}

__END__

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

=for html
<div class="pod">

=head1 NAME

dbipg_install - DBIPgSystem ١Υƥ򥤥󥹥ȡ뤹

=head1 DESCRIPTION

  $ dbipg_install basefile [groupname]

DBIPgSystem ١Υƥưνٱ礹롣
롼̾ꤵ줿ϤΥ롼פΤߡꤵʤä
ե˽񤫤Ƥ롼פˤĤƽԤ
ŪˤϡνԤ

 1. $dbi->{template}{decoded}  true ʤС
    ƥץ졼ȥեꤵ줿ǥ쥯ȥ˽񤭽Ф
 2. Ū˽񤭽Фƥץ졼ȥե񤭽Ф
 3. $base->{group}{*}{notemplate} 򥳥ԡ롣
 4. CGI ֤ǥ쥯ȥΥѡߥåѹ롣
 5. CGIեŬڤԽꤵ줿˽񤭽Ф
 6. ˵󤲤ǥ쥯ȥ꤬ʤк롣ޤѡߥåѹ롣
      * ƥݥǥ쥯ȥ $dbi->{global}{tmpdir}
      * ե񤭽Фǥ쥯ȥ$dbi->{log}{*} бˡ
      * ܺɽ HTML ΥݡΥǥ쥯ȥ
       $dbi->{global}{export}{$group}  true ξΤߡˡ
      * ɬפʤС˥åץɤ줿ե뤬񤭹ޤǥ쥯ȥ
       $dbi->{global}{filetype}{dir/pooldir/tmpdir}ˡ

$base->{...}, $dbi->{...} ϡ줾졢ե, ǡե
ɽ
ѡߥåϡsuEXEC Ȥɤǰۤʤ롣

񤭽ФΥեϡưǹԤȡ
񤭽ФΥեƤܥץȤ¹ԤƤ⡢
񤭽ФˤեϺʤ

=head1 SEE ALSO

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

=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

