#!/usr/bin/perl
#
#########################################################################
####                                                                #####
####                     SET-UP CONFIG STATS                        #####
####                                                                #####
####                                                                #####
####    domisse@w3perl.com                   version 26/06/2013     #####
####                                                                #####
#########################################################################
#

### In order to install w3perl, you just need to fill :
# 1) Perl path (first line of this script)
# 2) W3Perl cgi path (where the scripts will be installed)
# 3) W3Perl install path (where the package have been extracted)

### This script need to be run as root as it need to create a 
# directory in your cgi directory (root owner).

### If you want to install this package as a user, you'll first
# need to create manually a sub-directory (usually /w3perl/) in 
# your cgi : $pathcgi and own it to yours.  Then run the install.pl 
# script as the same user.

### 1) PERL Path (Unix only) :
# edit to reflect the location of Perl on your host
# usually /usr/local/bin/perl or /usr/bin/perl
# change if need the first line of this script 

### 2) $pathcgi is the path where the perl scripts will be
# installed. It should be somewhere inside your server cgi-bin directory.
# It's a good idea to place the scripts inside a /w3perl/ subdirectory.
# Usual Windows path is C:/Inetpub/wwwroot/cgi-bin/w3perl
# Unix path could be something like /var/www/cgi-bin/w3perl
# Your cgi path should at least have the word 'cgi' to be extracted later
# (/cgi-local/ or /richardsoncgi/ is ok, /binary-script/ not)
# (if you don't have cgi-bin, leave $pathcgi empty)

$pathcgi = "/var/w3perl/cgi-bin/w3perl";

### 3) $pathw3perl is the path where the package have been installed
# it should be somewhere inside your webserver root.
# Usual Windows path is C:/Inetpub/wwwroot/w3perl
# Unix path could be something like /var/www/html/w3perl
#

$pathw3perl = "/home/domisse/public_html/w3perl";

### ScriptAlias directory (Used with automatic mode : flag -a)
### Will extract ScriptAlias value (pathcgi) using $repcgi keyword
$repcgi = "cgi-bin"; # default value

### User directory alias (UserDir) if mod_userdir is enabled
$tildealias = "";

###
#########################################################################
### Do not change anything below this line
#########################################################################
###

$scriptname = $0;
$version = "3.18"; 
$verdate = "05/06/13";

#require "getopt.pl";
use Getopt::Std;
use Cwd;

#$status = getopts('abd:efg:hi:o:p:r:s:t:uvx');
$status = getopts('abd:efg:hi:o:p:r:uvx');
if (!($status)) {
    $msg = "Missing flag argument";
    print "$msg\n";
    exit;
#    &error_exit($msg);
}


#&Getopt('cdgijlopqrst');       

### First check you don't want to install the package into itself !
if ($pathcgi =~ /^$pathw3perl/ && $pathcgi ne '') {
    print "\nERROR : You should install W3Perl in your web server cgi directory\n";
    print "Change \$pathcgi according to your web server configuration\n\n";
    exit;
}

$nocgi = 0;
if ($pathcgi eq '') {
    $pathcgi = $pathw3perl;
    $nocgi = 1;
}

### Install w3perl on virtual hosts (manually)
# if you want to install w3perl on a virtual host,
# you should specify the server name, logfile path and virtual web root
#

$virtual_web = "/usr/local/etc/first/htdocs";
$virtual_web_log = "/usr/local/etc/first/logs";
$virtual_www = "www.first.com";

##################
# My own setting # (to set tildealias empty for everyone else !).
##################

$w3perlcgi_default = "/var/w3perl/cgi-bin/w3perl";
$w3perlweb_default = "/home/domisse/public_html/w3perl";

if ($pathw3perl eq $w3perlweb_default && $pathcgi eq $w3perlcgi_default) {
#if ($pathw3perl =~ /^\/home\/domisse\/public_html/ && $pathcgi =~ /^\/var\/w3perl\/cgi-bin\/w3perl/) {
    $tildealias = "public_html";
}


#############
# Perl path #
#############

unless (defined $perlpath) {
        open(ME,$0) || die "Can't open $0\n";
        $perlpath = <ME>;
        $perlpath =~ s/^#\!\s*(.*)\/perl(.*)\n$/$1/;
        close(ME);
}

#################################################
# Check default value have been changed by user #
#################################################

$enable_check_w3perl = 0;
#$w3perl_on = 0;
#$w3perl_on = 1 if ($pathw3perl =~ /\/home\/domisse\//);

if ($enable_check_w3perl == 1 && $opt_g eq '' && $opt_a eq '' && $opt_i eq '' && ($0 =~ /install\.pl$/))  {
    if ($pathw3perl eq "" || $pathw3perl =~ /\/home\/domisse\//) {
	print "You should change the default value of \$pathw3perl with your own value\n\n";
	exit;
    }
}

########
# init #
########

$fly_bin = "fly.exe";
$wget_bin = "wget.exe";
$gzip_bin = "gzip.exe";
$bzip2_bin = "bzip2.exe";
@win_bin = ('fly.exe','wget.exe','gzip.exe','bzip2.exe');
@lib_dll = ('bzip2.dll','libeay32.dll','libiconv2.dll','libintl3.dll','libssl32.dll');
$dirtools = "tools";
$dirwin = "windows";
$dirconfig = "config";
$dirresources = "resources";
$diradmin = "admin";
$locconf = "locconf";
$locconf_default = "locconf.default";
#$config_iis = "config-iis";  # Generic IIS configuration file
#$config_win = "config-win";  # Generic windows configuration file
$verbose = 1;
$plext = ".pl";  # Perl extension
$dirsep = "/";   # string separator
$dirsepurl = "/";   # string separator
$mode = 0755;
$pagegraph = "pagegraph".$plext;
$dayrange = "dayrange".$plext;
$pagesend = "pagesend".$plext;
$pathflyrpm = "/usr/bin/";
$exeext = "";
$filepass = "pass.txt";
$filepass_default = "pass.txt.default";
$upgrade_file = "upgrade.txt";

# Apache configuration file

$scriptalias = "ScriptAlias";
#$perlpathtest = `/usr/bin/which perl`;
@apacheconf = ('httpd.conf','srm.conf','apache.conf','httpd2.conf','000-default'); # file where ScriptAlias directive is set
#@apacheconf = ('httpd.conf','srm.conf','apache.conf'); # file where ScriptAlias directive is set
@location = ('/usr/local/etc/httpd/conf/','/etc/conf/','/home/httpd/conf/','/usr/local/etc/apache/','/var/lib/apache/conf/','/etc/httpd/conf/','/etc/apache2/sites-enabled/','/etc/apache/conf/');

$fileconf = $location[0].$apacheconf[0]; # default;

# Directory w3perl output for windows config
$stat_dir_output = "w3stats";

###############
# RPM Default #
###############

$delete_files = 0;
$distrib = 0;

if ($opt_r ne '') {
    $delete_files = 0;
    $pathcgi = $opt_d;
    $pathcgi =~ s/$opt_r//;
    $pathw3perl = $opt_i;
    $pathw3perl =~ s/$opt_r//;
#    $pathcgi = "/var/www/cgi-bin/w3perl"; # Mandriva
#    $pathw3perl = "/var/www/w3perl"; # Mandriva
    $distrib = 1;
#    $delete_files = 0 if ($0 !~ /upgrade\.pl/);
#    $delete_files = 1 if ($0 =~ /upgrade\.pl/);
}

#################################################################
###            parsing the command line option                ###
#################################################################

if ($opt_h) {
      print STDOUT "Usage : \n";
      print STDOUT "        -a                             : autoinstall (main server)\n";
      print STDOUT "        -b                             : autoinstall (virtual host)\n";
      print STDOUT "        -d <w3perl cgi path>           : w3perl cgi directory\n";
      print STDOUT "        -f                             : this script located in cgi (FTP install)\n";
      print STDOUT "        -i <w3perl path>               : w3perl directory\n";
      print STDOUT "        -j <apache config file>        : load apache configuration file\n";
      print STDOUT "        -u                             : autoinstall for virtual hosts\n";
      print STDOUT "        (use current cgi directory to detect virtual host)\n";
      print STDOUT "        -e                             : autoinstall for all virtual hosts\n";
      print STDOUT "        -g <file>                      : use NSIS config\n";
      print STDOUT "        -o <stats_dir>                 : stat output directory (virtual host)\n";
      print STDOUT "        -r                             : install from spec file\n";
#      print STDOUT "        -s                             : install tree build (debian)\n";
#      print STDOUT "        -t                             : move install scripts instead of copy\n";
      print STDOUT "        -x                             : show default value for flag options\n";
      print STDOUT "        -v                             : version\n";
      print STDOUT "\n";
      exit;
}

if ($opt_v) {
      print STDOUT "install.pl - version $version - $verdate\n";
      exit;
}

if ($opt_d ne '') {
    $pathcgi = $opt_d;
}

if ($opt_i ne '') {
    $pathw3perl = $opt_i;
}

if ($opt_j ne '') {
    $fileconf = $opt_j;
}

if ($opt_o ne '') {
    $dir_stat_output = $opt_o;
}

if ($opt_x) {
      print STDOUT "Default : \n";
      print STDOUT "          -a               : ";
      &id($opt_a);
      print STDOUT "          -b               : ";
      &id($opt_b);
      print STDOUT "          -d               : $pathcgi\n";
      print STDOUT "          -i               : $pathw3perl\n";
      print STDOUT "          -j               : $fileconf\n";
      print STDOUT "          -u               : ";
      &id($opt_u);
      print STDOUT "          -e               : ";
      &id($opt_e);
      print STDOUT "          -g               : ";
      &id($opt_g);
      print STDOUT "          -o               : $stat_dir_output\n";
      print STDOUT "          -r               : ";
      &id($opt_r);
#      print STDOUT "          -r               : ";
 #     &id($opt_s);
      print STDOUT "          -t               : ";
      &id($opt_t);
      print STDOUT "          -v               : $version\n";
      exit;
}

if ($ENV{'REQUEST_METHOD'} eq "GET") {
        print "Content-type: text/html\n\n";
	print "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\" \"http://www.w3.org/TR/html4/loose.dtd\">\n";
        print "<HTML><HEAD>\n";
        print "<TITLE>Installation</TITLE>\n" if ($0 !~ /upgrade\.pl$/);
        print "<TITLE>Upgrade</TITLE>\n" if ($0 =~ /upgrade\.pl$/);
	print "<meta http-equiv=\"Content-Type\" content=\"text/html; charset=utf-8\">\n";
	# Adding CSS style
	print "<style type=\"text/css\">\n";
	print "body {\n";
	print "background-color: #FCFCFC;\n";
	print "color: #202020;\n";
	print "margin: 10px;\n";
	print "font-family: Verdana, Geneva, Arial, sans-serif;\n";
	print "font-size: small;\n";
        print "}\n";
	print "ul {\n";
	print "list-style-type: square;\n";
        print "padding:0px 5px;\n";
	print "}\n";
	print "h1,h2,h3,h4,h5,h6 {\n";
        print "font-family: verdana, arial, sans serif;\n";
        print "color: #209090;\n";
        print "background: none;\n";
        print "font-weight: normal;\n";
        print "margin: 0;\n";
        print "padding-top: .5em;\n";
        print "padding-bottom: .17em;\n";
        print "}\n";
        print ".item_page {\n";
        print "padding:0px 10px;\n";
        print "text-align: left;\n";
        print "color: #505050;\n";
        print "font-weight: bold;\n";
        print "background-color:#fafafa;\n";
        print "}\n";
	print "</style>\n";
	print "</HEAD>\n";
        print "<BODY BGCOLOR=\"#FFFFFF\" TEXT=\"#000000\">\n";
}

###########
# version #
###########


if ($opt_g eq '') {
#    require "pwd.pl";
#    &initpwd;

    use Cwd;
    $cwd = cwd();

# si upgrade.txt present, on l'utilise

#    $version_config = $ENV{'PWD'}."/VERSION";
#    $upgrade_config = $ENV{'PWD'}."/upgrade.txt";
    $version_config = $cwd."/VERSION";
    $upgrade_config = $cwd."/upgrade.txt";

    if ($opt_i ne '') {
	$version_config = $opt_i."/VERSION";
	$upgrade_config = $opt_i."/upgrade.txt";
    }

    $base_dir_launch = $0;
    $base_dir_launch =~ s/\/upgrade//;
    $base_dir_launch =~ s/\/install//;
    $base_dir_launch =~ s/$plext//;

    # If not launch from cwd
    if (!(-f $upgrade_config)) {
	$version_config = $base_dir_launch."/VERSION";
	$upgrade_config = $base_dir_launch."/upgrade.txt";
    }

    if ($0 =~ /upgrade\.pl$/) {
	if (!(-f $upgrade_config)) {
	    print "Can't upgrade from $cwd : upgrade.txt cannot be found\n";
	    print " - This script must be run from the w3perl install directory\n";
	    print " - If the upgrade.txt have been deleted, setup back install.pl and run it\n";
	    exit;
	}

	open(FILE,"$upgrade_config");
	$a = <FILE>;
	($tmp,$up_perlpath) = split(/\s+/,$a); 
	$a = <FILE>;
	($tmp,$up_pathw3perl,@tmpstr) = split(/\s+/,$a);
	if (scalar(@tmpstr) != 0) {
	    for ($i=0;$i<=$#tmpstr;$i++) {
		$up_pathw3perl .= " ".$tmpstr[$i];
	    }
	}
	$a = <FILE>;
	($tmp,$up_pathcgi,@tmpstr) = split(/\s+/,$a); 
	if (scalar(@tmpstr) != 0) {
	    for ($i=0;$i<=$#tmpstr;$i++) {
		$up_pathcgi .= " ".$tmpstr[$i];
	    }
	}
	close(FILE);

	$pathw3perl = $up_pathw3perl;
	$perlpath = $up_perlpath;
	$pathcgi = $up_pathcgi;
#	if ($pathcgi eq '' || $pathw3perl eq '' || $perlpath eq '' ) {
#	if ($pathcgi eq '' || $pathw3perl eq '') {
	if ($pathw3perl eq '') {
	    print "Abort\n";
	    print "The $upgrade_config is empty. Remove this file please and try again";
	    exit;
	}

	# Find W3Perl version number
	$version_config = $pathw3perl."/VERSION";
###	$upgrade_config = $pathw3perl."/upgrade.txt";

	if (-f $version_config) {
	    open(FILE,"$version_config");
	    $version_w3perl = <FILE>;
	    close(FILE);
	    chop($version_w3perl) if ($version_w3perl =~ /\n$/);
	} else {
	    print "Problem : unable to find $version_config\n";
	    exit;
	}

	if ($version_w3perl eq '' ) {
	    print "Not able to found W3Perl version number in $version_config !\n";
	    exit;
	}

    } else {
	if (!(-f $upgrade_config)) {
	    open(FILE,">$upgrade_config");
	    print FILE "Perl $perlpath\n";
	    $tmp = $pathw3perl;
	    $tmp =~ s/$opt_r// if ($opt_r ne '');
	    print FILE "W3Perl $tmp\n";
	    $tmp = $pathcgi;
	    $tmp =~ s/$opt_r// if ($opt_r ne '');
	    print FILE "CGI $tmp\n";
	    close(FILE);
	} else {
	    print "Installation already completed.\n";
	    print "Run the upgrade.pl script\n";
	    exit;
	}
    }
}


#################################################################
###            some basic checkings                           ###
#################################################################

if ($virtual_www !~ /\d$/) {
    $localdomainename = substr($virtual_www,(index($virtual_www,'.')+1));
    $name_virtual_web = $localdomainename;
} else {
    $localdomainename = substr($virtual_www,0,(rindex($virtual_www,'.')+1));
    $name_virtual_web = $localdomainename;
    print "Warning : Can't compute domain name from a IP address, suggest $localdomainename\n";
}


chop($pathcgi) if ($pathcgi =~ /$dirsep$/);
chop($pathw3perl) if ($pathw3perl =~ /$dirsep$/);

if ($opt_g eq '' && $distrib == 0) {
#    if ($pathcgi ne '' && !(-w $pathcgi)) {
#	print "Will not be able to write W3Perl scripts in your $pathcgi directory\n";
#	print "Check permission\n";
#	unlink($upgrade_config);
#	exit;
 #   }

    if (substr($pathcgi,rindex($pathcgi,$dirsep)+1,length($pathcgi)) eq "cgi-bin") {
	print "WARNING : It\'s safer to use a dedicated directory in your cgi to avoid overwritting others scripts\n";
#    exit;
    }
}

########################################
#         Flags option                 #
########################################

# To check : opt_u ==> master installation should be done first

if ($opt_b ne '') {
    push(@web,$virtual_web);
    push(@www,$virtual_www);
    push(@web_log,$virtual_web_log);
}


if ($opt_g ne '') {

    %iis_w3c_code = ('524288','protocol_version',
		     '262144','refer',
		     '131072','cookie',
		     '65536','agent',
		     '32768','server_port',
		     '16384','elapsed',
		     '8192','bytes_received',
		     '4096','requetesize',
		     '2048','win32 status',
		     '1024','status',
		     '512','query',
		     '256','page',
		     '128','method',
		     '64','server_ip',
		     '32','null',
		     '16','null',
		     '8','login',
		     '4','host',
		     '2','time',
		     '1','date');


    $file = $opt_g;
    &error_open($file) if (!(-r $file));
    open(FILE,"$file");
    while (<FILE>) {
	chop;
	($tmp1,$tmp2) = split(/=/,$_);
	$perlpath = $tmp2 if (/PerlPath=/);
	$perlpath =~ s/\\/\//g;
	$exeext = ".exe";
#	$pathw3perl_url = $tmp2 if (/InstallPath_URL=/);
	$pathw3perl = $tmp2 if (/InstallPath=/);
	$pathw3perl =~ s/\\/\//g;
	$pathcgi = $tmp2 if (/CGIPath=/);
	$pathcgi =~ s/\\/\//g;
	$webroot = $tmp2 if (/WebRoot=/);
	$webroot =~ s/\\/\//g;
	$stat_dir_output = $tmp2 if (/DirOutput=/);
	$web_description = $tmp2 if (/Description=/);
	$iis_logtype = $tmp2 if (/LogType=/);
	$iis_logtype_format = $tmp2 if (/LogTypeFormat=/);
	$ipweb = $tmp2 if (/IP=/);
	$ipweb =~ s/\\/\//g;
	$portweb = $tmp2 if (/Port=/);
	$portweb =~ s/\\/\//g;
	$pathcgi_server = $tmp2 if (/CGIServer=/);
	$pathcgi_server =~ s/\\/\//g;
	$pathlogfile_server = $tmp2 if (/LogFileServer=/);
	$pathlogfile_server =~ s/\\/\//g;
	$config_win = $tmp2 if (/ConfigFile=/);
	$config_win =~ s/\\/\//g;
    }
    close FILE;

# Find W3Perl version number
$version_config = $pathw3perl."/VERSION";

if (-f $version_config) {
    open(FILE,"$version_config");
    $version_w3perl = <FILE>;
    close(FILE);
    chop($version_w3perl) if ($version_w3perl =~ /\n$/);
} else {
    print "Problem : unable to find $version_config\n";
    exit;
}

if ($version_w3perl eq '' ) {
    print "Not able to found W3Perl version number in $version_config !\n";
    exit;
}

print "Extract version : $version_w3perl\n";

###

    if ($iis_logtype =~ /W3C/) {

	$tmp = $iis_logtype_format;
	$iis_logtype_format = '';
	for ($i=19;$i>=0;$i--) {
	    $l = 2**$i;
	    
	    if ($tmp >= $l) {
		$iis_logtype_format = "%$iis_w3c_code{$l} ".$iis_logtype_format;
		$tmp = $tmp - $l;
	    }
	}
	chop($iis_logtype_format);
	$iis_logtype = "W3C";
	$prefixlog = "ex";
    }

    if ($iis_logtype =~ /NCSA/) {
	$iis_logtype_format = "%host %null %login %date %hourshift %method %page %protocol %status %requetesize";
	$iis_logtype = "CLF";
	$prefixlog = "nc";
    }

    if ($iis_logtype =~ /IIS/) {
	$iis_logtype_format = "%host %login %date %time %null %null %null %elapsed %null %requetesize %status %null %method %page %query";
	$iis_logtype = "IIS";
	$prefixlog = "in";
    }

#    open(FILE,"$pathw3perl$dirsep$dirresources$dirsep$diradmin$dirsep$locconf_default");
#    @oldlines = (<FILE>);
#    close(FILE);

#    open(FILE,">$pathw3perl$dirsep$dirresources$dirsep$diradmin$dirsep$locconf_default");
#    foreach $oldline (sort (@oldlines)) {
#	($tmp,$tmp1,$tmp2,$tmp3,$tmp4,$tmp5) = split(/\t/,$oldline);
	# Write Windows config file only
#	if ($tmp3 == 1) {
#	    print FILE "$oldline";
#	}
#   }
#    close(FILE);

    $upgrade_config = $file;
    $upgrade_config =~ s/Config/upgrade/;

    if ($0 !~ /upgrade\.pl$/) {
	if (!(-f $upgrade_config)) {
	    open(FILE,">$upgrade_config");
	    print FILE "Perl $perlpath\n";
	    print FILE "W3Perl $pathw3perl\n";
	    print FILE "CGI $pathcgi\n";
	    close(FILE);
	} else {
	    print "Installation already completed.\n";
	    print "Run the upgrade.pl script\n";
	    exit;
	}
    }

#    ($pathw3perl,$pathcgi) = split(/,/,$opt_g);
#    $pathcgi = $pathcgi."cgi-bin/w3perl";
}

if ($tildealias ne '' && $pathw3perl =~ /$tildealias/) {
    print "\nWARNING : Alias is set to $tildealias. Make sure your web server use UserDir directive (http://httpd.apache.org/docs/2.0/mod/mod_userdir.html)\n\n";
}


##########################
#     NT or Unix ?       #
##########################

$nt = 0;

# On teste le deuxieme caractere (':' sous NT)

$car = substr($pathw3perl,1,1);
$nt = 1 if ($car eq ':');

$user_home_pwd = (getpwuid($<))[7] if ($nt == 0); # Non supporte sous NT !

#################################################
# Unix : looking for apache configuration files #
#################################################

# -a : autoinstall 
# -u : autoinstall (virtual hosts)
# -e : autoinstall on all virtual hosts

if ($opt_a ne '' || $opt_u ne '' || $opt_e || $opt_j ne '') {

# Try to guess from ENV (work only on Unix)

if ($opt_u ne '') {
#    require "pwd.pl";
#    &initpwd;

    # Test si le script est dans le repertoire cgi ou principal
    if ($cwd =~ /cgi/i) {
	$virtual_cgi = $cwd;
#	$virtual_cgi =~ s/www/usr\/local\/etc\/httpd/ if ($azouz == 1);
#	$virtual_cgi =~ s/$user_home_pwd// if ($azouz == 1);
    } else {
	$virtual_web_dir = $cwd;
#	$virtual_web_dir =~ s/www/usr\/local\/etc\/httpd/ if ($azouz == 1);
#	$virtual_web_dir =~ s/$user_home_pwd// if ($azouz == 1);
    }
}

# Try to find cgi-bin path from Apache configuration server

if ($opt_j eq '') {

print "<P><BR><B><LI>" if ($ENV{'REQUEST_METHOD'} eq "GET");
print "Trying to find apache configuration file on Unix ...\n";
print "</B><BR>" if ($ENV{'REQUEST_METHOD'} eq "GET");

# Looking for Apache configuration file

$fileconf = $location[0].$apacheconf[0];

BOUCLE:
for ($j=0;$j<=$#apacheconf;$j++) {
    for ($i=0;$i<=$#location;$i++) {
	$fileconf = $location[$i].$apacheconf[$j];
#	print "$j $i $fileconf\n";
	last BOUCLE if (-f $fileconf);
    }
}

}

# Plusieurs fichiers de conf peuvent etre trouve ==> menu ?

if (-f $fileconf) {
print "Apache configuration file found : ";
print "<I>" if ($ENV{'REQUEST_METHOD'} eq "GET");
print "$fileconf";
print "</I>" if ($ENV{'REQUEST_METHOD'} eq "GET");
print "\n";
print "<BR>" if ($ENV{'REQUEST_METHOD'} eq "GET");

# opt_a (Apache)
# install on main server

if ($opt_a ne '' || $opt_j ne '') {

    $out = 0;

# Exclus les scriptalias des virtualhost

    $pathcgi = '';
    @includeconf = ();
    open(FILE,"$fileconf") || die "Can't open $fileconf\n";
    while (<FILE>) {
	chop;
	$out = 1 if /^\<VirtualHost/i;
	$out = 0 if (/^\<\/VirtualHost/i && $out == 1);
	if (/ScriptAlias/i && /\/cgi-bin\// && $out == 0 && !(/\#/)) {
	    ($tmp,$scriptalias,$repcgi,$pathcgi) = split(/\s+/);
	    if ($tmp ne '') {
		$pathcgi = $repcgi;
	    }
	}
#	($scriptalias,$pathw3perl) = split(/\s+/) if (/^DocumentRoot/i && $out == 0);
	if (/^Include/i && $out == 0) {
	    ($include,$tmp) = split(/\s+/);
	    push(@includeconf,$tmp);
	}
#	$pathw3perl = $pathw3perl.$dirsep.$stat_dir_output;

	$pathw3perl = $cwd;
#	$pathw3perl =~ s/www/usr\/local\/etc\/httpd/ if ($azouz == 1);
#	$pathw3perl =~ s/$user_home_pwd// if ($azouz == 1);
    }
    close(FILE);

    if ($pathcgi eq '') {
#	print "No ScriptAlias directive found with the Include directive\n";
#	exit;
#	print "Will try to find it in @includeconf\n";
	print "Searching ScriptAlias directive\n";
	for ($j=0;$j<=$#includeconf;$j++) {
	    next if ($includeconf[$j] =~ /\*/);
	    $file_include = $includeconf[$i] if ($includeconf[$i] =~ /\//);
	    if ($includeconf[$i] !~ /\//) {
		$tmp = substr($includeconf[$j],rindex($includeconf[$j],$dirsep)+1,length($includeconf[$j]));
		$file_include = $location[$i].$tmp;
	    }
	    print "Scanning $file_include\n";
	    open(FILE_INCLUDE,"$file_include");
	    while (<FILE_INCLUDE>) {
		chop;
		if (/ScriptAlias\s+\/cgi/i && !(/\#/)) {
		    ($tmp,$scriptalias,$repcgi,$pathcgi) = split(/\s+/);
		    if ($tmp ne '') {
			$pathcgi = $repcgi;
		    }
		    #

		}
	    }
	    close(FILE_INCLUDE);
	}
    }

    if ($pathcgi eq '') {
	print "No ScriptAlias directive found with the Include directive\n";
	exit;
    }

    if ($pathcgi !~ /cgi-bin/) {
	print "Problem cgi-bin : $pathcgi\n";
	exit;
    }

    $pathcgi .= "w3perl";

    $pathcgi =~ s/\"//g;
    $pathw3perl =~ s/\"//g;
    print "CGI Path : ";
    print "<I>" if ($ENV{'REQUEST_METHOD'} eq "GET");
    print "$pathcgi";
    print "</I>" if ($ENV{'REQUEST_METHOD'} eq "GET");
    print "\n";
    print "<BR>" if ($ENV{'REQUEST_METHOD'} eq "GET");
    print "W3Perl Path : ";
    print "<I>" if ($ENV{'REQUEST_METHOD'} eq "GET");
    print "$pathw3perl";
    print "</I>" if ($ENV{'REQUEST_METHOD'} eq "GET");
    print "\n";
    print "<BR>" if ($ENV{'REQUEST_METHOD'} eq "GET");
    

    open(FILE,">$upgrade_config");
    print FILE "Perl $perlpath\n";
    print FILE "W3Perl $pathw3perl\n";
    print FILE "CGI $pathcgi\n";
    close(FILE);

}

# opt_u (Apache)
# install for virtual hosts (detect from pwd)

if ($opt_u ne '' || $opt_e ne '') {
    $virtual_www = '';
    $found = 0;
    $out = 1;
    open(FILE,"$fileconf") || die "Can't open $fileconf\n";
    while (<FILE>) {
	chop;

	# ServerName ==> $virtual_www

	$out = 0 if (/^\<VirtualHost/i && $found != 1);
	$out = 1 if (/^\<\/VirtualHost/i && (($out == 0) || $found == 1));

	if ($out == 0) {
	    s/\>//;

	    ($scriptalias,$virtual_www) = split(/\s*ServerName\s*/) if (/ServerName/i);

	    if ($virtual_www eq '') {
		($scriptalias,@tmp) = split(/\s+/) if (/^\<VirtualHost/i);

#	    print "Error, unable to find virtual host name\n" if ($#tmp == -1);

		if ($#tmp == 0) {
		    $virtual_www = $tmp[0];
		    $pos = rindex($virtual_www,'.',length($virtual_www));
		    $racine = substr($virtual_www,0,$pos);
		    print "Error, invalid virtual host name : $virtual_www\n" if (index($racine,'.') == -1);
		} else {
		
		    if ($#tmp > 0) {
			foreach $tmp1 (@tmp) {
			    $pos = rindex($tmp1,'.',length($tmp1));
			    $racine = substr($tmp1,0,$pos);
			    $virtual_www = $tmp1 if (index($racine,'.') != -1);
			}
		    }
		}
	    }

	    if ($opt_e == 1 && !($seen{$virtual_www}++) && $virtual_www ne '') {
		push(@www,$virtual_www);
#		print "A - $virtual_www\n";
	    }

	    # TransferLog ==> $virtual_web_log
	    ($scriptalias,$tmp) = split(/\s*TransferLog\s*/) if (/TransferLog/i);
	    ($scriptalias,$tmp) = split(/\s*CustomLog\s*/) if (/CustomLog/i);
	    $pos = rindex($tmp,'/',length($tmp));
	    $virtual_web_log = substr($tmp,0,$pos);
#	    $virtual_web_log =~ s/www/usr\/local\/etc\/httpd/ if ($azouz == 1);

	    if ($opt_e == 1 && !($seen{$tmp}++) && $tmp ne '') {
		push(@web_log,$virtual_web_log);
#		print "B $virtual_web_log - $tmp\n";
	    }

	    # DocumentRoot ==> $virtual_web
	    ($scriptalias,$virtual_web) = split(/\s*DocumentRoot\s*/) if (/DocumentRoot/i);
#	    $virtual_web =~ s/www/usr\/local\/etc\/httpd/ if ($azouz == 1);

	    # ScriptAlias ==> $virtual_cgi
	    if (/ScriptAlias/i) {
		($scriptalias,$cgi_bin,$virtual_cgi_tmp) = split(/\s*ScriptAlias\s*/);
		($cgi_bin,$virtual_cgi_tmp) = split(/\s+/,$cgi_bin);
#		$virtual_cgi_tmp =~ s/www/usr\/local\/etc\/httpd/ if ($azouz == 1);
		chop($virtual_cgi_tmp);
	    }


	    if ($opt_e == 1 && !($seen{$virtual_cgi_tmp}++) && $virtual_cgi_tmp ne '') {
		push(@web_cgi,$virtual_cgi_tmp);
	    }

	    if ($opt_e == 1 && !($seen{$virtual_web}++) && $virtual_web ne '') {
		push(@web,$virtual_web);
#		print "C $virtual_web\n";
	    }

	    if ($opt_e eq '') {

	    $found = 1 if ($virtual_cgi_tmp eq $virtual_cgi && ($cwd =~ /cgi/i)); # script d'install dans le repertoire cgi du serveur virtuel
	    $found = 1 if ($virtual_web_dir eq $virtual_web && ($cwd !~ /cgi/i)); # script d'install dans le repertoire principal
	}
	}
    }
    close(FILE);

    if ($opt_u ne '') {
	if ($found != 1) {
	    print "No path matching in the server configuration file !\n";
	    exit;
	}
	push(@www,$virtual_www);
	push(@web_log,$virtual_web_log);
	push(@web,$virtual_web);
	push(@web_cgi,$virtual_cgi_tmp);
    }

    if ($virtual_www eq '') {
	print "Error, unable to find virtual host name\n";
	exit;
    }
    if ($virtual_web eq '') {
	print "Error, unable to find virtual host path\n";
	exit;
    }
    if ($virtual_web_log eq '') {
	print "Error, unable to find virtual host logfile path\n";
	exit;
    }

    if ($opt_e eq '') {
	print "Virtual Host Name : ";
	print "<I>" if ($ENV{'REQUEST_METHOD'} eq "GET");
	print "$virtual_www";
	print "</I>" if ($ENV{'REQUEST_METHOD'} eq "GET");
	print "\n";
	print "<BR>" if ($ENV{'REQUEST_METHOD'} eq "GET");
	print "Virtual Host Path : ";
	print "<I>" if ($ENV{'REQUEST_METHOD'} eq "GET");
	print "$virtual_web";
	print "</I>" if ($ENV{'REQUEST_METHOD'} eq "GET");
	print "\n";
	print "<BR>" if ($ENV{'REQUEST_METHOD'} eq "GET");
	print "Virtual Host Log Path : ";
	print "<I>" if ($ENV{'REQUEST_METHOD'} eq "GET");
	print "$virtual_web_log";
	print "</I>" if ($ENV{'REQUEST_METHOD'} eq "GET");
	print "\n";
	print "<BR>" if ($ENV{'REQUEST_METHOD'} eq "GET");
    }
}

} else {
print "<BR>" if ($ENV{'REQUEST_METHOD'} eq "GET");
print "Failed to find any apache configuration file\n";
print "<BR>" if ($ENV{'REQUEST_METHOD'} eq "GET");
print "Locate your apache configuration file and tell me its name and its location to improve this script please\n";
print "<BR>" if ($ENV{'REQUEST_METHOD'} eq "GET");
print "Use the '-j' flag to load the apache configuration file\n\n";
print "<P><BR>" if ($ENV{'REQUEST_METHOD'} eq "GET");
exit;
#$abort = 1;
}

# End auto-install
}


#########################################################################
#               Auto install for users on virtual host                  #
#########################################################################

if ($opt_u ne '' || $opt_e ne '' || $opt_b ne '') {

# Step 1 : get pwd from current directory
# Step 2 : Read httpd.conf to get $virtual_web (virtual web root path)
#                                 $virtual_web_log (virtual web logfile path)
#                                 $virtual_www (virtual web name)
# Step 1 : Create symbolic links
# Step 2 : Copy generic config.pl file to config-<web>.pl
# Step 3 : Alter config-<web>.pl
# step 4 : Copy config-<web>.pl and cron-w3perl.pl to client cgi-bin
# Step 5 : Create /resources/admin/config-<web> and /config/config-<web>.pl
# Step 6 : Modify /resources/admin/locconf

# On doit aussi recopier pagegraph.pl dans le repertoire cgi du serveur
# virtual si celui-ci existe.

    for ($i=0;$i<=$#www;$i++) {
	print "Server : $www[$i]\n";
	
#	if ($azouz == 1) {
#	    $web[$i] = $user_home_pwd.$web[$i];
#	    $web_log[$i] = $user_home_pwd.$web_log[$i];
#	    $web_cgi[$i] = $user_home_pwd.$web_cgi[$i];
#	}
	
#	    $localdomainename = substr($www[$i],(index($www[$i],'.')+1));
#	    $name_virtual_web = $localdomainename;
	
	if ($virtual_www !~ /\d$/) {
	    $localdomainename = substr($www[$i],(index($www[$i],'.')+1));
	    $name_virtual_web = $localdomainename;
	} else {
	    $localdomainename = substr($www[$i],0,(rindex($www[$i],'.')+1));
	    $name_virtual_web = $localdomainename;
	}
	
	print "Warning : Can't compute domain name from a IP address, suggest $localdomainename\n" if ($www[$i] =~ /\d$/);
	
	print "Create symbolic links\n";
	
        # Create stats output dir

	$tmp = $web[$i].$dirsep.$stat_dir_output;
	mkdir ($tmp,0775) unless -d $tmp;

        # Dir docs

	$newfile = $web[$i].$dirsep.$stat_dir_output.$dirsep."docs";
	$oldfile = $pathw3perl.$dirsep."docs";

	symlink($oldfile,$newfile);
	
        # Dir resources

	$newfile = $web[$i].$dirsep.$stat_dir_output.$dirsep."resources";
	$oldfile = $pathw3perl.$dirsep."resources";
	
	symlink($oldfile,$newfile);

        # Dir admin

	$newfile = $web[$i].$dirsep.$stat_dir_output.$dirsep."admin";
	$oldfile = $pathw3perl.$dirsep."admin";
	
	symlink($oldfile,$newfile);

        # Copy pagegraph.pl dans le cgi du serveur virtual si il existe

	if ($virtual_cgi ne '') {
	    print "Copy cgi w3perl scripts\n";

	    # make subdirectory w3perl inside cgi virtual server

	    $tmp2 = $virtual_cgi.$dirsep."w3perl";
	    mkdir ($tmp2,0775) unless -d $tmp2;

	    $file_update = $pathcgi.$dirsep.$pagegraph;

	    &error_open($file_update) if (!(-r $file_update));
	    open(FILE,"$file_update");
	    @lines = (<FILE>);
	    close FILE;

	    $file_update2 = $virtual_cgi.$dirsep."w3perl".$dirsep.$pagegraph;
	
	    &error_write($file_update2) if (!(-w $virtual_cgi));
	    open(FILE,">$file_update2") || die "Can't open $file_update2";

	    foreach $line (@lines) {
		print FILE "$line";
	    }

	    close(FILE);
	    &set_perm($file_update2,$mode);

	    #

	    $file_update = $pathcgi.$dirsep.$pagesend;

	    &error_open($file_update) if (!(-r $file_update));
	    open(FILE,"$file_update");
	    @lines = (<FILE>);
	    close FILE;

	    $file_update2 = $virtual_cgi.$dirsep."w3perl".$dirsep.$pagesend;
	
	    &error_write($file_update2) if (!(-w $virtual_cgi));
	    open(FILE,">$file_update2") || die "Can't open $file_update2";

	    foreach $line (@lines) {
		print FILE "$line";
	    }

	    close(FILE);
	    &set_perm($file_update2,$mode);

	    #

	    $file_update = $pathcgi.$dirsep.$dayrange;

	    &error_open($file_update) if (!(-r $file_update));
	    open(FILE,"$file_update");
	    @lines = (<FILE>);
	    close FILE;

	    $file_update2 = $virtual_cgi.$dirsep."w3perl".$dirsep.$dayrange;
	
	    &error_write($file_update2) if (!(-w $virtual_cgi));
	    open(FILE,">$file_update2") || die "Can't open $file_update2";

	    foreach $line (@lines) {
		print FILE "$line";
	    }

	    close(FILE);
	    &set_perm($file_update2,$mode);

	}

        # Copy generic config file
        # Attention : par interface web, pble de droit d'ecriture dans /cgi-bin/w3perl/ !

	print "Building generic w3perl configuration file\n";

#	$pathcgi = $user_home_pwd.$pathcgi if ($azouz == 1);
	$file_update = $pathcgi.$dirsep."config".$plext;

	&error_open($file_update) if (!(-r $file_update));
	open(FILE,"$file_update");
	@lines = (<FILE>);
	close FILE;
	
        # on copie le fichier dans le repertoire principal cgi-bin config-<web>.pl
        ### on copie le fichier dans le repertoire virtualhost cgi-bin config.pl

	$file_configdomain = $pathcgi.$dirsep."config"."-".$name_virtual_web.$plext;
#	$file_update2 = $virtual_cgi.$dirsep."config".$plext;
	
	&error_write($file_configdomain) if (!(-w $pathcgi));
#	&error_write($file_update2) if (!(-w $virtual_cgi));

	open(FILE,">$file_configdomain") || die "Can't open $file_configdomain";
#	open(FILE2,">$file_update2") || die "Can't open $file_update2";

	foreach $line (@lines) {
	    $line =~ s/\$path = \"(.*)\"/\$path = \"$tmp$dirsep\"/;
	    $line =~ s/\$pathinit = \"(.*)\"/\$pathinit = \"$pathw3perl$dirsep\"/;
	    $line =~ s/\$pathserver = \"(.*)\"/\$pathserver = \"$web[$i]$dirsep\"/;
	    $line =~ s/\$fileroot = \"(.*)\"/\$fileroot = \"$web_log[$i]$dirsep\"/;
	    $line =~ s/\$cgipath = \"(.*)\"/\$cgipath = \"$web_cgi[$i]$dirsep\"/;
	    $line =~ s/\$localserver = \"(.*)\"/\$localserver = \"$www[$i]\"/;
	    $line =~ s/\$localdomaine = \"(.*)\"/\$localdomaine = \"$localdomainename\"/;
	    $line =~ s/\$localdomainename = \"(.*)\"/\$localdomainename = \"$localdomainename\"/;
	    $line =~ s/\$emailadr = \"(.*)\"/\$emailadr = \"webmaster\\\@$localdomainename\"/;
	    print FILE "$line";
#	    print FILE2 "$line";
	}

	close(FILE);
#	close(FILE2);

        # Copy cron-w3perl.pl dans le repertoire virtualhost cgi-bin

	print "Building generic cron-w3perl script\n";

	$file_update = $pathcgi.$dirsep."cron-w3perl".$plext;

	&error_open($file_update) if (!(-r $file_update));
	open(FILE,"$file_update");
	@lines = (<FILE>);
	close FILE;
	
        # on copie le fichier dans le repertoire virtualhost cgi-bin config.pl

	$file_update = $virtual_cgi_tmp if ($cwd =~ /cgi/i); # script d'install dans le repertoire cgi du serveur virtuel
	$file_update = $virtual_web if ($cwd !~ /cgi/i); # Script d'install dans le repertoire principal
#	$file_update = $user_home_pwd.$file_update if ($azouz == 1);

	&error_write($file_update) if (!(-w $file_update));

	$file_update .= $dirsep."cron-w3perl".$plext; 

#	&error_write($file_update) if (!(-w $virtual_cgi));


	open(FILE,">$file_update") || die "Can't open $file_update";
	foreach $line (@lines) {
	    $out = 0;
	    $out = 1 if ($line =~ /^\# init/);
	    if ($out == 1) {
		$out = 0;
		print FILE "\$opt_c = 1;\n";
	    }
	    $line =~ s/\$configfile = (.*);$/\$configfile = \"$file_configdomain\";/;
	    
#	    $line =~ s/\$path = \"(.*)\"/\$path = \"$tmp$dirsep\"/;
#	    $line =~ s/\$pathinit = \"(.*)\"/\$pathinit = \"$pathw3perl$dirsep\"/;
#	    $line =~ s/\$pathserver = \"(.*)\"/\$pathserver = \"$web[$i]$dirsep\"/;
#	    $line =~ s/\$fileroot = \"(.*)\"/\$fileroot = \"$web_log[$i]$dirsep\"/;
#	    $line =~ s/\$localserver = \"(.*)\"/\$localserver = \"$www[$i]\"/;
#	    $line =~ s/\$localdomaine = \"(.*)\"/\$localdomaine = \"$localdomainename\"/;
#	    $line =~ s/\$localdomainename = \"(.*)\"/\$localdomainename = \"$localdomainename\"/;
#	    $line =~ s/\$emailadr = \"(.*)\"/\$emailadr = \"webmaster\\\@$localdomainename\"/;
	    print FILE "$line";
	}

	close(FILE);
	&set_perm($file_update,$mode);

    }

    print "Installation successful\n" if ($abort != 1);
    exit;
}

#

if ($ENV{'REQUEST_METHOD'} eq "GET" && $tototototo == 1) {
        print "Content-type: text/html\n\n";
        print "<HTML><HEAD><TITLE>Installation</TITLE></HEAD>\n" if ($0 !~ /upgrade\.pl$/);
        print "<HTML><HEAD><TITLE>Upgrade</TITLE></HEAD>\n" if ($0 =~ /upgrade\.pl$/);
        print "<BODY BGCOLOR=\"#FFFFFF\" TEXT=\"#000000\">\n";
	# Adding CSS style
	print "<style type=\"text/css\">\n";
	print "body {\n";
	print "background-color: #FCFCFC;\n";
	print "color: #202020;\n";
	print "margin: 10px;\n";
	print "font-family: Verdana, Geneva, Arial, sans-serif;\n";
	print "font-size: small;\n";
        print "}\n";
	print "ul {\n";
	print "list-style-type: square;\n";
        print "padding:0px 5px;\n";
	print "}\n";
	print "h1,h2,h3,h4,h5,h6 {\n";
        print "font-family: verdana, arial, sans serif;\n";
        print "color: #209090;\n";
        print "background: none;\n";
        print "font-weight: normal;\n";
        print "margin: 0;\n";
        print "padding-top: .5em;\n";
        print "padding-bottom: .17em;\n";
        print "}\n";
        print ".item_page {\n";
        print "padding:0px 10px;\n";
        print "text-align: left;\n";
        print "color: #505050;\n";
        print "font-weight: bold;\n";
        print "background-color:#fafafa;\n";
        print "}\n";
	print "</style>\n";

}

#########
# Title #
#########

print "<CENTER><H3>" if ($ENV{'REQUEST_METHOD'} eq "GET");
print "Installing w3perl $version in progress...\n" if ($0 !~ /upgrade\.pl$/);
print "Upgrading w3perl in progress...\n" if ($0 =~ /upgrade\.pl$/);
print "</H3></CENTER><BR>" if ($ENV{'REQUEST_METHOD'} eq "GET");

#################################################
# Reading parameters from the first three lines #
#################################################

if ($opt_g eq '' && $distrib == 0 && $opt_j eq '' && $opt_a eq '') {
    print "<BR><B>" if ($ENV{'REQUEST_METHOD'} eq "GET");
    print "<DIV CLASS=\"item_page\"><H3>" if ($ENV{'REQUEST_METHOD'} eq "GET");
    print "> Reading path paramaters within this script\n";
    print "</H3></DIV>" if ($ENV{'REQUEST_METHOD'} eq "GET");
    print "</B><BR>" if ($ENV{'REQUEST_METHOD'} eq "GET");

# Figure out the path to "perl" by reading ourself.

    unless (defined $perlpath) {
	open(ME,$0) || die "Can't open $0\n";
        $perlpath = <ME>;
        $perlpath =~ s/^#\!\s*(.*)\/perl(.*)\n$/$1/;
        close(ME);
    }

    if ($verbose) {
	print "Perl path is : ";
	print "<I>" if ($ENV{'REQUEST_METHOD'} eq "GET");
	print "$perlpath\n";
	print "</I>" if ($ENV{'REQUEST_METHOD'} eq "GET");
	print "<BR>" if ($ENV{'REQUEST_METHOD'} eq "GET");
	print "Cgi path is : ";
	print "<I>" if ($ENV{'REQUEST_METHOD'} eq "GET");
	print "$pathcgi\n";
	print "</I>" if ($ENV{'REQUEST_METHOD'} eq "GET");
	print "<BR>" if ($ENV{'REQUEST_METHOD'} eq "GET");
	print "W3perl path is : ";
	print "<I>" if ($ENV{'REQUEST_METHOD'} eq "GET");
	print "$pathw3perl\n";
	print "</I>" if ($ENV{'REQUEST_METHOD'} eq "GET");
	print "<BR>" if ($ENV{'REQUEST_METHOD'} eq "GET");
    }
}

# Init

$path3 = $pathw3perl;
$initw3perl = $path3;
$path3 .= $dirsep;
$path2 = $pathcgi.$dirsep if ($pathcgi ne '');
$path2 = $pathw3perl.$dirsep if ($pathcgi eq '');

#################################################
#        Installing resource file (RPM)         #
#################################################

if ($distrib == 1) {
#if ($opt_r ne '') {

print "<BR><B><LI>" if ($ENV{'REQUEST_METHOD'} eq "GET");
print "> Installing resource file\n";
print "</B><BR>" if ($ENV{'REQUEST_METHOD'} eq "GET");
# Dest $pathw3perl

#require "pwd.pl";
#&initpwd;

if ($0 !~ /upgrade\.pl/) {
#use Cwd;
#$dir = $ENV{'PWD'};
#$dir = cwd();
$dir = $cwd;
$dir_base = $dir."/";
#$filename = "/resources/rpmfile";

# Default RPM install
$dir_cgi = $opt_d;
$dir_html = $opt_i;

# directory a la racine

$tmp2 = 1;
$tmp = $dir_html;
$tmp2 = mkdir ($tmp,0775) unless -d $tmp;

# en cas d'echec, on essaye un repertoire en dessous

$i = 0;
while ($tmp2 == 0 && $tmp ne '') {
    $i++;
    $tmpold[$i] = $tmp;
    $tmp = substr($tmp,0,rindex($tmp,$dirsep)+1);
    chop($tmp);
    $tmp2 = mkdir ($tmp,0775) unless -d $tmp;
}

if ($i != 0) {
    for ($j=$i;$j>$0;$j--) {
	$tmp = $tmpold[$j];
	$tmp2 = mkdir ($tmp,0775) unless -d $tmp;
    }
}

if ($tmp2 == 0) {
    print "Failed to create $dir_html";
    exit;
}

#

$tmp2 = 1;
$tmp = $dir_cgi;
$tmp2 = mkdir ($tmp,0775) unless -d $tmp;

$i = 0;
while ($tmp2 == 0 && $tmp ne '') {
    $i++;
    $tmpold[$i] = $tmp;
    $tmp = substr($tmp,0,rindex($tmp,$dirsep)+1);
    chop($tmp);
    $tmp2 = mkdir ($tmp,0775) unless -d $tmp;
}

if ($i != 0) {
    for ($j=$i;$j>$0;$j--) {
	$tmp = $tmpold[$j];
	$tmp2 = mkdir ($tmp,0775) unless -d $tmp;
    }
}

if ($tmp2 == 0) {
    print "Failed to create $dir_cgi";
    exit;
}
}

#
#print "> Create $dir$filename\n";
#open (FILE,">$dir$filename");
&install_files($dir);
#close(FILE);

print "<P>" if ($ENV{'REQUEST_METHOD'} eq "GET");
print "> Create $upgrade_file\n" if $verbose;
print "<BR>" if ($ENV{'REQUEST_METHOD'} eq "GET");

open(FILE,">$pathw3perl$dirsep$upgrade_file");
print FILE "Perl $opt_p\n";
$tmp = $opt_i;
$tmp =~ s/$opt_r// if ($opt_r ne '');
print FILE "W3Perl $tmp\n";
$tmp = $opt_d;
$tmp =~ s/$opt_r// if ($opt_r ne '');
print FILE "CGI $tmp\n";
close(FILE);

}

########################################
# Making subdirectory inside /cgi-bin/ #
########################################

if ($pathcgi ne $pathw3perl && $pathcgi ne '' && ($ENV{'REQUEST_METHOD'} ne "GET")) {

$pos = rindex($w3perlcgi_default,$dirsep);
$w3perlcgi_default = substr($w3perlcgi_default,0,$pos);

$pos = rindex($pathcgi,$dirsep);
$cgisubdir = substr($pathcgi,0,$pos);
#($tmp) = (stat($cgisubdir)) [4];

#if ($tmp == 0 && $nt == 0) {
#    print "<BR><FONT COLOR=\"#AA2020\">" if ($ENV{'REQUEST_METHOD'} eq "GET");
#    print "\nYou should run this script as root\n";
#    print "</FONT><BR>" if ($ENV{'REQUEST_METHOD'} eq "GET");
#    exit;
#}

if (!(-d $cgisubdir)) {
    $tmp = mkdir ($cgisubdir,0775);
    if ($tmp != 1) {
	print "<BR>" if ($ENV{'REQUEST_METHOD'} eq "GET");
	print "\nError, unable to create $cgisubdir - $!\n";
	print "<BR>" if ($ENV{'REQUEST_METHOD'} eq "GET");

	if ($cgisubdir eq $w3perlcgi_default && $pathw3perl eq $w3perlweb_default) {
	    print "Did you change the default paths at the beginning of this script ?\n";
	    print "<BR><I>" if ($ENV{'REQUEST_METHOD'} eq "GET");
	    print "(Set \$pathw3perl and \$pathcgi according to your system)\n";
	    print "</I><BR>" if ($ENV{'REQUEST_METHOD'} eq "GET");
	} else {
	    print "Run the script as root or create the subdirectory by yourself\n";
	    print "<BR><I>" if ($ENV{'REQUEST_METHOD'} eq "GET");
	    print "(PS: The script may be confused with symbolic links)\n";
	    print "</I><BR>" if ($ENV{'REQUEST_METHOD'} eq "GET");
	}
	unlink($upgrade_config);
	exit;
    }
}

if (!(-d $pathcgi)) {

    $pos = rindex($cgisubdir,$dirsep);
    $cgisubdir2 = substr($cgisubdir,0,$pos);

    $tmp = mkdir ($cgisubdir2,0775);
    $tmp = mkdir ($cgisubdir,0775);

    $tmp = mkdir ($pathcgi,0775);
    if ($tmp != 1) {
	print "<BR>" if ($ENV{'REQUEST_METHOD'} eq "GET");
	print "\nError, unable to create $pathcgi - $!\n";
	print "<BR>" if ($ENV{'REQUEST_METHOD'} eq "GET");
	print "Run the script as root or create the subdirectory by yourself\n";
	print "<BR><I>" if ($ENV{'REQUEST_METHOD'} eq "GET");
	print "(PS: The script may be confused with symbolic links)\n";
	print "</I><BR>" if ($ENV{'REQUEST_METHOD'} eq "GET");
	unlink($upgrade_config);
	exit;
    }
}

print "> Making $pathcgi\n" if (!(-d $pathcgi));
}

# RiscOS
 
if ($dirsep eq "." && !(-f "$path2$conf")) {;
$plext = "/pl";
$conf = "config".$plext;
}

$conf = "config".$plext;
$lib = "libw3perl".$plext;
#$netgeo = "netgeo".$plext;
$check_modules = "check_modules".$plext;
#$geoip_free = "geoip_free".$plext;
#$fixperlpath = "fixperlpath".$plext;
$oldlib = $lib;
$init = "init".$plext;
$confstat = "confstat".$plext;
$delconf = "delconf".$plext;
$schedule = "schedule".$plext;
$runconf = "runconf".$plext;
$cronw3perl = "cron-w3perl".$plext;

################################################
# Modify /cgi-bin/ links in /admin/index.html  #
################################################

######## Le code vient de init.pl pour calculer $cgiurl

$pos = rindex(lc($pathcgi),"cgi");
$cgiurl = substr($pathcgi,$pos-1,length($pathcgi));
$bkg = substr($pathcgi,$pos-1,1);

#print "$pathcgi - $cgiurl\n";

if ($bkg ne $dirsep) {
$tmp = substr($pathcgi,0,$pos-1);
$pos2 = rindex($tmp,$dirsep);
$cgiurl = substr($pathcgi,$pos2,length($pathcgi));
}

if ($cgiurl =~ /CGI-Executables/i) {
    $cgiurl =~ s/CGI-Executables/cgi-bin/i;
    $macos = 1;
}

### /cgi-bin/w3perl is default w3perl scripts installation

print "<P>" if ($ENV{'REQUEST_METHOD'} eq "GET");
print  "> Updating admin page ... \n" if $verbose;
print "<BR>" if ($ENV{'REQUEST_METHOD'} eq "GET");

$admin_page = $pathw3perl."/admin/index.txt";

# On modifie la page /admin/index.txt (/cgi-bin/w3perl --> $cgiurl)

&error_open($admin_page) if (!(-r $admin_page));
open(FILE,"$admin_page");
@lines = (<FILE>);
close FILE;

&error_write($admin_page) if (!(-w $admin_page));

open(FILE,">$admin_page") || die "Can't open $admin_page";
foreach $line (@lines) {
    $line =~ s/HREF=\"\/(.*)\/(\w+)\.(\w+)\?(.*)/HREF=\"$cgiurl\/$2\.$3\?$4/;
    print FILE "$line";
}
close(FILE);

#################################################
#    Copying default locconf and config         #
#################################################

# UPDATE : mv ressources/admin/locconf en locconf.default
# idem pour ressources/admin/config-xxx en config-xxx.default
# idem pour les config dans /config/

$w3perlpathres = $pathw3perl.$dirsep.$dirresources.$dirsep.$diradmin; # w3perl resources path

#print "AAA - $w3perlpathres$dirsep$locconf - $upgrade_config - $pathcgi\n";

#if (!(-f "$w3perlpathres$dirsep$locconf") && -f "$upgrade_config") {
if (!(-f "$w3perlpathres$dirsep$locconf")) {

    # Install

    #admin/pass.txt.default -> admin/pass.txt if !(-f)
    if (!(-f "$pathw3perl$dirsep$diradmin$dirsep$filepass")) {
	&move_file("$pathw3perl$dirsep$diradmin$dirsep$filepass_default","$pathw3perl$dirsep$diradmin$dirsep$filepass",1,0);
#	print "MOVE $pathw3perl$dirsep$diradmin$dirsep$filepass_default to $pathw3perl$dirsep$diradmin$dirsep$filepass\n";
    }

    # locconf.default --> locconf

    if (-f "$w3perlpathres$dirsep$locconf_default") {
	open(FILE,"$w3perlpathres$dirsep$locconf_default");
	@lines = (<FILE>);
	close FILE;
    }# else {
#	open(FILE,"$w3perlpathres$dirsep$locconf");
#	@lines = (<FILE>);
#	close FILE;	
#    }

#    print "Opening $w3perlpathres$dirsep$locconf\n";
    open(FILE_LOC,">$w3perlpathres$dirsep$locconf") || die "Can't open $w3perlpathres$dirsep$locconf";
    foreach $line (@lines) {
	chop($line);
	next if ($line eq '');

#	$line =~ s/(.*)$dirsep(.*)/$pathw3perl$dirsep$dirconfig$dirsep$2/;
#	($file_conf) = split(/\s+/,$2);
	($file_conf,$tmp2,$tmp3,$tmp4,$tmp5,$tmp6) = split(/\t/,$line);
	$tmp = $file_conf;
	$file_conf =~ s/(.*)$dirsep(.*)/$pathw3perl$dirsep$dirconfig$dirsep$2/;
	$tmp =~ s/(.*)$dirsep(.*)/$pathw3perl$dirsep$dirresources$dirsep$diradmin$dirsep$2/;

	# Exclude Linux config files on Win
	if ($nt == 1 && $tmp4 != 1) {
	    unlink($file_conf);
	    unlink($tmp);
	    next;
	}

	# Exclude Windows config files on Linux
#	if ($w3perl_on == 0) {
#	    if ($nt == 0 && $tmp4 != 0) {
#		unlink($file_conf);
#		next;
#	    }
#	}

	$line = "$file_conf\t$tmp2\t$tmp3\t$tmp4\t$tmp5\t$tmp6";
	($file_conf) = split(/\s+/,$2);

	$file3_conf = $file_conf;
	$file3_conf =~ s/\.pl$/\.default/;
	$file3_conf = $pathw3perl.$dirsep.$dirconfig.$dirsep.$file3_conf;
	$file2_conf = $file_conf;
	$file2_conf = $pathw3perl.$dirsep.$dirconfig.$dirsep.$file2_conf;
	$file2_conf_cgi = $pathcgi.$dirsep.$file_conf;
	$file_conf =~ s/(.*)\.pl/$1/;
	$file_conf = $w3perlpathres.$dirsep.$file_conf;
	$file_conf_txt = $file_conf.".default";
#	print "TO $file_conf_txt - $file_conf\n";
#	&move_file($file_conf_txt,$file_conf,$delete_files) if (-f $file_conf_txt);
	# move *.default dans resources/admin/*
#	print "Move $file_conf_txt to $file_conf\n" if (-f $file_conf_txt);
	&move_file($file_conf_txt,$file_conf,1,1) if (-f $file_conf_txt);

	# Move config/*.default to config/*.pl if not present
#	print "Move $file3_conf to $file2_conf\n" if (!(-f $file2_conf));
	&move_file($file3_conf,$file2_conf,1,1) if (!(-f $file2_conf));


        # deplace les fichiers de config dans cgi si non present

#	print "TO $file2_conf_txt - $file_conf_cgi\n";
	# move config/*.pl to cgi if not present
#	print "Move $file2_conf to $file2_conf_cgi\n" if (!(-f $file2_conf_cgi) && -f $file2_conf);
	if (($nt == 1 && $tmp4 == 1) || ($nt == 0 && $tmp4 == 0)) {
	    &move_file($file2_conf,$file2_conf_cgi,0,1) if ($pathcgi ne '' && !(-f $file2_conf_cgi) && -f $file2_conf);
	}

#	&move_file($file2_conf,$file2_conf,'0') if ($pathcgi eq '' && -f $file2_conf);
	# chmod 666 sur $file_conf et $file2_conf
	$cnt = chmod 0666, $file_conf;
#	$cnt = chmod 0755, $file_conf;
	$cnt = chmod 0666, $file2_conf;
#	$cnt = chmod 0755, $file2_conf;
#	$line =~ s/$build_rpm_tmp// if ($opt_r ne '');
	$line =~ s/$opt_r// if ($opt_r ne '');
#	$line =~ s/$opt_s// if ($opt_s ne '');
#	if ($w3perl_on == 0) {
	if (($nt == 1 && $tmp4 == 1) || ($nt == 0 && $tmp4 == 0)) {
	    print FILE_LOC "$line\n";
	}
#	} else {
#	    print FILE_LOC "$line\n";
#	}
    }
    close(FILE_LOC);
    unlink("$w3perlpathres$dirsep$locconf_default");
    $cnt = chmod 0666, "$w3perlpathres$dirsep$locconf";

} else {
# Upgrading configuration files

    if (-z "$w3perlpathres$dirsep$locconf") {
	print "$w3perlpathres$dirsep$locconf is empty !\n";
	print "Delete this file please\n";
	unlink($upgrade_config);
	exit;
    }

    print "<DIV CLASS=\"item_page\"><H3>" if ($ENV{'REQUEST_METHOD'} eq "GET");
    print "> Updating configuration files ... \n";
    print "</H3></DIV>\n" if ($ENV{'REQUEST_METHOD'} eq "GET");

    $w3perlloc = $w3perlpathres.$dirsep.$locconf;

#    print "1 - Reading $w3perlloc\n";

    open(CONFLOC,"$w3perlloc"); # || die "Can't open $w3perlloc\n";
    @oldlines = (<CONFLOC>);
    close(CONFLOC);

    for ($i=0;$i<=$#oldlines;$i++) {
	($file_conf,$tmp2,$tmp3,$tmp4,$tmp5,$tmp6) = split(/\t/,$oldlines[$i]);
	$file_conf = substr($file_conf,rindex($file_conf,$dirsep)+1,length($file_conf));
	next if ($file_conf !~ /^config-example-/i);
	push(@oldlines_conf_example,$file_conf);
    }

    # if default is found
    if (-f "$w3perlpathres$dirsep$locconf_default") {

#	print "2 - Reading $w3perlpathres$dirsep$locconf_default\n";

	open(FILE,"$w3perlpathres$dirsep$locconf_default");
	@lines_default = (<FILE>);
	close FILE;

	# Find new entries (diff locconf et locconf.default)
	for ($i=0;$i<=$#lines_default;$i++) {
	    ($file_conf,$tmp2,$tmp3,$tmp4,$tmp5,$tmp6) = split(/\t/,$lines_default[$i]);
	    $file_conf2 = substr($file_conf,rindex($file_conf,$dirsep)+1,length($file_conf));
	    next if ($file_conf2 !~ /^config-example-/i);

	    $found = 0;
	    for ($j=0;$j<=$#oldlines_conf_example;$j++) {
		$found = 1 if ($oldlines_conf_example[$j] eq $file_conf2);
	    }
	    if ($found == 0) {
		$file_conf =~ s/(.*)$dirsep(.*)/$pathw3perl$dirsep$dirconfig$dirsep$2/;
		$line = "$file_conf\t$tmp2\t$tmp3\t$tmp4\t$tmp5\t$tmp6";
		push(@newlines,$line);
	    }
	}

	if ($#newlines != -1) {
	    open(CONFLOC,">$w3perlloc");
	    for ($j=0;$j<=$#oldlines;$j++) {
		print CONFLOC "$oldlines[$j]";
	    }
	    for ($j=0;$j<=$#newlines;$j++) {
		print CONFLOC "$newlines[$j]";
	    }
	    close(CONFLOC);
	}

	# Reload the file
	open(CONFLOC,"$w3perlloc"); # || die "Can't open $w3perlloc\n";
	@oldlines = (<CONFLOC>);
	close(CONFLOC);

    }

    $ok = 0;
    $file_upgrade = $up_pathw3perl.$dirsep."resources".$dirsep."upgrade";

#    print "2 - $file_upgrade\n";

    if (-f $file_upgrade) {     # RPM 
#    &error_open($file_upgrade) if (!(-r $file_upgrade));

	# Loading upgrade changelog for each version
	open(FILE,"$file_upgrade");
	while (<FILE>) {
	    if ($_ =~ /\[\d.\d\d\d\]/) {
		$ver_nb = $_ ;
		$ver_nb =~ s/\[//;
		$ver_nb =~ s/\]//;
		chop($ver_nb);
	    }
	    $bigver_nb = $ver_nb*1000;
	    $up{$bigver_nb} .= $_;
	}
	close(FILE);
	
	foreach $oldline (@oldlines) {
	    next if ($oldline eq '');
	    ($file,$ver) = split(/\t/,$oldline);
#	    print "BB - $ver - $version_w3perl\n";
	    if ($ver eq '') {
		print "No version found in $w3perlloc for $file\n";
		$ver = &ExtractConfigVersion($file);
		print "Assuming $ver\n";
		if ($ver eq '') {
		    print "Unable to extract config version from $file\nAbort\n\n";
		    exit;
		}
	    }
	    if ($ver < $version_w3perl && $ver ne '') {
		$tmp = $file;
		$tmp = substr($file,(rindex($file,'/')+1),length($file));
		print " - Upgrading $tmp $ver to $version_w3perl\n";
		
		# lecture du fichier
		open(FILE,"$file");
		@oldlines_conf = (<FILE>);
		close(FILE);
		
		open(FILE,">$file");
		foreach $oldline_conf (@oldlines_conf) {
		    print FILE $oldline_conf if ($oldline_conf !~ /^1\;/);
#		if ($oldline_conf =~ /^1\;/ && $ver != $version_w3perl) {
		    if ($oldline_conf =~ /^1\;/) {
#		    print "$i - $ver - $version_w3perl\n";
			for ($i=($ver*1000);$i<=($version_w3perl*1000);$i++) {
			    if ($up{$i} ne '' && ($i != ($ver*1000))) {
				print FILE "# What's new - $up{$i}\n" if ($up{$i} =~ /^\[\d.\d\d/);
				print FILE "$up{$i}\n" if ($up{$i} !~ /^\[\d.\d\d/);
			    }
			}
		    }
		}
		print FILE "1;\n";
		close(FILE);
		
		print " - Upgrading $tmp in your cgi-bin directory\n";

		# chemin dans cgi-bin
		$tmp2 = substr($file,rindex($file,'/'),length($file));
		$file_cgi = $pathcgi.$tmp2;

		open(FILECGI,">$file_cgi") || ($file_copied = -1);
		foreach $oldline_conf (@oldlines_conf) {
		    print FILECGI $oldline_conf if ($oldline_conf !~ /^1\;/);
		    if ($oldline_conf =~ /^1\;/) {
			for ($i=($ver*1000);$i<=($version_w3perl*1000);$i++) {
			    if ($up{$i} ne '' && ($i != ($ver*1000))) {
				print FILECGI "# What's new - $up{$i}\n" if ($up{$i} =~ /\[\d.\d\d\d\]/);
				print FILECGI "$up{$i}\n" if ($up{$i} !~ /\[\d.\d\d\d\]/);
			    }
			}
		    }
		}
		print FILECGI "1;\n";
		close(FILECGI);

		# check config and cgi-bin config file are the same

		($size_cgi)= (stat("$file_cgi")) [7];
		($size)= (stat("$file")) [7];
		
		if ($size != $size_cgi) {
		    print "   + Warning : $tmp seems to be different\n";
		    print "   + Always use the admin interface to modify configuration files\n";
		}
		
	    }
	}

    }

    # mis a jour de /resources/admin/locconf

#    print "MAJ de $w3perlloc - @oldlines\n";

    open(CONFLOC,">$w3perlloc");
    foreach $tmp (@oldlines) {
	chop($tmp);
	($tmp1,$tmp2,$tmp3,$tmp4,$tmp5,$tmp6) = split(/\t/,$tmp);
	print CONFLOC "$tmp1\t$version_w3perl\t$tmp3\t$tmp4\t$tmp5\t$tmp6\n";
#	print  "$tmp1\t$version_w3perl\t$tmp3\t$tmp4\t$tmp5\t$tmp6\n";
    }
    close(CONFLOC);


    # try to move to the cgi-bin directory

#    foreach $oldline (@oldlines) {
#	($file,$ver) = split(/\s+/,$oldline);

#	$tmp3 = $file;
#	$tmp3 = substr($file,(rindex($file,'/')+1),length($file));

	# lecture du fichier
#	open(FILE,"$file");
#	@oldlines_conf = (<FILE>);
#	close(FILE);
	
	# chemin dans cgi-bin
#	$tmp = rindex($file,'/');
#	$tmp2 = substr($file,$tmp,length($file));
#	$file_cgi = $pathcgi.$tmp2;

#	print " - Upgrading $tmp3 in your cgi-bin directory\n";

#	($size_cgi)= (stat("$file_cgi")) [7];
#	($size)= (stat("$file")) [7];

#	print "$size_cgi - $size\n";

#	if ($size != $size_cgi) {
#	    open(FILECGI,">$file_cgi") || ($file_copied = -1);
#	    foreach $oldline_conf (@oldlines_conf) {
#		print FILECGI $oldline_conf if ($oldline_conf !~ /^1\;/);
#		if ($oldline_conf =~ /^1\;/) {
#		    for ($i=($ver*1000);$i<=($version_w3perl*1000);$i++) {
#			if ($up[$i] ne '' && ($i != ($ver*1000))) {
#			    print FILECGI "# What's new - $up[$i]\n" if ($up[$i] =~ /\[\d.\d\d\d\]/);
#			    print FILECGI "$up[$i]\n" if ($up[$i] !~ /\[\d.\d\d\d\]/);
#			}
#		    }
#		}
#	    }
#	    print FILECGI "1;\n";
#	    close(FILECGI);
#	}
	
#	($size_cgi)= (stat("$file_cgi")) [7];
#	($size)= (stat("$file")) [7];

#	if ($size == $size_cgi) {
#	    $nbfile_copied++;
#	}
#    }

    # on test les fichiers de conf dans cgi-bin
    # diff /config/ $pathcgi
    # si idem $file_copied = 1

#    $tot_oldlines = $#oldlines+1;
    
#    if ($nbfile_copied != $tot_oldlines) {
	# je considere que les fichiers n'ont ete copies si au moins un different
#	$file_copied = -1;
#    }

    if ($file_copied == -1) {
	print "\n  WARNING : can't move the updated configuration files in your cgi directory\n";
	print "            - Make sure configuration files in /w3perl/config/ are read/write for all (chmod 666 config*)\n";
	print "            - Use root to run this script\n";
	print "            - or COPY manually your configuration files\n";
	print "              (cp $pathw3perl/config/* $pathcgi$dirsep)\n";
	print "\n";
	exit;
    }
}


###############################################################
# Perform the substitutions for cron-* scripts                #
# It should leave it unchanged if the path is already correct #
###############################################################

print "<BR><DIV CLASS=\"item_page\"><H3>&gt;&nbsp;" if ($ENV{'REQUEST_METHOD'} eq "GET");
print  "Updating scripts ... \n" if $verbose;
print "</H3></DIV><BR><P>" if ($ENV{'REQUEST_METHOD'} eq "GET");

# Si depuis une interface web, alors les scripts sont en fait dans /cgi-bin/
$path3 = $path2 if ($ENV{'REQUEST_METHOD'} eq "GET");

$path2 =~ s/$opt_r// if ($opt_r ne '');
#$path2 =~ s/$opt_s// if ($opt_s ne '');

$path3 = $path2 if ($opt_f ne '');

opendir(SOURCEDIR,$path3) || die "Couldn't open directory $path3 !!\n";
local(@filenames) = readdir(SOURCEDIR);
closedir(SOURCEDIR);

for ($j=0;$j<=$#filenames;$j++) {
    $file_update = $path3.$dirsep.$filenames[$j];

    next if ($file_update =~ m/$lib/);
    next if ($file_update =~ m/$cronw3perl/);
    next if ($file_update !~ m/cron/);
    next if ($filenames[$j] =~ /^\.#/); 

    &error_open($file_update) if (!(-r $file_update));
    open(FILE,"$file_update") || die "Can't open $file_update\n";
    @lines = (<FILE>);
    close FILE;

    unlink($file_update) if ($delete_files == 1);
    if ($pathcgi ne '') {
	$file_update = $pathcgi.$dirsep.$filenames[$j];
	&error_write($file_update) if (!(-w $pathcgi));
    }
    open(FILE2,">$file_update") || die "Can't open $file_update";

    foreach $i (0 .. $#lines) {
	$lines[$i] =~ s/^\#\! ?([^ ]*)perl(.*)/\#\!$perlpath\/perl$exeext$2/;
#	$lines[$i] =~ s/^require \"?([^ ]*)libw3perl(.*)\";/require \"$path2$lib\";/;
	print FILE2 "$lines[$i]";
    }
    close (FILE2);


    &set_perm($file_update,$mode);
    print "$filenames[$j] updated\n" if $verbose;

#    print "$file_update updated\n";
    print "<BR>" if ($ENV{'REQUEST_METHOD'} eq "GET");
}

#
### Perform the substitutions for fixperlpath script
#

#$file_update = $path3.$fixperlpath;

#&error_open($file_update) if (!(-r $file_update));
#open(FILE,"$file_update") || die "Can't open $file_update\n";
#@lines = (<FILE>);
#close FILE;

#unlink($file_update) if ($delete_files == 1);

if ($distrib == 1) {
    $tmp1_distrib = $pathcgi;
    $tmp1_distrib =~ s/$opt_r// if ($opt_r ne '');
#    $tmp1_distrib =~ s/$opt_s// if ($opt_s ne '');
    $tmp2_distrib = $pathw3perl;
    $tmp2_distrib =~ s/$opt_r// if ($opt_r ne '');
#    $tmp2_distrib =~ s/$opt_s// if ($opt_s ne '');
}

#$file_update = $pathcgi.$dirsep.$fixperlpath;
#&error_write($file_update) if (!(-w $pathcgi));
#open(FILE2,">$file_update") || die "Can't open $file_update\n";
#   foreach $i (0 .. $#lines){
#      $lines[$i] =~ s/^\#\! ?([^ ]*)perl(.*)/\#\!$perlpath\/perl$exeext$2/;

        # pathcgi

#	if ($lines[$i] =~ /\$pathcgi = "(.*)";/) {
#	    $already2 = 1;
#	    $past2 = "$1";
#	}
 
#        $ok2 = 1 if ($lines[$i] =~ /Your CGI path/ && $already2 != 1);
#        $ok2 = 2 if ($lines[$i] =~ /Your CGI path/ && ($already2 == 1 && $past2 ne $pathcgi));

#        print FILE2 "\$pathcgi = \"$pathcgi\"; " if ($ok2 == 1 && $distrib == 0);
#        print FILE2 "\$pathcgi = \"$tmp1\"; " if ($ok2 == 1 && $distrib == 1);
#	if ($ok2 == 2) {
#	    $lines[$i] =~ s/\"$past2\"/\"$pathcgi\"/ if ($distrib == 0);
#	    $lines[$i] =~ s/\"$past2\"/\"$tmp1\"/ if ($distrib == 1);
#	}

#        $ok2 = 0 if ($ok2 == 1 || $ok2 == 2);

        # pathw3perl

#	if ($lines[$i] =~ /\$pathw3perl = "(.*)";/) {
#	    $already = 1;
#	    $past = "$1";
#	}
	
#        $ok = 1 if ($lines[$i] =~ /Your W3Perl path/ && $already != 1);
#        $ok = 2 if ($lines[$i] =~ /Your W3Perl path/ && ($already == 1 && $past ne $initw3perl));

#	  print FILE2 "\$pathw3perl = \"$pathw3perl\"; " if ($ok == 1 && $distrib == 0);
#	  print FILE2 "\$pathw3perl = \"$tmp2\"; " if ($ok == 1 && $distrib == 1);
#	  if ($ok == 2) {
#	      $lines[$i] =~ s/\"$past\"/\"$pathw3perl\"/ if ($distrib == 0);
#	      $lines[$i] =~ s/\"$past\"/\"$tmp2\"/ if ($distrib == 1);
#	  }

#        $ok = 0 if ($ok == 1 || $ok == 2);

#      print FILE2 "$lines[$i]";
#   }
#close (FILE2);

#&set_perm($file_update,$mode);
#print  "$fixperlpath updated\n";
#print "<BR>" if ($ENV{'REQUEST_METHOD'} eq "GET");

#
### Perform the substitutions for check_modules script
#

$file_update = $path3.$check_modules;

&error_open($file_update) if (!(-r $file_update));
open(FILE,"$file_update") || die "Can't open $file_update\n";
@lines = (<FILE>);
close FILE;

unlink($file_update) if ($delete_files == 1);

if ($pathcgi ne '') {
    $file_update = $pathcgi.$dirsep.$check_modules;
    &error_write($file_update) if (!(-w $pathcgi));
}
open(FILE2,">$file_update") || die "Can't open $file_update\n";
   foreach $i (0 .. $#lines){
      $lines[$i] =~ s/^\#\! ?([^ ]*)perl(.*)/\#\!$perlpath\/perl$exeext$2/;   
#      $lines[$i] =~ s/\$conf_file = \"?([^ ]*)config(.*)\";/\$conf_file = \"$path2$conf\";/ if ($lines[$i] =~ /\# install/i);
#      $lines[$i] =~ s/\$w3perlcgiurl = \"\"/\$w3perlcgiurl = \"$cgiurl\"/;
      print FILE2 "$lines[$i]";
   }
close (FILE2);

&set_perm($file_update,$mode);
print  "$check_modules updated\n" if $verbose;
print "<BR>" if ($ENV{'REQUEST_METHOD'} eq "GET");

#
### Perform the substitutions for libw3perl script
#

$file_update = $path3.$lib;

&error_open($file_update) if (!(-r $file_update));
open(FILE,"$file_update") || die "Can't open $file_update\n";
@lines = (<FILE>);
close FILE;

unlink($file_update) if ($delete_files == 1);

if ($pathcgi ne '') {
    $file_update = $pathcgi.$dirsep.$lib;
    &error_write($file_update) if (!(-w $pathcgi));
}
open(FILE2,">$file_update") || die "Can't open $file_update\n";
   foreach $i (0 .. $#lines){
      $lines[$i] =~ s/^\#\! ?([^ ]*)perl(.*)/\#\!$perlpath\/perl$exeext$2/;   
#      $lines[$i] =~ s/require \"?([^ ]*)config(.*)\";/require \"$path2$conf\";/ if ($lines[$i] =~ /\# install/i);
      $lines[$i] =~ s/\$conf_file = \"?([^ ]*)config(.*)\";/\$conf_file = \"$path2$conf\";/ if ($lines[$i] =~ /\# install/i);
#      print "A $path2\n";
#      $lines[$i] =~ s/\$cgipath = \"?([^ ]*)cgi(.*)\";/\$cgipath = \"$path2\";/ if ($lines[$i] =~ /\# cgipath_install/i);
      $lines[$i] =~ s/\$cgipath = \"(.*)\";/\$cgipath = \"$path2\";/ if ($lines[$i] =~ /\# cgipath_install/i);
      $lines[$i] =~ s/\$w3perlcgiurl = \"(.*)\"/\$w3perlcgiurl = \"$cgiurl\"/ if ($nocgi == 0);
      $lines[$i] =~ s/\$w3perlcgiurl = \"(.*)\"/\$w3perlcgiurl = \"\"/ if ($nocgi == 1);
      $lines[$i] =~ s/require \"?([^ ]*)check_modules(.*)\"/require \"$path2$check_modules\"/ if ($lines[$i] =~ /check_modules/i);
#      $lines[$i] =~ s/qw\((.*)\)/qw\($path2\)/ if ($lines[$i] =~ /Perl_modules/i);
#      print "TOO - $lines[$i]\n"  if ($lines[$i] =~ /check_modules/i);
#      $lines[$i] =~ s/require \"?([^ ]*)netgeo(.*)\"/require \"$path2$netgeo\"/ if ($lines[$i] =~ /\$netgeo/i);
#      $lines[$i] =~ s/require \"?([^ ]*)geoip_free(.*)\"/require \"$path2$geoip_free\"/ if ($lines[$i] =~ /\$geoip_free/i);
      print FILE2 "$lines[$i]";
   }
close (FILE2);

&set_perm($file_update,$mode);
print  "$lib updated\n" if $verbose;
print "<BR>" if ($ENV{'REQUEST_METHOD'} eq "GET");

#
### Perform the substitutions for cron-w3perl script
#

$file_update = $path3.$cronw3perl;

&error_open($file_update) if (!(-r $file_update));
open(FILE,"$file_update") || die "Can't open $file_update\n";
@lines = (<FILE>);
close FILE;

unlink($file_update) if ($delete_files == 1);

$ok = 0;
$past = '';
$already = 0;

if ($pathcgi ne '') {
    $file_update = $pathcgi.$dirsep.$cronw3perl;
    &error_write($file_update) if (!(-w $pathcgi));
}
open(FILE2,">$file_update") || die "Can't open $file_update\n";
foreach $i (0 .. $#lines) {

#    $lines[$i] =~ s/^require \"?([^ ]*)libw3perl(.*)\";/require \"$path2$oldlib\";/;
    $lines[$i] =~ s/^#\! ?([^ ]*)perl(.*)/#\!$perlpath\/perl$exeext$2/;
    
    if ($lines[$i] =~ /\$w3perlpath = "(.*)";/) {
	$already = 1;
	$past = "$1";
    }

#    $ok = 1 if ($lines[$i] =~ /Do not remove this line/ && $already != 1);
#    $ok = 2 if ($lines[$i] =~ /Do not remove this line/ && ($already == 1 && $past ne $pathcgi));
    $ok = 1 if ($lines[$i] =~ /The W3Perl CGI Path/ && $already != 1);
    $ok = 2 if ($lines[$i] =~ /The W3Perl CGI Path/ && ($already == 1 && $past ne $pathcgi));
    
    print FILE2 "\$w3perlpath = \"$pathcgi\"; " if ($ok == 1 && $distrib == 0);
    print FILE2 "\$w3perlpath = \"$tmp1_distrib\"; " if ($ok == 1 && $distrib == 1);
    if ($ok == 2) {
	$lines[$i] =~ s/\"$past\"/\"$pathcgi\"/ if ($distrib == 0);
	$lines[$i] =~ s/\"$past\"/\"$tmp1_distrib\"/ if ($distrib == 1);
    }
    $ok = 0 if ($ok == 1 || $ok == 2);
    print FILE2 "$lines[$i]";
}
close (FILE2);

&set_perm($file_update,$mode);
print  "$cronw3perl updated\n" if $verbose;
print "<BR>" if ($ENV{'REQUEST_METHOD'} eq "GET");

#
### Copy configuration files for RPM
#

#if ($opt_r ne '') {
if ($distrib == 1) {

    open(FILE_LOC,"$path3$dirresources$dirsep$diradmin$dirsep$locconf");
    while (<FILE_LOC>) {
	($file_conf) = split;
	$pos = rindex($file_conf,$dirsep)+1;
	$tmp = substr($file_conf,$pos,length($file_conf));
	$file_conf_cgi = $pathcgi.$dirsep.$tmp;
	$file_conf = $opt_r.$file_conf if ($opt_r ne '');
#	$file_conf = $opt_s.$file_conf if ($opt_s ne '');
#	&move_file($file_conf,$file_conf_cgi,$delete_files) if (-f $file_conf);
	&move_file($file_conf,$file_conf_cgi,0,0) if (-f $file_conf);
	# chmod 666 sur $file_conf et $file2_conf
	$cnt = chmod 0666, $file_conf_cgi;
	print  "$tmp copied\n" if $verbose;
	print "<BR>" if ($ENV{'REQUEST_METHOD'} eq "GET");
    }
    close(FILE_LOC);

}


#
### Copy tools for Windows
#

if ($nt == 1) {

    if ($pathcgi ne '') {
	$tmp = "$pathcgi$dirsep$dirtools";
	mkdir ($tmp,0775) unless -d $tmp;

        ### Copy FLY

	$file_update = $path3.$dirsep.$dirtools.$dirsep.$dirwin.$dirsep.$fly_bin;

	$size = -s $file_update;
	if ($size < 0) {
	    print "Problem with fly binary size\n";
	    exit;
	}

	&error_open($file_update) if (!(-r $file_update));
	open(FILE,"$file_update") || die "Can't open $file_update\n";
	binmode(FILE);
	sysread(FILE,$tmp,$size);
	close FILE;

	unlink($file_update) if ($delete_files == 1);

	$file_update = $pathcgi.$dirsep.$dirtools.$dirsep.$fly_bin if ($pathcgi ne '');
#	$file_update = $path3.$dirsep.$dirtools.$dirsep.$fly_bin if ($pathcgi eq '');
	&error_write($file_update) if (!(-w $pathcgi) && $pathcgi ne '');
	open(FILE2,">$file_update") || die "Can't open $file_update\n";
	binmode(FILE2);
	syswrite(FILE2,$tmp,$size);   
	close (FILE2);

#&set_perm($file_update,$mode);
	print "$fly_bin copied\n";
	print "<BR>" if ($ENV{'REQUEST_METHOD'} eq "GET");

        ### Copy GZIP

	$file_update = $path3.$dirsep.$dirtools.$dirsep.$dirwin.$dirsep.$gzip_bin;

	$size = -s $file_update;
	if ($size < 0) {
	    print "Problem with gzip binary size\n";
	    exit;
	}

	&error_open($file_update) if (!(-r $file_update));
	open(FILE,"$file_update") || die "Can't open $file_update\n";
	binmode(FILE);
	sysread(FILE,$tmp,$size);
	close FILE;

	unlink($file_update) if ($delete_files == 1);

	$file_update = $pathcgi.$dirsep.$dirtools.$dirsep.$gzip_bin if ($pathcgi ne '');
#	$file_update = $path3.$dirsep.$dirtools.$dirsep.$gzip_bin if ($pathcgi eq '');
	&error_write($file_update) if (!(-w $pathcgi) && $pathcgi ne '');
	open(FILE2,">$file_update") || die "Can't open $file_update\n";
	binmode(FILE2);
	syswrite(FILE2,$tmp,$size);   
	close (FILE2);
	
#&set_perm($file_update,$mode);
	print "$gzip_bin copied\n" if $verbose;
	print "<BR>" if ($ENV{'REQUEST_METHOD'} eq "GET");

        # Copy WGET

	$file_update = $path3.$dirsep.$dirtools.$dirsep.$dirwin.$dirsep.$wget_bin;

	$size = -s $file_update;
	if ($size < 0) {
	    print "Problem with wget binary size\n";
	    exit;
	}

	&error_open($file_update) if (!(-r $file_update));
	open(FILE,"$file_update") || die "Can't open $file_update\n";
	binmode(FILE);
	sysread(FILE,$tmp,$size);
	close FILE;
	
	unlink($file_update) if ($delete_files == 1);

	$file_update = $pathcgi.$dirsep.$dirtools.$dirsep.$wget_bin if ($pathcgi ne '');
#	$file_update = $path3.$dirsep.$dirtools.$dirsep.$wget_bin if ($pathcgi eq '');
	&error_write($file_update) if (!(-w $pathcgi) && $pathcgi ne '');
	open(FILE2,">$file_update") || die "Can't open $file_update\n";
	binmode(FILE2);
	syswrite(FILE2,$tmp,$size);   
	close (FILE2);

#&set_perm($file_update,$mode);
	print "$wget_bin copied\n" if $verbose;
	print "<BR>" if ($ENV{'REQUEST_METHOD'} eq "GET");

        ### Copy BZIP2

	$file_update = $path3.$dirsep.$dirtools.$dirsep.$dirwin.$dirsep.$bzip2_bin;
	
	$size = -s $file_update;
	if ($size < 0) {
	    print "Problem with bzip2 binary size\n";
	    exit;
	}

	&error_open($file_update) if (!(-r $file_update));
	open(FILE,"$file_update") || die "Can't open $file_update\n";
	binmode(FILE);
	sysread(FILE,$tmp,$size);
	close FILE;

	unlink($file_update) if ($delete_files == 1);
	
	$file_update = $pathcgi.$dirsep.$dirtools.$dirsep.$bzip2_bin if ($pathcgi ne '');
#	$file_update = $path3.$dirsep.$dirtools.$dirsep.$bzip2_bin if ($pathcgi eq '');
	&error_write($file_update) if (!(-w $pathcgi) && $pathcgi ne '');
	open(FILE2,">$file_update") || die "Can't open $file_update\n";
	binmode(FILE2);
	syswrite(FILE2,$tmp,$size);   
	close (FILE2);

#&set_perm($file_update,$mode);
	print "$bzip2_bin copied\n" if $verbose;
	print "<BR>" if ($ENV{'REQUEST_METHOD'} eq "GET");

        ### Copy DLL

	for ($i=0;$i<$#lib_dll;$i++) {
	    $file_update = $path3.$dirsep.$dirtools.$dirsep.$dirwin.$dirsep.$lib_dll[$i];

	    $size = -s $file_update;
	    if ($size < 0) {
		print "Problem with $lib_dll[$i] binary size\n";
		exit;
	    }

	    &error_open($file_update) if (!(-r $file_update));
	    open(FILE,"$file_update") || die "Can't open $file_update\n";
	    binmode(FILE);
	    sysread(FILE,$tmp,$size);
	    close FILE;
	    
	    unlink($file_update) if ($delete_files == 1);

	    $file_update = $pathcgi.$dirsep.$dirtools.$dirsep.$lib_dll[$i] if ($pathcgi ne '');
#	    $file_update = $path3.$dirsep.$dirtools.$dirsep.$lib_dll[$i] if ($pathcgi eq '');
	    &error_write($file_update) if (!(-w $pathcgi) && $pathcgi ne '');
	    open(FILE2,">$file_update") || die "Can't open $file_update\n";
	    binmode(FILE2);
	    syswrite(FILE2,$tmp,$size);   
	    close (FILE2);

#&set_perm($file_update,$mode);
	    print "$lib_dll[$i]_bin copied\n" if $verbose;
	    print "<BR>" if ($ENV{'REQUEST_METHOD'} eq "GET");
	}
    }


# Write default IIS configuration file in cgi-bin/w3perl/config.pl

#$file_update = $pathw3perl.$dirsep.$dirconfig.$dirsep.$config_iis.$plext;
if ($config_win ne '') {

    $webroot_nsis = $webroot;
    $pathw3perl_nsis = $pathw3perl;
    $pathcgi_nsis = $pathcgi;
    $pathcgi_server_nsis = $pathcgi_server;
    $pathlogfile_server_nsis = $pathlogfile_server;

    $file_update = $pathw3perl.$dirsep.$dirconfig.$dirsep.$config_win.$plext;
    &error_open($file_update) if (!(-r $file_update));
    open(FILE,"$file_update");
    @lines = (<FILE>);
    close FILE;

    $localdomainename = $ipweb;
    $localdomainename = substr($ipweb,(index($ipweb,'.')+1)) if ($ipweb !~ /\d$/);

    $file_update = $pathcgi.$dirsep.$config_win.$plext if ($pathcgi ne '');
    $file_update = $pathw3perl.$dirsep.$config_win.$plext if ($pathcgi eq '');
    &error_write($file_update) if (!(-w $pathcgi) && $pathcgi ne '');

#    print "Default configuration : $file_update\n";
    print "Default configuration : $config_win$plext\n";
    print "<BR>" if ($ENV{'REQUEST_METHOD'} eq "GET");

    open(FILE2,">$file_update");
    foreach $i (0 .. $#lines){
	$lines[$i] =~ s/^\@fileroot\s=\s\(\'(.*)/\@fileroot = \(\'$pathlogfile_server_nsis$dirsep\'\);/ if ($pathlogfile_server_nsis ne '');
	$lines[$i] =~ s/^\$pathserver\s=\s\"(.*)/\$pathserver = \"$webroot_nsis$dirsep\";/ if ($webroot_nsis ne '');
	$lines[$i] =~ s/^\$path\s=\s\"(.*)/\$path = \"$webroot_nsis$dirsep$stat_dir_output$dirsep\";/ if ($webroot_nsis ne '');
	$lines[$i] =~ s/^\$pathinit\s=\s\"(.*)/\$pathinit = \"$pathw3perl_nsis$dirsep\";/ if ($pathw3perl_nsis ne '');
	$lines[$i] =~ s/^\$linkpath_url\s=\s\"(.*)/\$linkpath_url = \"$dirsep$stat_dir_output$dirsep\";/ if ($stat_dir_output ne '');
	$lines[$i] =~ s/^\$cgipath\s=\s\"(.*)/\$cgipath = \"$pathcgi_server_nsis$dirsep\";/ if ($pathcgi_server_nsis ne '');
	$lines[$i] =~ s/^\$cgipath\s=\s\"(.*)/\$cgipath = \"\";/ if ($pathcgi_server_nsis eq '');
	$lines[$i] =~ s/^\$FLY\s=\s\"(.*)/\$FLY = \"$pathcgi_nsis$dirsep$dirtools$dirsep$fly_bin\";/ if ($pathcgi_server_nsis ne '');
	$lines[$i] =~ s/^\$GZIP\s=\s\"(.*)/\$GZIP = \"$pathcgi_nsis$dirsep$dirtools$dirsep$gzip_bin\";/ if ($pathcgi_nsis_server ne '');
	$lines[$i] =~ s/^\$wget_bin\s=\s\"(.*)/\$wget_bin = \"$pathcgi_nsis$dirsep$dirtools$dirsep$wget_bin\";/ if ($pathcgi_server_nsis ne '');
	$lines[$i] =~ s/^\$localserver\s=\s\"(.*)/\$localserver = \"$ipweb\";/ if ($ipweb ne '');
	$lines[$i] =~ s/^\$localserver_port\s=\s\"(.*)/\$localserver_port = $portweb;/ if ($portweb ne '');
	$lines[$i] =~ s/^\$localhost\s=\s\"(.*)/\$localhost = \"$ipweb\";/ if ($ipweb ne '');
	$lines[$i] =~ s/^\$localhost_port\s=\s\"(.*)/\$localhost_port = $portweb;/ if ($portweb ne '');
	$lines[$i] =~ s/^\$localdomainename\s=\s\"(.*)/\$localdomainename = \"$localdomainename\";/ if ($localdomainename ne '');
	$lines[$i] =~ s/^\$localdomaine\s=\s\"(.*)/\$localdomaine = \"$localdomainename\";/ if ($localdomainename ne '');
	$lines[$i] =~ s/^\$logfile_format\s=\s\"(.*)/\$logfile_format = \"$iis_logtype\";/ if ($iis_logtype ne '');
	$lines[$i] =~ s/^\$struct_logfile\s=\s\"(.*)/\$struct_logfile = \"$iis_logtype_format\";/ if ($iis_logtype_format ne '');
	$lines[$i] =~ s/^\$prefixlog\s=\s\"(.*)/\$prefixlog = \"$prefixlog\";/ if ($prefixlog ne '');
	print FILE2 "$lines[$i]";
    }
    close (FILE2);

    # Copy the config file to the default one config.pl if the latter doesn't exist of course

    $file_update_def = $pathcgi.$dirsep.$conf if ($pathcgi ne '');
    $file_update_def = $pathw3perl.$dirsep.$conf if ($pathcgi eq '');
    if (!(-f $file_update_def)) {
	&move_file($file_update,$file_update_def,0,0) if (-f $file_update);
    }

    # well, need to overwrite the file in the w3perl package also !

    $file_update = $pathw3perl.$dirsep.$dirconfig.$dirsep.$config_win.$plext;
    &error_write($file_update) if (!(-w $file_update));
    open(FILE2,">$file_update");
    foreach $i (0 .. $#lines){
	$lines[$i] =~ s/^\@fileroot\s=\s\(\'(.*)/\@fileroot = \(\'$pathlogfile_server_nsis$dirsep\'\);/ if ($pathlogfile_server_nsis ne '');
	$lines[$i] =~ s/^\$pathserver\s=\s\"(.*)/\$pathserver = \"$webroot_nsis$dirsep\";/ if ($webroot_nsis ne '');
	$lines[$i] =~ s/^\$path\s=\s\"(.*)/\$path = \"$webroot_nsis$dirsep$stat_dir_output$dirsep\";/ if ($webroot_nsis ne '');
	$lines[$i] =~ s/^\$pathinit\s=\s\"(.*)/\$pathinit = \"$pathw3perl_nsis$dirsep\";/ if ($pathw3perl_nsis ne '');
	$lines[$i] =~ s/^\$linkpath_url\s=\s\"(.*)/\$linkpath_url = \"$dirsep$stat_dir_output$dirsep\";/ if ($stat_dir_output ne '');
	$lines[$i] =~ s/^\$cgipath\s=\s\"(.*)/\$cgipath = \"$pathcgi_server_nsis$dirsep\";/ if ($pathcgi_server_nsis ne '');
	$lines[$i] =~ s/^\$FLY\s=\s\"(.*)/\$FLY = \"$pathcgi_nsis$dirsep$dirtools$dirsep$fly_bin\";/ if ($pathcgi_server_nsis ne '');
	$lines[$i] =~ s/^\$GZIP\s=\s\"(.*)/\$GZIP = \"$pathcgi_nsis$dirsep$dirtools$dirsep$gzip_bin\";/ if ($pathcgi_server_nsis ne '');
	$lines[$i] =~ s/^\$wget_bin\s=\s\"(.*)/\$wget_bin = \"$pathcgi_nsis$dirsep$dirtools$dirsep$wget_bin\";/ if ($pathcgi_server_nsis ne '');
	$lines[$i] =~ s/^\$localserver\s=\s\"(.*)/\$localserver = \"$ipweb\";/ if ($ipweb ne '');
	$lines[$i] =~ s/^\$localserver_port\s=\s\"(.*)/\$localserver_port = $portweb;/ if ($portweb ne '');
	$lines[$i] =~ s/^\$localhost\s=\s\"(.*)/\$localhost = \"$ipweb\";/ if ($ipweb ne '');
	$lines[$i] =~ s/^\$localhost_port\s=\s\"(.*)/\$localhost_port = $portweb;/ if ($portweb ne '');
	$lines[$i] =~ s/^\$localdomainename\s=\s\"(.*)/\$localdomainename = \"$localdomainename\";/ if ($localdomainename ne '');
	$lines[$i] =~ s/^\$localdomaine\s=\s\"(.*)/\$localdomaine = \"$localdomainename\";/ if ($localdomainename ne '');
	$lines[$i] =~ s/^\$logfile_format\s=\s\"(.*)/\$logfile_format = \"$iis_logtype\";/ if ($iis_logtype ne '');
	$lines[$i] =~ s/^\$struct_logfile\s=\s\"(.*)/\$struct_logfile = \"$iis_logtype_format\";/ if ($iis_logtype_format ne '');
	$lines[$i] =~ s/^\$prefixlog\s=\s\"(.*)/\$prefixlog = \"$prefixlog\";/ if ($prefixlog ne '');
	print FILE2 "$lines[$i]";
    }
    close (FILE2);

    # Alter config in resources/config/

    $file_update = $pathw3perl.$dirsep.$dirresources.$dirsep.$diradmin.$dirsep.$config_win;
    &error_open($file_update) if (!(-r $file_update));
    open(FILE,"$file_update");
    @lines = (<FILE>);
    close FILE;

    &error_write($file_update) if (!(-w $file_update));
    open(FILE2,">$file_update");
    foreach $i (0 .. $#lines){
	$lines[$i] =~ s/^fileroot\t(.*)/fileroot\t$pathlogfile_server_nsis$dirsep/ if ($pathlogfile_server_nsis ne '');
	$lines[$i] =~ s/^pathserver\t(.*)/pathserver\t$webroot_nsis$dirsep/ if ($webroot_nsis ne '');
	$lines[$i] =~ s/^path\t(.*)/path\t$webroot_nsis$dirsep$stat_dir_output$dirsep/ if ($webroot_nsis ne '');
	$lines[$i] =~ s/^pathinit\t(.*)/pathinit\t$pathw3perl_nsis$dirsep/ if ($pathw3perl_nsis ne '');
	$lines[$i] =~ s/^linkpath_url\t(.*)/linkpath_url\t$dirsep$stat_dir_output$dirsep/ if ($stat_dir_output ne '');
	$lines[$i] =~ s/^cgipath\t(.*)/cgipath\t$pathcgi_server_nsis$dirsep/ if ($pathcgi_server_nsis ne '');
	$lines[$i] =~ s/^FLY\t(.*)/FLY\t$pathcgi_nsis$dirsep$dirtools$dirsep$fly_bin/ if ($pathcgi_server_nsis ne '');
	$lines[$i] =~ s/^GZIP\t(.*)/GZIP\t$pathcgi_nsis$dirsep$dirtools$dirsep$gzip_bin/ if ($pathcgi_server_nsis ne '');
	$lines[$i] =~ s/^wget_bin\t(.*)/wget_bin\t$pathcgi_nsis$dirsep$dirtools$dirsep$wget_bin/ if ($pathcgi_server_nsis ne '');
	$lines[$i] =~ s/^localserver\t(.*)/localserver\t$ipweb/ if ($ipweb ne '');
	$lines[$i] =~ s/^localserver_port\t(.*)/localserver_port\t$portweb/ if ($portweb ne '');
	$lines[$i] =~ s/^localhost\t(.*)/localhost\t$ipweb/ if ($ipweb ne '');
	$lines[$i] =~ s/^localhost_port\t(.*)/localhost_port\t$portweb/ if ($portweb ne '');
	$lines[$i] =~ s/^localdomainename\t(.*)/localdomainename\t$localdomainename/ if ($localdomainename ne '');
	$lines[$i] =~ s/^localdomaine\t(.*)/localdomaine\t$localdomainename/ if ($localdomainename ne '');
	$lines[$i] =~ s/^configfile_description\t(.*)/configfile_description\t$web_description/ if ($web_description ne '');
	$lines[$i] =~ s/^logfile\t(.*)/logfile\t$iis_logtype/ if ($iis_logtype ne '');
	$lines[$i] =~ s/^struct_logfile\t(.*)/struct_logfile\t$iis_logtype_format/ if ($iis_logtype_format ne '');
	$lines[$i] =~ s/^prefixlog\t(.*)/prefixlog\t$prefixlog/ if ($prefixlog ne '');
	print FILE2 "$lines[$i]";
    }
    close (FILE2);

#    print "Updating default configuration resource : $file_update\n";
    print "<BR>" if ($ENV{'REQUEST_METHOD'} eq "GET");
}
}

###############################################################
# Perform the substitutions for the cgi-bin scripts           #
# Scripts located in the same level as cron-* scripts         #
###############################################################


#$path2b = $path3."cgi-bin".$dirsep."w3perl";
$path2b = $path3."admin".$dirsep."scripts";
$tmp = "";
$tmp = $path2b.$dirsep if ($dirsep eq ".");

# confstat script
if ($nocgi == 0) {
$file_update = $path3.$confstat;

if (-f $file_update) {
    &error_open($file_update) if (!(-r $file_update));
    open(FILE,"$file_update");
    @lines = (<FILE>);
    close FILE;

    unlink($file_update) if ($delete_files == 1);

    if ($pathcgi ne '') {
	$file_update = $pathcgi.$dirsep.$confstat;
	&error_write($file_update) if (!(-w $pathcgi));
    }

    open(FILE2,">$file_update");
    foreach $i (0 .. $#lines){
	$lines[$i] =~ s/^\#\! ?([^ ]*)perl(.*)/\#\!$perlpath\/perl$exeext$2/;
#	$lines[$i] =~ s/^require \"?([^ ]*)init(.*)\";/require \"$path2$init\";/;
	print FILE2 "$lines[$i]";
    }
    close (FILE2);

    &set_perm($file_update,$mode);
    print  "$confstat updated\n" if $verbose;
    print "<BR>" if ($ENV{'REQUEST_METHOD'} eq "GET");
}

#
### delconf script
#

$file_update = $path3.$delconf;

if (-f $file_update) {
    &error_open($file_update) if (!(-r $file_update));
    open(FILE,"$file_update");
    @lines = (<FILE>);
    close FILE;

    unlink($file_update) if ($delete_files == 1);

    if ($pathcgi ne '') {
	$file_update = $pathcgi.$dirsep.$delconf;
	&error_write($file_update) if (!(-w $pathcgi));
    }
    open(FILE2,">$file_update");
    foreach $i (0 .. $#lines){
	$lines[$i] =~ s/^\#\! ?([^ ]*)perl(.*)/\#\!$perlpath\/perl$exeext$2/;
#	$lines[$i] =~ s/^require \"?([^ ]*)init(.*)\";/require \"$path2$init\";/;
	print FILE2 "$lines[$i]";
    }
    close (FILE2);

    &set_perm($file_update,$mode);    
    print  "$delconf updated\n" if $verbose;
    print "<BR>" if ($ENV{'REQUEST_METHOD'} eq "GET");
}

#
### schedule script
#

$file_update = $path3.$schedule;

if (-f $file_update) {
    &error_open($file_update) if (!(-r $file_update));
    open(FILE,"$file_update");
    @lines = (<FILE>);
    close FILE;

    unlink($file_update) if ($delete_files == 1);

    if ($pathcgi ne '') {
	$file_update = $pathcgi.$dirsep.$schedule;
	&error_write($file_update) if (!(-w $pathcgi));
    }
    open(FILE2,">$file_update");
    foreach $i (0 .. $#lines){
        $lines[$i] =~ s/^\#\! ?([^ ]*)perl(.*)/\#\!$perlpath\/perl$exeext$2/;
#        $lines[$i] =~ s/^require \"?([^ ]*)init(.*)\";/require \"$tmp$init\";/;
        print FILE2 "$lines[$i]";      
    }
    close (FILE2);

    &set_perm($file_update,$mode);
    print  "$schedule updated\n" if $verbose;
    print "<BR>" if ($ENV{'REQUEST_METHOD'} eq "GET");
}


#
### runconf script
#

$file_update = $path3.$runconf;

if (-f $file_update) {
    &error_open($file_update) if (!(-r $file_update));
    open(FILE,"$file_update");
    @lines = (<FILE>);
    close FILE;

    unlink($file_update) if ($delete_files == 1);

    if ($pathcgi ne '') {
	$file_update = $pathcgi.$dirsep.$runconf;
	&error_write($file_update) if (!(-w $pathcgi));
    }
    open(FILE2,">$file_update");
    foreach $i (0 .. $#lines){
        $lines[$i] =~ s/^\#\! ?([^ ]*)perl(.*)/\#\!$perlpath\/perl$exeext$2/;
#        $lines[$i] =~ s/^require \"?([^ ]*)init(.*)\";/require \"$tmp$init\";/;
        print FILE2 "$lines[$i]";      
    }
    close (FILE2);

    &set_perm($file_update,$mode);
    print  "$runconf updated\n" if $verbose;
    print "<BR>" if ($ENV{'REQUEST_METHOD'} eq "GET");
}

#
### init script
#

$file_update = $path3.$init;

if (-f $file_update) {
    &error_open($file_update) if (!(-r $file_update));
    open(FILE,"$file_update");
    @lines = (<FILE>);
    close FILE;

    unlink($file_update) if ($delete_files == 1);

    $ok = 0;
    $past = '';
    $already = 0;
    $already2 = 0;

    if ($pathcgi ne '') {
	$file_update = $pathcgi.$dirsep.$init;
	&error_write($file_update) if (!(-w $pathcgi));
    }

    open(FILE2,">$file_update");
    foreach $i (0 .. $#lines){
        $lines[$i] =~ s/^\#\! ?([^ ]*)perl(.*)/\#\!$perlpath\/perl$exeext$2/;

        # pathcgi

	if ($lines[$i] =~ /\$cgipath = "(.*)";/) {
	    $past2 = "$1";
	    $already2 = 1 if ($past ne '');
	}

        $ok2 = 1 if ($lines[$i] =~ /The W3Perl CGI Path/ && $already2 != 1);
        $ok2 = 2 if ($lines[$i] =~ /The W3Perl CGI Path/ && ($already2 == 1 && $past2 ne $pathcgi));

        $lines[$i] = "\$cgipath = \"$pathcgi\";\n" if ($ok2 == 1);

	if ($ok2 == 2) {
	    $lines[$i] =~ s/\"$past2\"/\"$pathcgi\"/;
	}

        $ok2 = 0 if ($ok2 == 1 || $ok2 == 2);

	# w3perlpath

	if ($lines[$i] =~ /\$w3perlpath = "(.*)";/) {
	    $past = "$1";
	    $already = 1 if ($past ne '');
	}

        $ok = 1 if ($lines[$i] =~ /The W3Perl Path/ && $already != 1);
        $ok = 2 if ($lines[$i] =~ /The W3Perl Path/ && ($already == 1 && $past ne $initw3perl));
	
        $lines[$i] = "\$w3perlpath = \"$initw3perl\";\n" if ($ok == 1);

	if ($ok == 2) {
	    $lines[$i] =~ s/\"$past\"/\"$initw3perl\"/;
	}

        $ok = 0 if ($ok == 1 || $ok == 2);

	# tildealias

	if ($lines[$i] =~ /\$tildealias = "(.*)";/) {
	    $past = "$1";
	    $already3 = 1 if ($past ne '');
	}

        $ok3 = 1 if ($lines[$i] =~ /User directory alias/ && $already3 != 1);
        $ok3 = 2 if ($lines[$i] =~ /User directory alias/ && ($already3 == 1 && $past ne $tildealias));
	
        $lines[$i] = "\$tildealias = \"$tildealias\";\n" if ($ok3 == 1);

	if ($ok3 == 2) {
	    $lines[$i] =~ s/\"$past\"/\"$tildealias\"/;
	}
        $ok3 = 0 if ($ok3 == 1 || $ok3 == 2);

        print FILE2 "$lines[$i]";
    }
    close (FILE2);

    &set_perm($file_update,$mode);
    print  "$init updated\n" if $verbose;
    print "<BR>" if ($ENV{'REQUEST_METHOD'} eq "GET");
}

#
### pagegraph script
#

$file_update = $path3.$pagegraph;

if (-f $file_update) {
    &error_open($file_update) if (!(-r $file_update));
    open(FILE,"$file_update");
    @lines = (<FILE>);
    close FILE;

    unlink($file_update) if ($delete_files == 1);

    $ok = 0;
    $past = '';
    $already = 0;

    if ($pathcgi ne '') {
	$file_update = $pathcgi.$dirsep.$pagegraph;
	&error_write($file_update) if (!(-w $pathcgi));
    }
    open(FILE2,">$file_update");
    foreach $i (0 .. $#lines){

#	$lines[$i] =~ s/^require \"?([^ ]*)libw3perl(.*)\";/require \"$path2$oldlib\";/;
        $lines[$i] =~ s/^\#\! ?([^ ]*)perl(.*)/\#\!$perlpath\/perl$exeext$2/;

        print FILE2 "$lines[$i]";
    }
    close (FILE2);

    &set_perm($file_update,$mode);
    print  "$pagegraph updated\n" if $verbose;
    print "<BR>" if ($ENV{'REQUEST_METHOD'} eq "GET");
}


#
### dayrange script
#

$file_update = $path3.$dayrange;

if (-f $file_update) {
    &error_open($file_update) if (!(-r $file_update));
    open(FILE,"$file_update");
    @lines = (<FILE>);
    close FILE;

    unlink($file_update) if ($delete_files == 1);

    $ok = 0;
    $past = '';
    $already = 0;

    if ($pathcgi ne '') {
	$file_update = $pathcgi.$dirsep.$dayrange;
	&error_write($file_update) if (!(-w $pathcgi));
    }
    open(FILE2,">$file_update");
    foreach $i (0 .. $#lines){

#	$lines[$i] =~ s/^require \"?([^ ]*)libw3perl(.*)\";/require \"$path2$oldlib\";/;
        $lines[$i] =~ s/^\#\! ?([^ ]*)perl(.*)/\#\!$perlpath\/perl$exeext$2/;

        print FILE2 "$lines[$i]";
    }
    close (FILE2);

    &set_perm($file_update,$mode);
    print  "$dayrange updated\n" if $verbose;
    print "<BR>" if ($ENV{'REQUEST_METHOD'} eq "GET");
}

#
### pagesend script
#

$file_update = $path3.$pagesend;

if (-f $file_update) {
    &error_open($file_update) if (!(-r $file_update));
    open(FILE,"$file_update");
    @lines = (<FILE>);
    close FILE;

    unlink($file_update) if ($delete_files == 1);

    $ok = 0;
    $past = '';
    $already = 0;

    if ($pathcgi ne '') {
	$file_update = $pathcgi.$dirsep.$pagesend;
	&error_write($file_update) if (!(-w $pathcgi));
    }
    open(FILE2,">$file_update");
    foreach $i (0 .. $#lines){

#	$lines[$i] =~ s/^require \"?([^ ]*)libw3perl(.*)\";/require \"$path2$oldlib\";/;
        $lines[$i] =~ s/^\#\! ?([^ ]*)perl(.*)/\#\!$perlpath\/perl$exeext$2/;

        print FILE2 "$lines[$i]";
    }
    close (FILE2);

    &set_perm($file_update,$mode);
    print  "$pagesend updated\n" if $verbose;
    print "<BR>" if ($ENV{'REQUEST_METHOD'} eq "GET");
}
}

###############################################################
# Scripts located in /w3perl/admin/scripts/                   #
###############################################################

#$path2b = $path3."cgi-bin".$dirsep."w3perl";
$path2b = $path3."admin".$dirsep."scripts";
$tmp = "";
$tmp = $path2b.$dirsep if ($dirsep eq ".");

if ($nocgi == 0) {

if (-d $path2b && ($ENV{'REQUEST_METHOD'} ne "GET")) {
    opendir(SOURCEDIR,$path2b) || die "Couldn't open directory $path2b !!\n";
    local(@filenames) = readdir(SOURCEDIR);
    closedir(SOURCEDIR);

    for ($j=0;$j<=$#filenames;$j++) {

	$file_update = $path2b.$dirsep.$filenames[$j];

	next if ($filenames[$j] eq ".");
	next if ($filenames[$j] eq "..");
	next if ($filenames[$j] =~ /^\.#/); 

	&error_open($file_update) if (!(-r $file_update));
        open(FILE,"$file_update");
        @lines = (<FILE>);
        close FILE;

	unlink($file_update) if ($delete_files == 1);

        $ok = 0;
        $ok2 = 0;
        $ok3 = 0;
	$past = '';
	$already = 0;
	$already2 = 0;
	$already3 = 0;

	if ($pathcgi ne '') {
	    $file_update = $pathcgi.$dirsep.$filenames[$j];
	    &error_write($file_update) if (!(-w $pathcgi));
	}
	open(FILE2,">$file_update") || die "Can't open $file_update";	
        foreach $i (0 .. $#lines) {
	    
#	    $lines[$i] =~ s/^require \"?([^ ]*)libw3perl(.*)\";/require \"$path2$oldlib\";/;
#	    $lines[$i] =~ s/^require \"?([^ ]*)init(.*)\";/require \"$path2$init\";/;
	    $lines[$i] =~ s/^\#\! ?([^ ]*)perl(.*)/\#\!$perlpath\/perl$exeext$2/;

	    # pathcgi

	    if ($lines[$i] =~ /\$cgipath = "(.*)";/) {
		$past2 = "$1";
		$already2 = 1 if ($past ne '');
	    }

	    $ok2 = 1 if ($file_update =~ /$init/ && $lines[$i] =~ /The W3Perl CGI Path/ && $already2 != 1);
	    $ok2 = 2 if ($file_update =~ /$init/ && $lines[$i] =~ /The W3Perl CGI Path/ && ($already2 == 1 && $past2 ne $pathcgi));

	    $lines[$i] = "\$cgipath = \"$pathcgi\";\n" if ($ok2 == 1 && $distrib == 0);
	    $lines[$i] = "\$cgipath = \"$tmp1_distrib\";\n" if ($ok2 == 1 && $distrib == 1);

	    if ($ok2 == 2) {
		$lines[$i] =~ s/\"$past2\"/\"$pathcgi\"/ if ($distrib == 0);
		$lines[$i] =~ s/\"$past2\"/\"$tmp1_distrib\"/ if ($distrib == 1);
	    }

	    $ok2 = 0 if ($ok2 == 1 || $ok2 == 2);

	    # w3perlpath

	    if ($lines[$i] =~ /\$w3perlpath = "(.*)";/) {
		$past = "$1";
		$already = 1 if ($past ne '');
	    }

	    $ok = 1 if ($file_update =~ /$init/ && $lines[$i] =~ /The W3Perl Path/ && $already != 1);
	    $ok = 2 if ($file_update =~ /$init/ && $lines[$i] =~ /The W3Perl Path/ && ($already == 1 && $past ne $initw3perl));

	    $lines[$i] = "\$w3perlpath = \"$initw3perl\";\n" if ($ok == 1 && $distrib == 0);
	    $lines[$i] = "\$w3perlpath = \"$tmp2_distrib\";\n" if ($ok == 1 && $distrib == 1);

	    if ($ok == 2) {
		$lines[$i] =~ s/\"$past\"/\"$initw3perl\"/ if ($distrib == 0);
		$lines[$i] =~ s/\"$past\"/\"$tmp2_distrib\"/ if ($distrib == 1);
	    }
	    $ok = 0 if ($ok == 1 || $ok == 2);

	    # tildealias

	    if ($lines[$i] =~ /\$tildealias = "(.*)";/) {
		$past = "$1";
		$already3 = 1 if ($past ne '');
	    }

	    $ok3 = 1 if ($lines[$i] =~ /User directory alias/ && $already3 != 1);
	    $ok3 = 2 if ($lines[$i] =~ /User directory alias/ && ($already3 == 1 && $past ne $tildealias));
	
	    $lines[$i] = "\$tildealias = \"$tildealias\";\n" if ($ok3 == 1);

	    if ($ok3 == 2) {
		$lines[$i] =~ s/\"$past\"/\"$tildealias\"/;
	    }
	    $ok3 = 0 if ($ok3 == 1 || $ok3 == 2);

	    print FILE2 "$lines[$i]";
	}
	close (FILE2);

	&set_perm($file_update,$mode);
	print  "$filenames[$j] updated\n" if $verbose;
	print "<BR>" if ($ENV{'REQUEST_METHOD'} eq "GET");
    }
}
}

################################################################
# Checking permissions files for /config/ and /resources/admin #
################################################################

$mode = 0777;

print "> Setting directories permission\n" if $verbose;
print "<BR>" if ($ENV{'REQUEST_METHOD'} eq "GET");

$tmp = $pathw3perl.$dirsep.$dirconfig;
&set_perm($tmp,$mode);
$tmp = $pathw3perl.$dirsep.$dirresources.$dirsep.$diradmin;
&set_perm($tmp,$mode);

if ($verbose) {
    print "<BR><B><I>" if ($ENV{'REQUEST_METHOD'} eq "GET");
    print "> Successfully completed\n\n";
    print "</B></I><BR>" if ($ENV{'REQUEST_METHOD'} eq "GET");

    print "> You can now go to http://localhost/w3perl/admin/index.html\n";
    print "> (where localhost is the server name where w3perl have been installed)\n\n";
    print "<BR>" if ($ENV{'REQUEST_METHOD'} eq "GET");
    print "> Don't forget to password protect this admin directory !\n";
    print "<BR>" if ($ENV{'REQUEST_METHOD'} eq "GET");
}

##################
# Errors report  #
##################

sub install_files {
    local($dir,$nlink,$symlinkdir) = @_;
    local($dev,$ino,$mode,$subcount);
   ($dev,$ino,$mode,$nlink) = stat('.') unless $nlink;

    opendir(SOURCEDIR,$dir) || die "Couldn't open directory $dir !!\n";
    local(@filenames) = readdir(SOURCEDIR);
    closedir(SOURCEDIR);

    if ($nlink == 2) {
        for (@filenames) {
	    next if $_ eq '.';
	    next if $_ eq '..';
	    next if ($_ =~ /\~$/);
	    next if ($_ =~ /rpm\.pl/);
	    $name = "$dir/$_";
	    $name2 = $name;
	    $name2 =~ s/$dir_base//;
	    $output = "$dir_html/$name2";

#	    print "COPY1 $name to $output\n";
#	    print "MKDIR1 $output\n" if (-d $name);
	    &move_file($name,$output,$delete_files,0) if (-f $name);
	    $output .= $dirsep if (-d $name);
	    mkdir ($output,0777) if (-d $name);
	    $name2 = $name2."\n";

	    $name3 = "$dir_cgi/$_\n" if ($_ =~ /\.pl/);
	    $name3 = "$dir_html/$name2" if ($_ !~ /\.pl/);
	    $name3 = "$dir_html/$name2" if ($_ =~ /global\.pl/);
	    $name3 = "$dir_html/$name2" if ($_ =~ /clean_log\.pl/);
	    $name3 = "$dir_html/$name2" if (length($_) == 5);
#	    print FILE "$name3\n";

	}
    }
    else {
	$subcount = $nlink-2;
	
	for (@filenames) {
	    next if $_ eq '.';
	    next if $_ eq '..';
	    next if ($_ =~ /\~$/);
	    next if ($_ =~ /rpm\.pl/);
	    $name = "$dir/$_";
	    $name2 = $name;
	    $name2 =~ s/$dir_base//;
	    $output = "$dir_html/$name2";
	    $name3 = "$dir_cgi/$_" if ($_ =~ /\.pl/ && $_ !~ /global/);
	    $name3 = "$dir_html/$name2" if ($_ !~ /\.pl/);
	    $name3 = "$dir_html/$name2" if ($_ =~ /global\.pl/);
	    $name3 = "$dir_html/$name2" if ($_ =~ /clean_log\.pl/);
	    $name3 = "$dir_html/$name2" if (length($_) == 5);
#	    print FILE $name3,"\n";
#	    print "COPY2 $name to $output\n" if (-f $name);
#	    print "MKDIR2 $output\n" if (-d $name);
	    &move_file($name,$output,$delete_files,0) if (-f $name);
	    $output .= $dirsep if (-d $name);
	    mkdir ($output,0777) if (-d $name);
	    next if ($subcount == 0);
	    ($dev,$ino,$mode,$nlink) = lstat($_);
	    next unless -d _;
	    chdir $_ || die "Can't cd to $name";
	    &install_files($name,$nlink);
	    chdir '..';
	    --$subcount;
	}
    }
}

sub error_open {
    local($file) = @_;

    print "<P><DIR><FONT COLOR=\"#AA2020\">" if ($ENV{'REQUEST_METHOD'} eq "GET");
    print "Unable to open $file : $!\n";
    print "</FONT><BR>" if ($ENV{'REQUEST_METHOD'} eq "GET");
    print " ==> check read permission\n";
    print "</DIR>" if ($ENV{'REQUEST_METHOD'} eq "GET");
    unlink($upgrade_config);
    exit;
}

sub error_write {
    local($file) = @_;

    print "<P><DIR><FONT COLOR=\"#AA2020\">" if ($ENV{'REQUEST_METHOD'} eq "GET");
    print "Unable to write $file : $!\n";
    print "</FONT><BR>" if ($ENV{'REQUEST_METHOD'} eq "GET");
    print " ==> check write permission\n";
    print "</DIR>" if ($ENV{'REQUEST_METHOD'} eq "GET");
    unlink($upgrade_config) if ($0 =~ /install\.pl$/);
    exit;
}

sub set_perm {
    local($file,$mode) = @_;

    $cnt = chmod $mode, $file;
    $msg = "Unable to change file permission in $file to set them executable : $!";
    &error($msg) if ($cnt != 1);
}


sub error {
    local($msg) = @_;

    print "<P><DIR><FONT COLOR=\"#AA2020\">" if ($ENV{'REQUEST_METHOD'} eq "GET");
    print "$msg : $!\n";
    print "</FONT><BR>" if ($ENV{'REQUEST_METHOD'} eq "GET");
#    print " ==> check write permission\n";
    print "</DIR>" if ($ENV{'REQUEST_METHOD'} eq "GET");
    unlink($upgrade_config);
    exit;
}

sub id {
    local($affirmation) = @_;

print STDOUT "Yes\n" if ($affirmation == 1);
print STDOUT "No\n" if ($affirmation == 0);
}


sub ExtractConfigVersion {
    local($file) = @_;
    local($tmp,$tmp1,$tmp2);

    # Extract version number from config file
    # match v 3.XXX (YY/YYY/YYYY) or # What's new - [3.XXX]

    if (!(-f $file)) {
	&error_open($file);
    } else {
	open(CFGFILE,$file);
	while (<CFGFILE>) {
	    if (/^####\s+v\s(\d\.\d+)/) {
		$tmp1 = $1;
	    }
	    if (/^#\s+What\'s\snew\s-\s\[(\d\.\d+)\]/) {
		$tmp1 = $1;
	    }
	}
	close(CFGFILE);
    }
    return $tmp1;
}


sub move_file {
    local($infile,$outfile,$delete_files,$mode) = @_;
    local($tmp);

    $size = -s $infile;

    if ($size < 0) {
	print "Problem with corrupted file size : $infile\n";
	exit;
    }

    open(FILE,"$infile") || die "Can't open $infile\n";
    binmode(FILE);
    sysread(FILE,$tmp,$size);
    close FILE;

    unlink($infile) if ($delete_files == 1);

    open(FILE2,">$outfile"); # || die "Can't open $outfile - Check write permission\n";
    binmode(FILE2);
    syswrite(FILE2,$tmp,$size);
    close (FILE2);

    if (!(-f $outfile)) {
	unlink($upgrade_config);
	unlink("$w3perlpathres$dirsep$locconf") if ($mode == 1);
	&error_write($outfile);
	exit;
    }


}

1;
