#! /usr/bin/perl

use strict;
use Getopt::Long;
use File::Copy;
use File::Find;
use File::Spec;
use File::ShareDir;


import File::Copy::Recursive 'rcopy';

sub mirror;
sub recursive(&@);

Getopt::Long::Configure ('no_ignore_case');

my ($opt_docroot, $opt_skindir, $opt_imagedir, $opt_icondir, $opt_help, $opt_jsdir, $opt_cgibin, $opt_absolute_cgibin, $opt_static_uri_script, $opt_pack);
my @copy_argv = @ARGV;

GetOptions (
	'docroot=s'           => \$opt_docroot,
	'skindir=s'           => \$opt_skindir,
	'imagedir=s'          => \$opt_imagedir,
	'icondir=s'           => \$opt_icondir,
	'jsdir=s'             => \$opt_jsdir,
	'cgibin=s'            => \$opt_cgibin,
    'absolute_cgibin=s'   => \$opt_absolute_cgibin,
	'static_uri_script=s' => \$opt_static_uri_script,
	'packjs'              => \$opt_pack,
	'help'                => \$opt_help,
) or exit 1;

display_help() if $opt_help;

usage_error("The option '--docroot' is mandatory.") unless $opt_docroot;

my $docroot = File::Spec->rel2abs($opt_docroot);
die "$docroot: $!" unless -d $docroot;

sanitize($opt_cgibin, $opt_absolute_cgibin, $opt_jsdir, $opt_skindir, $opt_imagedir, $opt_icondir, $opt_static_uri_script);

my $cgibin = $opt_absolute_cgibin || $docroot . ($opt_cgibin || '/cgi-bin');

my $jsdir    = $opt_jsdir    || '/iwl/jscript';
my $skindir  = $opt_skindir  || '/iwl/skin';
my $imagedir = $opt_imagedir || '/images';
my $icondir  = $opt_icondir  || '/images/icons';

my $full_jsdir    = $docroot      . $jsdir;
my $full_skindir  = $docroot      . $skindir . '/default';
my $full_imagedir = $full_skindir . $imagedir;
my $full_icondir  = $full_skindir . $icondir;

my $static_script = $opt_static_uri_script ? $opt_static_uri_script . '?IWLStaticURI=' : '';

die "$cgibin: $!" unless -d $cgibin;

create_conf_file();

require IWL;
my $sharedir    = File::ShareDir::module_dir('IWL');
my $sharejs     = $sharedir . '/jscript';
my $shareskin   = $sharedir . '/skin';
my $shareimages = $sharedir . '/images';
my $shareicons  = $sharedir . '/icons';

require Pack if $opt_pack;

mirror $sharedir . '/iwl_demo.pl', $cgibin;
mirror $sharejs                  , $full_jsdir;
mirror $shareskin                , $full_skindir;
mirror $shareimages              , $full_imagedir;
mirror $shareicons               , $full_icondir;

chmod 0755, $cgibin . '/iwl_demo.pl';

prefix_replace(
    $full_skindir . '/main.css',
    $full_skindir . '/ie6.css',
    $full_icondir . '/iepngfix.htc'
);

#######################################################################
# PREFIX replace subroutine {{{
#######################################################################
sub prefix_replace {
    my $image = $static_script . $skindir . '/default' . $imagedir;
    my $icon  = $static_script . $skindir . '/default' . $icondir;

    sanitize($image, $icon);
	return if $image eq '/iwl/skin/default/images' && $icon eq '/iwl/skin/default/images/icons';

    foreach my $file (@_) {
        next unless -f $file && -r $file && -w $file;
        local *FILE;
        my $content = '';
        open FILE, $file;
        while (<FILE>) {
			$_ =~ s,(?<=\W)/iwl/skin/default/images(?!/icons),$image,;
			$_ =~ s,(?<=\W)/iwl/skin/default/images/icons,$icon,;
            $content .= $_;
        }
        close FILE;

        open FILE, "> $file";
        print FILE $content;
        close FILE;
    }
}
#######################################################################
# PREFIX replace subroutine }}}
#######################################################################

#######################################################################
# Conf creation subroutine {{{
#######################################################################
sub create_conf_file {
    my $sep = $";
    $" = "' '";
    my $content = <<EOF;
# Installated using:
#   $0 '@copy_argv'
#
EOF
    $" = $sep;

    $content .= <<EOF;
# The skin name to use
# 
# SKIN = "default"

# The directory, containing the skins. It is relative to the server document
# root
#
SKIN_DIR = "$skindir"

# The directory, containing the images. It is relative to the skin directory
#
IMAGE_DIR = "$imagedir"

# The directory, containing the icons. It is relative to the skin directory
#
ICON_DIR = "$icondir"

# The icon extension
#
# ICON_EXT = "gif"

# The directory, containing all javascript files. It is relative to the server
# document root
#
JS_DIR = "$jsdir"

# The level of strictness. If greater than 1, attribute names will be checked,
# and an exception will be thrown in case the name is illegal
#
# STRICT_LEVEL = "1"
EOF
    if ($opt_static_uri_script) {
        $content .= <<EOF

# The path to the static URIs handling script. It is relative to the document
# root
#
STATIC_URI_SCRIPT = "$opt_static_uri_script"

# The absolute path to the document root
#
DOCUMENT_ROOT = "$docroot"
EOF
    }

    my $conf_name = $cgibin . '/iwl.conf';
    $conf_name .= '.new' if -s $conf_name;
    local *CONF;

    open (CONF, "> $conf_name") or die "Couldn't open $conf_name: $!\n";  
    print CONF $content;
    close CONF;
}
#######################################################################
# Conf creation subroutine }}}
#######################################################################

#######################################################################
# Info subroutines {{{
#######################################################################
sub display_help {
	die <<EOF;
Usage: $0 [OPTIONS]
    -d, --docroot=DIR       the server document root
    -h, --help              print this help message

    Optional:
        -j, --jsdir=URI     the javascript dir, relative to the document root
        --skindir=URI       the skins dir, relative to the document root
        --imagedir=URI      the image dir, relative to the default skin dir
        --icondir=URI       the icon dir, relative to the default icon dir

        -c, --cgibin=URI    the cgi-bin directory, relative to the document root
                            /cgi-bin is assumed if none is specified

        --absolute_cgibin=DIR
                            the absolute path to the server's cgi-bin directory

        --static_uri_script=SCRIPT
                            the static script path, relative to the
                            document root

        --packjs            if specified, will pack all JavaScript files using
                            Pack. This option is for TESTING purposes only!
                            (http://dean.edwards.name/download/#packer)
                            

EOF
	exit 0;
}

sub usage_error {
	my $message = shift;
	if ($message) {
		$message =~ s/\s+$//;
		$message = "$message\n\n";
	} else {
		$message = '';
	}
	die <<EOF;
${message}usage: $0 [OPTIONS]
try '$0 --help' for more information!
EOF
}
#######################################################################
# Info subroutines }}}
#######################################################################

#######################################################################
# File::Mirror {{{
#######################################################################
sub recursive(&@) {
    my ($code, $src, $dst) = @_;
    my @src = File::Spec->splitdir($src);
    pop @src unless defined $src[$#src] and $src[$#src] ne '';
    my $src_level = @src;
    find({ wanted => sub {
               my @src = File::Spec->splitdir($File::Find::name);
               my $from = File::Spec->catfile($src, @src[$src_level .. $#src]);
               my $to = File::Spec->catfile($dst, @src[$src_level .. $#src]);
               $code->($from, $to);
           },
           no_chdir => 1,
         },
         $src,
        );
}

sub packjs {
    my ($from, $to) = @_;
    my $old = $/;
    local *INFILE;
    local *OUTFILE;
    open INFILE, "$from" or return;
    open OUTFILE, "> $to" or return;
    undef $/;
    my $js = <INFILE>;
    close INFILE;

    $/ = $old;

    print OUTFILE Pack::pack($js, 62, 1, 0);
    close OUTFILE;
}

sub mirror {
    mkdir_p($_[1]);
    recursive {
        -d $_[0]
          ? do { mkdir($_[1]) unless -d $_[1] }
          : $opt_pack && substr($_[0], -3) eq '.js'
            ? packjs(@_)
            : copy(@_) 
    } @_;
}
#######################################################################
# File::Mirror }}}
#######################################################################

#######################################################################
# File subroutines {{{
#######################################################################
sub mkdir_p {
    my $path = shift;
    my @path = File::Spec->splitdir($path);
    my $partial = $path[0];
    mkdir $partial or die "$partial: $!\n"
      unless -d $partial || !$partial;
    foreach (@path[1 .. $#path]) {
        $partial = File::Spec->catdir($partial, $_);
        mkdir $partial or die "$partial: $!\n"
          unless -d $partial;
    }
}

sub sanitize {
    foreach (@_) {
        $_ = '/' . $_ if $_ && index $_, '/';
        $_ =~ s{/+}{/}g;
    }
}

#######################################################################
# File subroutines }}}
#######################################################################
