# -------------------------------------------------------------------------------------
# install.pl
# -------------------------------------------------------------------------------------
#
#    Author: Jean-Michel Hiver (jhiver@webarchitects.co.uk)     (c) MKDoc Holdings Ltd.
#    Installation script for MKDoc.
#
# -------------------------------------------------------------------------------------


# code taken from CPAN's Apache::Htpasswd 1.5
# (this package was copy-n-pasted and POD documentation was removed)
# ------------------------------------------------------------------
#
# Copyright 1998..2001, Kevin Meltzer.  All rights reserved.  It may
# be used and modified freely, but I do request that this copyright
# notice remain attached to the file.  You may modify this module as you
# wish, but if you redistribute a modified version, please attach a note
# listing the modifications you have made.
package Apache::Htpasswd;
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
use strict;		# Restrict unsafe variables, references, barewords
use Carp;

use POSIX qw ( SEEK_SET SEEK_END );

# I have amended the module so that it doesn't use locking,
# which crashes ActivePerl under windows 9x
# use Fcntl qw ( LOCK_EX LOCK_UN );

@ISA = qw(Exporter);

@EXPORT = qw();

@EXPORT_OK = qw(htpasswd htDelete fetchPass fetchInfo writeInfo htCheckPassword error Version);

%EXPORT_TAGS = (all => [@EXPORT_OK]);

($VERSION = substr(q$Revision: 1.9.2.8 $, 10)) =~ s/\s+$//;

sub Version {
	return $VERSION;
}

#-----------------------------------------------------------#
# Public Methods
#-----------------------------------------------------------#

sub new {
	my ($proto, $passwdFile) = @_;

	my $class = ref($proto) || $proto;
	my ($self) = {};
	bless ($self, $class);

	$self->{'PASSWD'} = $passwdFile;
	$self->{'ERROR'} = "";
	$self->{'LOCK'} = 0;
	$self->{'OPEN'} = 0;
	
	return $self;
}

#-----------------------------------------------------------#

sub error {
	my ($self) = @_;
	return $self->{'ERROR'};
}

#-----------------------------------------------------------#

sub htCheckPassword {
	my ($self) = shift;
	my ($Id, $pass) = @_;

	my ($cryptPass) = $self->fetchPass($Id);

	if (!$cryptPass) { return undef; }

	my ($fooCryptPass) = $self->CryptPasswd($pass, $cryptPass);

	if ($fooCryptPass eq $cryptPass) {
		return 1;
	} else {
		$self->{'ERROR'} = __PACKAGE__."::htCheckPassword - Passwords do not match.";
		carp $self->error() unless caller ne $self;
		return 0;
	}
}

#-----------------------------------------------------------#

sub htpasswd {
	my ($self) = shift;
	my ($Id) = shift;
	my ($newPass) = shift;
	my ($oldPass) = @_ if (@_);
	my ($noOld)=0;

	if (!defined($oldPass)) { $noOld=1;}
	if (defined($oldPass) && $oldPass =~ /^\d$/) {
		if ($oldPass) {
			$newPass = $Id unless $newPass;
			my ($newEncrypted) = $self->CryptPasswd($newPass);
			return $self->writePassword($Id, $newEncrypted);
		}
	}

	# New Entry
	if ($noOld) {
	    my ($passwdFile) = $self->{'PASSWD'};

		# Encrypt new password string

		my ($passwordCrypted) = $self->CryptPasswd($newPass);

    		$self->_open();

		if ($self->fetchPass($Id)) {

			# User already has a password in the file. 
			$self->{'ERROR'} = __PACKAGE__. "::htpasswd - $Id already exists in $passwdFile";
			carp $self->error();

			$self->_close();  
			return undef;
		} else {
			# If we can add the user.
	
	    		seek(FH, 0, SEEK_END);
	    		print FH "$Id\:$passwordCrypted\n";
	    
	    		$self->_close();  
	    		return 1;
		}

    		$self->_close();

	} else {
    		$self->_open();

		my ($exists) = $self->htCheckPassword($Id, $oldPass);

		if ($exists) {
			my ($newCrypted) = $self->CryptPasswd($newPass);
			return $self->writePassword($Id, $newCrypted);
		} else {
			# ERROR returned from htCheckPass
			$self->{'ERROR'} = __PACKAGE__."::htpasswd - Password not changed.";
			carp $self->error();
			return undef;
		}

    		$self->_close();
    	}
} # end htpasswd

#-----------------------------------------------------------#

sub htDelete {
	my ($self, $Id) = @_;
	my ($passwdFile) = $self->{'PASSWD'};
	my (@cache);
	my ($return);

	# Loop through the file, building a cache of exising records
	# which don't match the Id.

	$self->_open();

	seek(FH, 0, SEEK_SET);
	while (<FH>) {

		if (/^$Id\:/) {
			$return = 1; 
		} else {
			push(@cache, $_);
		}
	}


	# Write out the @cache if needed.

	if ($return) {

	    # Return to beginning of file
	    seek(FH, 0, SEEK_SET);
	    
	    while (@cache) { 
		print FH shift (@cache); 
	    }

	    # Cut everything beyond current position
	    truncate(FH, tell(FH));

	} else {
	    $self->{'ERROR'} = __PACKAGE__. "::htDelete - User $Id not found in $passwdFile: $!";
	    carp $self->error();
	}

	$self->_close();

	return $return;
}

#-----------------------------------------------------------#

sub fetchPass {
	my ($self) = shift;
	my ($Id) = @_;
	my ($passwdFile) = $self->{'PASSWD'};

	my $passwd = 0;

	$self->_open();
	
	while (<FH>) {
		chop;
		my @tmp = split(/:/,$_,3);
		if ( $tmp[0] eq $Id ) {
		    $passwd = $tmp[1];
		    last;
		}
	}

	$self->_close();

	return $passwd;
}

#-----------------------------------------------------------#

sub writePassword {
	my ($self) = shift;
	my ($Id, $newPass) = @_;

	my ($passwdFile) = $self->{'PASSWD'};
	my (@cache);

	my ($return);
	
	$self->_open();
	seek(FH, 0, SEEK_SET);

	while (<FH>) {

	    my @tmp = split(/:/,$_,3);
	    if ( $tmp[0] eq $Id ) {
		my $info = $tmp[2] ? $tmp[2] : "";
	        push (@cache, "$Id\:$newPass\:$info");
	        $return = 1; 

	    } else {
	        push (@cache, $_);
	    }
	}

	# Write out the @cache, if needed.

	if ($return) {
	    
	    # Return to beginning of file
	    seek(FH, 0, SEEK_SET);

		while (@cache) { 
			print FH shift (@cache); 
		}

	    # Cut everything beyond current position
	    truncate(FH, tell(FH));

	} else {
		$self->{'ERROR'} = __PACKAGE__. "::writePassword - User $Id not found in $passwdFile: $!";
		carp $self->error() . "\n";
	}

	$self->_close();

	return $return;
}

#-----------------------------------------------------------#

sub fetchInfo {
	my ($self) = shift;
	my ($Id) = @_;
	my ($passwdFile) = $self->{'PASSWD'};

	my $info = 0;

	$self->_open();
	
	while (<FH>) {
		chop;
		my @tmp = split(/:/,$_,3);
		if ( $tmp[0] eq $Id ) {
		    $info = $tmp[2];
		    last;
		}
	}

	$self->_close();

	return $info;
}

#-----------------------------------------------------------#

sub writeInfo {
	my ($self) = shift;
	my ($Id, $newInfo) = @_;

	my ($passwdFile) = $self->{'PASSWD'};
	my (@cache);

	my ($return);
	
	$self->_open();
	seek(FH, 0, SEEK_SET);

	while (<FH>) {

	        my @tmp = split(/:/,$_,3);

		if ( $tmp[0] eq $Id ) {
			chomp $tmp[1] if (@tmp == 2); # Cut out EOL if there was no info
			push (@cache, "$Id\:$tmp[1]\:$newInfo\n");
			$return = 1; 

		} else {
			push (@cache, $_);
		}
	}

	# Write out the @cache, if needed.

	if ($return) {
	    
	    # Return to beginning of file
	    seek(FH, 0, SEEK_SET);

		while (@cache) { 
			print FH shift (@cache); 
		}

	    # Cut everything beyond current position
	    truncate(FH, tell(FH));

	} else {
		$self->{'ERROR'} = __PACKAGE__. "::writeInfo - User $Id not found in $passwdFile: $!";
		carp $self->error() . "\n";
	}

	$self->_close();

	return $return;
}

#-----------------------------------------------------------#

sub CryptPasswd {
	my ($self) = shift;
	my ($passwd, $salt) = @_;

	if ($salt) {
		# Make sure only use 2 chars
		$salt = substr ($salt, 0, 2);
	} else {
		$salt = substr ($0, 0, 2);
	}

	return crypt ($passwd, $salt);
}

#-----------------------------------------------------------#

sub DESTROY { close(FH); };

#-----------------------------------------------------------#

    sub _lock {

	my ($self) = shift;
	
	# Lock if we don't have the lock
        # we don't need to lock stuff, this is just for an
        # install script and it doesn't work under win 9x
        # series
        # Jean-Michel Hiver, 21.10.2001
        # flock(FH, LOCK_EX) if($self->{'LOCK'} == 0);

	# We have the lock
	$self->{'LOCK'} = 1;

	# Seek to head
        seek(FH, 0, SEEK_SET);
    }

#-----------------------------------------------------------#

    sub _unlock {
	my ($self) = shift;
        # we don't need to lock stuff, this is just for an
        # install script and it doesn't work under win 9x
        # series
        # Jean-Michel Hiver, 21.10.2001
        # flock(FH, LOCK_UN);

	$self->{'LOCK'} = 0;
    }

#-----------------------------------------------------------#

sub _open {
    my ($self) = shift;

    if($self->{'OPEN'} > 0) {
	$self->{'OPEN'}++;
	$self->_lock();
	return;
    }

    my $passwdFile = $self->{'PASSWD'};
    if (!open(FH,"+<$passwdFile")) {
	$self->{'ERROR'} = __PACKAGE__. "::fetchPass - Cannot open $passwdFile: $!";
	croak $self->error();
    }

    $self->{'OPEN'}++;
    $self->_lock();
}

#-----------------------------------------------------------#

sub _close {
    my ($self) = shift;
    $self->_unlock();

    $self->{'OPEN'}--;

    if($self->{'OPEN'} > 0) { return; }

    if (!close(FH)) {
	my $passwdFile = $self->{'PASSWD'};
	$self->{'ERROR'} = __PACKAGE__. "::htDelete - Cannot close $passwdFile: $!";
	carp $self->error();
	return undef;
    }
}

#-----------------------------------------------------------#


1;


package main;
use Cwd;
use strict;
use vars qw /$CONFIG $OS/;


BEGIN
{
    $CONFIG = {};
    
    open FP, "<install.conf" or die "Cannot read-open install.conf";
    while (my $string = <FP>)
    {
	chomp ($string);

	# if the line starts with a comment, then it's all a comment
	next if ($string =~ /^\#.*/);
	
        # has this line got comments?
        if ($string =~ /(?<!\\)\#/)
        {
            my ($key, $val, $cmt) = $string =~ /(.*?)\s+(.*?)\s+(.*)/;
            $val =~ s/\s+$//;
	    $CONFIG->{$key} = $val;
        }
        else
        {
            if ($string =~ /\S+(\s+)\S+/)
            {
                my ($key, $val) = $string =~ /(.*?)\s+(.*)/;
                $val =~ s/\s+$//;
		$CONFIG->{$key} = $val;
            }
            else
            {
                my $key = $string;
                my $val = 1;
		$CONFIG->{$key} = $val;
            }
        }
    }
    close FP;
    
    # unshift @INC to add MKDoc install dir
    unshift @INC, $CONFIG->{MKDOC_DIR};
}


eval
{
    use lib::Config;
    use lib::Template;
    use lib::Exception;
    use flo::Category;
    use lib::Config;
    use lib::sql::type::ALL;
    use Data::Dumper;
};
die $@ if (defined $@ and $@);


main();


##
# main();
# -------
#  Performs the installation
##
sub main
{
    # MKDoc install script beautiful ASCII headers
    print_hello();

    # check basic requirements
    check_perl();
    check_dbi();
    check_dbd_mysql();
    check_database_connect();
    
    # check for tidy
    $CONFIG->{TIDY_PATH} = check_tidy ($CONFIG->{TIDY_PATH});
    
    # check for HTML2TEXT dependencies
    check_html2text() if (defined $CONFIG->{H2TXT} and $CONFIG->{H2TXT});
    
    # check for RSS 090 Headlines dependencies
    check_r090hd() if (defined $CONFIG->{R090HD} and $CONFIG->{R090HD});
    
    # check for RSS 091 Headlines dependencies
    check_r091hd() if (defined $CONFIG->{R091HD} and $CONFIG->{R091HD});
    
    # check for RSS 100 Headlines dependencies
    check_r100hd() if (defined $CONFIG->{R100HD} and $CONFIG->{R100HD});
    
    # check for RSS 100 Sitemap dependencies
    check_r100sm() if (defined $CONFIG->{R100SM} and $CONFIG->{R100SM});
    
    # create needed directories and permissions
    setup_mkdoc_directories();
    
    # now we will write the configuration files from the configuration
    # templates, let's add a few extra keys to the $CONFIG hash
    my $site_dir = getcwd;
    chomp ($site_dir);
    $CONFIG->{SITE_DIR}  = $site_dir;
    write_config_files ($CONFIG);
    
    # check that the database connection works
    setup_database ($CONFIG);
    
    # now, we need to write the apache config file
    write_apache_config_file ('conf/httpd.conf.tmpl', $site_dir . '/httpd.conf');
    
    # let us write the .htpasswd file
    my $passwd = write_apache_htpasswd_file ($site_dir);
    
    # finally, add this new site in the $mkdoc_dir/conf config files dir
    add_site_to_mkdoc();
    
    # tell the user what the password is for the admin interface and says bye-bye
    print_bye_bye ($passwd);
}


##
# print_bye_bye ($password);
# --------------------------
#   If we arrived at that stage, then the install script is nearly
#   done. Print a goodbye message with the password.
##
sub print_bye_bye
{
    my $passwd = shift;
    print "\n";
    print "===============================================================\n";
    print "  The installation is now finished. You should make sure that  \n";
    print "  the following domain names are correctly set in your DNS:    \n";
    print "    + " . $CONFIG->{PUBLIC_DOMAIN} . "\n";
    print "    + " . $CONFIG->{ADMIN_DOMAIN} . "\n";
    print "    + " . $CONFIG->{SU_DOMAIN} . "\n";
    print "\n";
    print "  Super user interface details:\n";
    print "    + Login    : admin\n";
    print "    + Password : $passwd (no digits)\n";
    print "\n";
    print "  You have to restart apache for the changes to take effect.\n\n";
    print "===============================================================\n";
}


##
# setup_database;
# ---------------
#   Creates def files and database tables
##
sub setup_database()
{
    my $site_dir = $CONFIG->{SITE_DIR};
    
    print "Setting up MKDoc database driver... ";
    open FP, ">$site_dir/su/driver.pl" or
	die "$site_dir/su/driver.pl";
    print FP "use flo::Category;\n";
    print FP "use lib::sql::Table;\n";
    print FP "use lib::sql::type::Char;\n";
    print FP "use lib::sql::type::DateTime;\n";
    print FP "use lib::sql::type::Int;\n";
    print FP "use lib::sql::type::Text;\n";
    print FP "use lib::sql::DBH;\n";
    print FP "lib::sql::DBH->spawn (" . "\n";
    print FP "        database => '$CONFIG->{DATABASE}'," . "\n" if ($CONFIG->{DATABASE});
    print FP "        host     => '$CONFIG->{HOST}'," . "\n"     if ($CONFIG->{HOST});
    print FP "        port     => '$CONFIG->{PORT}'," . "\n"     if ($CONFIG->{PORT});
    print FP "        user     => '$CONFIG->{USER}'," . "\n"     if ($CONFIG->{USER});
    print FP "        password => '$CONFIG->{PASSWORD}'," . "\n" if ($CONFIG->{PASSWORD});
    print FP ");\n";
    print FP "lib::sql::Table->driver ('MySQL');"  . "\n";
    print FP "1;" . "\n";    
    print "OK\n";
    
    # try to eval the driver.pl to initialize the database
    print "Initializing database... ";

    open FP, "<su/driver.pl";
    my $data = join '', <FP>;
    close FP;
    eval $data;
    die $@ if ($@);
    
    new lib::sql::Table ( name   => "Editor",
                          cols   => [
				     { name => "ID",          type => new lib::sql::type::Int ( not_null => 1 )               },
				     { name => "Login",       type => new lib::sql::type::Char ( size => 15, not_null => 1 )  },
				     { name => "Password",    type => new lib::sql::type::Char ( size => 15, not_null => 1 )  },
				     { name => "Email",       type => new lib::sql::type::Char ( size => 255, not_null => 1 ) },
				     { name => "First_Name",  type => new lib::sql::type::Char ( size => 50 )                 },
				     { name => "Family_Name", type => new lib::sql::type::Char ( size => 50 )                 },
				     { name => "Disabled",    type => new lib::sql::type::Int ( not_null => 1 )               }
				     ],
                          pk     => [ "ID" ],
                          ai     => "ID",
                          unique => { login_uk => ["Login"] },
                          ai     => "ID",
                          bless_into => "flo::Record::Editor" );
    
    new flo::Category ( name   => "Document",
                        cols   => [
                                   { name => "ID",                      type => new lib::sql::type::Int ( not_null => 1 )               },
                                   { name => "Parent_ID",               type => new lib::sql::type::Int()                               },
                                   { name => "Cache_Control",           type => new lib::sql::type::Int ( not_null => 1 )               },
                                   { name => "Template",                type => new lib::sql::type::Char ( size => 255, not_null => 1 ) },
                                   { name => "Description",             type => new lib::sql::type::Text()                              },
                                   { name => "Keywords",                type => new lib::sql::type::Char ( size => 255, not_null => 1 ) },
                                   { name => "Date_Created",            type => new lib::sql::type::DateTime ( not_null => 1 )          },
                                   { name => "Date_Last_Modified",      type => new lib::sql::type::DateTime ( not_null => 1 )          },
                                   { name => "Editor_Created_ID",       type => new lib::sql::type::Int ( not_null => 1 )               },
                                   { name => "Editor_Last_Modified_ID", type => new lib::sql::type::Int ( not_null => 1 )               },
                                   { name => "Name",                    type => new lib::sql::type::Char ( not_null => 1, size => 50 )  },
                                   { name => "Full_Path",               type => new lib::sql::type::Char ( not_null => 1, size => 255 ) },
                                   { name => "Title",                   type => new lib::sql::type::Char ( size => 255 )                },
                                   { name => "Lang",                    type => new lib::sql::type::Char ( not_null => 1, size => 8 )   },
                                   { name => "Rights",                  type => new lib::sql::type::Text()                              },
                                   { name => "Publisher",               type => new lib::sql::type::Text()                              },
                                   { name => "Source",                  type => new lib::sql::type::Text()                              },
                                   { name => "Relation",                type => new lib::sql::type::Text()                              },
                                   { name => "Coverage",                type => new lib::sql::type::Text()                              },
                                   { name => "Body",                    type => new lib::sql::type::Text()                              },
                                   { name => "Sibling_Position",                type => new lib::sql::type::Int()                               },
                                   { name => "Sort_By",                 type => new lib::sql::type::Char ( size => 50 )                 },
                                   { name => "Order_By",                type => new lib::sql::type::Int()                               },
                                   ],
                        unique    => { Full_Path_UK => [ qw /Full_Path/ ] },
                        index     => { Parent_ID_IDX => [ qw /Parent_ID/ ] },
                        selectbox => { Parent_ID => [ qw /Document ID Full_Path/ ] },
                        category_id       => "ID",
                        category_parent   => "Parent_ID",
                        category_name     => "Name",
                        category_path     => "Full_Path",
                        category_position => "Sibling_Position",
                        pk     => [ "ID" ],
                        ai     => [ "ID" ],
                        fk     => {
                            Editor => {
                                Editor_Created_ID => 'ID',
                                Editor_Last_Modified_ID => 'ID',
                            },
                        },
                        weight => {
                            Keywords    => 10,
                            Description => 8,
                            Title       => 10,
                            Name        => 10,
                            Full_Path   => 5,
                            Lang        => 3,
                            Rights      => 3,
                            Publisher   => 3,
                            Relation    => 3,
                            Coverage    => 3,
                            Body        => 1,
                        },
                        bless_into => 'flo::Record::Document' );

    
    new lib::sql::Table ( name => "Redirect",
                          cols => [
                                   { name => "ID",       type => new lib::sql::type::Int ( not_null => 1 )               },
                                   { name => "Old_Path", type => new lib::sql::type::Char ( size => 255, not_null => 1 ) },
                                   { name => "New_Path", type => new lib::sql::type::Char ( size => 255, not_null => 1 ) }
                                   ],
                          pk     => [ "ID" ],
			  unique => { Old_New_Uk => [ qw /Old_Path/ ] },
                          ai => "ID",
                          bless_into => 'flo::Record::Redirect' );
    
    
    new lib::sql::Table ( name => "Base_Document",
                          cols => [
                                   { name => "ID",          type => new lib::sql::type::Int ( not_null => 1 ) },
                                   { name => "Editor_ID",   type => new lib::sql::type::Int ( not_null => 1 ) },
                                   { name => "Document_ID", type => new lib::sql::type::Int ( not_null => 1 ) }
                                   ],
                          pk     => [ "ID" ],
                          ai     => "ID",
                          unique => { Editor_Document_Owner_uk => [ qw/Editor_ID Document_ID/ ] },
                          selectbox => { Editor_ID => [ qw /Editor ID Login/ ], Document_ID => [ qw /Document ID Full_Path/ ] },
                          fk => {
                              Editor   => { Editor_ID => 'ID' },
                              Document => { Document_ID => 'ID' },
                          } );
    
    
    new lib::sql::Table ( name => "Contributor",
                          cols => [
                                   { name => "ID",          type => new lib::sql::type::Int ( not_null => 1 ) },
                                   { name => "Editor_ID",   type => new lib::sql::type::Int ( not_null => 1 ) },
                                   { name => "Document_ID", type => new lib::sql::type::Int ( not_null => 1 ) }
                                   ],
                          pk     => [ "ID" ],
                          ai     => "ID",
                          unique => { Editor_Document_Contributor_uk => [ qw /Editor_ID Document_ID/ ] },
                          selectbox => {
                              Editor_ID   => [ qw /Editor ID Login/ ],
                              Document_ID => [ qw /Document ID Full_Path/ ],
                          },
                          fk => {
                              Editor   => { Editor_ID => 'ID'   },
                              Document => { Document_ID => 'ID' },
                          },
                          bless_into => 'flo::Record::Contributor' );
    
    
    new lib::sql::Table ( name   => "Session",
                          cols   => [
                                     { name => "ID",        type => new lib::sql::type::Char ( size => 50, not_null => 1 ) },
                                     { name => "Last_Time", type => new lib::sql::type::Int ( not_null => 1 )              },
                                     { name => "IP",        type => new lib::sql::type::Char ( size => 20 )                },
                                     { name => "Editor_ID", type => new lib::sql::type::Int ( not_null => 1 )              },
                                     ],
                          pk => [ "ID" ],
                          fk => { Editor => { Editor_ID => "ID" } },
                          selectbox => { Editor_ID => [ qw /Editor ID Login/ ] } );
    
    lib::sql::Table->save_state ('su');

    # tries to silently drop everything
    try { lib::sql::Table->drop_all } catch {};
    
    # tries to create all the tables
    lib::sql::Table->create_all;
    
    # initialize database
    my $editor   = lib::sql::Table->table ('Editor');
    my $document = lib::sql::Table->table ('Document');
    my $base_document = lib::sql::Table->table ('Base_Document');
    
    $editor->insert ( Login       => 'admin',
                      Password    => 'admin',
                      Email       => $CONFIG->{ORGANIZATION_EMAIL},
                      First_Name  => '',
                      Family_Name => $CONFIG->{ORGANIZATION_NAME},
                      Disabled    => 1 );
    
    $editor->insert ( Login       => $CONFIG->{USER_LOGIN},
                      Password    => $CONFIG->{USER_PASSWORD},
                      Email       => $CONFIG->{USER_EMAIL},
                      First_Name  => $CONFIG->{USER_FIRST_NAME},
                      Family_Name => $CONFIG->{USER_LAST_NAME},
                      Disabled    => 0 );
    
    $base_document->insert ( Editor_ID => 2, Document_ID => 1 );
    
    $document->insert ( Template                => 'default',
                        Cache_Control           => 10,
                        Description             => 'enter a description here',
                        Keywords                => 'enter keywords here',
                        Date_Created            => current_date(),
                        Date_Last_Modified      => current_date(),
                        Editor_Created_ID       => 2,
                        Editor_Last_Modified_ID => 2,
                        Name                    => '',
                        Title                   => 'Root document',
                        Lang                    => 'en',
                        Sort_By                 => 'Title',
                        Order_By                => 0 );
    print "OK\n";
}


##
# current_date;
# -------------
#   Returns the current date in MySQL format
##
sub current_date
{
    # Prefill date fields with current date
    my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = localtime (time);
    $mon++;
    $year += 1900;

    if (length ($mon)  == 1) { $mon  = "0" . $mon  }
    if (length ($mday) == 1) { $mday = "0" . $mday }

    return "$year-$mon-$mday $hour:$min:$sec";
}


##
# write_apache_htpasswd_file ($site_dir);
# ---------------------------------------
#   Writes a .htpasswd file with user name 'admin'
#   and returns the auto-generated password
##
sub write_apache_htpasswd_file($)
{
    my $site_dir = shift;
    my $admin    = 'admin';
    my @chars    = ('a'..'z', 'A'..'Z');
    my $pwd      = join '', map { $chars[int (rand ($#chars + 1))] } 1..8;
    
    print "Writing .htpasswd file... ";
    unlink "$site_dir/.htpasswd" if (-e "$site_dir/.htpasswd");
    open FP, ">$site_dir/.htpasswd";
    close FP;
    my $htpwd = new Apache::Htpasswd ("$site_dir/.htpasswd");
    $htpwd->htpasswd ("admin", $pwd);
    print "OK\n";
    return $pwd;
}


##
# add_site_to_mkdoc;
# ------------------
#   Adds this website to the MKDoc sites config files and
#   amends conf/httpd.conf as well
##
sub add_site_to_mkdoc()
{
    my $mkdoc_dir = $CONFIG->{MKDOC_DIR};
    print "Re-building $mkdoc_dir/conf/sites.conf... ";
    
    # read conf/sites.conf data
    open FP, "<$mkdoc_dir/conf/sites.conf" or
	die "Cannot read-open $mkdoc_dir/conf/sites.conf";
    my $data = join '', <FP>;
    close FP;
    
    # instanciates the $VAR1 hashref
    my $VAR1 = undef;
    eval "$data";
    die $@ if (defined $@ and $@);
    
    # add the new site to the $VAR1 hashref
    $VAR1->{$CONFIG->{PUBLIC_DOMAIN}} = $CONFIG->{SITE_DIR};
    $VAR1->{$CONFIG->{ADMIN_DOMAIN}} = $CONFIG->{SITE_DIR};
    $VAR1->{$CONFIG->{SU_DOMAIN}} = $CONFIG->{SITE_DIR};
    
    # saves the $VAR1 hashref
    open FP, ">$mkdoc_dir/conf/sites.conf" or
	die "Cannot write-open $mkdoc_dir/conf/sites.conf";
    print FP Dumper ($VAR1);
    close FP;
    print "OK\n";
        
    # rewrites the conf/httpd.conf file
    print "Re-writing $mkdoc_dir/conf/httpd.conf... ";
    my $includes = { map { 'Include ' . $_ . '/httpd.conf' => 1 } values %{$VAR1} };
    open FP, ">$mkdoc_dir/conf/httpd.conf" or
	die "Cannot write-open $mkdoc_dir/conf/httpd.conf";
    for (keys %{$includes}) { print FP $_ . "\n" }
    close FP;
    print "OK\n";
}


##
# write_config_files;
# -------------------
#   Writes all the MKDoc config files for that site from what's
#   in $CONFIG
##
sub write_config_files()
{
    print "Writing config files...\n";
    die $@ if (defined $@ and $@);   
    write_config_file ('cgi.mkdoc');
    write_config_file ('cgi.admin');
    write_config_file ('flo.plugin.Cache')                    if (defined $CONFIG->{CACHE} and $CONFIG->{CACHE});
    write_config_file ('flo.plugin.Cache.Reader')             if (defined $CONFIG->{CACHE} and $CONFIG->{CACHE});
    write_config_file ('flo.plugin.Cache.Writer')             if (defined $CONFIG->{CACHE} and $CONFIG->{CACHE});
    write_config_file ('flo.plugin.Convert.TXT')              if (defined $CONFIG->{H2TXT} and $CONFIG->{H2TXT});
    write_config_file ('flo.plugin.Error');
    write_config_file ('flo.plugin.explorer.Admin');
    write_config_file ('flo.plugin.explorer.Admin_LANG');
    write_config_file ('flo.plugin.explorer.Print');
    write_config_file ('flo.plugin.explorer.Public');
    write_config_file ('flo.plugin.JavaScript.Headline');
    write_config_file ('flo.plugin.Search');
    write_config_file ('flo.plugin.Sitemap');
    write_config_file ('flo.plugin.Static');
    write_config_file ('flo.plugin.XML.IMS');
    write_config_file ('flo.plugin.XML.RDF.DC');
    write_config_file ('flo.plugin.XML.RDF.RSS.090.Headline') if (defined $CONFIG->{R090HD} and $CONFIG->{R090HD});
    write_config_file ('flo.plugin.XML.RSS.091.Headline')     if (defined $CONFIG->{R091HD} and $CONFIG->{R091HD});
    write_config_file ('flo.plugin.XML.RDF.RSS.100.Headline') if (defined $CONFIG->{R100HD} and $CONFIG->{R100HD});
    write_config_file ('flo.plugin.XML.RDF.RSS.100.Sitemap')  if (defined $CONFIG->{R100SM} and $CONFIG->{R100SM});
    write_config_file ('flo.plugin.Robots');
    write_config_file ('flo.XHTMLFilter');
    write_config_file ('mime.types');
    write_config_file ('GLOBAL');
		       
    # this file can't be parsed by the template engine indeed
    write_template_config_file();
    print "OK\n";
}


##
# write_template_config_file;
# ---------------------------
#   The template config file cannot be written from a template config
#   because it defines the tags that the template engine uses itself,
#   therefore we have to hard code the content of this config file into
#   the install script
##
sub write_template_config_file()
{
    my $file = 'flo.Template';
    my $template_dir = $CONFIG->{SITE_DIR} . '/templates';
    my $data = <<'EOF';
LEFT_TOKEN      <%
RIGHT_TOKEN     %>
BASE_DIR        $template_dir/templates

# do not change these tags
sibling         flo::Template::Sibling
path            flo::Template::Path
include         flo::Template::Include
var             lib::Template::Var
if              lib::Template::If
perl            lib::Template::Perl
loop            flo::Template::Loop
document_list   flo::Template::DocumentList
browser_detect  flo::Template::BrowserDetect
uri_encode      flo::Template::URIEncode
a               flo::Template::Anchor
http            flo::Template::HTTP
http_date       flo::Template::HTTPDate
iso_date        flo::Template::ISODate
comment         flo::Template::Comment
link            flo::Template::Link
component       flo::Template::Component
to_html         flo::Template::Text2Html
EOF

    print "Writing $file... ";
    open FP, ">config/$file" or die "Cannot write-open config/$file";
    print FP qq |LEFT_TOKEN      <%|, "\n";
    print FP qq |RIGHT_TOKEN     %>|, "\n";
    print FP qq |BASE_DIR        $template_dir|,     "\n";

    print FP qq |sibling         flo::Template::Sibling|,      "\n";
    print FP qq |path            flo::Template::Path|,         "\n";
    print FP qq |include         flo::Template::Include|,      "\n";
    print FP qq |var             lib::Template::Var|,          "\n";
    print FP qq |if              lib::Template::If|,           "\n";
    print FP qq |perl            lib::Template::Perl|,         "\n";
    print FP qq |loop            flo::Template::Loop|,         "\n";
    print FP qq |document_list   flo::Template::DocumentList|, "\n";
    print FP qq |browser_detect  flo::Template::BrowserDetect|, "\n";
    print FP qq |uri_encode      flo::Template::URIEncode|, "\n";
    print FP qq |a               flo::Template::Anchor|, "\n";
    print FP qq |http            flo::Template::HTTP|, "\n";
    print FP qq |http_date       flo::Template::HTTPDate|, "\n";
    print FP qq |iso_date        flo::Template::ISODate|, "\n";
    print FP qq |comment         flo::Template::Comment|, "\n";
    print FP qq |link            flo::Template::Link|, "\n";
    print FP qq |component       flo::Template::Component|, "\n";
    print FP qq |to_html         flo::Template::Text2Html|, "\n";
    print FP qq |headlines       flo::Template::Headlines|, "\n";
    close FP;
    print "OK\n";
}


##
# write_config_file ($file);
# --------------------------
#   Writes the $CONFIG file using variables set in $CONFIG
##
sub write_config_file
{
    my $file = shift;

    # initialize template module
    $lib::Template::CONFIG = new lib::Config;
    $lib::Template::CONFIG->set (qw /LEFT_TOKEN <%/);
    $lib::Template::CONFIG->set (qw /RIGHT_TOKEN %>/);
    $lib::Template::CONFIG->set ('BASE_DIR', $CONFIG->{SITE_DIR});
    $lib::Template::CONFIG->set ('var', 'lib::Template::Var');
    $lib::Template::CONFIG->set ('if', 'lib::Template::If');
    $lib::Template::RIGHT_TOKEN = quotemeta ('%>');
    $lib::Template::LEFT_TOKEN  = quotemeta ('<%');
    $lib::Template::BASE_DIR    = $CONFIG->{SITE_DIR};
    $lib::Template::TOKEN_REGEX = $lib::Template::LEFT_TOKEN . '.*?' . $lib::Template::RIGHT_TOKEN;
    $lib::Template::STASH = {};
    my $tmpl = new lib::Template ( file => 'config_templates/' . $file, hash => $CONFIG );
    open FP, ">config/$file" or die "Cannot write-open config/$file";
    print FP $tmpl->parse;
    close FP;
    print " + $file\n";
}


##
# write_apache_config_file ($template, $file);
# --------------------------------------------
#   Writes the apache config file for that website
##
sub write_apache_config_file
{
    my $template = shift;
    my $file = shift;
    
    print "Writing $file... ";
    # initialize template module
    eval "use lib::Template";
    $lib::Template::CONFIG = new lib::Config;
    $lib::Template::CONFIG->set (qw /LEFT_TOKEN <%/);
    $lib::Template::CONFIG->set ('BASE_DIR', $CONFIG->{MKDOC_DIR});
    $lib::Template::CONFIG->set (qw /RIGHT_TOKEN %>/);
    $lib::Template::CONFIG->set ('var', 'lib::Template::Var');
    $lib::Template::CONFIG->set ('if', 'lib::Template::If');
    $lib::Template::RIGHT_TOKEN = quotemeta ('%>');
    $lib::Template::LEFT_TOKEN  = quotemeta ('<%');
    $lib::Template::BASE_DIR    = $CONFIG->{MKDOC_DIR};
    $lib::Template::TOKEN_REGEX = $lib::Template::LEFT_TOKEN . '.*?' . $lib::Template::RIGHT_TOKEN;
    $lib::Template::STASH = {};
    my $tmpl = new lib::Template ( file => $template, hash => $CONFIG );
    open FP, ">$file" or die "Cannot write-open $file";
    print FP $tmpl->parse;
    close FP;
    print "OK\n";
}


##
# setup_mkdoc_directories();
# --------------------------
#   This function is in charge of creating directories
#   which will be needed for this site and to give them
#   the right permissions
##
sub setup_mkdoc_directories()
{
    print "Setting up MKDoc directories... ";
    
    # if the cache dir is not there, let's create it
    # then let's change the permission
    unless (-e 'cache')
    {
	mkdir 'cache', 0777;
    }
    chmod 0777, 'cache';
    
    # if the tmp dir is not there, let's create it
    # then let's change the permission
    unless (-e 'tmp')
    {
	mkdir 'tmp', 0777;
    }
    chmod 0777,  'tmp';    
    
    # if the static dir is not here let's create it
    unless (-e 'static')
    {
	mkdir 'static', 0777;
    }
    
    # if the config dir is not here let's create it
    unless (-e 'config')
    {
	mkdir 'config', 0777;
    }
    
    # if the static/images dir is not here let's create it
    # then let's change the permission
    unless (-e 'static/images')
    {
	mkdir 'static/images', 0777;
    }
    chmod 0777, 'static/images';
    
    # if the static/images dir is not here let's create it
    # then let's change the permission
    unless (-e 'static/files')
    {
	mkdir 'static/files', 0777;
    }
    chmod 0777, 'static/files';
    
    # create the apache log directory
    unless (-e 'log')
    {
	mkdir 'log', 0777;
    }
    chmod 0777, 'log';
    
    # create the su directory
    unless (-e 'su')
    {
	mkdir 'su', 0777;
    }
    
    chmod 0700, 'install.conf';
    print "OK\n";
}


##
# check_database_connect;
# -----------------------
#   Attempts to connect to the MySQL database
##
sub check_database_connect()
{
    my $mysql_host     = $CONFIG->{HOST};
    my $mysql_database = $CONFIG->{DATABASE};
    my $mysql_port     = $CONFIG->{PORT};
    my $mysql_user     = $CONFIG->{USER};
    my $mysql_password = $CONFIG->{PASSWORD};
    
    print "Trying to connect to MySQL... ";
    eval
    {
	my $dsn = "DBI:mysql:database=$mysql_database";
	$dsn   .= ":host=$mysql_host" if (defined $mysql_host and $mysql_host);
        $dsn   .= ":port=$mysql_port" if (defined $mysql_port and $mysql_port);
	my $dbh = DBI->connect($dsn, $mysql_user, $mysql_password, {'RaiseError' => 1});
    };
    
    if ($@)
    {
	print "FAILED\n\n";
	print "$@";
	exit;
    }
    
    print "OK\n";
}


##
# check_r090hd();
# ---------------
#   Checks for RSS 090 Headlines plugin dependencies
#     + XML::RSS
##
sub check_r090hd
{
    print "Checking for RSS 090 Headlines plugin dependencies... ";
    eval "use XML::RSS";
    if ($@)
    {
	print "FAILED\n\n";
	print "You need XML::RSS to use the RSS 090 Headlines plugin.\n";
	print "Check ftp:://ftp.cpan.org to download a recent version of XML::RSS.\n";
	print "Installation aborted.\n";
	exit;
    }
    print "OK\n";
}


##
# check_r091hd();
# ---------------
#   Checks for RSS 091 Headlines plugin dependencies
#     + XML::RSS
##
sub check_r091hd
{
    print "Checking for RSS 091 Headlines plugin dependencies... ";
    eval "use XML::RSS";
    if ($@)
    {
	print "FAILED\n\n";
	print "You need XML::RSS to use the RSS 091 Headlines plugin.\n";
	print "Check ftp:://ftp.cpan.org to download a recent version of XML::RSS.\n";
	print "Installation aborted.\n";
	exit;
    }
    print "OK\n";
}


##
# check_r100hd();
# ---------------
#   Checks for RSS 100 Headlines plugin dependencies
#     + XML::RSS
##
sub check_r100hd
{
    print "Checking for RSS 100 Headlines plugin dependencies... ";
    eval "use XML::RSS";
    if ($@)
    {
	print "FAILED\n\n";
	print "You need XML::RSS to use the RSS 100 Headlines plugin.\n";
	print "Check ftp:://ftp.cpan.org to download a recent version of XML::RSS.\n";
	print "Installation aborted.\n";
	exit;
    }
    print "OK\n";
}


##
# check_r100sm();
# ---------------
#   Checks for RSS 100 Headlines plugin dependencies
#     + XML::RSS
##
sub check_r100sm
{
    print "Checking for RSS 100 Sitemap plugin dependencies... ";
    eval "use XML::RSS";
    if ($@)
    {
	print "FAILED\n\n";
	print "You need XML::RSS to use the RSS 100 Sitemap plugin.\n";
	print "Check ftp:://ftp.cpan.org to download a recent version of XML::RSS.\n";
	print "Installation aborted.\n";
	exit;
    }
    print "OK\n";
}


##
# check_html2text();
# ------------------
#   Checks for HTML to TEXT plugin dependencies
#     + HTML::TreeBuilder
#     + HTML::FormatText
##
sub check_html2text
{
    print "Checking for HTML to TEXT plugin dependencies... ";
    eval "use HTML::TreeBuilder";
    if ($@)
    {
	print "FAILED\n\n";
	print "You need HTML::FormatText to use the HTML 2 TEXT plugin.\n";
	print "Check ftp:://ftp.cpan.org to download a recent version of HTML::TreeBuilder.\n";
	print "Installation aborted.\n";
	exit;
    }
    
    eval "use HTML::FormatText";
    if ($@)
    {
	print "FAILED\n\n";
	print "You need HTML::FormatText to use the HTML 2 TEXT plugin.\n";
	print "Check ftp:://ftp.cpan.org to download a recent version of HTML::FormatText.\n";
	print "Installation aborted.\n";
	exit;
    }

    print "OK\n";
}


##
# prompt_mkdoc_dir();
# -------------------
#   Prompts for the installation dir of MKDoc and returns it
##
sub prompt_mkdoc_dir()
{
    print "\n";
    print "Enter MKDoc 1.1 installation directory. [/opt/mkdoc]: ";
    my $mkdoc_dir = <STDIN>;
    chomp ($mkdoc_dir);
    $mkdoc_dir =~ s/\/$//;
    $mkdoc_dir ||= '/opt/mkdoc';
    unless (-e $mkdoc_dir and -d $mkdoc_dir)
    {
	print "\n";
	print "$mkdoc_dir does not exist or is not a valid directory!\n";
	print "Installation aborted.\n";
	exit;
    }
    
    return $mkdoc_dir;
}


##
# print_hello();
# --------------
#   Print a welcome / warning message and asks wether to continue
#   or not
##
sub print_hello()
{
    print "===============================================================\n";
    print "  MKDoc 1.1 website install script                             \n";
    print "===============================================================\n\n";
    print "  This installation script will attempt to setup a new MKDoc   \n";
    print "  website using the information provided in the install.conf   \n";
    print "  file.                                                        \n\n";
    print "  Please make sure that install.conf parameters are correct    \n";
    print "  before you continue.                                         \n\n";
    print "  ATTENTION! If the website which is set in install.conf does  \n";
    print "  exist, all its data will be removed.                         \n";
    print "===============================================================\n\n";
    print "Are you sure you want to continue [y|N] ?";
    my $in = <STDIN>;
    chomp ($in);
    unless ($in eq 'y' or $in eq 'Y')
    {
	print "Good bye!\n\n";
	exit;
    }
    print "\n";
}


##
# check_perl();
# -------------
#   Checks that we are using a version of Perl which is recent enough
##
sub check_perl()
{
    print "Checking for Perl 5.005_03... ";
    eval "use 5.005_03";
    if ($@)
    {
	print "FAILED\n\n";
	print "You need at least Perl 5.005_03 to use this software.\n";
	print "Check http://www.perl.com to download a recent version of Perl.\n";
	print "Installation aborted.\n";
	exit;
    }
    else
    {
	print "OK\n";
    }
}


##
# check_dbi;
# ----------
#   Checks that the DBI module are installed
#   so that we can access the MySQL database
##
sub check_dbi()
{
    print "Checking for DBI... ";
    eval "use DBI";
    if ($@)
    {
	print "FAILED\n\n";
	print "You need CPAN's DBI module to use this software.\n";
	print "Check ftp://ftp.cpan.org to download the latest version of this module.\n";
	print "Installation aborted.\n";
	exit;
    }
    else
    {
	print "OK\n";
    }
}


##
# check_dbd_mysql();
# ------------------
#   Checks that the Msql-Mysql DBD modules are installed
#   so that we can access the MySQL database
##
sub check_dbd_mysql()
{
    print "Checking for DBD::mysql... ";
    eval "use DBD::mysql";
    if ($@)
    {
	print "FAILED\n\n";
	print "You need CPAN's DBD msql-mysql modules to use this software.\n";
	print "Check ftp://ftp.cpan.org to download the latest version of this module.\n";
	print "Installation aborted.\n";
	exit;
    }
    else
    {
	print "OK\n";
    }
}


##
# check_tidy ($tidy_path);
# ------------------------
#   Checks that tidy is installed
##
sub check_tidy($)
{
    print "\n";
    print "Checking for HTML Tidy... ";
    my $tidy  = shift;
    unless (defined $tidy or $tidy or -e $tidy)
    {
        print "FAILED\n\n";
        print "You need Raggett's HTML Tidy program to use this software.\n";
        print "Check http://www.w3.org/People/Raggett/tidy to download the latest version of this program.\n";
        print "Installation aborted.\n";
    }
    print "OK\n";
    return $tidy;
}


1;