Você não pode selecionar mais de 25 tópicos Os tópicos devem começar com uma letra ou um número, podem incluir traços ('-') e podem ter até 35 caracteres.

mkconfig.pl 4.5KB

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