125 lines
2.7 KiB
Perl
125 lines
2.7 KiB
Perl
#!/usr/bin/perl
|
|
#
|
|
# Copyright (C) 2001-2021 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" ) ;
|
|
# my %vars = $cs->vars() ;
|
|
# my %switches = $cs->switches() ;
|
|
#
|
|
# See also: AutoMakeParser
|
|
#
|
|
|
|
use strict ;
|
|
use FileHandle ;
|
|
|
|
package ConfigStatus ;
|
|
|
|
sub new
|
|
{
|
|
my ( $classname , $filename ) = @_ ;
|
|
my $this = bless {
|
|
m_vars => {} ,
|
|
m_switches => {} ,
|
|
} , $classname ;
|
|
$this->parse( $filename ) if $filename ;
|
|
return $this ;
|
|
}
|
|
|
|
sub vars
|
|
{
|
|
my ( $this ) = @_ ;
|
|
return %{$this->{m_vars}} ;
|
|
}
|
|
|
|
sub switches
|
|
{
|
|
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 ;
|