[xfonts-traditional] / update-xfonts-traditional

#!/usr/bin/perl -w
use strict;
use POSIX;
use IO::File;
use Getopt::Long;
use File::Glob qw(:glob);
use Data::Dumper;
use IO::Pipe;

our $prefix="/usr/local";
our $package='xfonts-traditional';
our $sharedir="$prefix/share/$package";
our @fontparentdirs=qw(/usr/share/fonts/X11 /usr/local/share/fonts/X11);
our $donefile="$package.done";
our $logfile="$package.log";
our $fontprefix="trad--";
our @rulespath;
our $mode;
our %foundrymap;
our $verbose=0;
our $reportfh;

sub reportloaded {
    return unless $verbose;
    print $reportfh @_,"\n" or die $!;
}

sub loadrules ($) {
    my ($key) = @_;
    our %cache;
    my $fc=$cache{$key};  
    return $fc if $fc;
    foreach my $path (@rulespath) {
	my $script="$path/$key.rules";
	$!=0; $@=''; my $f = do $script;
	if (defined $f) {
	    reportloaded("rules: loaded ",$script);
	    $cache{$key}=$f;
	    return $f;
	}
	die "$! $? $script" unless $! == &ENOENT;
    }
    return $cache{$key}=undef;
}

sub processbdf ($$$$) {
    my ($inbdf,$outbdf,$logfile,$what) = @_;
    my $state='idle';
    my ($foundry,$font);
    my ($w,$h,$xo,$yo,$y,$bitmap,$glyph);
    my $modified=0;
    while (<$inbdf>) {
	if ($state eq 'bitmap' && $y==$h) {
	    $glyph = uc $glyph;
	    $glyph =~ s/\;$//;
	    local ($_) = $glyph;
	    my $key= sprintf "%s,%d,%d,%d,%d", $foundry,$w,$h,$xo,$yo;
	    my $rules= loadrules($key);
	    return (0,'no rules') if !$rules;
	    $rules->();
	    $modified += ($_ ne $glyph);
	    print $outbdf $_,"\n" or die $!
		foreach split /\;/, $_; # /;
	    $state='idle';
	}
	if ($state eq 'bitmap') {
	    m/^([0-9a-fA-F]+)\s+$/ or die $y;
	    length($1) == (($w+7 >> 3) << 1) or die "$1 $w";
	    $glyph .= "$1;";
	    $y++;
	    next;
	}
	if ($state eq 'idle' && m/^FOUNDRY\s+/) {
	    die if defined $foundry;
	    return (0,'foundry syntax') unless m/^FOUNDRY\s+\"(\w+)\"\s+/;
	    $foundry = $foundrymap{lc $1};
	    return (0,'no foundry') unless defined $foundry;
	    $_ = "FOUNDRY \"$foundry\"\n";
	}
	if ($state eq 'idle' && m/^FONT\s+/) {
	    die if defined $font;
	    return (0,'simple font name') unless m/^(FONT\s+)\-(\w+)\-/;
	    $font = $foundrymap{lc $2};
	    return (0,'no foundry') unless defined $font;
	    $_ = "FONT -$font-$'";
	}
	if ($state eq 'idle' && m/^STARTCHAR\s/) {
	    die unless defined $foundry;
	    die unless defined $font;
	    return (0,'foundry != font') unless $foundry eq $font;
	    $state='startchar';
	    $w=undef;
	}
	if ($state eq 'startchar') {
	    if (m/^BBX\s+(\+?\d+)\s+(\+?\d+)\s+([-+]?\d+)\s+([-+]?\d+)\s+$/) {
		($w,$h,$xo,$yo) = ($1,$2,$3,$4);
	    }
	    if (m/^BITMAP\s+$/) {
		die unless defined $w;
		$y=0;
		$glyph='';
		$state='bitmap';
	    }
	}
	print $outbdf $_ or die $!;
    }
    die $! if $inbdf->error;
    die $! if $outbdf->error or !$outbdf->flush;
    die unless $state eq 'idle';
    if ($modified) {
	printf $logfile "%s: %d glyphs changed\n", $what, $modified
	    or die $!;
    } else {
	printf $logfile "%s: unchanged - no rules matched\n", $what
	    or die $!;
    }
    return $modified;
}

our (@options)=(
    'R|rules-include=s@' => \@rulespath,
    'share-dir=s' => \$sharedir,
    'verbose|v+' => \$verbose,
    );

sub define_mode ($$) {
    my ($optname,$f) = @_;
    push @options, $optname, sub {
	die "only one mode may be specified\n" if defined $mode;
	$mode=$f;
    };
}

sub loadfoundries () {
    foreach my $path (@rulespath) {
	my $p = "$path/foundries";
	my $f = new IO::File $p;
	if (!$f) {
	    die "$p $!" unless $!==&ENOENT;
	    print $reportfh "foundries: none in $p\n" or die $! if $verbose;
	    next;
	}
	while (<$f>) {
	    s/^\s*//; s/\s+$//;
	    next if m/^\#/;
	    m/^(\w+)\s+(\w+)$/ or die;
	    my $k = lc $1;
	    next if exists $foundrymap{$k};
	    $foundrymap{$k}=$2;
	}
	$f->error and die $!;
	reportloaded('foundries: loaded ',$p);
    }
    die "no foundry maps\n" unless %foundrymap;
}

sub processpcfgz ($$$$) {
    my ($inpcfgz,$outpcfgz,$logfile,$what) = @_;

    my $current = new IO::File $inpcfgz, '<' or die "$inpcfgz $!";
    my ($usread,$uswrite);
    my ($reader,$writer);
    my @children;
    foreach my $proc (['zcat'], ['pcf2bdf'], [],
		      ['bdftopcf'],['',qw(gzip -1)]) {
	my $isfinal = (@$proc && $proc->[0] eq '');
	if (!$isfinal) {
	    $reader = new IO::Handle or die $!;
	    $writer = new IO::Handle or die $!;
	    new IO::Pipe($reader,$writer) or die $!;
	} else {
	    shift @$proc;
	    $reader = undef;
	    $writer = new IO::File $outpcfgz, '>' or die "$outpcfgz $!";
	}
	if (@$proc) {
	    my $exe = $proc->[0];
	    my $child = fork;  defined $child or die $!;
	    if (!$child) {
		open STDIN, '<&', $current or die $!;
		open STDOUT, '>&', $writer or die $!;
		if (!$isfinal) {
		    close $reader or die $!;
		}
		close $usread or die $! if $usread;
		close $uswrite or die $! if $uswrite;
		exec $exe @$proc or die "$exe $!";
	    }
	    push @children, [ $child, $exe, defined $usread ];
	    close $current or die $!;
	    close $writer or die $!;
	    $current = $reader;
	} else {
	    $usread = $current;
	    $uswrite = $writer;
	    $current = $reader;
	}
    }
    my $r = processbdf($usread,$uswrite,$logfile,$what);
    my $none = $r !~ m/^\d/;
    if ($none) {
	flush $uswrite or die $!;
    } else {
	close $uswrite or die $!;
    }
    close $usread or die $!;
    foreach my $chinfo (@children) {
	my ($child,$exe,$isoutput)=@$chinfo;
	my $sigok = 0;
	if ($none) {
	    if ($isoutput) {
		$sigok = 9;
		kill 9, $child or die "$child $!";
	    } else {
		$sigok = 13;
	    }
	}
	$!=0; waitpid($child, 0) == $child or die "$child $!";
	!$? or ($?&~128)==$sigok or die "$exe [$child] $sigok $?";
    }
    return $r;
}

sub processfontdir ($) {
    my ($fontdir) = @_;
    if (!opendir FD, $fontdir) {
	die "$fontdir $!" unless $!==&ENOENT;
	return;
    }
    my $olddone = do "$fontdir/$donefile";
    if (!$olddone) {
	die "$fontdir $! $@ " unless $!==&ENOENT;
	$olddone = { };
    }
    my $newdone = { };
    my $log = new IO::File "$fontdir/$logfile", "w" 
	or die "$fontdir/$logfile $!";
    my %outfiles; # bitmask: 1 /*exists*/ | 2 /*wanted*/
    my $changed;
    my $updated=0;

    print $reportfh "processing $fontdir...\n" or die $!;
    flush $reportfh or die $!;
    while (my $dent = scalar readdir FD) {
	if ($dent =~ m/^\Q$fontprefix\E.*\.new$/) {
	    unlink "$fontdir/$dent" or $!==&ENOENT or die "$fontdir $dent $!";
	    next;
	}
	next unless $dent =~ m/^[^.\/].*\.pcf\.gz$/;
	if ($dent =~ m/^\Q$fontprefix/) {
	    $outfiles{$dent} |= 1;
	    next;
	}
	if (!stat "$fontdir/$dent") {
	    die "$fontdir $dent $!" unless $!==&ENOENT;
	    next;
	}
	die "$fontdir $dent" unless -f _;
	my $stats = join ' ', ((stat _)[1,7,9,10]);
	my $tdone = $olddone->{$dent};
	my $outdent = $fontprefix.$dent;
	if (defined $tdone && $tdone eq $stats) {
	    $outfiles{$outdent} |= 2;
	    $newdone->{$dent} = $stats;
	    next;
	}

	my $r = processpcfgz("$fontdir/$dent",
			     "$fontdir/$outdent.new",
			     $log, $dent);
	if ($r !~ m/^\d/) {
	    printf $log "%s: unchanged - %s\n", $dent, $r;
	    unlink "$fontdir/$outdent.new" or die "$fontdir $outdent $!";
	} else {
	    rename "$fontdir/$outdent.new", "$fontdir/$outdent"
		or die "$fontdir $outdent $!";
	    $updated++;
	    $outfiles{$outdent} |= 3;
	    $changed = 1;
	}
	$newdone->{$dent} = $stats;
    }
    my $affected=0;
    foreach my $olddent (keys %outfiles) {
	my $state = $outfiles{$olddent};
	if ($state & 2) {
	    $affected++ if $state & 1;
	    next;
	}
	unlink "$fontdir/$olddent" or die "$fontdir $olddent $!";
	$changed = 1;
    }
    if (!%$newdone) {
	unlink "$fontdir/$logfile" or die "$fontdir $!";
	unlink "$fontdir/$donefile" or $!==&ENOENT or die "$fontdir $!";
    } elsif ($changed) {
	$!=0; $?=0; system 'mkfontdir',$fontdir;
	die "$fontdir $? $!" if $? or $!;
	my $newdoneh = new IO::File "$fontdir/$donefile.new", 'w' 
	    or die "$fontdir $!";
	print $newdoneh Dumper($newdone) or die "$fontdir $!";
	close $newdoneh or die "$fontdir $!";
	rename "$fontdir/$donefile.new","$fontdir/$donefile"
	    or die "$fontdir $!";
    }
    printf " processed %s: %d pcfs, %d affected, %d updated.\n",
        $fontdir, (scalar keys %$newdone), $affected, $updated;
}

our $stdin = new IO::File '<&STDIN' or die $!;
our $stdout = new IO::File '>&STDOUT' or die $!;
our $stderr = new IO::File '>&STDERR' or die $!;
$reportfh = $stdout;

define_mode('bdf-filter', sub {
    die "no arguments allowed with --bdf-filter\n" if @ARGV;
    $reportfh = $stderr;
    loadfoundries();
    my $r = processbdf($stdin,$stdout,$reportfh,'stdin');
    if ($r !~ m/^\d/) {
	print STDERR "stdin not processed: $r\n";
	exit 2;
    }
});

define_mode('process-pcf', sub {
    die "need source and destination pcf.gz\n" if @ARGV!=2;
    loadfoundries();
    my $r = processpcfgz($ARGV[0],$ARGV[1],$reportfh,"pcf");
    if ($r !~ m/^\d/) {
	print STDERR "pcf not processed: $r\n";
	exit 2;
    }
});

define_mode('process-fontdir', sub {
    die "need font dir(s)\n" unless @ARGV;
    loadfoundries();
    foreach my $d (@ARGV) {
	processfontdir($d);
    }
});

Getopt::Long::Configure(qw(bundling));
GetOptions(@options) or exit 127;

push @rulespath, "$sharedir/rules";

die "need a mode\n" unless $mode;

$mode->();

#   70  zcat /usr/share/fonts/X11/misc/6x13.pcf.gz |pcf2bdf >in.bdf
#   71  ./utility <in.bdf >out.bdf
#   83  bdftopcf out.bdf >out.pcf
#   84  gzip out.pcf 
#   85  cp out.pcf.gz /usr/share/fonts/X11/misc/
# really mkfontdir /usr/share/fonts/X11/misc/
# xset fp rehash
# xfontsel
Commit	Line	Data
18d2cc90 IJ	1	#!/usr/bin/perl -w
	2	use strict;
	3	use POSIX;
	4	use IO::File;
a2d36db5	5	use Getopt::Long;
baaae949	6	use File::Glob qw(:glob);
a94959e6	7	use Data::Dumper;
71e1fff3	8	use IO::Pipe;
18d2cc90	9
1b17f3ec	10	our $prefix="/usr/local";
a2d36db5	11	our $package='xfonts-traditional';
1b17f3ec	12	our $sharedir="$prefix/share/$package";
71e1fff3	13	our @fontparentdirs=qw(/usr/share/fonts/X11 /usr/local/share/fonts/X11);
baaae949	14	our $donefile="$package.done";
a94959e6	15	our $logfile="$package.log";
baaae949	16	our $fontprefix="trad--";
a2d36db5 IJ	17	our @rulespath;
a2d36db5 IJ	18	our $mode;
148a1d85 IJ	19	our %foundrymap;
	20	our $verbose=0;
	21	our $reportfh;
	22
	23	sub reportloaded {
	24	return unless $verbose;
	25	print $reportfh @_,"\n" or die $!;
	26	}
18d2cc90	27
4ee8efe0 IJ	28	sub loadrules ($) {
4ee8efe0 IJ	29	my ($key) = @_;
18d2cc90	30	our %cache;
18d2cc90 IJ	31	my $fc=$cache{$key};
	32	return $fc if $fc;
	33	foreach my $path (@rulespath) {
	34	my $script="$path/$key.rules";
	35	$!=0; $@=''; my $f = do $script;
	36	if (defined $f) {
148a1d85	37	reportloaded("rules: loaded ",$script);
18d2cc90 IJ	38	$cache{$key}=$f;
	39	return $f;
	40	}
	41	die "$! $? $script" unless $! == &ENOENT;
	42	}
	43	return $cache{$key}=undef;
	44	}
	45
a94959e6 IJ	46	sub processbdf ($$$$) {
a94959e6 IJ	47	my ($inbdf,$outbdf,$logfile,$what) = @_;
4ee8efe0	48	my $state='idle';
148a1d85	49	my ($foundry,$font);
4ee8efe0	50	my ($w,$h,$xo,$yo,$y,$bitmap,$glyph);
148a1d85	51	my $modified=0;
18d2cc90 IJ	52	while (<$inbdf>) {
18d2cc90 IJ	53	if ($state eq 'bitmap' && $y==$h) {
148a1d85 IJ	54	$glyph = uc $glyph;
	55	$glyph =~ s/\;$//;
	56	local ($_) = $glyph;
	57	my $key= sprintf "%s,%d,%d,%d,%d", $foundry,$w,$h,$xo,$yo;
4ee8efe0	58	my $rules= loadrules($key);
148a1d85	59	return (0,'no rules') if !$rules;
18d2cc90	60	$rules->();
148a1d85	61	$modified += ($_ ne $glyph);
18d2cc90	62	print $outbdf $_,"\n" or die $!
4ee8efe0	63	foreach split /\;/, $_; # /;
18d2cc90 IJ	64	$state='idle';
	65	}
	66	if ($state eq 'bitmap') {
	67	m/^([0-9a-fA-F]+)\s+$/ or die $y;
	68	length($1) == (($w+7 >> 3) << 1) or die "$1 $w";
	69	$glyph .= "$1;";
4ee8efe0 IJ	70	$y++;
4ee8efe0 IJ	71	next;
18d2cc90	72	}
4ee8efe0	73	if ($state eq 'idle' && m/^FOUNDRY\s+/) {
148a1d85 IJ	74	die if defined $foundry;
	75	return (0,'foundry syntax') unless m/^FOUNDRY\s+\"(\w+)\"\s+/;
	76	$foundry = $foundrymap{lc $1};
	77	return (0,'no foundry') unless defined $foundry;
	78	$_ = "FOUNDRY \"$foundry\"\n";
4ee8efe0 IJ	79	}
4ee8efe0 IJ	80	if ($state eq 'idle' && m/^FONT\s+/) {
148a1d85	81	die if defined $font;
71e1fff3	82	return (0,'simple font name') unless m/^(FONT\s+)\-(\w+)\-/;
148a1d85 IJ	83	$font = $foundrymap{lc $2};
	84	return (0,'no foundry') unless defined $font;
	85	$_ = "FONT -$font-$'";
18d2cc90 IJ	86	}
18d2cc90 IJ	87	if ($state eq 'idle' && m/^STARTCHAR\s/) {
148a1d85 IJ	88	die unless defined $foundry;
	89	die unless defined $font;
	90	return (0,'foundry != font') unless $foundry eq $font;
18d2cc90 IJ	91	$state='startchar';
	92	$w=undef;
	93	}
	94	if ($state eq 'startchar') {
	95	if (m/^BBX\s+(\+?\d+)\s+(\+?\d+)\s+([-+]?\d+)\s+([-+]?\d+)\s+$/) {
	96	($w,$h,$xo,$yo) = ($1,$2,$3,$4);
	97	}
	98	if (m/^BITMAP\s+$/) {
	99	die unless defined $w;
	100	$y=0;
	101	$glyph='';
	102	$state='bitmap';
	103	}
	104	}
4ee8efe0	105	print $outbdf $_ or die $!;
18d2cc90 IJ	106	}
18d2cc90 IJ	107	die $! if $inbdf->error;
4ee8efe0	108	die $! if $outbdf->error or !$outbdf->flush;
18d2cc90	109	die unless $state eq 'idle';
148a1d85	110	if ($modified) {
a94959e6	111	printf $logfile "%s: %d glyphs changed\n", $what, $modified
148a1d85 IJ	112	or die $!;
148a1d85 IJ	113	} else {
a94959e6	114	printf $logfile "%s: unchanged - no rules matched\n", $what
148a1d85 IJ	115	or die $!;
	116	}
	117	return $modified;
18d2cc90 IJ	118	}
18d2cc90 IJ	119
a2d36db5 IJ	120	our (@options)=(
	121	'R\|rules-include=s@' => \@rulespath,
	122	'share-dir=s' => \$sharedir,
148a1d85	123	'verbose\|v+' => \$verbose,
a2d36db5	124	);
4ee8efe0	125
a2d36db5 IJ	126	sub define_mode ($$) {
	127	my ($optname,$f) = @_;
	128	push @options, $optname, sub {
	129	die "only one mode may be specified\n" if defined $mode;
	130	$mode=$f;
	131	};
	132	}
	133
148a1d85 IJ	134	sub loadfoundries () {
	135	foreach my $path (@rulespath) {
	136	my $p = "$path/foundries";
	137	my $f = new IO::File $p;
	138	if (!$f) {
	139	die "$p $!" unless $!==&ENOENT;
	140	print $reportfh "foundries: none in $p\n" or die $! if $verbose;
	141	next;
	142	}
	143	while (<$f>) {
	144	s/^\s*//; s/\s+$//;
	145	next if m/^\#/;
	146	m/^(\w+)\s+(\w+)$/ or die;
	147	my $k = lc $1;
	148	next if exists $foundrymap{$k};
	149	$foundrymap{$k}=$2;
	150	}
	151	$f->error and die $!;
	152	reportloaded('foundries: loaded ',$p);
	153	}
	154	die "no foundry maps\n" unless %foundrymap;
	155	}
a2d36db5	156
71e1fff3 IJ	157	sub processpcfgz ($$$$) {
	158	my ($inpcfgz,$outpcfgz,$logfile,$what) = @_;
	159
	160	my $current = new IO::File $inpcfgz, '<' or die "$inpcfgz $!";
	161	my ($usread,$uswrite);
	162	my ($reader,$writer);
	163	my @children;
	164	foreach my $proc (['zcat'], ['pcf2bdf'], [],
	165	['bdftopcf'],['',qw(gzip -1)]) {
	166	my $isfinal = (@$proc && $proc->[0] eq '');
	167	if (!$isfinal) {
	168	$reader = new IO::Handle or die $!;
	169	$writer = new IO::Handle or die $!;
	170	new IO::Pipe($reader,$writer) or die $!;
	171	} else {
	172	shift @$proc;
	173	$reader = undef;
	174	$writer = new IO::File $outpcfgz, '>' or die "$outpcfgz $!";
	175	}
	176	if (@$proc) {
	177	my $exe = $proc->[0];
	178	my $child = fork; defined $child or die $!;
	179	if (!$child) {
	180	open STDIN, '<&', $current or die $!;
	181	open STDOUT, '>&', $writer or die $!;
	182	if (!$isfinal) {
	183	close $reader or die $!;
	184	}
	185	close $usread or die $! if $usread;
	186	close $uswrite or die $! if $uswrite;
	187	exec $exe @$proc or die "$exe $!";
	188	}
	189	push @children, [ $child, $exe, defined $usread ];
	190	close $current or die $!;
	191	close $writer or die $!;
	192	$current = $reader;
	193	} else {
	194	$usread = $current;
	195	$uswrite = $writer;
	196	$current = $reader;
	197	}
	198	}
	199	my $r = processbdf($usread,$uswrite,$logfile,$what);
	200	my $none = $r !~ m/^\d/;
	201	if ($none) {
	202	flush $uswrite or die $!;
	203	} else {
	204	close $uswrite or die $!;
	205	}
	206	close $usread or die $!;
	207	foreach my $chinfo (@children) {
	208	my ($child,$exe,$isoutput)=@$chinfo;
	209	my $sigok = 0;
	210	if ($none) {
	211	if ($isoutput) {
	212	$sigok = 9;
	213	kill 9, $child or die "$child $!";
	214	} else {
	215	$sigok = 13;
	216	}
	217	}
	218	$!=0; waitpid($child, 0) == $child or die "$child $!";
	219	!$? or ($?&~128)==$sigok or die "$exe [$child] $sigok $?";
	220	}
221	return $r;
222	}
30c6d632	223
baaae949 IJ	224	sub processfontdir ($) {
	225	my ($fontdir) = @_;
	226	if (!opendir FD, $fontdir) {
	227	die "$fontdir $!" unless $!==&ENOENT;
	228	return;
	229	}
a94959e6	230	my $olddone = do "$fontdir/$donefile";
30c6d632	231	if (!$olddone) {
baaae949	232	die "$fontdir $! $@ " unless $!==&ENOENT;
30c6d632	233	$olddone = { };
baaae949	234	}
a94959e6 IJ	235	my $newdone = { };
	236	my $log = new IO::File "$fontdir/$logfile", "w"
	237	or die "$fontdir/$logfile $!";
71e1fff3	238	my %outfiles; # bitmask: 1 /exists/ \| 2 /wanted/
a94959e6	239	my $changed;
71e1fff3 IJ	240	my $updated=0;
	241
	242	print $reportfh "processing $fontdir...\n" or die $!;
	243	flush $reportfh or die $!;
	244	while (my $dent = scalar readdir FD) {
a94959e6 IJ	245	if ($dent =~ m/^\Q$fontprefix\E.*\.new$/) {
	246	unlink "$fontdir/$dent" or $!==&ENOENT or die "$fontdir $dent $!";
	247	next;
	248	}
baaae949 IJ	249	next unless $dent =~ m/^[^.\/].*\.pcf\.gz$/;
baaae949 IJ	250	if ($dent =~ m/^\Q$fontprefix/) {
71e1fff3	251	$outfiles{$dent} \|= 1;
baaae949 IJ	252	next;
baaae949 IJ	253	}
71e1fff3	254	if (!stat "$fontdir/$dent") {
baaae949 IJ	255	die "$fontdir $dent $!" unless $!==&ENOENT;
	256	next;
	257	}
	258	die "$fontdir $dent" unless -f _;
	259	my $stats = join ' ', ((stat _)[1,7,9,10]);
30c6d632	260	my $tdone = $olddone->{$dent};
71e1fff3	261	my $outdent = $fontprefix.$dent;
baaae949	262	if (defined $tdone && $tdone eq $stats) {
71e1fff3	263	$outfiles{$outdent} \|= 2;
a94959e6	264	$newdone->{$dent} = $stats;
baaae949 IJ	265	next;
baaae949 IJ	266	}
a94959e6	267
30c6d632 IJ	268	my $r = processpcfgz("$fontdir/$dent",
30c6d632 IJ	269	"$fontdir/$outdent.new",
71e1fff3	270	$log, $dent);
a94959e6	271	if ($r !~ m/^\d/) {
71e1fff3	272	printf $log "%s: unchanged - %s\n", $dent, $r;
a94959e6 IJ	273	unlink "$fontdir/$outdent.new" or die "$fontdir $outdent $!";
	274	} else {
	275	rename "$fontdir/$outdent.new", "$fontdir/$outdent"
	276	or die "$fontdir $outdent $!";
71e1fff3 IJ	277	$updated++;
71e1fff3 IJ	278	$outfiles{$outdent} \|= 3;
a94959e6 IJ	279	$changed = 1;
a94959e6 IJ	280	}
71e1fff3	281	$newdone->{$dent} = $stats;
a94959e6	282	}
71e1fff3 IJ	283	my $affected=0;
	284	foreach my $olddent (keys %outfiles) {
	285	my $state = $outfiles{$olddent};
	286	if ($state & 2) {
	287	$affected++ if $state & 1;
	288	next;
	289	}
a94959e6 IJ	290	unlink "$fontdir/$olddent" or die "$fontdir $olddent $!";
	291	$changed = 1;
	292	}
71e1fff3 IJ	293	if (!%$newdone) {
	294	unlink "$fontdir/$logfile" or die "$fontdir $!";
	295	unlink "$fontdir/$donefile" or $!==&ENOENT or die "$fontdir $!";
	296	} elsif ($changed) {
a94959e6 IJ	297	$!=0; $?=0; system 'mkfontdir',$fontdir;
	298	die "$fontdir $? $!" if $? or $!;
	299	my $newdoneh = new IO::File "$fontdir/$donefile.new", 'w'
	300	or die "$fontdir $!";
	301	print $newdoneh Dumper($newdone) or die "$fontdir $!";
	302	close $newdoneh or die "$fontdir $!";
	303	rename "$fontdir/$donefile.new","$fontdir/$donefile"
	304	or die "$fontdir $!";
	305	}
71e1fff3 IJ	306	printf " processed %s: %d pcfs, %d affected, %d updated.\n",
71e1fff3 IJ	307	$fontdir, (scalar keys %$newdone), $affected, $updated;
a94959e6	308	}
baaae949	309
148a1d85 IJ	310	our $stdin = new IO::File '<&STDIN' or die $!;
	311	our $stdout = new IO::File '>&STDOUT' or die $!;
	312	our $stderr = new IO::File '>&STDERR' or die $!;
	313	$reportfh = $stdout;
	314
	315	define_mode('bdf-filter', sub {
	316	die "no arguments allowed with --bdf-filter\n" if @ARGV;
	317	$reportfh = $stderr;
	318	loadfoundries();
a94959e6	319	my $r = processbdf($stdin,$stdout,$reportfh,'stdin');
148a1d85 IJ	320	if ($r !~ m/^\d/) {
	321	print STDERR "stdin not processed: $r\n";
	322	exit 2;
	323	}
a2d36db5 IJ	324	});
a2d36db5 IJ	325
71e1fff3 IJ	326	define_mode('process-pcf', sub {
	327	die "need source and destination pcf.gz\n" if @ARGV!=2;
	328	loadfoundries();
	329	my $r = processpcfgz($ARGV[0],$ARGV[1],$reportfh,"pcf");
	330	if ($r !~ m/^\d/) {
	331	print STDERR "pcf not processed: $r\n";
	332	exit 2;
	333	}
	334	});
	335
	336	define_mode('process-fontdir', sub {
	337	die "need font dir(s)\n" unless @ARGV;
	338	loadfoundries();
	339	foreach my $d (@ARGV) {
	340	processfontdir($d);
	341	}
	342	});
	343
a2d36db5 IJ	344	Getopt::Long::Configure(qw(bundling));
	345	GetOptions(@options) or exit 127;
	346
db16069b	347	push @rulespath, "$sharedir/rules";
a2d36db5 IJ	348
	349	die "need a mode\n" unless $mode;
	350
	351	$mode->();
5f15b814 IJ	352
	353	# 70 zcat /usr/share/fonts/X11/misc/6x13.pcf.gz \|pcf2bdf >in.bdf
	354	# 71 ./utility <in.bdf >out.bdf
	355	# 83 bdftopcf out.bdf >out.pcf
	356	# 84 gzip out.pcf
	357	# 85 cp out.pcf.gz /usr/share/fonts/X11/misc/
	358	# really mkfontdir /usr/share/fonts/X11/misc/
	359	# xset fp rehash
	360	# xfontsel