#!/usr/bin/perl5
#
#-------------------------------------------------------------------------------
# DISCUS COPYRIGHT NOTICE
#
# Discus is copyright (c) 2002 by DiscusWare, LLC, all rights reserved.
# The use of Discus is governed by the Discus License Agreement which is
# available from the Discus WWW site at:
#    http://www.discusware.com/discus/license
#
# Pursuant to the Discus License Agreement, this copyright notice may not be
# removed or altered in any way.
#-------------------------------------------------------------------------------

use strict;
use vars qw($GLOBAL_OPTIONS $PARAMS $DCONF);

###
### discus_conf
###
### If you get a "Script Execution Error" because discus.conf can't be found,
### you didn't enter the directory path properly.  You will need to fix the
### $DISCUS_CONF_DEFINITION on the following line to fix your scripts.
###

sub discus_conf {
	my $DISCUS_CONF_DEFINITION = '/home01/members/d/dolsson/public_html/discus_admin_309210740/discus.conf';
	return $DISCUS_CONF_DEFINITION;
}

###
### WARNING!
###
### Do not edit anything below this point unless you REALLY know what you are
### doing.  DiscusWare will not provide any support to you, whatsoever, for
### anything, if you change code below here.
###

if (! $PARAMS->{no_execute_config}) {
	$DCONF = get_parameters();
	$DCONF->{source_dir} = get_source_dir() if ! $DCONF->{source_dir};
	$DCONF->{pro_fileid} = get_pro_fileid() if $DCONF->{pro};
	require "$DCONF->{source_dir}/common.pl";
	discus("discus") if $0 =~ /config\.\w+$/i;
}

sub get_parameters {
	my $dconf = discus_conf();
	my $dc = {};
	if (open (FILE, "< $dconf")) {
		while (<FILE>) {
			if (/^(\w+)=(.*)/) {
				my ($one, $two) = ($1, $2); $two =~ s/\r//g;
				$dc->{$one} = $two;
			}
		}
		close (FILE);
	} else {
		bail("Open discus.conf: $!");
	}
	return $dc;
}

sub get_pro_fileid {
	my $PRO_FILEID_DEFINITION = '';
	return $PRO_FILEID_DEFINITION if $PRO_FILEID_DEFINITION ne "";
	opendir(DIR, $DCONF->{source_dir}) || bail("Pro File ID Location Error [1]");
	my @pro_dir = grep { /^PRO_(\d+)$/ } readdir(DIR);
	closedir(DIR);
	if (scalar @pro_dir == 1) {
		$pro_dir[0] =~ /^PRO_(\d+)/;
		return $1;
	} elsif (scalar @pro_dir > 1) {
		my @build_files = map { join("/", $DCONF->{source_dir}, $_, "build.txt") } @pro_dir;
		my @build_files_exist = grep { -f "$DCONF->{source_dir}/$_/build.txt" } @pro_dir;
		if (scalar @build_files_exist) {
			foreach my $dir (map { join("/", $DCONF->{source_dir}, $_) } @pro_dir) {
				next if -f "$dir/build.txt";
				opendir(DIR, $dir);
				while (my $f = readdir(DIR)) {
					unlink join("/", $dir, $f);
				}
				closedir(DIR);
				rmdir $dir;
			}
			if (scalar @build_files_exist > 1) {
				my $u = {};
				foreach my $build_file (@build_files_exist) {
					open (FILE, "< $DCONF->{admin_dir}/$build_file/build.txt");
					my @u = <FILE>;
					close (FILE);
					$u[0] =~ s/[^\d\.]//g;
					$u[0] =~ /^(\d+)\.(\d+)\.(\d+)$/;
					$u->{$build_file} = $3 + (10000 * $2) + (10000000 * $1);
				}
				my @pro_sort = sort { $u->{$b} <=> $u->{$a} } @pro_dir;
				my $actual = shift @pro_sort;
				foreach my $dir (map { join("/", $DCONF->{source_dir}, $_) } @pro_sort) {
					opendir(DIR, $dir);
					while (my $f = readdir(DIR)) {
						unlink join("/", $dir, $f);
					}
					closedir(DIR);
					rmdir $dir;
				}
				$actual =~ /^PRO_(\d+)/; return $1;
			} else {
				$build_files_exist[0] =~ /^PRO_(\d+)/; return $1;
			}
		} else {
			bail("Pro File ID Location Error [3]");
		}
		bail("Pro File ID Location Error [4]");
	} else {
		bail("Pro File ID Location Error [2]");
	}
}

sub get_source_dir {
	return join("/", $DCONF->{admin_dir}, "source");
}

sub bail {
	return undef if $PARAMS->{no_execute_config};
	my ($error) = @_;
	print "Content-type: text/html\n\n";
	print "<h2>Script Execution Error</h2>\n";
	print "<pre>Your discus.conf file could not be opened.\n";
	print "Error:  <b>$error</b>\nScript: $0\nOS:     $^O\nPerl:   $]\nDescr:  $!\nDiscus: 4.0</pre><p>\n";
	print "Read documentation in the <a href='http://support.discusware.com/center/resources/errors/see40.html' target='_blank'>Support Center</a><br>";
	if ($0 =~ m|.*\.(\w+)$|) {
		print "Also try your <a href='diagnose.$1' target=_blank>Program Diagnostics</a>\n";
	}
	exit(0);
}

1;