# -*- perl -*-

# --8<--8<--8<--8<--
#
# Copyright (C) 2006 Smithsonian Astrophysical Observatory
#
# This file is part of mst_envs
#
# mst_envs is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation; either version 2
# of the License, or (at your option) any later version.
#
# mst_envs is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the
#       Free Software Foundation, Inc.
#       51 Franklin Street, Fifth Floor
#       Boston, MA  02110-1301, USA
#
# -->8-->8-->8-->8--

package MST;

require 5.14.0;

use strict;
use warnings;

use List::Util qw[ first ];
use File::Spec::Functions qw(catdir catfile splitpath catpath );

use SysArch;
use SysPathSubst qw( syspathsubst compact_paths );

our @platforms = @{ $SysArch::Vars{platforms} };

use constant HAVE_CaptureTiny => eval { require Capture::Tiny; 1 };

sub _croak {
    require Carp;
    goto \&Carp::croak;
}

##--------------------------------------------------------------------##

# from configure
use constant DEFAULT_PGHOST   => '@MST_PGHOST@';
use constant DEFAULT_SYBASE   => '@MST_SYBASE@';
use constant DEFAULT_MST_ROOT => '@MST_ROOT@';

use constant MST_ROOT_VAR          => '@MST_ROOT_VAR@';
use constant MST_SIMUL_ROOT_VAR    => '@MST_SIMUL_ROOT_VAR@';
use constant MST_OTS_ROOT_VAR      => '@MST_OTS_ROOT_VAR@';
use constant MST_TEMPLATE_ROOT_VAR => '@MST_TEMPLATE_ROOT_VAR@';
use constant MST_LOCATE_PATH_VAR   => '@MST_LOCATE_PATH_VAR@';
use constant MST_PGHOST_VAR        => '@MST_PGHOST_VAR@';
use constant MST_SYBASE_VAR        => '@MST_SYBASE_VAR@';

my ( $MST_ROOT, $MST_SIMUL_ROOT, $MST_OTS_ROOT, $MST_TEMPLATE_ROOT );

##--------------------------------------------------------------------##

sub split_env {
    my ( $key, $sep ) = @_;
    return exists $ENV{$key} ? split( $sep, $ENV{$key} ) : ();
}

sub _handle_path_env {

    my ( $export, $env_var, $sep, $opts, @values ) = @_;

    my @path;

    push @path, split_env( $env_var, $sep )
      if $opts->{fullpath} && $opts->{append};

    push @path, @values;

    push @path, split_env( $env_var, $sep )
      if $opts->{fullpath} && !$opts->{append};

    $export->{$env_var} = compact_paths( $sep, @path );
}

sub envs {
    my $opts = shift;
    my %ENV = shift || %ENV;

    my %opts = (
        append        => 0,
        fullpath      => 1,
        ldlibrarypath => 0,
        ldrunpath     => 1,
        sysarch       => 0,
	ignore_errors => 0,
        $opts ? %$opts : () );

    $MST_ROOT = $ENV{+MST_ROOT_VAR} // $ENV{AXAF_ROOT} // DEFAULT_MST_ROOT;
    $MST_SIMUL_ROOT = $ENV{+MST_SIMUL_ROOT_VAR} // $ENV{AXAF_SIMUL_ROOT}
      // catdir( $MST_ROOT, 'simul' );
    $MST_OTS_ROOT = $ENV{+MST_OTS_ROOT_VAR} // catdir( $MST_ROOT, 'ots' );
    $MST_TEMPLATE_ROOT = $ENV{+MST_TEMPLATE_ROOT_VAR}
      // catdir( $MST_SIMUL_ROOT, 'lib', 'templates' );

    my %EXPORT;
    $EXPORT{+MST_ROOT_VAR}       = $EXPORT{AXAF_ROOT}       = $MST_ROOT;
    $EXPORT{+MST_OTS_ROOT_VAR}   = $EXPORT{AXAF_OTS_ROOT}   = $MST_OTS_ROOT;
    $EXPORT{+MST_SIMUL_ROOT_VAR} = $EXPORT{AXAF_SIMUL_ROOT} = $MST_SIMUL_ROOT;
    $EXPORT{+MST_TEMPLATE_ROOT_VAR} = $EXPORT{AXAF_TEMPLATE_ROOT}
      = $MST_TEMPLATE_ROOT;
    $EXPORT{SAOTRACE_DB} = catdir( $MST_SIMUL_ROOT, 'databases' );

    map( $EXPORT{$_} = $SysArch::Vars{$_}, keys( %SysArch::Vars ) )
      if ( $opts{sysarch} );

    setup_ld( \%opts, \%EXPORT );

    my $perl = do {
	my $res = eval { setup_perl( \%opts, \%EXPORT ) };
	die $@ if $@ && ! $opts{ignore_errors};
	$res // {};
    };

    my $lua = do {
	my $res = eval { setup_lua( \%opts, \%EXPORT ) };
	die $@ if $@ && ! $opts{ignore_errors};
	$res // {};
    };

    setup_sybase( \%opts, \%EXPORT);
    setup_postgresql( \%opts, \%EXPORT );
    setup_cint( \%opts, \%EXPORT );
    setup_pkgconfig( \%opts, \%EXPORT );
    setup_pfiles( \%opts, \%EXPORT );
    setup_tex( \%opts, \%EXPORT );
    setup_boost( \%opts, \%EXPORT );

    # locate database setup.
    $EXPORT{+MST_LOCATE_PATH_VAR} = compact_paths( ':',
        glob( catfile( $MST_ROOT, qw( var lib mlocate ), '*.db' ) ) );

    # CVS Repository
    $EXPORT{CVSROOT} = catdir( $MST_SIMUL_ROOT, qw( src cvs ) )
      unless exists $ENV{CVSROOT};

    _handle_path_env(
        \%EXPORT,
        'MANPATH',
        ':',
        \%opts,
        syspathsubst(
            undef,
            \@platforms,
            @{ $perl->{MANPATH} },
            [ $MST_OTS_ROOT,   qw( %P man) ],
            [ $MST_OTS_ROOT,   qw( %P share man) ],
            [ $MST_OTS_ROOT,   qw( man ) ],
            [ $MST_OTS_ROOT,   qw( share man ) ],
            [ $MST_ROOT,       qw( man ) ],
            [ $MST_ROOT,       qw( share man ) ],
            [ $MST_SIMUL_ROOT, qw( %P man ) ],
            [ $MST_SIMUL_ROOT, qw( %P share man ) ],
            [ $MST_SIMUL_ROOT, qw( man ) ],
            [ $MST_SIMUL_ROOT, qw( share man ) ],
        ),
    );

    _handle_path_env(
        \%EXPORT,
        'INFOPATH',
        ':',
        \%opts,
        syspathsubst(
            undef,
            \@platforms,
            [ $MST_OTS_ROOT,   qw( %l info ) ],
            [ $MST_OTS_ROOT,   qw( info ) ],
            [ $MST_OTS_ROOT,   qw( share info ) ],
            [ $MST_ROOT,       qw( info ) ],
            [ $MST_SIMUL_ROOT, qw( info ) ],
            [ $MST_SIMUL_ROOT, qw( share info ) ],
        ),
    );

    _handle_path_env(
        \%EXPORT,
        'PATH', ':',
        \%opts,
        syspathsubst(
            undef,
            \@platforms,
            @{ $perl->{PATH} },
            @{ $lua->{PATH} },
	    map {
            [ $MST_ROOT,       $_ ],
            [ $MST_SIMUL_ROOT, $_ ],
            [ $MST_SIMUL_ROOT, '%l', $_ ],
            [ $MST_ROOT,       '%l', $_ ],
            [ $MST_OTS_ROOT,   '%l', $_ ],
            [ $MST_OTS_ROOT,   $_ ],
	} qw[ sbin bin ]
        ),
    );

    %EXPORT;
}

sub _ots_exe_path {
    my ( $exe, $version ) = @_;

    $version //= '';

    my $path = syspathsubst( undef, \@platforms,
        [ $MST_OTS_ROOT, qw( %P bin ), "${exe}${version}" ] );

    _croak( "couldn't resolve path to $exe", $version ne '' ? " version $version\n" : "\n" )
      unless defined $path;

    _croak( "couldn't find OTS $exe in $path" )
      unless -x $path;

    $path = catpath( (splitpath( $path))[0,1] );
    $path =~ s{/$}{};

    return $path;
}

sub _ots_exe_pkgs_path {
    my ( $exe, $version ) = @_;

    $version = '-' . $version if $version //= '' ne '';

    my $path = syspathsubst( undef, \@platforms,
        [ $MST_OTS_ROOT, 'pkgs', "${exe}${version}", qw( %l bin ) ] );


    _croak( "couldn't resolve path to $exe", $version ne '' ? " version $version\n" : "\n" )
      unless defined $path;

    _croak( "couldn't find OTS $path/$exe", $version ne '' ? " version $version\n" : "\n" )
      unless -x catfile( $path, $exe );

    return $path;
}

sub setup_perl {
    my ( $opts, $EXPORT ) = @_;
    my $perl_dir;

    for ( $opts->{perl_version} // 'default' ) {

        if ( /path/ ) {
            $perl_dir = _find_in_path( $EXPORT, 'perl', 1 );
        }

        elsif ( $_ eq 'default' ) {
            $perl_dir = _ots_exe_pkgs_path( 'perl' );
        }

        else {
            $perl_dir = _ots_exe_pkgs_path( 'perl', $opts->{perl_version} );
        }
    }

    my $perl = catfile( $perl_dir, 'perl' );

    # signal perl wrapper that we're dealing with a non-default Perl
    $EXPORT->{MSTENVS_WRAP_perl} = $perl_dir ne _ots_exe_pkgs_path( 'perl' ) ? $perl : undef;

    my ( $pcfg, $inc ) = get_perl_config( $perl );

    my %config;

    $config{MANPATH} = [
        [ $MST_OTS_ROOT, qw( pkgs perl %l man ) ],
        [ $MST_OTS_ROOT,   qw( %l lib perl), $pcfg->{version}, qw( man ) ],
        [ $MST_SIMUL_ROOT, qw( lib perl man ) ],
    ];

    $config{PATH} = [

        # add Perl binary directory if it isn't one of the standard
        # system ones. otherwise we might add /bin or /usr/local/bin
        # into the wrong part of the path

        # pull in Perl directly, not through dispatch
        # wrapper in $MST_ROOT/bin, to improve startup
        # time
        $pcfg->{installbin} !~ '/usr/(local/)?bin'
        ? $pcfg->{installbin}
        : (),

        # binaries installed by Perl code into Perl bin.
        # first try sitebin
        $pcfg->{installsitebin} !~ '/usr/(local/)?bin'
        ? $pcfg->{installsitebin}
        : (),

        # then local installs if using system perl
        [ $MST_OTS_ROOT, qw( %l lib perl ), $pcfg->{version}, qw( bin ) ],
    ];

    _handle_path_env(
        $EXPORT,
        'PERL5LIB',
        ':', $opts,
        syspathsubst(
            undef,
            \@platforms,
            [ $MST_SIMUL_ROOT, qw( lib perl5 ) ],
            [ $MST_SIMUL_ROOT, qw( %l lib perl5 ) ],
        ),
    );

    # PDL Setup
    _handle_path_env(
        $EXPORT,
        'PDLLIB',
        ':',
        $opts,
        syspathsubst( undef, \@platforms, [ $MST_SIMUL_ROOT, qw( lib pdl ) ] ),
    );

    return \%config;
}

sub get_perl_config {
    my $perl = shift;

    my $dump;
    {
        local %ENV = %ENV;
        delete $ENV{PERL5LIB};
        delete $ENV{PERLIB};

	$dump = _capture_cmd_stdout( $perl, '-MData::Dumper', '-MConfig', '-E',
            'say Data::Dumper->Dump( [ [ \%Config, \@INC  ]], [ q(config) ] )' );
    }

    my $config;
    eval $dump;
    return @$config;
}


sub setup_boost {
    my ( $opts, $EXPORT ) = @_;
    $EXPORT->{BOOST_ROOT} = syspathsubst( undef, \@platforms, [ $MST_OTS_ROOT, qw( %L ) ] );
}

sub setup_postgresql {
    my ( $opts, $EXPORT ) = @_;

    $EXPORT->{PGHOST} = $ENV{+MST_PGHOST_VAR} // DEFAULT_PGHOST;

    delete $EXPORT->{PGHOST}
      if !defined $EXPORT->{PGHOST} || !length $EXPORT->{PGHOST};

    $EXPORT->{+MST_PGHOST_VAR} = $EXPORT->{PGHOST} if exists $EXPORT->{PGHOST};

    return;
}

sub setup_sybase {
    my ( $opts, $EXPORT ) = @_;

    $EXPORT->{SYBASE} = $ENV{+MST_SYBASE_VAR} // DEFAULT_SYBASE;

    delete $EXPORT->{SYBASE}
      if !defined $EXPORT->{SYBASE} || !length $EXPORT->{SYBASE};

    $EXPORT->{+MST_SYBASE_VAR} = $EXPORT->{SYBASE} if exists $EXPORT->{SYBASE};

    return;
}
sub setup_cint {
    my ( $opts, $EXPORT ) = @_;

    # cint Setup
    delete $EXPORT->{CINTSYSDIR}
      unless ( $EXPORT->{CINTSYSDIR}
        = syspathsubst( undef, \@platforms, [ $MST_ROOT, qw( pkgs cint %P ) ] )
      );

    delete $EXPORT->{ROOTSYS}
      unless ( $EXPORT->{ROOTSYS}
        = syspathsubst( undef, \@platforms, [ $MST_ROOT, qw( pkgs root %P ) ] )
      );
}


# Lua Setup

sub setup_lua {
    my ( $opts, $EXPORT ) = @_;

    # figure out which version of Lua is available. capture both STDOUT
    # and STDERR as the message is not written to the same stream by all
    # versions.

    my $lua_dir;

    $opts->{lua_version} //= 'default';

    for ( $opts->{lua_version} ) {
        if ( /path/ ) {
            $lua_dir = _find_in_path( $EXPORT, 'lua', 1 )
              or _croak( "unable to find lua in path\n" );
        }

        elsif ( $_ eq 'default' ) {
            $lua_dir = _ots_exe_path( 'lua' );
        }

        else {
            $lua_dir = _ots_exe_path( 'lua', $opts->{lua_version} );
        }
    }

    my $lua = catfile( $lua_dir, 'lua' );

    my $banner = _capture_cmd_merged( $lua, '-v' );

    if ( defined( $banner ) && $banner =~ /Lua\s+(\d+).(\d+)/ ) {
        my $version = "$1.$2";
        my ( @dirs, @paths );

        @dirs = syspathsubst(
            undef,
            \@platforms,
            [ $MST_OTS_ROOT,   qw( %P lib lua ), $version ],
            [ $MST_SIMUL_ROOT, qw( %P lib lua ), $version ],
            [ $MST_OTS_ROOT,   qw( lib lua ),    $version ],
            [ $MST_OTS_ROOT,   qw( share lua ),  $version ],
            [ $MST_SIMUL_ROOT, qw( lib lua ),    $version ],
            [ $MST_SIMUL_ROOT, qw( share lua ),  $version ],
        );

        @paths = map {
            my $dir = $_;
            map { catfile( $dir, $_ ) } qw( ?.lc ?.lua ?/init.lc ?/init.lua )
        } @dirs;

	_handle_path_env( $EXPORT, 'LUA_PATH', ';', $opts, @paths );
        $EXPORT->{LUA_PATH} .= ';;' unless $EXPORT->{LUA_PATH} =~ /;;$/;

        @dirs = syspathsubst(
            undef, \@platforms,
            [ $MST_OTS_ROOT,   qw( %P lib lua ), $version ],
            [ $MST_SIMUL_ROOT, qw( %P lib lua ), $version ],
        );

        @paths = map { catfile( $_, '?.so' ) } @dirs;

	_handle_path_env( $EXPORT, 'LUA_CPATH', ';', $opts, @paths );
        $EXPORT->{LUA_CPATH} .= ';;' unless $EXPORT->{LUA_CPATH} =~ /;;$/;
    }

    else {
        _croak( "couldn't get $lua version" );
    }

    return $opts->{lua_version} ne 'default' ? { PATH => [$lua_dir] } : () ;
}

sub setup_pkgconfig {
    my ( $opts, $EXPORT ) = @_;

    # PkgConfig Setup
    _handle_path_env(
        $EXPORT,
        'PKG_CONFIG_PATH',
        ':', $opts,
        syspathsubst(
            undef,
            \@platforms,
            [ $MST_OTS_ROOT,   qw(    lib pkgconfig ) ],
            [ $MST_OTS_ROOT,   qw( %l lib pkgconfig ) ],
            [ $MST_SIMUL_ROOT, qw(    lib pkgconfig ) ],
            [ $MST_SIMUL_ROOT, qw( %l lib pkgconfig ) ],
            [ $MST_ROOT,       qw(    lib pkgconfig ) ],
            [ $MST_ROOT,       qw( %l lib pkgconfig ) ],
            '/usr/lib64/pkgconfig',
            '/usr/lib/pkgconfig',
            '/usr/share/pkgconfig',
        ),
    );

}

sub setup_pfiles {
    my ( $opts, $EXPORT ) = @_;

    # Parameter File default directories
    my ( $w_dirs, $ro_dirs );

    ( $w_dirs, $ro_dirs ) = $ENV{PFILES} =~ /([^;]*)(?:|;(.*))$/
      if exists $ENV{PFILES};

    $w_dirs  ||= '';
    $ro_dirs ||= '';

    $w_dirs = compact_paths(
        ':',
        # must use './' to work around bug in cxcparam library
        './',
        './uparm',
        [ $ENV{HOME}, 'mst_param' ],
        split( ':', $w_dirs ),
    );
    $ro_dirs = compact_paths(
        ':',
        split( ':', $ro_dirs ),
        [ $MST_SIMUL_ROOT, qw( share uparm ) ],
        [ $MST_SIMUL_ROOT, qw( lib uparm ) ],
    );
    $EXPORT->{PFILES} = $w_dirs . ';' . $ro_dirs;

    return;
}

sub setup_tex {
    my ( $opts, $EXPORT ) = @_;

    # TEXINPUTS
    #  this has to be handled differently as an empty path component is
    #  valid.  currently syspathsubst checks for the existence of a
    #  path, and an empty path will get removed.  So, only use
    #  syspathsubst on the paths specified here.

    my $TEXINPUTS = syspathsubst(
        ':',
        \@platforms,
        [ $MST_SIMUL_ROOT, qw( %l share texmf ) ],
        [ $MST_SIMUL_ROOT, qw( share texmf ) ],
        [ $MST_OTS_ROOT,   qw( %l share texmf ) ],
        [ $MST_OTS_ROOT,   qw( share texmf ) ],
        [ $MST_ROOT,       qw( %l share texmf ) ],
        [ $MST_ROOT,       qw( share texmf ) ],
    );

    # make sure to add // to each to get text to descend into the directory
    my @TEXINPUTS = map { $_ . '//' } split( ':', $TEXINPUTS );

    $EXPORT->{TEXINPUTS} = join(
        ':',
        @TEXINPUTS,

        # if the user doesn't have TEXINPUTS set, then setting it without
        # including the default path will mess up the user. the empty
        # path here causes a trailing ':' to be appended which is
        # kpsearch's way of marking where the default TEXINPUTS value
        # should be inserted.
        exists $ENV{TEXINPUTS} ? $ENV{TEXINPUTS} : '',
    );

    return;
}

sub setup_ld {
    my ( $opts, $EXPORT ) = @_;

    if ( $opts->{ldlibrarypath} ) {

        _handle_path_env(
            $EXPORT,
            'LD_LIBRARY_PATH',
            ':', $opts,
            syspathsubst(
                undef,
                \@platforms,
                [ $MST_SIMUL_ROOT, qw( %l lib ) ],
                [ $MST_ROOT,       qw( %l lib ) ],
            ),
        );
    }

    _handle_path_env(
        $EXPORT,
        'LD_RUN_PATH',
        ':', $opts,
        syspathsubst(
            undef, \@platforms,
            [ $MST_SIMUL_ROOT, qw( %l lib ) ], [ $MST_ROOT, qw( %l lib ) ],
        ),
    );
}


sub _find_in_path {
    my ( $ENV, $exe, $fatal ) = @_;

    my ( $dir ) = first { -e catfile( $_, $exe ) } split( ':', $ENV->{PATH} );

    if ( !defined $dir ) {
        _croak( "unable to find $exe in path\n" ) if $fatal;
        return;
    }

    return $dir;
}

sub _capture_cmd_stdout {
    my @cmd = @_;

    my $stdout;

    if ( HAVE_CaptureTiny ) {

	my $err;
	$stdout = Capture::Tiny::capture_stdout( sub {

	    $err = system( @cmd ) != 0;
	});

	_croak "error getting config from $cmd[0]: $!\n" if $err;
    }
    else {

	open( my $fh, '-|', @cmd )
          or croak( "error getting config from $cmd[0]\n" );

	local $/ = undef;
	$stdout = <$fh>;
	close( $fh ) or croak( "error getting config from $cmd[0]\n" );
    }

    return $stdout;
}

sub _capture_cmd_merged {
    my @cmd = @_;
    my $merged;

    if ( HAVE_CaptureTiny ) {
	my $err;
	$merged = Capture::Tiny::capture_merged( sub {

	    $err = system( @cmd ) != 0;
	} );

	_croak "error getting config from $cmd[0]: $!\n" if $err;
    }
    else {
	open( my $fh, '-|', join( ' ', @cmd, '2>&1' ) )
          or croak( "error getting config from $cmd[0]\n" );

	local $/ = undef;
	$merged = <$fh>;
	close( $fh ) or croak( "error getting config from $cmd[0]\n" );
    }

    return $merged;
}

1;

