The London Perl and Raku Workshop takes place on 26th Oct 2024. If your company depends on Perl, please consider sponsoring and/or attending.
#!/usr/bin/perl

=head1 SCRIPT

Inevitably, every system has parameters which differ between development, 
certification and production.  Any parameter which will vary in such a way 
should be set up as an environment variable.  For testing, e.g., a new 
version of perl, it may be necessary to set one or more aliases.  The 
environment script in every arena is a shell script which sets environment 
variables and aliases necessary for successful execution in that arena.  
This script is generated by the create_environment script, which requires 
an environment.template file and can use an environment.defaults file.  

The environment.template file consists of lines like the following:

	FOO_DB_SERVER=
	FOO_DB_USER=
	FOO_DB_PASS=
	...

The create_environment function will prompt the user for the values of 
each of these variables, defaulting to the values it finds in the 
environment.defaults file, if available, and generate the environment 
shell script.  In addition, it will modify the environment.defaults file 
to contain the same values as are contained in the environment script.  
The environment script will generally look like: 

	ENV_TEMPLATE=/home/epbzs01/foo/environment.template
	export ENV_TEMPLATE
	FOO_DB_SERVER=albsun8_sql11_prd
	export FOO_DB_SERVER
	FOO_DB_USER=foo
	export FOO_DB_USER
	FOO_DB_PASS=bar
	export FOO_DB_PASS

And the environment.defaults file will generally look like:

	FOO_DB_SERVER=albsun8_sql11_prd
	FOO_DB_DB=foo_dbdata_prd
	FOO_DB_USER=foo
	FOO_DB_PASS=bar

In particular, note that the environment.defaults script may contain 
entries which no longer appear in the environment.template or environment 
files.  Since the environment.template file is under source control, 
variables may be removed from it over time.  At some point, an older 
version might get checked out, and we might as well have around the last 
default for those variables which newer versions don’t contain.  

There is a module, Environment.pm, to help applications and modules verify and
use these environment variables.  When a perl script or module incants 

	use POP::Environment;

the environment.template file is parsed and every variable mentioned in it 
must have a non-null value or croak() will be called with a suitable error 
message.  The error message will list all the non-existent variables.  
Furthermore, each environment variable thus mentioned will be exported to 
a scalar of the same name in the caller’s namespace.  The list of 
variables to be exported may be limited by providing a list of names to 
use POP::Environment.  Environment.pm knows where to find the 
environment.template file by looking at the ENV_TEMPLATE environment 
variable, which is added to environment by create_environment.  

=cut

package POP::Environment;

use Term::ReadLine;
use Carp;
use Fcntl;
my($template, $default) = @ARGV;
my %defaults;
chomp(my $wd = `pwd`);
$template ||= "$wd/environment.template";
$template =~ m|^(.*?)[^/]+$|;
my $template_path = $1;
$default ||= "${template_path}environment.defaults";
open(TEMPLATE, $template) or
  croak "Couldn't open [$template]: $!";
if (-e $default) {
  open(DEFAULT, $default) or
    croak "Couldn't open [$default]: $!";
  while (<DEFAULT>) {
    chomp;
    my($k,$v) = split '=', $_, 2;
    $defaults{$k} = $v;
  }
  close DEFAULT;
}
my $environment = "${template_path}environment";
sysopen(ENVIRONMENT, $environment, O_CREAT|O_RDWR|O_TRUNC, 0750) or
  croak "Couldn't open [$environment]: $!";
print ENVIRONMENT "ENV_TEMPLATE=$template\nexport ENV_TEMPLATE\n";
my $rl = new Term::ReadLine 'ce';
$rl->ornaments('md,me,,') if $rl->Features->{'ornaments'};
while (<TEMPLATE>) {
  next if /^\s*#/;
  /^(.+?)=/ or next;
  $defaults{$1} = $rl->readline("$1: ", $defaults{$1});
  print ENVIRONMENT "$1=$defaults{$1}\nexport $1\n";
}
close TEMPLATE;
close ENVIRONMENT;
open(DEFAULT, ">$default") or
  croak "Couldn't open [$default]: $!";
while (my($k,$v) = each %defaults) {
  print DEFAULT "$k=$v\n";
}
close DEFAULT;