From 71e1fff3fdd26d849f5f0a9bf34354c3d020e848 Mon Sep 17 00:00:00 2001 From: Ian Jackson Date: Mon, 9 Jan 2012 03:07:59 +0000 Subject: [PATCH] process pcfs --- update-xfonts-traditional | 140 +++++++++++++++++++++++++++++++++++++--------- 1 file changed, 115 insertions(+), 25 deletions(-) diff --git a/update-xfonts-traditional b/update-xfonts-traditional index e8ed7ab..9d05e3a 100755 --- a/update-xfonts-traditional +++ b/update-xfonts-traditional @@ -5,11 +5,12 @@ 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 @fontsdirs=qw(/usr/share/fonts/X11 /usr/local/share/fonts/X11); +our @fontparentdirs=qw(/usr/share/fonts/X11 /usr/local/share/fonts/X11); our $donefile="$package.done"; our $logfile="$package.log"; our $fontprefix="trad--"; @@ -78,7 +79,7 @@ sub processbdf ($$$$) { } if ($state eq 'idle' && m/^FONT\s+/) { die if defined $font; - return 0 unless m/^(FONT\s+)\-(\w+)\-/; + return (0,'simple font name') unless m/^(FONT\s+)\-(\w+)\-/; $font = $foundrymap{lc $2}; return (0,'no foundry') unless defined $font; $_ = "FONT -$font-$'"; @@ -153,16 +154,72 @@ sub loadfoundries () { die "no foundry maps\n" unless %foundrymap; } -sub processpcfgz ($$) { - my ($inpcfgz,$outpcfgz) = @_; - my $inh = new IO::File $inpcfgz, 'r', or die "$inpcfgz $!"; - my $outh = new IO::File $outpcfgz, 'w' or die "$outpcfgz $!"; - my $inpipe = new IO:Handle or die $!; - my $outpipe = new IO:Handle or die $!; - my $inchild = open $inpipe, "-|"; defined $inchild or die $!; - if (!$inchild) { - - opne +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) = @_; @@ -178,52 +235,65 @@ sub processfontdir ($) { my $newdone = { }; my $log = new IO::File "$fontdir/$logfile", "w" or die "$fontdir/$logfile $!"; - my %found; + my %outfiles; # bitmask: 1 /*exists*/ | 2 /*wanted*/ my $changed; - while ($!=0, my $dent = readdir FD) { + 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/) { - $found{$dent} ||= 1; + $outfiles{$dent} |= 1; next; } - if (!stat $dent) { + 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) { - $found{$dent} = 2; + $outfiles{$outdent} |= 2; $newdone->{$dent} = $stats; next; } - my $outdent = $fontprefix.$dent; my $r = processpcfgz("$fontdir/$dent", "$fontdir/$outdent.new", - $dent"); + $log, $dent); if ($r !~ m/^\d/) { - print $logfile "%s: unchanged - %s\n", $dent, $r; + 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; } - $found{$outdent} = 2; + $newdone->{$dent} = $stats; } - die "$fontdir $!" if $!; - foreach my $olddent (keys %found) { - next if $found{olddent} != 1; + 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 ($changed) { + 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' @@ -233,6 +303,8 @@ sub processfontdir ($) { 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 $!; @@ -251,6 +323,24 @@ define_mode('bdf-filter', sub { } }); +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; -- 2.11.0