cvsuser 02/10/15 14:55:29
Modified: App-Context/bin app
Log:
add support to search for app.conf
Revision Changes Path
1.2 +84 -41 p5ee/App-Context/bin/app
Index: app
===================================================================
RCS file: /cvs/public/p5ee/App-Context/bin/app,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -w -r1.1 -r1.2
--- app 18 Sep 2002 02:54:10 -0000 1.1
+++ app 15 Oct 2002 21:55:28 -0000 1.2
@@ -1,41 +1,95 @@
-#!perl -wT
+#!/usr/local/bin/perl -w
+
+# removed -T option because then it ignores PERL5LIB, which is used at times
#############################################################################
-# $Id: app,v 1.1 2002/09/18 02:54:10 spadkins Exp $
+# $Id: app,v 1.2 2002/10/15 21:55:28 spadkins Exp $
#############################################################################
BEGIN {
- my ($var, $value, $open, $file, $path_part);
- my ($app_path_info, $default_wname);
local(*FILE);
- $app_path_info = "";
- $app_path_info = $ENV{PATH_INFO} if (defined $ENV{PATH_INFO});
-
+ my ($open, $file, $conf_base, $app_path_info, $prog_dir);
+ $app_path_info = $ENV{PATH_INFO} || "";
+ $open = 0; # assume we cannot find an openable config file ...
$file = "";
- $path_part = "";
- if ($app_path_info =~ s!^/([^/]+)!!) {
- $path_part = $1;
- $file = "$path_part.conf"; # initialization config file
+ $conf_base = "";
+ $prog_dir = $0;
+ %main::conf = ();
+
+ if ($prog_dir =~ m!^/!) {
+ # i.e. /usr/local/bin/app, /app
+ $prog_dir =~ s!/[^/]+$!!;
+ }
+ else {
+ # i.e. app, ./app, ../bin/app, bin/app
+ $prog_dir =~ s!/?[^/]+$!!;
+ $prog_dir = "." if (!$prog_dir);
}
- $open = 0; # assume we cannot find an openable config file ...
- $open = open(main::FILE, "< $file") if ($file && !$open);
+ my ($var, $value);
- if ($open) {
- $default_wname = "";
- if ($app_path_info =~ s!^/([^/]+)!!) {
- $default_wname = $1; # default widget name
+ #################################################################
+ # read command-line configuration variables
+ # (anything starting with one or two dashes is a config var, not a CGI var)
+ # i.e. --debugmode=record -debugmode=replay
+ # an option without an "=" (i.e. --help) acts as --help=1
+ #################################################################
+ while ($#ARGV >= 0 && $ARGV[0] =~ /^--?([^=-][^=]*)(=?)(.*)/) {
+ $var = $1;
+ $value = ($2 eq "") ? 1 : $3;
+ shift @ARGV;
+ $main::conf{$var} = $value;
}
+
+ if ($main::conf{initconf} && open(main::FILE, "< $main::conf{initconf}")) {
+ $open = 1;
+ }
+
+ # #1. first arg matches a conf file
+ if (!$open && $app_path_info =~ m!^/([^/]+)!) {
+ $conf_base = $1;
+ $file = "$conf_base.conf"; # initialization config file
+ # check config directory
+ $open = open(main::FILE, "< $ENV{APP_CONF_DIR}/$file") if
($ENV{APP_CONF_DIR} && !$open);
+ # check current directory
+ $open = open(main::FILE, "< $file") if (!$open);
+ # check program directory
+ $open = open(main::FILE, "< $prog_dir/$file") if ($prog_dir ne "." &&
!$open);
+ # check home directory (for interactive use)
+ $open = open(main::FILE, "< $ENV{HOME}/.app/$file") if ($ENV{HOME} &&
!$open);
+ if ($open) {
+ $app_path_info =~ s!^/([^/]+)!!;
}
- else {
- $default_wname = $path_part;
}
- $open = open(main::FILE, "< $0.conf") if (!$open);
- $open = open(main::FILE, "< app.conf") if (!$open);
+ if (!$open) {
+ $conf_base = $0;
+ $conf_base =~ s!.*/!!;
+ $conf_base =~ s!\.[^.]+$!!;
+ $file = "$conf_base.conf"; # initialization config file
+ # check config directory
+ $open = open(main::FILE, "< $ENV{APP_CONF_DIR}/$file") if
($ENV{APP_CONF_DIR} && !$open);
+ # check current directory
+ $open = open(main::FILE, "< $file") if (!$open);
+ # check program directory
+ $open = open(main::FILE, "< $prog_dir/$file") if ($prog_dir ne "." &&
!$open);
+ # check home directory (for interactive use)
+ $open = open(main::FILE, "< $ENV{HOME}/.app/$file") if ($ENV{HOME} &&
!$open);
+ }
+
+ if (!$open) {
+ $file = "app.conf"; # initialization config file
+ # check config directory
+ $open = open(main::FILE, "< $ENV{APP_CONF_DIR}/$file") if
($ENV{APP_CONF_DIR} && !$open);
+ # check current directory
+ $open = open(main::FILE, "< $file") if (!$open);
+ # check program directory
+ $open = open(main::FILE, "< $prog_dir/$file") if ($prog_dir ne "." &&
!$open);
+ # check home directory (for interactive use)
+ $open = open(main::FILE, "< $ENV{HOME}/.app/$file") if ($ENV{HOME} &&
!$open);
+ }
- %main::conf = ();
if ($open) {
while (<main::FILE>) {
chomp;
@@ -48,30 +102,19 @@
if (/^([a-zA-Z_.-]+) *= *(.*)/) { # untainting also happens
$var = $1;
$value = $2;
+ if (!defined $main::conf{$var}) {
$main::conf{$var} = $value; # save all in %main::conf
}
}
+ }
close(main::FILE);
+ }
+
if (defined $main::conf{perlinc}) { # add perlinc entries
unshift(@INC, split(/[ ,]+/,$main::conf{perlinc}));
}
- }
- $main::conf{defaultWname} = $default_wname if ($default_wname);
$main::conf{app_path_info} = $app_path_info if ($app_path_info);
-}
-
-#################################################################
-# read command-line configuration variables
-# (anything starting with one or two dashes is a config var, not a CGI var)
-# i.e. --debugmode=record -debugmode=replay
-# an option without an "=" (i.e. --help) acts as --help=1
-#################################################################
-while ($#ARGV >= 0 && $ARGV[0] =~ /^--?([^=-][^=]*)(=?)(.*)/) {
- $var = $1;
- $value = ($2 eq "") ? 1 : $3;
- shift @ARGV;
- $main::conf{$var} = $value;
}
use App;
