#!/usr/bin/perl

###
##	IRCCS Configuration utility version 1a
##	Copyright (C) 2000  Daniel J. Wightman <dent@abonica.net>
##
##	See the copyright or COPYRIGHT in the main directory for
##	details.  See the LICENSE in the main program directory.
##
##	My suggestion is that you get the newest version
##	of this program.  One way to locate the newest
##	version is to point your web browser at:
##
##	http://www.abonica.net/ircserv
###

# ------------------------------------------------------------------------
# Variable Configuration Utility
# ------------------------------------------------------------------------
# I needed a quick way to allow people, installing my irc services
# package, to change the variables in the config file without much,
# or any, knowledge of perl.  The explainations and variable structres
# are easy to figure out but I'm always assuming something is easier
# that it is.  I'm always trying to correct myself with the basic
# truth " I don't know ".  Even when it looks like I should, or do.
# So, I tossed this utility together, which started to grab too much
# of my attention. It's just a quick hack.
#
# If it's to be used in other programs then a few changes have to be made.
# The first that comes to mind is OUR variables. We can't own any of our own
# variables as we inherit variables from options and just pray that there
# are no duplicates HERE.  I know there aren't because I programmed the
# package that this utility configures.  After a few hours, however, I
# discovered that it could be used by many packages that I've seen.  Some
# that come to mind are those written for html.
#
# The config file is built up of ONLY variables and for a configurator
# to be globaly useable a seperate file, or segment, would have to be
# allocated for settable variables.  I've seen this technique in web
# for cgi and others.  I use this technique myself.  It would be nice
# if we all had ONE utility that could configure a script that we obtained
# from another by just answering questions.
#
# Here's how mine works.  My config file is made up of commented text,
# variables and it's values.  The text, explaination of the variable,
# comes before the variable is set, describes what the variable does.
# Any file that uses this simple approach SHOULD be able to use this
# utility to configure it's script.  The script first pulls in the
# old, default, variables from the original config file ( which is never
# actualy changed by the configurator ) and then overlays that with
# an options file that the configurator built, if such exists.  Hence,
# changing, internaly, only those variables that the user had time to
# answer in the last pass.  Using those overlayed values we're able to
# show them the default, their last setting, and what the variable does.
# If no such option has been set we issue the "default" default, contained
# in the original config file.  After they're done with all the questions,
# or have decided to stop /exit we write the options file.  Your script
# that uses the variables has to require the original config file and then
# overlay it with the options file, just like this does, simply by using
# the 'require' for config first and then options, unless you have a better
# way, works for me.
#
# If there are variables in your config file that do not need setting you
# can simply make a tag for it's begining and it's end...here's an example:
# # SKIP START
#  $boo = "moo";
# # SKIP END
#
# Yes, these do need to be commented, after all you're simply writting
# a perl file or altering one to fit the needs of the configurator.
# I think that's it.  Sombody please rewrite this. Is there a configurator
# out there? *sigh* not enough time to go searching.  I guess I should
# check for an RFC.
# 

$optionsconf = "options.conf";
$serviceconf = "service.conf";

# Open the win32use.pm file to deposit our windows
# specific 'use' modules.
open WIN32USE, ">win32use.pm" or die "Can't generate OS specific useage file win32use.pm : $!\n";

$date = localtime(time);
print WIN32USE <<"HEADER";
## 
# Date Generated: $date
## 
# -------------------------------------------------------------------------
# win32use.pm - generated by Configure (FruitBrick configuration utility)
# -------------------------------------------------------------------------
# This file is OS specific.  If you move to a new platform rerun Configure.
# If this file is missing the main process, service.pl, may not run at all.
##
HEADER

# test to see if they have win32 process, if they do
# then they must have Win32 as well.
eval('use Win32::Process;');
if($@)
	{
	print WIN32USE '1;';
	close(WIN32USE);
	}
else
	{
	print WIN32USE '
	use Win32;
	use Win32::Process;
	1;
	';
	close(WIN32USE);
	}

$scroll = "\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n";

require "./$serviceconf"; # load this one first

# this will load THEIR defaults if they have any.
if(-f "$optionsconf") { require "./$optionsconf"; }

{

$text = qq~

    ---------------------------------------------------------------
    -            FruitBrick Configuration Utility v1a            -
    ---------------------------------------------------------------
    Before you go wasting your time and not be able to finish this
    configuration you'll want to obtain the following information
    first.  You can edit the config file manualy "$serviceconf" if
    you want but the safest thing to do is use this utility.
    ---------------------------------------------------------------
    * Uplink Server name, or IP (ip prefered)
    * C/N line password from uplink server
    * A snickers, cos _I_ got one </humor>
    * Your domain name or host.domain.
    * An email address (shows in services)
    * Know your OS. Windows? Linux? Other?
    * Does your system support fork() ? win32 does NOT, enable fakefork
    ---------------------------------------------------------------
    * * Hit Control+C  to exit without changes
    * * Typing \\ and then pressing the ENTER key will bring you back
      * a question at a time. Typing / goes forward and typing /exit
      * will exit and save your current configuration settings.
    * * At the end of configuration it will automaticaly save.
    ---------------------------------------------------------------
    print "Press ENTER to begin...";
~;

&sendtext($text);

open STDIN;
$line = <STDIN>;
&getdefaults; # just build the hash of questions and pointers

# this will help us locate the previouse sections
# that we answered.
$cnt = 0;

foreach $option (@lines)
	{
	# let's not process the lines that they don't need to change
	if ($option =~ /SKIP START/i) { $skip = 1; next; } # define it
	if ($option =~ /SKIP END/i) { undef($skip); next; }
	next if $skip;

	if($option =~ /\.\=/) { next; }

	($eval) = split /\=/, $option;
	$eval =~ s/\s+//g;
	$eval =~s/\;//g; # we use $more; which will error when run later
	if($eval =~ /^\$/)
		{
		$old{evals}{$cnt} = $eval;
	REDO:
		print $scroll;
		# display the explaination, works for backup and forward too
		print $old{lines}{$cnt};
		$eval = $old{evals}{$cnt};
		$line = ""; # gotta reset it

		# if our last $line was \ then we issue the
		# old lines, we're on a second loop here, or more.
		#if( ($line eq "\\")  || ($line eq "/") )
		#	{
		#	}
		print "\nDefault:\n", eval($eval) , "\n\n";
		print "Navigation: [ \\ go back ] [ / move forward ][ /exit exit and save ]\n";
		print "Change this item by typing or use one of the navigation commands: \n";

		$line = <STDIN>;
		chomp($line);
		# get rid of some characters they might actually type
		# expecting results.
		$line =~ s/\[A|\[B|\[C|\[D|\[2~|\[1~|\[5~|\[3~|\[4~|\[6~|//g;

		# did they goof? reasign the old variable
		if($line eq "\\")
			{
			# if this is our first line then there's no place
			# to backup, just get out.
			if($cnt == 0)
				{
				print "You're on the first question already.\n";
				print "PLEASE WAIT FOR PROMPT BEFORE TYPING\n";
				sleep 2;
				goto REDO;
				}
			$cnt--;
			goto REDO;
			}
		if($line eq "/")
			{
			if(!$old{evals}{$cnt+1})
				{
				print "You're on the last question you answered already.\n";
				print "PLEASE WAIT FOR PROMPT BEFORE TYPING\n";
				sleep 2;
				goto REDO;
				}
			$cnt++;
			goto REDO;
			}
		if($line =~ /\/exit/i)
			{
			&writeconfig;
			exit;
			}
		# PROCESS THE VARIABLE AND ASSIGN
		# if there's anything but white space then they
		# wanted to alter the default.
		if($line =~ /[^\s+]/)
			{
			print "altering values\n";
			$line =~ s/\@/\\@/g;
			$line =~ s/\\/\\\\/g; # quote this

			$neweval = $eval.' = "'.$line.'";';
			eval($neweval);
			print "new default: ", eval($eval), "\n";
			$values{$eval} = $neweval;
			# sleep 2;

			}
		else
			{
			print "Nothing typed, using default!\n";
			$neweval = eval($eval);
			$neweval =~ s/\@/\\@/g; # quote this
			$neweval =~ s/\\/\\\\/g; # quote this

			# $neweval = $eval." \= \'".$neweval."\';";
			$neweval = $eval.' = "'.$neweval.'";';
			$values{$eval} = $neweval;
			}
		# if we got this far it's time to check the forward
		# direction, if we're behind in the hash we have to
		# keep doing REDO until we're back in sync.
		# we check by seeing if this particular hash has
		# been defined yet, if it hasn't we've got a new one
		# to fill with $option.

		$cnt++; # now inc and do next

		if($old{evals}{$cnt}) { goto REDO; }
		}
	else
		{
	#	print $option;
		$old{lines}{$cnt} .= $option;
		}
	}
&writeconfig;
}
# --------------------------------------------------------------------------
# GETDEFAULTS
# --------------------------------------------------------------------------
# Just put the text and variables inside the hash
sub getdefaults
{
if (-f "./$optionsconf")
	{
	# Let's pull in their old values, they'll be overwritten
	# in the has by any new values they use as we use the variable
	# as the key.

	open CONFIG, "<./$optionsconf" || die "Can't open $optionsconf $!\n";
	@lines = <CONFIG>;
	close(CONFIG);

	# we only need the variable as a reference, since we alreay
	# have the value stored, it's easier that way.

	foreach $option (@lines)
		{
		# Let's not do any extrordinary checking here, if they
		# messed up their config they can just rewrite it.
		# if there's a $ sign in the first column it's a variable,
		# if it isn't, well... they'll figure it out eventualy.
		if($option !~ /^\$/) { next; }

		# Grab the variable
		($eval) = split /\=/, $option;
		# Get rid if the space in it
		$eval =~ s/\s+//g;
			{
			# find it in our internal memory
			$neweval = eval($eval);
			# quote this
			$neweval =~ s/\@/\\@/g; # quote this
			# build the structure
			$neweval = $eval.' = "'.$neweval.'";';
			# save it
			$values{$eval} = $neweval;
			}
		}
	}

# We need this for any variables that aren't in options, they may have
# stopped too soon, or to reset defaults.  Also, the descriptions of
# each item are in this file.

open CONFIG, "<./$serviceconf" || die "Can't open config file $serviceconf $!\n";
@lines = <CONFIG>;
close(CONFIG);

1;
}
# --------------------------------------------------------------------------
# WRITECONFIG
# --------------------------------------------------------------------------
# create, overwrite the config file
sub writeconfig
{
print "Writing new configuration options to $optionsconf\n";
open CONFIG, ">$optionsconf" or die "Can't open $options config: $!\n";

$date = localtime(time);
print CONFIG <<"HEADER";
## 
# Date Generated: $date
## 
# -------------------------------------------------------------------------
# $optionsconf - generated by Configure (FruitBrick configuration utility)
# -------------------------------------------------------------------------
# If you want to find out what these items do take a look at $serviceconf.
##
HEADER
foreach $i (keys %values)
	{	
	print "$values{$i}\n";
	print CONFIG $values{$i},"\n";
	}
print "\nDone! You might want to check \"$optionsconf\"\n";
print "just to be sure.  If you're feeling lucky then just\n";
print "start the services by typing perl service.pl\n\n";
print CONFIG <<"FOOTER";
# -------------------------------------------------------------------------
# End $optionsconf
# -------------------------------------------------------------------------
FOOTER
}
# --------------------------------------------------------------------------
# SEND
# --------------------------------------------------------------------------
# obvious what this does, if you don't know get out of this code
# and pick up a camel book.
sub send
{
print STDOUT "$_[0]";
}
# --------------------------------------------------------------------------
# SENDTEXT
# --------------------------------------------------------------------------
# Just a small routine to make sending multiple lines of text easier.
# In the source we're called with 1 or more variables. Additional variables
# contain elements we want removed from our text. Now why would they do that?
# Because it's easier to read formated.  Then we just take out the stuff
# we don't want before we send the array. All parameters are recursed over
# until there are none. So you could say &sentext($text, "\n", "\t", "\r");
# To remove newlines, tabs and returns.
#
# We also check $sendsize against the size of the string and report an
# error if the string size is larger. We'll still attempt to send
# the text, for debuging purposes, and call &writelog.
#
# OPTIONS: T / (none)
###
# Subs Used: &send()
##
# Variables already set and required:
#	$_[0]		-	the text we're formating and sending
#	$_[1]..		-	additonal parameters contain that which
#				we want removed from our text before
#				delivery.
##
sub sendtext
{
my($i, @text, $cnt);
$_[0] =~ s/^\n//; # take off the first \n, just a convenience
$_[0] =~ s/^\r//g; # take out dos junk # WHY DID I DO THIS?
$cnt = 1; # need to point to things to remove
while($_[$cnt])
	{ 
	$_[0] =~ s/$_[$cnt]//g; # take out this match
	$cnt++;
	}
(@text) = split /\n/,$_[0];
foreach $i (@text)
	{
	&send("$i\n"); # no \n's anymore
	}
}
# --------------------------------------------------------------------------
# END ALL
# --------------------------------------------------------------------------




