1#!/usr/bin/perl -w 2 3# 4# Copyright (C) 2009 Edwin Groothuis. All rights reserved. 5# 6# Redistribution and use in source and binary forms, with or without 7# modification, are permitted provided that the following conditions 8# are met: 9# 1. Redistributions of source code must retain the above copyright 10# notice, this list of conditions and the following disclaimer. 11# 2. Redistributions in binary form must reproduce the above copyright 12# notice, this list of conditions and the following disclaimer in the 13# documentation and/or other materials provided with the distribution. 14# 15# THIS SOFTWARE IS PROVIDED BY THE AUTHORS AND CONTRIBUTORS ``AS IS'' AND 16# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 17# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE 18# ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE 19# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 20# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS 21# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) 22# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 23# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY 24# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF 25# SUCH DAMAGE. 26# 27# 28 29use strict; 30use Data::Dumper; 31 32if ($#ARGV < 0) { 33 print <<EOF; 34Usage: $0 -c <term1> <term2> 35Compares the entries in the termcap.src for <term1> and <term2> and 36print the keys and definitions on the screen. This can be used to reduce 37the size of two similar termcap entries with the "tc" option. 38 39Usage: $0 -l [term] 40Show all lengths or the ones for terminals matching [term] 41 42Usage: $0 -p <term> 43Print all information about <term> 44 45Usage: $0 -r <term> 46Print all relations from and to <term> 47EOF 48 exit(0); 49} 50 51my $command = $ARGV[0]; 52my $tca = $ARGV[1]; 53my $tcb = $ARGV[2]; 54 55open(FIN, "termcap.src"); 56my @lines = <FIN>; 57chomp(@lines); 58close(FIN); 59 60my %tcs = (); 61 62my $tc = ""; 63foreach my $l (@lines) { 64 next if ($l =~ /^#/); 65 next if ($l eq ""); 66 67 $tc .= $l; 68 next if ($l =~ /\\$/); 69 70 $tc =~ s/:\\\s+:/:/g; 71 72 my @a = split(/:/, $tc); 73 next if ($#a < 0); 74 my @b = split(/\|/, $a[0]); 75 if ($#b >= 0) { 76 $tcs{$b[0]} = $tc; 77 } else { 78 $tcs{$a[0]} = $tc; 79 } 80 if (length($tc) - length($a[0]) > 1023) { 81 print "$a[0] has a length of ", length($tc) - length($a[0]), "\n"; 82 exit(0); 83 } 84 $tc = ""; 85} 86 87my %tc = (); 88my %keys = (); 89my %len = (); 90my %refs = (); 91 92for my $tcs (keys(%tcs)) { 93 $len{$tcs} = 0; 94 my $first = 0; 95 foreach my $tc (split(/:/, $tcs{$tcs})) { 96 if ($first++ == 0) { 97 foreach my $ref (split(/\|/, $tc)) { 98 $refs{$ref} = $tcs; 99 } 100 next; 101 } 102 next if ($tc =~ /^\\/); 103 $tc{$tcs}{$tc} = 0 if (!defined $tc{$tcs}{$tc}); 104 $tc{$tcs}{$tc}++; 105 $len{$tcs} += length($tc) + 1; 106 $keys{$tc} = 0; 107 } 108} 109 110$tca = $refs{$tca} if (defined $tca && defined $refs{$tca}); 111$tcb = $refs{$tcb} if (defined $tcb && defined $refs{$tca}); 112 113die "Cannot find definitions for $tca" if (defined $tca && !defined $tcs{$tca}); 114die "Cannot find definitions for $tcb" if (defined $tcb && !defined $tcs{$tcb}); 115 116if ($command eq "-c") { 117 foreach my $key (sort(keys(%keys))) { 118 next if (!defined $tc{$tca}{$key} && !defined $tc{$tcb}{$key}); 119 printf("%-3s %-3s %s\n", 120 defined $tc{$tca}{$key} ? "+" : "", 121 defined $tc{$tcb}{$key} ? "+" : "", 122 $key, 123 ); 124 } 125 126 print "$len{$tca} - $len{$tcb}\n"; 127} 128 129if ($command eq "-l") { 130 foreach my $tcs (sort(keys(%tcs))) { 131 next if (defined $tca && $tcs !~ /$tca/); 132 printf("%4d %s\n", $len{$tcs}, $tcs); 133 } 134} 135 136if ($command eq "-p") { 137 printf("%s (%d bytes)\n", $tca, $len{$tca}); 138 foreach my $key (sort(keys(%keys))) { 139 next if (!defined $tc{$tca}{$key}); 140 printf("%s\n", $key); 141 } 142} 143 144if ($command eq "-r") { 145 foreach my $key (keys(%{$tc{$tca}})) { 146 next if ($key !~ /^tc=/); 147 $key =~ s/tc=//; 148 print "Links to:\t$key\n"; 149 } 150 my $first = 0; 151 foreach my $ref (sort(keys(%refs))) { 152 next if ($refs{$ref} ne $tca); 153 foreach my $tc (sort(keys(%tcs))) { 154 if (defined $tc{$tc}{"tc=$ref"}) { 155 if ($first++ == 0) { 156 print "Links from:\t"; 157 } else { 158 print "\t\t"; 159 } 160 print "$ref -> $tc\n"; 161 } 162 } 163 } 164} 165