You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

mkconfig.pl 3.4KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163
  1. #!/usr/bin/perl -w
  2. use File::Spec::Functions qw ( :ALL );
  3. use strict;
  4. use warnings;
  5. my $cfgdir = "config";
  6. my $config_h = "config.h";
  7. # Read in a whole file
  8. #
  9. sub read_file {
  10. my $file = shift;
  11. open my $fh, "<$file" or die "Could not open file $file: $!\n";
  12. local $/;
  13. my $data = <$fh>;
  14. close $fh;
  15. return $data;
  16. }
  17. # Write out a whole file
  18. #
  19. sub write_file {
  20. my $file = shift;
  21. my $data = shift;
  22. open my $fh, ">$file" or die "Could not write $file: $!\n";
  23. print $fh $data;
  24. close $fh;
  25. }
  26. # Delete a file
  27. #
  28. sub delete_file {
  29. my $file = shift;
  30. unlink $file or die "Could not delete $file: $!\n";
  31. }
  32. # Read a directory listing (excluding the . and .. entries)
  33. #
  34. sub read_dir {
  35. my $dir = shift;
  36. opendir my $dh, $dir or die "Could not open directory $dir: $!\n";
  37. my @entries = grep { ! /^(\.)+$/ } readdir $dh;
  38. closedir $dh;
  39. return @entries;
  40. }
  41. # Get the current configuration by reading the configuration file
  42. # fragments
  43. #
  44. sub current_config {
  45. my $dir = shift;
  46. my $cfg = {};
  47. foreach my $file ( read_dir ( $dir ) ) {
  48. $cfg->{$file} = read_file ( catfile ( $dir, $file ) );
  49. }
  50. return $cfg;
  51. }
  52. # Calculate guard name for a header file
  53. #
  54. sub guard {
  55. my $name = shift;
  56. $name =~ s/\W/_/g;
  57. return "CONFIG_".( uc $name );
  58. }
  59. # Calculate preamble for a header file
  60. #
  61. sub preamble {
  62. my $name = shift;
  63. my $master = shift;
  64. my $guard = guard ( $name );
  65. my $preamble = <<"EOF";
  66. /*
  67. * This file is automatically generated from $master. Do not edit this
  68. * file; edit $master instead.
  69. *
  70. */
  71. #ifndef $guard
  72. #define $guard
  73. EOF
  74. return $preamble;
  75. }
  76. # Calculate postamble for a header file
  77. #
  78. sub postamble {
  79. my $name = shift;
  80. my $guard = guard ( $name );
  81. return "\n#endif /* $guard */\n";
  82. }
  83. # Get the new configuration by splitting config.h file using the
  84. # @BEGIN/@END tags
  85. #
  86. sub new_config {
  87. my $file = shift;
  88. my $cfg = {};
  89. my $cursor = "";
  90. open my $fh, "<$file" or die "Could not open $file: $!\n";
  91. while ( <$fh> ) {
  92. if ( ( my $newcursor, my $suffix ) = /\@BEGIN\s+(\w+\.h)(.*)$/ ) {
  93. die "Missing \"\@END $cursor\" before \"\@BEGIN $1\""
  94. ." at $file line $.\n" if $cursor;
  95. $cursor = $newcursor;
  96. $cfg->{$cursor} = preamble ( $cursor, $file )
  97. unless exists $cfg->{$cursor};
  98. $cfg->{$cursor} .= "\n/*".$suffix."\n";
  99. } elsif ( ( my $prefix, my $oldcursor ) = /^(.*)\@END\s+(\w+\.h)/ ) {
  100. die "Missing \"\@BEGIN $oldcursor\" before \"\@END $oldcursor\""
  101. ." at $file line $.\n" unless $cursor eq $oldcursor;
  102. $cfg->{$cursor} .= $prefix."*/\n";
  103. $cursor = "";
  104. } else {
  105. $cfg->{$cursor} .= $_ if $cursor;
  106. }
  107. }
  108. close $fh;
  109. die "Missing \"\@END $cursor\" in $file\n" if $cursor;
  110. foreach $cursor ( keys %$cfg ) {
  111. $cfg->{$cursor} .= postamble ( $cursor );
  112. }
  113. return $cfg;
  114. }
  115. #############################################################################
  116. #
  117. # Main program
  118. # Read in current config file fragments
  119. #
  120. my $current = current_config ( $cfgdir );
  121. # Read in config.h and split it into fragments
  122. #
  123. my $new = new_config ( $config_h );
  124. # Delete any no-longer-wanted config file fragments
  125. #
  126. foreach my $file ( keys %$current ) {
  127. unlink catfile ( $cfgdir, $file ) unless exists $new->{$file};
  128. }
  129. # Write out any modified fragments
  130. #
  131. foreach my $file ( keys %$new ) {
  132. write_file ( catfile ( $cfgdir, $file ), $new->{$file} )
  133. unless $current->{$file} && $new->{$file} eq $current->{$file};
  134. }