src/util/mkconfig.pl

   1 #!/usr/bin/perl -w
   2
   3 use File::Spec::Functions qw ( :ALL );
   4 use File::stat;
   5 use strict;
   6 use warnings;
   7
   8 my $cfgdir = "config";
   9 my $config_h = shift || "config.h";
  10
  11 # Read in a whole file
  12 #
  13 sub read_file {
  14   my $file = shift;
  15
  16   open my $fh, "<$file" or die "Could not open file $file: $!\n";
  17   local $/;
  18   my $data = <$fh>;
  19   close $fh;
  20   return $data;
  21 }
  22
  23 # Write out a whole file
  24 #
  25 sub write_file {
  26   my $file = shift;
  27   my $data = shift;
  28
  29   open my $fh, ">$file" or die "Could not write $file: $!\n";
  30   print $fh $data;
  31   close $fh;
  32 }
  33
  34 # Delete a file
  35 #
  36 sub delete_file {
  37   my $file = shift;
  38
  39   unlink $file or die "Could not delete $file: $!\n";
  40 }
  41
  42 # Get a file modification time
  43 #
  44 sub file_mtime {
  45   my $file = shift;
  46
  47   my $stat = stat ( $file ) or die "Could not stat $file: $!\n";
  48   return $stat->mtime;
  49 }
  50
  51 # Read all the .h files in a directory
  52 #
  53 sub read_dir {
  54   my $dir = shift;
  55
  56   opendir my $dh, $dir or die "Could not open directory $dir: $!\n";
  57   my @entries = grep { /\.h$/ } readdir $dh;
  58   closedir $dh;
  59   return @entries;
  60 }
  61
  62 # Get the current configuration by reading the configuration file
  63 # fragments
  64 #
  65 sub current_config {
  66   my $dir = shift;
  67
  68   my $cfg = {};
  69   foreach my $file ( read_dir ( $dir ) ) {
  70     $cfg->{$file} = read_file ( catfile ( $dir, $file ) );
  71   }
  72   return $cfg;
  73 }
  74
  75 # Calculate guard name for a header file
  76 #
  77 sub guard {
  78   my $name = shift;
  79
  80   $name =~ s/\W/_/g;
  81   return "CONFIG_".( uc $name );
  82 }
  83
  84 # Calculate preamble for a header file
  85 #
  86 sub preamble {
  87   my $name = shift;
  88   my $master = shift;
  89
  90   my $guard = guard ( $name );
  91   my $preamble = <<"EOF";
  92 /*
  93  * This file is automatically generated from $master.  Do not edit this
  94  * file; edit $master instead.
  95  *
  96  */
  97
  98 #ifndef $guard
  99 #define $guard
 100 EOF
 101   return $preamble;
 102 }
 103
 104 # Calculate postamble for a header file
 105 #
 106 sub postamble {
 107   my $name = shift;
 108
 109   my $guard = guard ( $name );
 110   return "\n#endif /* $guard */\n";
 111 }
 112
 113 # Get the new configuration by splitting config.h file using the
 114 # @BEGIN/@END tags
 115 #
 116 sub new_config {
 117   my $file = shift;
 118
 119   my $cfg = {};
 120   my $cursor = "";
 121
 122   open my $fh, "<$file" or die "Could not open $file: $!\n";
 123   while ( <$fh> ) {
 124     if ( ( my $newcursor, my $suffix ) = /\@BEGIN\s+(\w+\.h)(.*)$/ ) {
 125       die "Missing \"\@END $cursor\" before \"\@BEGIN $1\""
 126           ." at $file line $.\n" if $cursor;
 127       $cursor = $newcursor;
 128       $cfg->{$cursor} = preamble ( $cursor, $file )
 129           unless exists $cfg->{$cursor};
 130       $cfg->{$cursor} .= "\n/*".$suffix."\n";
 131     } elsif ( ( my $prefix, my $oldcursor ) = /^(.*)\@END\s+(\w+\.h)/ ) {
 132       die "Missing \"\@BEGIN $oldcursor\" before \"\@END $oldcursor\""
 133           ." at $file line $.\n" unless $cursor eq $oldcursor;
 134       $cfg->{$cursor} .= $prefix."*/\n";
 135       $cursor = "";
 136     } else {
 137       $cfg->{$cursor} .= $_ if $cursor;
 138     }
 139   }
 140   close $fh;
 141   die "Missing \"\@END $cursor\" in $file\n" if $cursor;
 142
 143   foreach $cursor ( keys %$cfg ) {
 144     $cfg->{$cursor} .= postamble ( $cursor );
 145   }
 146
 147   return $cfg;
 148 }
 149
 150 #############################################################################
 151 #
 152 # Main program
 153
 154 # Read in current config file fragments
 155 #
 156 my $current = current_config ( $cfgdir );
 157
 158 # Read in config.h and split it into fragments
 159 #
 160 my $new = new_config ( $config_h );
 161
 162 # Delete any no-longer-wanted config file fragments
 163 #
 164 foreach my $file ( keys %$current ) {
 165   unlink catfile ( $cfgdir, $file ) unless exists $new->{$file};
 166 }
 167
 168 # Write out any modified fragments, and find the oldest timestamp of
 169 # any unmodified fragments.
 170 #
 171 my $oldest = time ();
 172 foreach my $file ( keys %$new ) {
 173   if ( $current->{$file} && $new->{$file} eq $current->{$file} ) {
 174     # Unmodified
 175     my $time = file_mtime ( catfile ( $cfgdir, $file ) );
 176     $oldest = $time if $time < $oldest;
 177   } else {
 178     write_file ( catfile ( $cfgdir, $file ), $new->{$file} );
 179   }
 180 }
 181
 182 # If we now have fragments that are older than config.h, set the
 183 # timestamp on config.h to match the oldest fragment, to prevent make
 184 # from always attempting to rebuild the fragments.
 185 #
 186 if ( $oldest < file_mtime ( $config_h ) ) {
 187   utime time(), $oldest, $config_h or die "Could not touch $config_h: $!\n";
 188 }