use strict;
use Fcntl;

use constant CF_CACHE  => '.cf.cache';
use constant BLOCKSIZE => 8192;

use DBIShell::UTIL qw(get_param);

use constant BUNDLED_LIB_DIRS => ('DBIShell'     ,
				  'DBIShell/dr'  ,
				  'DBIShell/help',
				  'Gtk'          ,
				  'DBIShell/Gtk' ,
				 );

use constant EXTRA_DATA_DIRS  => ('icons');

use vars qw(*SH *TH *CF);
#use vars qw($DDIR $BDIR);
#use vars qw($PERL $IDIR $LDIR);

sub interpolate_and_copy ($$$);

my(%RH);
my($dirent);

# this sould all get defaults from the makefile,
# but some people don't read the docs [or run the Makefile]
# so for them we add defaults here:
$CF{PERL} = $ARGV[0] || '/usr/bin/perl';
$CF{IDIR} = $ARGV[1] || '/usr/local/dbishell';
$CF{LDIR} = $ARGV[2];
$CF{PFIX} = $ARGV[3] || '';

# load defaults from config cache:
if(sysopen(*CF, CF_CACHE, O_RDONLY))
{
    while(<CF>) { /^(\w+)=(.*)/ && ($CF{$1} = $2) }
    close(*CF);
}

# couple of basic questions, default to answers from cache:
$CF{PERL} = get_param("Where does your perl live? [$CF{PERL}] : ")
  || $CF{PERL};
$CF{IDIR} = get_param("Where should I install dbishell? [$CF{IDIR}] : ")
  || $CF{IDIR};

# construct sensible defaults for anything still missing:
$CF{BDIR} ||= join('/',$CF{IDIR},'bin');
$CF{LDIR} ||= join('/',$CF{IDIR},'lib');
$CF{DDIR} ||= join('/',$CF{IDIR},'share/doc/dbishell');
$CF{SDIR} ||= join('/',$CF{IDIR},'share/dbishell');

# Ok - now the user gets a chance to override:
$CF{BDIR}
  = get_param("Where should I install the dbishell script? [$CF{BDIR}] : ")
  || $CF{BDIR};
$CF{LDIR}
  = get_param("Where should I install the dbishell libs?   [$CF{LDIR}] : ")
  || $CF{LDIR};
$CF{DDIR}
  = get_param("Where should I install the dbishell docs?   [$CF{DDIR}] : ")
  || $CF{DDIR};
$CF{SDIR}
  = get_param("Where should I install extra data files?    [$CF{SDIR}] : ")
  || $CF{SDIR};

# save state to cache:
if(sysopen(*CF, CF_CACHE, O_WRONLY|O_CREAT|O_TRUNC))
{
    foreach (keys(%CF)) { print(CF "$_=$CF{$_}\n") }
    close(*CF);
}

# make install paths or die:
mkdirhier($CF{IDIR}, 0755) || exit(0);
mkdirhier($CF{BDIR}, 0755) || exit(0);
mkdirhier($CF{DDIR}, 0755) || exit(0);
mkdirhier($CF{LDIR}, 0755) || exit(0);
mkdirhier($CF{SDIR}, 0755) || exit(0);

foreach my $dir (BUNDLED_LIB_DIRS)
{
    mkdirhier(join('/', $CF{LDIR}, $dir), 0755) || exit(0);
}

foreach my $dir (EXTRA_DATA_DIRS)
{
    mkdirhier(join('/', $CF{SDIR}, $dir), 0755) || exit(0);
}

#-d($IDIR)            || mkdir($IDIR, 0755);
#-d($LDIR)            || mkdir($LDIR, 0755);
#-d("$LDIR/DBIShell") || mkdir("$LDIR/DBIShell", 0755);

$RH{PERL} = $CF{PERL};
$RH{LDIR} = $CF{LDIR};
$RH{SDIR} = $CF{SDIR};

interpolate_and_copy('LICENSE'        , "$CF{DDIR}/LICENSE"        , 0444);
interpolate_and_copy('LICENSE'        , "$CF{DDIR}/README"         , 0444);
interpolate_and_copy('dbishell'       , "$CF{IDIR}/bin/dbishell"   , 0555);
interpolate_and_copy('dbigtk'         , "$CF{IDIR}/bin/dbigtk"     , 0555);
interpolate_and_copy('DBIShell.pm'    , "$CF{LDIR}/DBIShell.pm"    , 0444);
#unnecessary?
#interpolate_and_copy('DBIShell/Gtk.pm', "$CF{LDIR}/DBIShell/Gtk.pm", 0444);

foreach my $dir (BUNDLED_LIB_DIRS)
{
    opendir(DH, $dir);
    while ($dirent = readdir(DH))
    {
	if($dirent =~ /^[A-Z_]+.pm$/i)
	{
	    interpolate_and_copy(join('/', $dir,      $dirent),
				 join('/', $CF{LDIR}, $dir, $dirent),
				 0444
				);
	}
    }
    closedir(DH);
}

foreach my $dir (EXTRA_DATA_DIRS)
{
    opendir(DH, $dir);

  DATAFILE:
    while($dirent = readdir(DH))
    {
	if( $dirent =~ /^\./ ) { next DATAFILE }

	copy_file( join('/', $dir, $dirent),
		   join('/', $CF{SDIR}, $dir, $dirent),
		   0444
		 );
    }

    closedir(DH);
}

sub mkdirhier ($)
{
    my($target,@target,$T,$mode);

    $target    =  $CF{PFIX} . $_[0];
    $mode      =  $_[1];

    ($T,@target) =
      ($target =~ /^\//) ?
	(undef(), split(/\//,$target)) :
	  split(/\//,$target);

    #warn("mkdirhier($target)\n");

  DIRECTORY:
    foreach (@target)
    {
	$T =  join('/', $T, $_);
	#warn("$T\n");
	-d($T) ?
	  next DIRECTORY :
	    (mkdir($T, $mode)
	     || (warn("mkdir($T, $mode): $!\n"),return 0));
    }

    return 1;
}

sub interpolate_and_copy ($$$)
{
    my $sh = local(*SH);
    my $th = local(*TH);
    my ($src,$dst,$mode) = @_;

#    warn("i_a_c(@_)\n");
    sysopen($sh, $src, O_RDONLY)
      || die("sysopen($src) failed: $!\n");
    unlink($CF{PFIX}.$dst);
    sysopen($th, $CF{PFIX}.$dst, O_WRONLY|O_CREAT|O_TRUNC|O_EXCL, $mode)
      || die("sysopen($dst) failed: $!\n");

    while (<$sh>)
    {
	if(m/^#::(.*)/s)
	{
	    $_ = $1; s/<%(\w+)%>/$RH{$1}/g;
	}
	print($th $_);
    }

    close($th);
    close($sh);
}

sub sysprnt ($$$)
{
    my $done = 0;
    my($fh,$data,$len) = @_;

    while( $done < $len )
    {
	my $d  = syswrite($fh, $data, $len, $done);
	$done += defined($d) ? $d : die("syswrite() failed: $!\n");
    }
}

sub copy_file ($$$)
{
    my $buf = ' ' x BLOCKSIZE;
    my $sh  = local(*SH);
    my $th  = local(*TH);
    my ($src,$dst,$mode) = @_;

    sysopen($sh, $src, O_RDONLY)
      || die("sysopen($src) failed: $!\n");
    unlink($dst);
    sysopen($th, $CF{PFIX}.$dst, O_WRONLY|O_CREAT|O_TRUNC|O_EXCL, $mode)
      || die("sysopen($dst) failed: $!\n");

    while(sysread($sh, $buf, BLOCKSIZE) > 0)
    {
	sysprnt($th, $buf, length($buf));
    }

    close($th);
    close($sh);
}

__END__