package Installer;
# $Id: Installer.pm,v 1.19 2000/11/22 18:08:07 tom Exp $
###############################################################

=head1 NAME

Installer - general installer class

=head1 SYNOPSIS

 use Installer;

 $i = new Installer;
 $i->AddItem({name=>foo, data=>bar});
 $i->Input;
 print $i->Get;

=cut

use strict;

use Exporter;
use File::Path;
use Exporter;
#use File::Copy;
use File::Find;
use File::Basename;

use JConv;
use ObjectTemplate;
use DateTime::Date;
use Input;
use Installer::Item;

use vars qw(@ISA @EXPORT
	    $DefaultPerlPath $PerlPath
	    $DefaultLibDir $LibDir);
@ISA = qw(ObjectTemplate Exporter);
@EXPORT = qw(attributes which makedir copy newer);

# 静的変数

=head1 STATIC VARIABLES

 $DefaultPerlPath    default perl path
 $PerlPath           actual perl path

 $DefaultLibDir      default library directory
 $LibDir             actual library directory

=cut


$DefaultPerlPath = "/usr/local/bin/perl";    # default value
$PerlPath = "/usr/local/bin/perl";           # maybe overriden

$DefaultLibDir = "lib";
$LibDir = "lib";

# メンバ変数

=head1 MEMBER VARIABLES

 setup_file         setup filename
 yes                force yes

=cut

attributes qw(setup_file start_message yes used_classes
	      items
	      confirmed
	      first_install);

################################################################

=head1 MEMBER FUNCTIONS

=cut

sub initialize($)
{
    my $self = shift;
    $self->setup_file("$ENV{'HOME'}/.setup")
	unless $self->setup_file;
    $self->items({});
    $self->SUPER::initialize;
}

sub Do($)
{
    my $self = shift;

    $self->AddDefaultItems;
    $self->QuestionToUser;
    $self->DoInstall;
}

=head2 $i->LoadSetup;
=head2 $i->LoadSetup($readonly_setupfile);

read setup file.
if $readonly_setupfile is set,
read from the file.

=cut

sub LoadSetup($;$)
{
    my ($self, $filename) = @_;

    $filename ||= $self->setup_file;
    unless (open(F, $filename)){
	$self->first_install(1);
	return;
    }
    while (<F>){
	next if (/^$/ || /^\#/);
	chomp;
	my ($var, $cont) = split(/\t+/);
	if (ref $self->items->{$var}){
	    $self->items->{$var}->data($cont);
	    $self->items->{$var}->loaded(1);
	}
    }
    close F;
}

=head2 $i->SaveSetup;

save to setup file

=cut

sub SaveSetup($)
{
    my $self = shift;

    open(F, ">" . $self->setup_file) || die "can't write to setup file: " . $self->setup_file;
    my ($key, $cont);
    while (($key, $cont) = each(%{$self->items})){
	print F "$key	" . $cont->data . "\n";
    }
    close F;
}

=head2 $i->Confirm;

confirm configuration.
if OK, return true.

=cut

sub Confirm($)
{
    my $self = shift;

    for (sort {$self->items->{$a}->num <=> $self->items->{$b}->num}
	 keys %{$self->items}){
	my $item = $self->items->{$_};

	next if $item->unshow; # || $item->name =~ /^_/;
	print $item->AsConfirm;
    }
    if ($self->yes){
	return 1;
    } else {
	my $yn = InputYN("OK", $self->confirmed);
	$self->confirmed(1);
	return $yn;
    }
}

=head2 $i->WritePerlHeader($ph_file, $package_name, $footer);

指定した perl header に設定を書き込む。

 package $package_name;

と先頭に記述。
$footer が渡されれば末尾に追加。
一番最後には必ず

 1;

が追加される。

=cut

sub WritePerlHeader ($$$;$$)
{
    my ($self, $ph_file, $package_name, $footer, $add_mode) = @_;
    
    # create backup file
    if (-f $ph_file){
	copy($ph_file, "${ph_file}-old");
	print "backup $ph_file\n";
    }

    my $line;
    if ($add_mode eq 'package' && $package_name){
	$line = "package $package_name;\n\n";
    }
    for (@{$self->used_classes}){
	$line .= "use $_;\n";
    }
    for (sort {$self->items->{$a}->num <=> $self->items->{$b}->num}
	 keys %{$self->items}){
	my $key = $_;
	my $item = $self->items->{$key};
	next if $key =~ /^_/ || $item->unsave;
	if ($add_mode eq 'variable' && $key !~ /::/){
	    my $pkg = $item->class || $package_name;
	    $key = "${pkg}::$key";
	}
	my $data = $item->data;
	# print "$key, $data:";
	if ($data =~ /^(?:\d+)(?:\.\d+)?$/){    # 数字
	    $line .= "\$$key = $data;\n";
	    # print "digit\n";
	} else {
	    $line .= qq(\$$key = q($data);\n);
	    # print "string\n";
	}
    }
    $line .= $footer;
    $line .= "1;\n";
    jconv(\$line, 'euc');
    open(F, ">$ph_file") || die "can't write : $ph_file";
    print F $line;
    close F;
}
################################################################
# Item に対する操作

=head2 $i->AddItem(%ass);

項目を追加。
属性値をハッシュで渡す。

=cut

sub AddItem($%)
{
    my ($self, %ass) = @_;

#    $self->items->{$item->name} = $item;
    $self->items->{$ass{name}} = new Installer::Item(%ass);
}

=head2 $i->GetItem($name);

項目 $name へのリファレンスを返す

=cut

sub GetItem($$)
{
    my ($self, $name) = @_;

    # チェック
    die "no such item: $name"
	unless $self->items->{$name};
    return $self->items->{$name};
}

=head2 $i->Input($name);

項目 $name を入力する

=cut

sub Input ($$)
{
    my ($self, $name) = @_;

    if ($self->yes){
	return $self->GetItem($name)->data;
    } else {
	$self->GetItem($name)->Input;
    }
}

=head2 $i->Get($name);

項目 $name の値(data)を取得する

=cut

sub Get($$)
{
    my ($self, $name) = @_;

    $self->GetItem($name)->data;
}

=head2 $i->Set($name, $value);

項目 $name の値(data) に $value をセットする

=cut

sub Set($$$)
{
    my ($self, $name, $value) = @_;

    $self->GetItem($name)->data($value);
}

sub AskUser($)
{
    my $self = shift;
    # must be override
}
sub Install($)
{
    my $self = shift;
    # override
}

################################################################
# CGI をインストールする
# $PerlPath, $LibDir がデフォルトと異なる設定がされていたら、
# それらを変換したのちインストールする
sub InstallCGI($$$){
    my ($self, $cgi, $dir) = @_;

    my @files;
    unless (ref $cgi){
	@files = ($cgi);
    } else {
	@files = @$cgi;
    }
    for (@files){
	my $file = $_;
	if ($PerlPath ne $DefaultPerlPath ||
	    $LibDir ne $DefaultLibDir){
	    # 最初の一行を "#!$PerlPath" に変換
#	    my $tmpdir = $ENV{'TMP'} || $ENV{'TEMP'} || '/tmp';
	    my $tmpdir = "/tmp";
	    makedir($tmpdir);

	    # 一旦一時ファイルに吐く
	    my $tmpfile = $file;
	    $tmpfile =~ s!^.*/!! if $file =~ m!/!;
	    $tmpfile = "$tmpdir/$tmpfile";
	    open(IN, $file) || die "$file";
	    open(OUT, ">$tmpfile") || die "$tmpfile";
	    my @lines = <IN>;
	    
	    # 最初の一行
	    my $first_line = shift(@lines);
	    die "illegal: '$file' not begin with '\#!': $first_line"
		unless $first_line =~ /^\#!/;
	    print OUT "#!$PerlPath\n";

	    if ($LibDir ne $DefaultLibDir){
		for (@lines){
		    if (/^use lib/ && !/NOCONV/){    # library dir の変換
			print OUT "use lib q($LibDir);\n";
		    } else {
			print OUT $_;
		    }
		}
	    } else {
		print OUT @lines;
	    }
	    close (OUT);
	    close (IN);
	    $self->InstallFile($tmpfile, $dir, 'FORCE', 0755);
	    unlink($tmpfile);
	} else {
	    $self->InstallFile($file, $dir, 'FORCE', 0755);
	}
    }

}
# ディレクトリ丸ごとインストール
sub InstallDir($$$$)
{
    my ($self, $src_dir, $dst_dir, $mode) = @_;
    makedir($dst_dir, 0755);
    
    find(sub {
	return if (/~$/ || /\.\.?$/);
	my $name = $File::Find::name;
	return if ($name =~ /CVS/);
	
	if (-d $_){
#	    makedir("$dst_dir/$name", 0755);
	} elsif (-f $_){
#	    my $dir = "$dst_dir/$name";
#	    $dir =~ s!^(.*)/.*!$1!;
	    my $tmp = $name;
	    $tmp =~ s!^$src_dir/!!;    # $src_dir
	    $tmp = dirname $tmp;
	    my $dir = "$dst_dir/$tmp";
	    $self->InstallFile($_, $dir, $mode);
	}}
	 , $src_dir);
}
sub InstallFile($$$$;$)
{
    my ($self, $file, $dir, $mode, $perm) = @_;
    # ディレクトリが無かったら作る
    makedir($dir, 0755);
    # 指定がなければ 0644 に
    # $perm ||= 0644;
    $perm = 0644 unless defined($perm);

    my @files;
    unless (ref $file){
	@files = ($file);
    } else {
	@files = @$file;
    }
    for (@files){
	my $file = $_;
	my $filename = $file;
	$filename =~ s!^(.*)/(.*)$!$2!;
	unless (-f "$dir/$filename"){                # ファイルが無ければコピー
	    copy($file, "$dir/$filename");
	} else {                                 # あった場合は、、
	    # モードを修正
	    my $t_mode = $mode;
	    if ($mode =~ /^CONFIRM(_NO)?/){             # 確認する(EXIST or BACKUP)
		my $default_no = $1;
		if ($self->yes){
		    $t_mode = ($default_no) ? 'EXIST' : 'BACKUP';
		} else {
#		    if (newer($file, "$dir/$file")){
		    if (-f $file){
			my $do = InputYN("$dir/$filename overwrite ?", !$default_no);
			$t_mode = ($do) ? 'BACKUP' : 'EXIST';
		    } else {
			$t_mode = 'EXIST';
		    }
		}
	    }
	    # コピー実行
	    if ($t_mode eq 'EXIST'){               # 存在するものを優先
		print "exist $dir/$filename.\n";
	    } elsif ($t_mode eq 'FORCE'){          # 強制上書き
		print "overwrite $dir/$filename.\n";
		copy($file, "$dir/$filename");
	    } elsif ($t_mode eq 'BACKUP'){         # バックアップ生成
		print "backup to $dir/$filename-old.\n";
		copy("$dir/$filename", "$dir/$filename-old", quiet=>1);
		copy($file, "$dir/$filename");
	    } else {
		die "install_file(): illegal mode: $mode($filename)\n";
	    }
	}
	chmod($perm, "$dir/$filename");
    }
}
################################################################

=head2 $i->Attention($msg);

警告メッセージ $msg を表示する

=cut

sub Attention($$)
{
    my ($self, $msg) = @_;

    print "ATTENTION: $msg\n";
}
sub makedir($;$)
{
    my ($dir, $perm) = @_;
    $perm = 0755 unless defined $perm;

    my @dirs;
    unless (ref $dir){
	@dirs = ($dir);
    } else {
	@dirs = @$dir;
    }
    for (@dirs){
	unless (-d $_){
	    mkpath($_, 0, $perm) || die "cannot create : $_";
	    print "$_ created.\n";
	}
    }
    return 1;
}
sub newer($$)
{
    my ($base, $obj) = @_;
    
    my ($base_size, $base_lm) = (stat($base))[7,9];
    my ($obj_size, $obj_lm) = (stat($obj))[7,9];

    if (($base_lm > $obj_lm) &&
	($base_size == $obj_size)){
	return 1;
    } else {
	return 0;
    }
}    
sub copy($$;$)
{
    my ($src, $dst, %opt) = @_;

    die unless -f $src;
#    unless (newer($src, $dst)){
#	print "skip: $src and $dst are same l-m and size\n"
#	    unless $opt{'quiet'};
#	return 0;
#    }
    open(SRC, $src) || die "src: $src";
    open(DST, ">$dst") || die "dst: $dst";
    if ($src =~ /\.gif$/ || $src =~ /\.jpe?g$/){
	binmode(SRC);
	binmode(DST);
    }
    print DST <SRC>;
    close DST;
    close SRC;
    return 1;
}
sub which($)
{
    my $command = shift;

    my $os = $^O || "Unix";
    
    my ($path_sep, $dir_sep, $ext) = ($os eq 'MSWin32') ?
	(';', '\\', '.exe')  : # DOS/Win32
	    (':', '/');        # UNIX

    for (split($path_sep, $ENV{'PATH'})){
	my $file = "$_$dir_sep$command$ext";
	if (-x $file){
	    return $file;
	}
    }
    return undef;
}
1;
