home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
rtsi.com
/
2014.01.www.rtsi.com.tar
/
www.rtsi.com
/
OS9
/
FAQ
/
cgi-bin
/
discus4_00
/
source
/
config.cgi
< prev
next >
Wrap
Text File
|
2009-11-06
|
4KB
|
137 lines
#
#-------------------------------------------------------------------------------
# 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 = '.';
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;