root/1.8.3/tags/p5rc1/utils/mkcmds.pl

#!/usr/bin/perl -w
# perl version of the old mkcmds.sh script. Runs faster by simply not running
# a bazillion child processes. Also uses SelfLoader to avoid compiling functions
# that are never used, since it's usually invoked with at most 1 argument.
#

use SelfLoader;
use File::Compare;
use File::Copy;
use strict; # Please ma'am may I have another?

# SelfLoaded functions
use subs qw/make_patches make_switches make_cmds make_funs/;
# Always present functions
use subs qw/maybemove temp_header temp_source scan_files_for_pattern/;

# Main loop, dispatch for each command line argument.
foreach my $command (@ARGV) {
    if ($command eq "patches") {
        make_patches;
    } elsif ($command eq "switches") {
        make_switches;
    } elsif ($command eq "commands") {
        make_cmds;
    } elsif ($command eq "functions") {
        make_funs;
    } elsif ($command eq "all") {
        make_patches;
        make_switches;
        make_cmds;
        make_funs;
    } else {
        warn "Unknown option '${command}'\n";
    }
}

# Return name of a temp file in hdrs/
sub temp_header {
    return "hdrs/temp.$$.h";
}

# Return name of a temp file in src/
sub temp_source {
    return "src/temp.$$.c";
}

# maybemove(file1, file2) copies file1 to file 2 if they are different,
# otherwise just deletes file1 and leaves file2 unchanged.
sub maybemove {
    my $from = shift;
    my $to = shift;

    if (compare $from, $to) {
        if (move $from, $to) {
            print "File ${to} updated.\n";
        } else {
            warn "Couldn't rename ${from} to ${to}: $!\n";
        }
    } else {
        print "File ${to} unchanged.\n";
        unlink $from;
    }
}

# scan_files_for_pattern(glob-pattern, re) searches all files matching
# glob-pattern for lines matching re, and returns a sorted list of
# $1's for each matching line.
sub scan_files_for_pattern {
    my $filepattern = shift;
    my $re = shift;
    my @idents;

    foreach my $file (glob $filepattern) {
        open FILE, "<", $file 
            or die "Cannot open ${file} for reading: $!\n";
        while (<FILE>) {
            chomp;
            push @idents, $1 if m/$re/;
        }
        close FILE;
    }
    return sort @idents;
}


END {
    # Make sure temp files get deleted.
    my @files = (temp_header(), temp_source());
    foreach my $file (@files) {
        unlink $file if -f $file;
    }
}

__DATA__

sub make_patches {
    print "Rebuilding list of installed patches\n";
    my $tempfile = temp_header;
    my $patchfile = "hdrs/patches.h";
    my $auto_msg = "/* AUTOGENERATED FILE. DO NOT EDIT! */\n";
    open PATCHES, ">", $tempfile
        or die "Couldn't open $tempfile for writing: $!\n";
    print PATCHES $auto_msg;
    print PATCHES "#ifndef PATCHES_H\n";
    print PATCHES "#define PATCHES_H\n";
    my %patches;
    if (-d "patches") {
        foreach $file (<patches/*>) {
            next if $file =~ /(?:\.bak|\.orig|\.rej|~)$/o;
            open FILE, "<", $file
                or die "Couldn't open file '$file' for reading: $!\n";
            my $name = undef;
            my $version = undef;
            LINE: while (<FILE>) {
                chomp;
                $name = $1 if m/^# Patch name: (.*)/o;
                $version = $1 if m/^# Patch version: (.*)/o;
                if (defined $name && defined $version) {
                    $patches{$name} = $version;
                    last LINE;
                }
            }
            close FILE;
        }
        if (scalar keys %patches > 0) {
            print PATCHES '#define PATCHES "';
            while (my ($name, $version) = each %patches) {
                print PATCHES "$name($version) ";                
            }
            print PATCHES '"', "\n";
        } else {
            print PATCHES "#undef PATCHES\n";
        }
    } else {
        print PATCHES "#undef PATCHES\n";
    }
    print PATCHES "#endif /* PATCHES_H */\n";
    close PATCHES;
    
    maybemove $tempfile, $patchfile;
}

sub make_switches {
    print "Rebuilding command switch file and header.\n";
    my $auto_msg = "/* AUTOGENERATED FILE. DO NOT EDIT! */\n";
    
    my $temphdr = temp_header;
    my $tempsrc = temp_source;

    open CMDHDR, "<", "hdrs/command.h" or
        die "Unable to open hdrs/command.h for reading: $!\n";
    my $numbytes = 20;
    while (<CMDHDR>) {
        if (m/^#define\s+NUM_BYTES\s+(\d+)/o) {
            $numbytes = $1;
            last;
        }
    }
    close CMDHDR;

    my $MAXSWITCHES = $numbytes * 8;
    
    my @switches = scan_files_for_pattern "src/SWITCHES", qr/^(.+)/;
    
    warn "Too many switches defined!\n" if length @switches > $MAXSWITCHES;

    open HDR, ">", $temphdr or
        die "Unable to open $temphdr for writing: $!\n";
    open SRC, ">", $tempsrc or
        die "Unable to open $tempsrc for writing: $1\n";

    print HDR $auto_msg;
    print HDR "#ifndef SWITCHES_H\n";
    print HDR "#define SWITCHES_H\n";

    print SRC $auto_msg;
    print SRC "SWITCH_VALUE switch_list[] = {\n";
    
    my $n = 1;
    foreach my $switch (@switches) {
        print HDR "#define SWITCH_${switch} ${n}\n";
        print SRC "  {\"${switch}\", SWITCH_${switch}},\n";
        $n++;
    }
    
    print SRC "  {NULL, 0}\n";
    print SRC "};\n";
    close SRC;

    print HDR "#endif                          /* SWITCHES_H */\n";
    close HDR;

    maybemove $temphdr, "hdrs/switches.h";
    maybemove $tempsrc, "src/switchinc.c";
}

# I really should combine this and make_funs into one function that does
# the work with specific files/regexps/defines passed as arguments

sub make_cmds {
    my $auto_msg = "/* AUTOGENERATED FILE. DO NOT EDIT! */\n";

    print "Rebuilding command prototype header.\n";
    
    my $tempfile = temp_header;
    
    my @commands =
        scan_files_for_pattern "src/*.c", qr/^\s*COMMAND\(([^\)]+)\)/;

    open HDR, ">", $tempfile
        or die "Can't open ${tempfile} for writing: $!\n";
    
    print HDR $auto_msg;
    print HDR "#ifndef CMDS_H\n";
    print HDR "#define CMDS_H\n";

    foreach my $command (@commands) {
        print HDR "COMMAND_PROTO(${command});\n";
    }

    print HDR "#endif /* CMDS_H */\n";
    close HDR;

    maybemove $tempfile, "hdrs/cmds.h";

}

sub make_funs {
    my $auto_msg = "/* AUTOGENERATED FILE. DO NOT EDIT! */\n";

    print "Rebuilding function prototype header.\n";
    
    my $tempfile = temp_header;
    
    my @functions =
        scan_files_for_pattern "src/*.c", qr/^\s*FUNCTION\(([^\)]+)\)/;

    open HDR, ">", $tempfile
        or die "Can't open ${tempfile} for writing: $!\n";
    
    print HDR $auto_msg;
    print HDR "#ifndef FUNS_H\n";
    print HDR "#define FUNS_H\n";

    foreach my $function (@functions) {
        print HDR "FUNCTION_PROTO(${function});\n";
    }

    print HDR "#endif /* FUNS_H */\n";
    close HDR;

    maybemove $tempfile, "hdrs/funs.h";
}