#!perl

use strict;
use warnings;

use Getopt::Long qw( :config require_order );

use File::Basename;
use File::Spec::Functions qw( file_name_is_absolute );
use Env::Path;
use App::Env;

our $VERSION = '0.33';
our $prog = basename( $0, '.pl' );

# program options; see parse_args();
our %opt;

eval { main() };

if ( $@ )
{
    print STDERR "# $prog: $_\n" foreach split /\n/, $@;
    exit 1;
}

exit 0;


sub main
{
    parse_args();

    help(1) if $opt{help};
    help(2) if $opt{usage};

    do { print "$prog $VERSION\n"; return }
      if $opt{version};

    die "please specify an environment\n"
      unless defined $opt{env};

    if ( $opt{clear} ) {
	%ENV = map { $_ => $ENV{$_} } grep { exists $ENV{$_} }qw[ HOME LOGNAME SHELL ];
    }

    my @envs = split( ',', $opt{env} );

    # if more than one environment, sort out possible environment specific appopts
    my %appopts;
    @appopts{ @envs } = map { {} } 1..@envs;

    if ( @envs > 1 ) {


	while( my ( $k, $value ) = each %{ $opt{appopts} } ) {

	    my ( $env, $key ) = $k =~ /^([^:]*):(.*)$/;

	    die( "appopts ($key) not specific to one of the specified environments" )
	      unless exists $appopts{$env};

	    $appopts{$env}{$key} = $value;
	}

    }

    else {

	$appopts{$envs[0]} = $opt{appopts};

    }


    eval { App::Env::import( ( map { [ $_ => { AppOpts => $appopts{$_} } ] } @envs ),
                           {
                            ( defined $opt{site} ? (Site => $opt{site}) : () ),
                           } );
       };
    die( "error setting up environment `$opt{env}': $@\n" )
      if $@;

    if ( $opt{dumpenv} )
    {
	while( my ($env, $val ) = each %ENV )
	{
	    $val = '' unless defined $val;

            $val = App::Env::_shell_escape( $val )
              if $val ne '' && $opt{dumpenv} ne 'unquoted';

	    if ( $opt{dumpenv} eq 'ksh' )
	    {
		print "export $env=$val;\n";
	    }
	    elsif ( $opt{dumpenv} eq 'bash' )
	    {
		# if bash is trying to export a module, help it
		if ( $env =~ /^BASH_FUNC_(.*?)\(\)$/ ) {

		    my $func = $1;
		    $val = $ENV{$env}; 		    # use the unquoted version
		    $val =~ s/\n/;\n/g;             # add a semi-colon after every line
		    print "$func $val;\n";
		    print "export -f $func;\n";
		}
		else {
		    print "export $env=$val;\n";
		}
	    }
	    elsif ( $opt{dumpenv} =~ /^(?:csh|tcsh)$/ )
	    {
		print "setenv $env $val;\n";
	    }
	    else
	    {
		print "$env=$val\n";
	    }
	}

    }

    print join(' ', @ARGV ), "\n"
      if $opt{verbose} & @ARGV;

    if ( @ARGV )
    {
	die( "$ARGV[0] does not exist, is not executable, or is not in PATH\n" )
	  unless
            ( file_name_is_absolute($ARGV[0]) && -e $ARGV[0] )
              || Env::Path->PATH->Whence($ARGV[0]);

	exec @ARGV
	  or die( "can't exec $ARGV[0]: not in path?\n" );
    }
}

sub parse_args
{

    %opt =
      (
       appopts  => {},
       clear    => 0,
       verbose  => 0,
       version	=> 0,
       usage	=> 0,
       help	=> 0,
      );

    eval {
	local $SIG{ __WARN__ } = sub { die $_[0] };


	GetOptions ( \%opt,
		     qw/
			env=s
                        appopts|o=s%
			usage
			help
			clear|c
			dumpenv|d=s
                        site=s
			verbose
			version
			/,
		   );
    };

    die $@ if $@;

    return if $opt{version} || $opt{help} || $opt{usage};


    my @notset = grep { ! defined $opt{$_} } keys %opt;
    die( 'parameters `', join( "`, `", @notset ), "' are not set\n" )
      if @notset;

    # ensure that the dumpenv option is correct
    if ( exists $opt{dumpenv} )
    {
	die( "unsupported dumpenv format: $opt{dumpenv}\n" )
	  unless grep { $opt{dumpenv} eq $_ }
	    qw( ksh bash raw unquoted tcsh csh );
    }

    # if --env wasn't specified, the first argument is the application
    # name
    $opt{env} = shift( @ARGV) unless defined $opt{env};

}


sub help
{
    my ( $verbose ) = @_;

    require Pod::Usage;
    Pod::Usage::pod2usage ( { -exitval => 0, -verbose => $verbose } );
}



__END__

=pod

=head1 NAME

appexec - execute a command under a specified environment

=head1 SYNOPSIS

B<appexec> --env environment I<[options]> program [I<program arguments>]

B<appexec> I<[options]> environment program [I<program arguments>]

=head1 DESCRIPTION

B<appexec> will execute a program with the specified arguments in the
specified environment.  The environment is generated by B<App::Env>,
so an appropriate B<App::Env> application module must exist.

=head1 OPTIONS AND ARGUMENTS

B<appexec> uses long options. Options may be abbreviated, and the "="
character shown below in the option templates may be replaced by
whitespace.

The environment to use may be specified either via the B<--env> option,
or as the first non-option argument.

The following options are available:

=over

=item C<--clear> | C<-c>

Clear out the environment prior to loading the specified ones.  This is equivalent
to deleting all environment variables except for

  HOME
  SHELL
  LOGNAME


=item C<--env>=I<name>

A comma separated list of environments (or I<applications> in
B<App::Env> terminology) in which to run the program.  The Perl modules
definining the environments (e.g. B<App::Env::<environment name>> ) must exist.

If this option is not specified, the first non-option argument should
contain the environment name(s).

=item C<--appopts> I<key>=I<value> | C<-o> I<key>=I<value>

Specify a option key and value to be passed via B<AppOpts> to the
B<App::Env> application module.  This option may be specified multiple times.

If multiple environments will be loaded, then each key must be prefixed with
an environment name followed by a colon, e.g.:

  appexec --env env1,env2 -o env1:opt1=val1 -o env2:opt2=val2

=item B<--site>=I<site>

Specify a site. (See B<App::Env> for more information.)

=item C<--dumpenv>=I<fmt> | B<-d> I<fmt>

Output the environmental variables to the standard output stream.  The
output format is determined by the B<--dumpfmt> option.

The possible formats are:

  bash
  csh
  ksh
  raw
  tcsh
  unquoted


=item C<--verbose>

Print the command to be run to the standard output stream before running it.

=item C<--help>

Print a short help summary and exit.

=item C<--usage>

Print full documentation and exit.

=back


=head1 EXAMPLES

Real-life examples:

=over

=item 1

Run the B<fhelp> tool from the HEADAS FTOOLS application suite:

  appexec HEADAS fhelp fparkey

=item 2

Run the B<dmlist> tool from the CIAO version 3.4 application suite:

  appexec -o version=3.4 CIAO dmlist

=back


=head1 VERSION

This documents version 1.0.0 of B<appexec>.

=head1 COPYRIGHT AND LICENSE

This software is copyright the Smithsonian Astrophysical Observatory
and is released under the GNU General Public License.  You may find a
copy at L<http://www.fsf.org/copyleft/gpl.html>.


=head1 AUTHOR

Diab Jerius E<lt>djerius@cfa.harvard.eduE<gt>

