empire/empserver
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Make mksubj.pl touch subject files only when it needs to change

Browse source 
Avoids unnecessary reformatting of subject pages again.
This commit is contained in:
Markus Armbruster 2013-04-28 15:22:11 +02:00
parent 890e88d149
commit 156930c515
1 changed files with 32 additions and 31 deletions
Download patch file Download diff file Expand all files Collapse all files

63
info/mksubj.pl
View file

@ -25,7 +25,7 @@
# #
# --- # ---
# #
# mksubj.pl: Create the subject index pages # mksubj.pl: Update the subject index pages
# #
# Known contributors to this file: # Known contributors to this file:
# Ken Stevens (when it was still info.pl) # Ken Stevens (when it was still info.pl)
@ -33,14 +33,12 @@
# #
# Usage: mksubj.pl SUBJECT... INFO-FILE... # Usage: mksubj.pl SUBJECT... INFO-FILE...
# #
# Read the INFO-FILE..., create info/SUBJECT.t for each SUBJECT. # Read the INFO-FILE..., update info/SUBJECT.t for each SUBJECT.
use strict; use strict;
use warnings; use warnings;
use File::stat; use File::stat;
use Fcntl qw(O_WRONLY O_EXCL O_CREAT);
# The chapters, in order # The chapters, in order
my @Chapters = qw/Introduction Concept Command Server/; my @Chapters = qw/Introduction Concept Command Server/;
@ -84,7 +82,9 @@ for my $t (sort keys %desc) {
parse_see_also($t); parse_see_also($t);
} }
create_subjects(); for (keys %Subjects) {
update_subj($_);
}
# Parse an info file # Parse an info file
# Set $filename, $filename{TOPIC}, $long{TOPIC}, $chapter{TOPIC}, # Set $filename, $filename{TOPIC}, $long{TOPIC}, $chapter{TOPIC},
@ -194,22 +194,20 @@ sub set_subject {
$largest{$sub} = $topic if length $topic > length $largest{$sub}; $largest{$sub} = $topic if length $topic > length $largest{$sub};
} }
# Create a Subject.t file # Update a Subject.t file
sub create_subj { sub update_subj {
my ($subj) = @_; my ($subj) = @_;
my $fname = "info/$subj.t"; my $fname = "info/$subj.t";
my $out = "";
my ($any_topic, $any_basic, $any_obsolete, $any_long); my ($any_topic, $any_basic, $any_obsolete, $any_long);
sysopen(SUBJ, $fname, O_WRONLY | O_EXCL | O_CREAT) $out .= '.\" DO NOT EDIT THIS FILE. It was automatically generated by mksubj.pl'."\n";
or die "Unable to create $fname: $!\n"; $out .= ".TH Subject \U$subj\n";
print SUBJ '.\" DO NOT EDIT THIS FILE. It was automatically generated by mksubj.pl'."\n";
print SUBJ ".TH Subject \U$subj\n";
$largest{$subj} =~ s/-/M/g; $largest{$subj} =~ s/-/M/g;
print SUBJ ".in \\w'$largest{$subj}XX\\0\\0\\0\\0'u\n"; $out .= ".in \\w'$largest{$subj}XX\\0\\0\\0\\0'u\n";
for my $chap (@Chapters) { for my $chap (@Chapters) {
next unless exists $subject{$subj}{$chap}; next unless exists $subject{$subj}{$chap};
print SUBJ ".s1\n"; $out .= ".s1\n";
for my $topic (split(/\n/, $subject{$subj}{$chap})) { for my $topic (split(/\n/, $subject{$subj}{$chap})) {
$any_topic = 1; $any_topic = 1;
my $flags = ""; my $flags = "";
@ -226,40 +224,43 @@ sub create_subj {
$any_long = 1; $any_long = 1;
} }
$flags = sprintf("%-2s", $flags); $flags = sprintf("%-2s", $flags);
print SUBJ ".L \"$topic $flags\"\n"; $out .= ".L \"$topic $flags\"\n";
print SUBJ "$desc{$topic}\n"; $out .= "$desc{$topic}\n";
} }
} }
unless ($any_topic) { unless ($any_topic) {
print STDERR "$0: Subject $subj has no topics\n"; print STDERR "$0: Subject $subj has no topics\n";
exit 1; exit 1;
} }
print SUBJ ".s1\n" $out .= ".s1\n"
. ".in 0\n" . ".in 0\n"
. "For info on a particular subject, type \"info <subject>\" where <subject> is\n" . "For info on a particular subject, type \"info <subject>\" where <subject> is\n"
. "one of the subjects listed above.\n"; . "one of the subjects listed above.\n";
print SUBJ "Subjects marked by * are the most important and should be read by new players.\n" $out .= "Subjects marked by * are the most important and should be read by new players.\n"
if $any_basic; if $any_basic;
print SUBJ "Subjects marked by + are obsolete.\n" $out .= "Subjects marked by + are obsolete.\n"
if $any_obsolete; if $any_obsolete;
print SUBJ "Unusually long subjects are marked with a !.\n" $out .= "Unusually long subjects are marked with a !.\n"
if $any_long; if $any_long;
return if (same_contents($fname, $out));
open(SUBJ, ">$fname")
or die "Can't open $fname for writing: $!";
print SUBJ $out;
close SUBJ; close SUBJ;
} }
# Remove the old Subject.t files and create new ones sub same_contents {
sub create_subjects { my ($fname, $contents) = @_;
my (@subj); local $/;
for (keys %Subjects) { if (!open(SUBJ, "<$fname")) {
unlink "info/$_.t"; return 0 if ($!{ENOENT});
} die "Can't open $fname for reading: $!";
@subj = sort keys %subject;
for my $subj (@subj) {
create_subj($subj);
} }
my $old = <SUBJ>;
close SUBJ;
return $contents eq $old;
} }
# Print an integrity error message and exit with code 1 # Print an integrity error message and exit with code 1