Re: Perl: config-h.pl - Draft

[Derek Robert Price]

-----BEGIN PGP SIGNED MESSAGE-----
Hash: SHA1

Conrad T. Pino wrote:

>use strict;

. . .

I've attached a rewrite of your draft.  Mostly I removed the nesting
handling and the useless warning I mentioned in my earlier mail and
reformatted it to look more like it fits CVS's C coding standards.  I
also set it up to expect to be run from the windows-NT directory since
this is how the UNIX build file will be written.

As near as I can tell, when run using the root config.h.in and the old
windows-NT/config.h.in file as inputs, it generates a new config.h.in
file which looks like a proper config.h minus the PACKAGE strings and
a few macros in the old windows-NT/config.h.in which mkconfig.pl is
generating proper warnings about.

Basically, someone now needs to go through those warnings and decide
whether the offending #defines need to be removed or moved into the
footer file.

Cheers,

Derek

- --
                *8^)

Email: derek@ximbiot.com

Get CVS support at <http://ximbiot.com>!
-----BEGIN PGP SIGNATURE-----
Version: GnuPG v1.2.1 (GNU/Linux)
Comment: Using GnuPG with Mozilla - http://enigmail.mozdev.org

iD8DBQFAqMERLD1OTBfyMaQRAlpNAKDfaHnh9hTV2JlslxYF4iIT58C9XACfSwCO
b+pvs51KQAi6YYLo7/4SqG0=
=MD2d
-----END PGP SIGNATURE-----

use strict;



###
### FUNCTIONS
###
sub save_edit
{
    my ($same, $file_name, $temp_name) = @_;

    if ($same)
    {
        unlink $temp_name;
        print "no change: ", $file_name, "\n";
    }
    else
    {
        rename $temp_name, $file_name;
        print "save edit: ", $file_name, "\n";
    }
}

sub get_default
{
    my ($value, $default) = @_;

    if ($value eq "")
    {
        $value = $default;
    }

    return $value;
}



sub show_repeat
{
    my ($file, $new_no, $old_no, $line) = @_;

    print $file, " line ", $new_no, " duplicates line ", $old_no, ": ", $line;
}



sub show_orphan
{
    my ($case, $that, $this, $this_key, %this_macros) = @_;
    my $type = $this_macros{$this_key}[1];

    if ($case eq 0)
    {
        # roots file has extra macro statement
        # tell only of #undef
        return if $type eq "d";
    }
    elsif ($case eq 1)
    {
        # build file has extra macro statement
        # tell only of #define
        return if $type eq "u";
    }
    else
    {
        die "Internal script error";
    }

    if ($type eq "d")
    {
            $type = "#define";
    }
    elsif ($type eq "u")
    {
            $type = "#undef";
    }
    else
    {
        die "Internal script error";
    }

    print $this, " line ", $this_macros{$this_key}[0], " has ", $type, " ",
          $this_key, " not found in ", $that, "\n";
}



sub make_config_h
{
    my ($ph_name, $out_name, $inp_name, $end_name) = @_;

    $ph_name = get_default $ph_name, "../config.h.in";
    $out_name = get_default $out_name, "config.h.in";
    $inp_name = get_default $inp_name, $out_name . ".in";
    $end_name = get_default $end_name, $out_name . ".footer";

    print STDERR "($inp_name + $ph_name) . $end_name --> $out_name\n";
    #==========================================================================
    # scan build level configuration to collect define/undef values
    #==========================================================================

    open FINP, "< $inp_name" or die "open error: ", $inp_name;
    my %build_macros;
    while (<FINP>)
    {
        if (/^\s*#\s*define\s*(\w+)\s*(.*)/)
        {
            if (exists $build_macros{$1})
            {
                show_repeat $inp_name, $., $build_macros{$1}[0], $_;
            }
            else
            {
                $build_macros{$1} = [$., "d", $2];
            }
        }
        elsif (/^\s*#\s*undef\s*(\w+)/)
        {
            if (exists $build_macros{$1})
            {
                show_repeat $inp_name, $., $build_macros{$1}[0], $_;
            }
            else
            {
                $build_macros{$1} = [$., "u"];
            }
        }
    }
    close FINP;
    #==========================================================================

    #==========================================================================
    # temporary output file
    #==========================================================================
    my $temp_name = "$out_name.tmp";

    open FOUT, "> $temp_name" or die "open error: ", $temp_name;

    #==========================================================================
    # copy root level configuration to output file
    # while keeping track of conditional compile nesting level
    #==========================================================================
    open FINP, "< $ph_name" or die "open error: ", $ph_name;
    my %ph_macros;
    while (<FINP>)
    {

        my $out_line = $_;

        if (/^\s*#\s*undef\s*(\w+)/)
        {
            if (exists $ph_macros{$1})
            {
                    show_repeat $ph_name, $., $ph_macros{$1}[0], $_;
            }
            else
            {
                    $ph_macros{$1} = [$., "u"];
            }

            if (exists $build_macros{$1}
                and $build_macros{$1}[1] eq "d")
            {
                $out_line = "#define $1";

                $out_line .= " " . $build_macros{$1}[2]
                    if $build_macros{$1}[2];

                $out_line .= "\n";
            }
        }
        print FOUT $out_line;
    }
    close FINP;
    #==========================================================================

    #==========================================================================
    # copy build level configuration append file to output file
    #==========================================================================
    if (open FINP, "< $end_name")
    {
        while (<FINP>)
        {
                print FOUT $_;
        }
        close FINP;
    }
    #==========================================================================
    close FOUT;
    #==========================================================================

    #==========================================================================
    # determine whether output (if any) has changed from last run
    #==========================================================================
    my $same = 0;

    if (open FINP, "< $out_name")
    {
        open FOUT, "< $temp_name" or die "open error: ", $temp_name;

        $same = 1;
        while ($same)
        {
            last if eof FINP and eof FOUT;
            if (eof FINP or eof FOUT or <FINP> ne <FOUT>)
            {
                $same = 0;
                last;
            }
        }
        close FOUT;
        close FINP;
    }

    #==========================================================================
    # nag the guilty
    #==========================================================================
    my @keys_build = sort keys %build_macros;
    my @keys_roots = sort keys %ph_macros;
    my ($idx_build, $idx_roots) = (0, 0);
    while ($idx_build < @keys_build or $idx_roots < @keys_roots) {
        if ($idx_build >= @keys_build)
        {
            show_orphan 0, $inp_name, $ph_name, $keys_roots[$idx_roots],
                        %ph_macros;
            $idx_roots++;
        }
        elsif ($idx_roots >= @keys_roots)
        {
            show_orphan 1, $ph_name, $inp_name, $keys_build[$idx_build],
                           %build_macros;
            $idx_build++;
        }
        elsif ($keys_build[$idx_build] gt $keys_roots[$idx_roots])
        {
            show_orphan 0, $inp_name, $ph_name, $keys_roots[$idx_roots],
                        %ph_macros;
            $idx_roots++;
        }
        elsif ($keys_roots[$idx_roots] gt $keys_build[$idx_build])
        {
            show_orphan 1, $ph_name, $inp_name, $keys_build[$idx_build],
                        %build_macros;
            $idx_build++;
        }
        else
        {
            $idx_build++;
            $idx_roots++;
        }
    }

    #==========================================================================
    # save output only if changed
    #==========================================================================
    save_edit $same, $out_name, $temp_name;
}



###
### MAIN
###
make_config_h @ARGV;