#!/usr/bin/perl
|
#!/usr/bin/perl
|
|
|
package main ;
|
package main ;
|
|
|
use strict ;
|
use strict ;
|
|
|
#
|
#
|
# Perl script to beautify and enhance RTEMS automake Makefile.ams
|
# Perl script to beautify and enhance RTEMS automake Makefile.ams
|
#
|
#
|
# Reads from stdin and writes to stdout
|
# Reads from stdin and writes to stdout
|
#
|
#
|
# usage:
|
# usage:
|
# /ampolish Makefile.am~
|
# /ampolish Makefile.am~
|
# mv Makefile.am~ Makefile.am
|
# mv Makefile.am~ Makefile.am
|
#
|
#
|
|
|
my @vars ;
|
my @vars ;
|
my @conditions = ( "" ) ;
|
my @conditions = ( "" ) ;
|
my @buffer = ();
|
my @buffer = ();
|
my %var_ ;
|
my %var_ ;
|
|
|
define_variable( "\$(AUTOMAKE_OPTIONS)", ( "foreign", "1.4" ) );
|
define_variable( "\$(AUTOMAKE_OPTIONS)", ( "foreign", "1.4" ) );
|
define_variable( "\$(VPATH)", ( "\@srcdir\@" ) );
|
define_variable( "\$(VPATH)", ( "\@srcdir\@" ) );
|
|
|
# find relative up-path to configure.in
|
# find relative up-path to configure.in
|
my $rtems_cfg = find_file(".","configure.in");
|
my $rtems_cfg = find_file(".","configure.in");
|
|
|
# find relative up-path from configure.in to VERSION
|
# find relative up-path from configure.in to VERSION
|
my $rtems_top = find_file("$rtems_cfg","VERSION");
|
my $rtems_top = find_file("$rtems_cfg","VERSION");
|
|
|
if ( "$rtems_top" eq "." ) { $rtems_top = "" ; }
|
if ( "$rtems_top" eq "." ) { $rtems_top = "" ; }
|
else { $rtems_top .= "/" ; }
|
else { $rtems_top .= "/" ; }
|
|
|
{
|
{
|
# PASS1:
|
# PASS1:
|
# read input file and concatenate multiple lines into single lines.
|
# read input file and concatenate multiple lines into single lines.
|
|
|
my @ibuf = () ;
|
my @ibuf = () ;
|
|
|
while( )
|
while( )
|
{ # consume header
|
{ # consume header
|
last if ( /^[^#].*$/ ) ;
|
last if ( /^[^#].*$/ ) ;
|
push @ibuf, "$_" ;
|
push @ibuf, "$_" ;
|
}
|
}
|
|
|
push @ibuf, "§header\n" ;
|
push @ibuf, "§header\n" ;
|
|
|
do
|
do
|
{
|
{
|
if ( /^(#.*)$/o )
|
if ( /^(#.*)$/o )
|
{ # preserve comments
|
{ # preserve comments
|
push @ibuf, "$_" ;
|
push @ibuf, "$_" ;
|
}
|
}
|
elsif ( /^(\t.*)\\[\s]*$/o )
|
elsif ( /^(\t.*)\\[\s]*$/o )
|
{ # multilines for scripts
|
{ # multilines for scripts
|
my $line = "$1§" ;
|
my $line = "$1§" ;
|
while( )
|
while( )
|
{
|
{
|
if ( /^(.*)\\[\s]*$/o )
|
if ( /^(.*)\\[\s]*$/o )
|
{
|
{
|
$line .= "$1§" ;
|
$line .= "$1§" ;
|
}
|
}
|
else
|
else
|
{
|
{
|
$line .= "$_" ;
|
$line .= "$_" ;
|
push @ibuf, $line ;
|
push @ibuf, $line ;
|
last ;
|
last ;
|
}
|
}
|
}
|
}
|
}
|
}
|
elsif ( /^(.*)\\[\s]*$/o )
|
elsif ( /^(.*)\\[\s]*$/o )
|
{ # multilines
|
{ # multilines
|
my $line = "$1" ;
|
my $line = "$1" ;
|
while( )
|
while( )
|
{
|
{
|
if ( /^(.*)\\[\s]*$/o )
|
if ( /^(.*)\\[\s]*$/o )
|
{
|
{
|
$line .= "$1" ;
|
$line .= "$1" ;
|
}
|
}
|
else
|
else
|
{
|
{
|
$line .= "$_" ;
|
$line .= "$_" ;
|
$line =~ s%[\s]+% %g ;
|
$line =~ s%[\s]+% %g ;
|
push @ibuf, "$line\n" ;
|
push @ibuf, "$line\n" ;
|
last ;
|
last ;
|
}
|
}
|
}
|
}
|
}
|
}
|
else
|
else
|
{
|
{
|
push @ibuf, "$_" ;
|
push @ibuf, "$_" ;
|
}
|
}
|
} while ( ) ;
|
} while ( ) ;
|
@buffer = @ibuf ;
|
@buffer = @ibuf ;
|
}
|
}
|
|
|
{
|
{
|
# PASS2:
|
# PASS2:
|
# fix obsolete constructs
|
# fix obsolete constructs
|
my @ibuf = () ;
|
my @ibuf = () ;
|
|
|
foreach ( @buffer )
|
foreach ( @buffer )
|
{
|
{
|
# tr /\{\}/\(\)/ ;
|
# tr /\{\}/\(\)/ ;
|
|
|
if ( /^(TMP|PRE)INSTALL_FILES[\s]*=(.*)$/o )
|
if ( /^(TMP|PRE)INSTALL_FILES[\s]*=(.*)$/o )
|
{ # force "+="
|
{ # force "+="
|
push @ibuf, "$1INSTALL_FILES +=$2\n" ;
|
push @ibuf, "$1INSTALL_FILES +=$2\n" ;
|
}
|
}
|
elsif ( /^(VPATH|EXTRA_DIST)[\s]*\+=(.*)$/o )
|
elsif ( /^(VPATH|EXTRA_DIST)[\s]*\+=(.*)$/o )
|
{ # force "="
|
{ # force "="
|
push @ibuf, "$1 = $2\n" ;
|
push @ibuf, "$1 = $2\n" ;
|
}
|
}
|
elsif ( /^[\s]*ACLOCAL[\s]*=[\s]*\@ACLOCAL\@.*$/o )
|
elsif ( /^[\s]*ACLOCAL[\s]*=[\s]*\@ACLOCAL\@.*$/o )
|
{ # remove the line
|
{ # remove the line
|
}
|
}
|
elsif ( /^[\s]*(ACLOCAL_AMFLAGS)[\s\t]*[\+]*=[\s]*(.*)[\s]*$/o )
|
elsif ( /^[\s]*(ACLOCAL_AMFLAGS)[\s\t]*[\+]*=[\s]*(.*)[\s]*$/o )
|
{ # remove the line
|
{ # remove the line
|
}
|
}
|
elsif ( /^[\s]*(AM_CFLAGS)[\s\t]*[\+]*=[\s]*\$\(CFLAGS_OS_V\)[\s]*$/o )
|
elsif ( /^[\s]*(AM_CFLAGS)[\s\t]*[\+]*=[\s]*\$\(CFLAGS_OS_V\)[\s]*$/o )
|
{ # remove the line
|
{ # remove the line
|
}
|
}
|
elsif ( /^[\s]*debug-am:.*$/o )
|
elsif ( /^[\s]*debug-am:.*$/o )
|
{ # remove the line
|
{ # remove the line
|
}
|
}
|
elsif ( /^[\s]*all(\-am):(.*)$/o )
|
elsif ( /^[\s]*all(\-am):(.*)$/o )
|
{ # replace the line
|
{ # replace the line
|
push @ibuf, "all-local:$2\n" ;
|
push @ibuf, "all-local:$2\n" ;
|
}
|
}
|
elsif ( /^[\s]*profile-am:.*$/o )
|
elsif ( /^[\s]*profile-am:.*$/o )
|
{ # remove the line
|
{ # remove the line
|
}
|
}
|
elsif ( /^[\s]*include[\s\t]*\$\(RTEMS_ROOT\)\/make\/lib.cfg[\s]*$/o )
|
elsif ( /^[\s]*include[\s\t]*\$\(RTEMS_ROOT\)\/make\/lib.cfg[\s]*$/o )
|
{
|
{
|
push @ibuf, "include \$(top_srcdir)/${rtems_top}automake/lib.am\n" ;
|
push @ibuf, "include \$(top_srcdir)/${rtems_top}automake/lib.am\n" ;
|
}
|
}
|
elsif ( /^(.*[^\s])[\s]*$/o )
|
elsif ( /^(.*[^\s])[\s]*$/o )
|
{ # remove trailing spaces
|
{ # remove trailing spaces
|
push @ibuf, "$1\n" ;
|
push @ibuf, "$1\n" ;
|
}
|
}
|
else
|
else
|
{
|
{
|
push @ibuf, "$_" ;
|
push @ibuf, "$_" ;
|
}
|
}
|
}
|
}
|
@buffer = @ibuf ;
|
@buffer = @ibuf ;
|
}
|
}
|
|
|
# print STDERR "\n", @buffer, "\n" ;
|
# print STDERR "\n", @buffer, "\n" ;
|
|
|
{
|
{
|
my @ibuf = () ;
|
my @ibuf = () ;
|
foreach ( @buffer )
|
foreach ( @buffer )
|
{
|
{
|
if ( /^#(.*)$/o )
|
if ( /^#(.*)$/o )
|
{
|
{
|
push @ibuf, "#$1\n" ;
|
push @ibuf, "#$1\n" ;
|
}
|
}
|
elsif ( /^[\s]*if[\s\t]+([a-zA-Z0-9_]+)[\s\t]*$/o )
|
elsif ( /^[\s]*if[\s\t]+([a-zA-Z0-9_]+)[\s\t]*$/o )
|
{
|
{
|
push @conditions, "\@" . $1 . "_TRUE\@" ;
|
push @conditions, "\@" . $1 . "_TRUE\@" ;
|
push @ibuf, "if $1\n" ;
|
push @ibuf, "if $1\n" ;
|
}
|
}
|
elsif ( /^[\s]*else[\s\t]*$/o )
|
elsif ( /^[\s]*else[\s\t]*$/o )
|
{
|
{
|
@conditions[$#conditions] =~ s/_TRUE\@$/_FALSE\@/;
|
@conditions[$#conditions] =~ s/_TRUE\@$/_FALSE\@/;
|
push @ibuf, "else\n" ;
|
push @ibuf, "else\n" ;
|
}
|
}
|
elsif ( /^[\s]*endif[\s\t]*$/o )
|
elsif ( /^[\s]*endif[\s\t]*$/o )
|
{
|
{
|
pop @conditions ;
|
pop @conditions ;
|
push @ibuf, "endif\n" ;
|
push @ibuf, "endif\n" ;
|
}
|
}
|
elsif ( /^§.*$/o )
|
elsif ( /^§.*$/o )
|
{
|
{
|
push @ibuf, "$_" ;
|
push @ibuf, "$_" ;
|
}
|
}
|
elsif ( /^[\s]*(VPATH)[\s\t]*([\+]*)=[\s]*(.*)[\s]*$/o )
|
elsif ( /^[\s]*(VPATH)[\s\t]*([\+]*)=[\s]*(.*)[\s]*$/o )
|
{
|
{
|
my $lh = "\$($1)" ;
|
my $lh = "\$($1)" ;
|
my @rh = split( /:/,"$3");
|
my @rh = split( /:/,"$3");
|
if ( $#conditions > 0 )
|
if ( $#conditions > 0 )
|
{
|
{
|
print STDERR "WARNING: $1 must not be set inside of conditionals!\n"
|
print STDERR "WARNING: $1 must not be set inside of conditionals!\n"
|
}
|
}
|
define_variable( "$lh", @rh );
|
define_variable( "$lh", @rh );
|
|
|
}
|
}
|
elsif ( /^[\s]*(AUTOMAKE_OPTIONS)[\s\t]*([\+]*)=[\s]*(.*)$/o )
|
elsif ( /^[\s]*(AUTOMAKE_OPTIONS)[\s\t]*([\+]*)=[\s]*(.*)$/o )
|
{
|
{
|
my $lh = "\$($1)" ;
|
my $lh = "\$($1)" ;
|
my @rh = &split_vars("$3");
|
my @rh = &split_vars("$3");
|
|
|
if ( $#conditions > 0 )
|
if ( $#conditions > 0 )
|
{
|
{
|
print STDERR "WARNING: $1 must not be set inside of conditionals!\n"
|
print STDERR "WARNING: $1 must not be set inside of conditionals!\n"
|
}
|
}
|
|
|
define_variable( "$lh", @rh );
|
define_variable( "$lh", @rh );
|
}
|
}
|
elsif ( /^[\s]*([a-zA-Z0-9_]+)[\s\t]*([\+]*)=[\s]*(.*)$/o )
|
elsif ( /^[\s]*([a-zA-Z0-9_]+)[\s\t]*([\+]*)=[\s]*(.*)$/o )
|
{
|
{
|
my $lh = join ('',@conditions) . "\$($1)" ;
|
my $lh = join ('',@conditions) . "\$($1)" ;
|
my @rh = &split_vars("$3");
|
my @rh = &split_vars("$3");
|
my $seen = variable_seen( "$lh" ) ;
|
my $seen = variable_seen( "$lh" ) ;
|
|
|
if ( $#conditions > 0 )
|
if ( $#conditions > 0 )
|
{
|
{
|
define_variable( "\$($1)", () );
|
define_variable( "\$($1)", () );
|
}
|
}
|
|
|
define_variable( "$lh", @rh );
|
define_variable( "$lh", @rh );
|
|
|
if ( not $seen )
|
if ( not $seen )
|
{
|
{
|
push @ibuf, "§$2var_$lh\n" ;
|
push @ibuf, "§$2var_$lh\n" ;
|
}
|
}
|
}
|
}
|
elsif ( /^[\s]*include[\s\t]*\$\(top_srcdir\)[\.\/]*automake\/(.*)\.am$/o )
|
elsif ( /^[\s]*include[\s\t]*\$\(top_srcdir\)[\.\/]*automake\/(.*)\.am$/o )
|
{
|
{
|
if ( "$1" eq "lib" )
|
if ( "$1" eq "lib" )
|
{
|
{
|
push @ibuf, "include \$(top_srcdir)/${rtems_top}automake/$1.am\n" ;
|
push @ibuf, "include \$(top_srcdir)/${rtems_top}automake/$1.am\n" ;
|
}
|
}
|
elsif ( "$1" eq "local" )
|
elsif ( "$1" eq "local" )
|
{
|
{
|
$main::seen_local = 1 ;
|
$main::seen_local = 1 ;
|
}
|
}
|
elsif ( "$1" eq "host" )
|
elsif ( "$1" eq "host" )
|
{
|
{
|
$main::seen_host = 1 ;
|
$main::seen_host = 1 ;
|
}
|
}
|
}
|
}
|
elsif ( /^[\s]*include[\s\t]*(.*)$/o )
|
elsif ( /^[\s]*include[\s\t]*(.*)$/o )
|
{
|
{
|
push @ibuf, "include $1\n" ;
|
push @ibuf, "include $1\n" ;
|
}
|
}
|
elsif ( /^\t(.*)$/o )
|
elsif ( /^\t(.*)$/o )
|
{
|
{
|
push @ibuf, "\t$1\n" ;
|
push @ibuf, "\t$1\n" ;
|
}
|
}
|
elsif ( /^(.*)\:(.*)$/o )
|
elsif ( /^(.*)\:(.*)$/o )
|
{
|
{
|
push @ibuf, "$1:$2\n" ;
|
push @ibuf, "$1:$2\n" ;
|
}
|
}
|
elsif ( /^[\s]*$/o )
|
elsif ( /^[\s]*$/o )
|
{
|
{
|
push @ibuf, "\n" ;
|
push @ibuf, "\n" ;
|
}
|
}
|
else
|
else
|
{
|
{
|
die "ERROR: Don't know how to handle <$_>" ;
|
die "ERROR: Don't know how to handle <$_>" ;
|
}
|
}
|
} # for
|
} # for
|
@buffer = @ibuf ;
|
@buffer = @ibuf ;
|
} # while
|
} # while
|
|
|
die "Conditional stack corrupted" if ( $#conditions != 0 );
|
die "Conditional stack corrupted" if ( $#conditions != 0 );
|
|
|
foreach( @vars )
|
foreach( @vars )
|
{
|
{
|
purge( \@{$var_{"$_"}} );
|
purge( \@{$var_{"$_"}} );
|
}
|
}
|
|
|
# print STDERR "\n", @buffer, "\n" ;
|
# print STDERR "\n", @buffer, "\n" ;
|
|
|
|
|
{
|
{
|
my @ibuf = () ;
|
my @ibuf = () ;
|
foreach( @buffer )
|
foreach( @buffer )
|
{
|
{
|
if ( /^#.*$/o )
|
if ( /^#.*$/o )
|
{
|
{
|
push @ibuf, "$_" ;
|
push @ibuf, "$_" ;
|
}
|
}
|
elsif( /^§header$/o )
|
elsif( /^§header$/o )
|
{
|
{
|
my $l = $var_{"\$(AUTOMAKE_OPTIONS)"} ;
|
my $l = $var_{"\$(AUTOMAKE_OPTIONS)"} ;
|
push @ibuf, "\nAUTOMAKE_OPTIONS = @{$l}\n" ;
|
push @ibuf, "\nAUTOMAKE_OPTIONS = @{$l}\n" ;
|
if ( "$rtems_cfg" eq "." )
|
if ( "$rtems_cfg" eq "." )
|
{
|
{
|
push @ibuf, "ACLOCAL_AMFLAGS = -I \$(RTEMS_TOPdir)/aclocal\n" ;
|
push @ibuf, "ACLOCAL_AMFLAGS = -I \$(RTEMS_TOPdir)/aclocal\n" ;
|
}
|
}
|
if ( defined( @{$var_{"\$(VPATH)"}} ) )
|
if ( defined( @{$var_{"\$(VPATH)"}} ) )
|
{
|
{
|
if ( $#{$var_{"\$(VPATH)"}} > 0 )
|
if ( $#{$var_{"\$(VPATH)"}} > 0 )
|
{
|
{
|
my $l = join (':',@{$var_{"\$(VPATH)"}}) ;
|
my $l = join (':',@{$var_{"\$(VPATH)"}}) ;
|
push @ibuf, "\nVPATH = $l\n" ;
|
push @ibuf, "\nVPATH = $l\n" ;
|
}
|
}
|
}
|
}
|
push @ibuf, "\n" ;
|
push @ibuf, "\n" ;
|
}
|
}
|
elsif ( /^§(\+|)var_(.*)\$\((.*)\)$/o )
|
elsif ( /^§(\+|)var_(.*)\$\((.*)\)$/o )
|
{
|
{
|
print_var(\@ibuf, "$3 $1=", $var_{"$2\$($3)"}) ;
|
print_var(\@ibuf, "$3 $1=", $var_{"$2\$($3)"}) ;
|
}
|
}
|
elsif ( /^\t.*$/o )
|
elsif ( /^\t.*$/o )
|
{
|
{
|
&print_script(\@ibuf, "$_");
|
&print_script(\@ibuf, "$_");
|
}
|
}
|
elsif ( /^[\s]*if[\s]+([a-zA-Z0-9_]+)[\s\t]*$/o )
|
elsif ( /^[\s]*if[\s]+([a-zA-Z0-9_]+)[\s\t]*$/o )
|
{
|
{
|
push @conditions, "\@$1_TRUE\@" ;
|
push @conditions, "\@$1_TRUE\@" ;
|
push @ibuf, "if $1\n" ;
|
push @ibuf, "if $1\n" ;
|
}
|
}
|
elsif ( /^[\s]*else[\s]*$/o )
|
elsif ( /^[\s]*else[\s]*$/o )
|
{
|
{
|
@conditions[$#conditions] =~ s/_TRUE\@$/_FALSE\@/;
|
@conditions[$#conditions] =~ s/_TRUE\@$/_FALSE\@/;
|
push @ibuf, "else\n" ;
|
push @ibuf, "else\n" ;
|
}
|
}
|
elsif ( /^[\s]*endif[\s]*$/o )
|
elsif ( /^[\s]*endif[\s]*$/o )
|
{
|
{
|
pop @conditions ;
|
pop @conditions ;
|
push @ibuf, "endif\n" ;
|
push @ibuf, "endif\n" ;
|
}
|
}
|
else
|
else
|
{
|
{
|
print_line(\@ibuf,$_);
|
print_line(\@ibuf,$_);
|
}
|
}
|
}
|
}
|
|
|
if ( variable_seen("\$(SUBDIRS)") )
|
if ( variable_seen("\$(SUBDIRS)") )
|
{
|
{
|
push @ibuf, "include \$(top_srcdir)/${rtems_top}automake/subdirs.am\n" ;
|
push @ibuf, "include \$(top_srcdir)/${rtems_top}automake/subdirs.am\n" ;
|
}
|
}
|
|
|
if ( defined( $main::seen_host ) )
|
if ( defined( $main::seen_host ) )
|
{
|
{
|
push @ibuf, "include \$(top_srcdir)/${rtems_top}automake/host.am\n" ;
|
push @ibuf, "include \$(top_srcdir)/${rtems_top}automake/host.am\n" ;
|
}
|
}
|
else
|
else
|
{
|
{
|
push @ibuf, "include \$(top_srcdir)/${rtems_top}automake/local.am\n" ;
|
push @ibuf, "include \$(top_srcdir)/${rtems_top}automake/local.am\n" ;
|
}
|
}
|
|
|
@buffer = @ibuf ;
|
@buffer = @ibuf ;
|
}
|
}
|
|
|
#print STDERR "\n", @buffer, "\n" ;
|
#print STDERR "\n", @buffer, "\n" ;
|
|
|
{ ## pretty print
|
{ ## pretty print
|
my $out = join ('',@buffer) ;
|
my $out = join ('',@buffer) ;
|
$out =~ s/\s\#\n(\#\n)+/\n/g ;
|
$out =~ s/\s\#\n(\#\n)+/\n/g ;
|
$out =~ s/\n\n\#\n\n/\n/g ;
|
$out =~ s/\n\n\#\n\n/\n/g ;
|
$out =~ s/\n\n[\n]*/\n\n/g ;
|
$out =~ s/\n\n[\n]*/\n\n/g ;
|
print $out ;
|
print $out ;
|
}
|
}
|
|
|
exit 0;
|
exit 0;
|
|
|
# find a relative up-path to a file $file, starting at directory $pre
|
# find a relative up-path to a file $file, starting at directory $pre
|
sub find_file
|
sub find_file
|
{
|
{
|
my $pre = $_[0] ;
|
my $pre = $_[0] ;
|
my $file= $_[1] ;
|
my $file= $_[1] ;
|
|
|
my $top = "." ;
|
my $top = "." ;
|
if (not "$pre") { $pre = "." ; }
|
if (not "$pre") { $pre = "." ; }
|
|
|
for ( my $str = "$pre" . "/" . "$top" ;
|
for ( my $str = "$pre" . "/" . "$top" ;
|
( -d "$str" ) ;
|
( -d "$str" ) ;
|
$str = "$pre" . "/" . "$top" )
|
$str = "$pre" . "/" . "$top" )
|
{
|
{
|
if ( -f "${str}/${file}" )
|
if ( -f "${str}/${file}" )
|
{
|
{
|
return $top ;
|
return $top ;
|
}
|
}
|
if ( "$top" eq "." )
|
if ( "$top" eq "." )
|
{
|
{
|
$top = ".." ;
|
$top = ".." ;
|
}
|
}
|
else
|
else
|
{
|
{
|
$top .= "/.." ;
|
$top .= "/.." ;
|
}
|
}
|
} ;
|
} ;
|
die "Can't find file ${file}\n" ;
|
die "Can't find file ${file}\n" ;
|
}
|
}
|
|
|
sub variable_seen($)
|
sub variable_seen($)
|
{
|
{
|
my $label = "$_[0]" ;
|
my $label = "$_[0]" ;
|
my $res = defined $var_{"$label"};
|
my $res = defined $var_{"$label"};
|
#print STDERR "SEEN: $label ->$res<\n" ;
|
#print STDERR "SEEN: $label ->$res<\n" ;
|
return $res ;
|
return $res ;
|
}
|
}
|
|
|
sub define_variable($$)
|
sub define_variable($$)
|
{
|
{
|
my ($label,@value) = @_ ;
|
my ($label,@value) = @_ ;
|
|
|
if ( not variable_seen("$label") )
|
if ( not variable_seen("$label") )
|
{
|
{
|
#print STDERR "DEFINING: $label\n" ;
|
#print STDERR "DEFINING: $label\n" ;
|
push @vars, "$label" ;
|
push @vars, "$label" ;
|
}
|
}
|
|
|
foreach my $i ( @{value} )
|
foreach my $i ( @{value} )
|
{
|
{
|
push @{$var_{"$label"}}, $i ;
|
push @{$var_{"$label"}}, $i ;
|
}
|
}
|
}
|
}
|
|
|
# Strip off duplicate entries from a list
|
# Strip off duplicate entries from a list
|
sub purge($)
|
sub purge($)
|
{
|
{
|
my $list = $_[0] ; # Reference to list !
|
my $list = $_[0] ; # Reference to list !
|
my (@tmp) = () ;
|
my (@tmp) = () ;
|
|
|
foreach my $l ( @{$list} )
|
foreach my $l ( @{$list} )
|
{
|
{
|
my $i = 1 ;
|
my $i = 1 ;
|
foreach my $t (@tmp)
|
foreach my $t (@tmp)
|
{
|
{
|
if ( $t eq $l )
|
if ( $t eq $l )
|
{
|
{
|
$i = 0 ;
|
$i = 0 ;
|
last ;
|
last ;
|
}
|
}
|
}
|
}
|
push @tmp,$l if ($i) ;
|
push @tmp,$l if ($i) ;
|
}
|
}
|
|
|
@{$list} = @tmp ;
|
@{$list} = @tmp ;
|
}
|
}
|
|
|
#
|
#
|
# Break the right hand side of a variable assignment into separate chunks
|
# Break the right hand side of a variable assignment into separate chunks
|
#
|
#
|
sub split_vars($)
|
sub split_vars($)
|
{
|
{
|
my $line = $_[0] ;
|
my $line = $_[0] ;
|
my (@buf) = split(//,"$line") ;
|
my (@buf) = split(//,"$line") ;
|
|
|
my $begin = 0 ;
|
my $begin = 0 ;
|
my @res = () ;
|
my @res = () ;
|
|
|
my $depth = 0 ;
|
my $depth = 0 ;
|
my $state = 0 ;
|
my $state = 0 ;
|
|
|
my $len = $#buf + 1 ;
|
my $len = $#buf + 1 ;
|
for ( my $i = 0 ; $i < $len ; $i++ )
|
for ( my $i = 0 ; $i < $len ; $i++ )
|
{
|
{
|
my $c = @buf[$i] ;
|
my $c = @buf[$i] ;
|
if ( $state == 0 )
|
if ( $state == 0 )
|
{
|
{
|
if ( "$c" ne " " )
|
if ( "$c" ne " " )
|
{ # token
|
{ # token
|
$begin = $i ;
|
$begin = $i ;
|
$state++ ;
|
$state++ ;
|
}
|
}
|
if ( "$c" eq "\$" )
|
if ( "$c" eq "\$" )
|
{ # variable
|
{ # variable
|
$depth++ ;
|
$depth++ ;
|
}
|
}
|
}
|
}
|
elsif ( $state == 1 )
|
elsif ( $state == 1 )
|
{
|
{
|
if ( ( "$c" eq "\)" ) or ( "$c" eq "\}" ) )
|
if ( ( "$c" eq "\)" ) or ( "$c" eq "\}" ) )
|
{ # variable
|
{ # variable
|
$depth-- ;
|
$depth-- ;
|
}
|
}
|
elsif ( ("$c" eq " " ) and ( $depth == 0 ) )
|
elsif ( ("$c" eq " " ) and ( $depth == 0 ) )
|
{
|
{
|
push @res, substr($line,$begin,$i-$begin);
|
push @res, substr($line,$begin,$i-$begin);
|
$state-- ;
|
$state-- ;
|
}
|
}
|
elsif ( "$c" eq "\$" )
|
elsif ( "$c" eq "\$" )
|
{ # variable
|
{ # variable
|
$depth++ ;
|
$depth++ ;
|
}
|
}
|
}
|
}
|
else
|
else
|
{
|
{
|
die "split_vars: unknown mode\n" ;
|
die "split_vars: unknown mode\n" ;
|
}
|
}
|
}
|
}
|
|
|
if ( $state > 0 )
|
if ( $state > 0 )
|
{
|
{
|
push @res, substr($line,$begin,$len-$begin);
|
push @res, substr($line,$begin,$len-$begin);
|
$state = 0
|
$state = 0
|
}
|
}
|
return @res ;
|
return @res ;
|
}
|
}
|
|
|
sub print_var($$$)
|
sub print_var($$$)
|
{
|
{
|
my ($ibuf,$line,$l) = @_ ; # $l .. reference to list
|
my ($ibuf,$line,$l) = @_ ; # $l .. reference to list
|
|
|
foreach (@{$l}) {
|
foreach (@{$l}) {
|
if ( ( length($line) + length($_) ) < 76 )
|
if ( ( length($line) + length($_) ) < 76 )
|
{
|
{
|
$line .= " $_";
|
$line .= " $_";
|
}
|
}
|
else
|
else
|
{
|
{
|
push @{$ibuf}, "$line \\\n";
|
push @{$ibuf}, "$line \\\n";
|
$line = " $_" ;
|
$line = " $_" ;
|
}
|
}
|
}
|
}
|
push @{$ibuf}, "$line\n" ;
|
push @{$ibuf}, "$line\n" ;
|
}
|
}
|
|
|
sub print_line($$)
|
sub print_line($$)
|
{
|
{
|
my ($ibuf,$input) = @_ ;
|
my ($ibuf,$input) = @_ ;
|
my @l = split( / /, $input );
|
my @l = split( / /, $input );
|
my $line = shift @l ;
|
my $line = shift @l ;
|
|
|
foreach my $i (@l) {
|
foreach my $i (@l) {
|
if ( ( length($line) + length($i) ) < 76 )
|
if ( ( length($line) + length($i) ) < 76 )
|
{
|
{
|
$line .= " $i";
|
$line .= " $i";
|
}
|
}
|
else
|
else
|
{
|
{
|
push @{$ibuf}, "$line \\\n";
|
push @{$ibuf}, "$line \\\n";
|
$line = " $i" ;
|
$line = " $i" ;
|
}
|
}
|
}
|
}
|
push @{$ibuf}, "$line" ;
|
push @{$ibuf}, "$line" ;
|
}
|
}
|
|
|
sub print_script($$)
|
sub print_script($$)
|
{
|
{
|
my ($ibuf,$input) = @_ ;
|
my ($ibuf,$input) = @_ ;
|
$input =~ s%§%\\\n%g ;
|
$input =~ s%§%\\\n%g ;
|
push @{$ibuf}, $input ;
|
push @{$ibuf}, $input ;
|
}
|
}
|
|
|