#!/usr/bin/perl
#
# Copyright (C) 2001-2023 Graeme Walker <graeme_walker@users.sourceforge.net>
# 
# This program 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 3 of the License, or
# (at your option) any later version.
# 
# This program 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, see <http://www.gnu.org/licenses/>.
# ===
#
# ConfigStatus.pm
#
# Provides 'switches' and 'vars' parsed out of a "config.status"
# file (as generated by an autoconf configure script).
#
# Synopsis:
#  use ConfigStatus ;
#  my $cs = new ConfigStatus( "./config.status" ) ; # parse "./config.status"
#  my $cs = new ConfigStatus() ; # search up from "." and parse
#  my $cs = new ConfigStatus({dir=>"/tmp/src"}) ; # search up from "/tmp/src" and parse
#  my $cs = new ConfigStatus("") ; # use separate parse() call
#  $cs->parse( "/tmp/config.status" ) ;
#  my %vars = $cs->vars() ;
#  my %switches = $cs->switches() ;
#
# See also: AutoMakeParser
#

use strict ;
use FileHandle ;

package ConfigStatus ;

sub new
{
	my ( $classname , $path ) = @_ ;
	my $this = bless {
		m_vars => {} ,
		m_switches => {} ,
		m_path => $path ,
	} , $classname ;

	# optionally search the file-system for "config.status"
	my $start_dir = undef ;
	if( !defined($path) )
	{
		$start_dir = "."
	}
	elsif( ref($path) && exists($path->{dir}) )
	{
		$start_dir = $path->{dir} ;
	}
	if( defined($start_dir) )
	{
		for my $subdir ( "." , ".." , "../.." , "../../.." )
		{
			if( -e "$start_dir/$subdir/config.status" )
			{
				$path = "$start_dir/$subdir/config.status" ;
				last ;
			}
		}
		$path or die "no config.status file up from $start_dir" ;
		$this->{m_path} = $path ;
	}

	if( $path )
	{
		$this->parse( $path ) ;
	}

	return $this ;
}

sub path
{
	my ( $this ) = @_ ;
	return $this->{m_path} ;
}

sub vars
{
	my ( $this ) = @_ ;
	return %{$this->{m_vars}} ;
}

sub varsref
{
	my ( $this ) = @_ ;
	return $this->{m_vars} ;
}

sub switches
{
	my ( $this ) = @_ ;
	return %{$this->{m_switches}} ;
}

sub switchesref
{
	my ( $this ) = @_ ;
	return $this->{m_switches} ;
}

sub parse
{
	my ( $this , $filename ) = @_ ;
	$filename ||= "config.status" ;
	$this->{m_vars} = {} ;
	$this->{m_switches} = {} ;
	my $fh = new FileHandle( $filename , "r" ) or die "error: cannot open [$filename]: " . lc($!) . "\n" ;
	while(<$fh>)
	{
		chomp( my $line = $_ ) ;
		while( $line =~ m/\\$/ )
		{
			$line = substr( $line , 0 , length($line)-2 ) ; # remove doublequote-backslash
			my $next = <$fh> ;
			chomp( $next ) ;
			$next =~ s/^"// ;
			$line .= $next ;
		}
		my ( $k , $v ) = ( $line =~ m/^S\["([^"]+)"\]="([^"]*)"\s*$/ ) ;
		if( $k && defined($v) )
		{
			if( $k =~ m/_TRUE$/ )
			{
				( my $kk = $k ) =~ s/_TRUE$// ;
				my $vv = ( $v eq "" ? 1 : 0 ) ;
				$this->{m_switches}->{$kk} = $vv ;
			}
			elsif( $k =~ m/_FALSE$/ )
			{
				( my $kk = $k ) =~ s/_FALSE$// ;
				my $vv = ( $v eq "" ? 0 : 1 ) ;
				$this->{m_switches}->{$kk} = $vv ;
			}
			else
			{
				$this->{m_vars}->{$k} = $v ;
			}
		}
	}
	$this->_expand() ;
	return $this ;
}

sub _expand
{
	my ( $this ) = @_ ;
	for my $k ( sort keys %{$this->{m_vars}} )
	{
		my $v = $this->{m_vars}->{$k} ;
		for my $i ( 0 .. 10 )
		{
			my ( $subkey ) = ( $v =~ m/\$\{([^}]*)\}/ ) ;
			if( $subkey && exists($this->{m_vars}->{$subkey}) )
			{
				my $new = $this->{m_vars}->{$subkey} ;
				$v =~ s/\$\{$subkey\}/$new/ ;
			}
		}
		$this->{m_vars}->{$k} = $v ;
	}
	return $this ;
}

1 ;