Perl: config-h.pl - Draft

[Conrad T. Pino]

use strict;

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

                if ($type eq "d") {
                        # tell only of #undef
                        return;
                }
        }
        elsif ($case eq 1) {
                # build file has extra macro statement

                if ($type eq "u") {
                        # tell only of #define
                        return;
                }
        }
        else {
                # internal script error
        }

        if ($type eq "d") {
                $type = "#define";
        }
        elsif ($type eq "u") {
                $type = "#undef";
        }
        else {
                # 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 ($bld_name, $out_name, $inp_name, $end_name) = @ARGV;

        $bld_name = get_default $bld_name, "windows-NT";
        $out_name = get_default $out_name, "config.h";
        $inp_name = get_default $inp_name, $out_name . ".in";
        $end_name = get_default $end_name, $out_name . ".end";

        print $bld_name, "\n";
        print $out_name, "\n";
        print $inp_name, "\n";
        print $end_name, "\n";

        
#==========================================================================
        # scan build level configuration to collect define/undef values
        # while keeping track of conditional compile nesting level
        
#==========================================================================
        my $build_in_name = $bld_name . "/" . $inp_name;

        open FINP, "< " . $build_in_name or die "open error: ", $build_in_name;
        my %build_macros;
        my ($line, $nest) = (0, 0);
        while (<FINP>) {
                $line += 1;

                if (/^\s*#\s*ifn?(def)?\s/) {
                        $nest += 1;
#                       print $_;
                }
                elsif (/^\s*#\s*endif[^\w]/) {
                        $nest -= 1;
#                       print $_;
                }

                next if ($nest > 0);

                if (/^\s*#\s*define\s*(\w+)\s*(.*)/) {
                        if (exists $build_macros{ $1 }) {
                                show_repeat $build_in_name, $line, 
$build_macros{ $1 }[0], $_;
                        } else {
                                $build_macros{ $1 } = [ $line, "d", $2 ];
                        }

#                       print $1, "=", $2, "\n";
                }
                elsif (/^\s*#\s*undef\s*(\w+)/) {
                        if (exists $build_macros{ $1 }) {
                                show_repeat $build_in_name, $line, 
$build_macros{ $1 }[0], $_;
                        } else {
                                $build_macros{ $1 } = [ $line, "u" ];
                        }

#                       print $1, "\n";
                }
        }
        close FINP;
        
#==========================================================================

        
#==========================================================================
        # temporary output file
        
#==========================================================================
        my $temp_name = $bld_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
        
#==========================================================================
        my $roots_in_name = $inp_name;

        open FINP, "< " . $roots_in_name or die "open error: ", $roots_in_name;
        my %roots_macros;
        my ($line, $nest) = (0, 0);
        while (<FINP>) {
                $line += 1;

                if (/^\s*#\s*ifn?(def)?\s/) {
                        $nest += 1;
#                       print $_;
                }
                elsif (/^\s*#\s*endif[^\w]/) {
                        $nest -= 1;
#                       print $_;
                }

                my $out_line = $_;

                if (/^\s*#\s*define\s*(\w+)\s*(.*)/) {
                        if ($nest eq 0) {
                                if (exists $roots_macros{ $1 }) {
                                        show_repeat $roots_in_name, $line, 
$roots_macros{ $1 }[0], $_;
                                } else {
                                        $roots_macros{ $1 } = [ $line, "d", $2 
];
                                }

#                               print $1, "=", $2, "\n";
                        }
                }
                elsif (/^\s*#\s*undef\s*(\w+)/) {
                        if ($nest eq 0) {
                                if (exists $roots_macros{ $1 }) {
                                        show_repeat $roots_in_name, $line, 
$roots_macros{ $1 }[0], $_;
                                } else {
                                        $roots_macros{ $1 } = [ $line , "u" ];
                                }

#                               print $1, "\n";
                        }

                        if (exists $build_macros{ $1 } and $build_macros{ $1 }[ 
1 ] eq "d") {
#                               print $build_macros{ $1 }[ 1 ], " ", $1, " ", 
$build_macros{ $1 }[ 2 ], "\n";

                                $out_line = "#define ". $1;

                                if ($build_macros{ $1 }[ 2 ]) {
#                                       print $build_macros{ $1 }[ 1 ], " ", 
$1, " ", $build_macros{ $1 }[ 2 ], "\n";

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

                                $out_line = $out_line . "\n";
                        }
                }

                print FOUT $out_line;
        }
        close FINP;
        
#==========================================================================

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

        
#==========================================================================
        # determine whether output (if any) has changed from last run
        
#==========================================================================
        my $file_name = $bld_name . "/" . $out_name;
        my $same = 0;

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

                $same = 1;
                while ($same) {
                        last if (eof FINP and eof FOUT);

                        $same = 0;
                        last if (eof FINP);
                        last if (eof FOUT);

                        if (<FINP> eq <FOUT>) {
                                $same = 1;
                        }
                }
                close FOUT;
                close FINP;
        }

        
#==========================================================================
        # nag the guilty
        
#==========================================================================
        my @keys_build = sort keys %build_macros;
        my @keys_roots = sort keys %roots_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, $build_in_name, $roots_in_name, 
$keys_roots[$idx_roots], %roots_macros;
                        $idx_roots += 1;
                }
                elsif ($idx_roots >= @keys_roots) {
                        show_orphan 1, $roots_in_name, $build_in_name, 
$keys_build[$idx_build], %build_macros;
                        $idx_build += 1;
                }
                elsif ($keys_build[$idx_build] gt $keys_roots[$idx_roots]) {
                        show_orphan 0, $build_in_name, $roots_in_name, 
$keys_roots[$idx_roots], %roots_macros;
                        $idx_roots += 1;
                }
                elsif ($keys_roots[$idx_roots] gt $keys_build[$idx_build]) {
                        show_orphan 1, $roots_in_name, $build_in_name, 
$keys_build[$idx_build], %build_macros;
                        $idx_build += 1;
                }
                else {
                        $idx_build += 1;
                        $idx_roots += 1;
                }
        }

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

make_config_h;