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# $FreeBSD$ 28# 29 30use strict; 31use Data::Dumper; 32 33if ($#ARGV < 0) { 34 print <<EOF; 35Usage: $0 -c <term1> <term2> 36Compares the entries in the termcap.src for <term1> and <term2> and 37print the keys and definitions on the screen. This can be used to reduce 38the size of two similar termcap entries with the "tc" option. 39 40Usage: $0 -l [term] 41Show all lengths or the ones for terminals matching [term] 42 43Usage: $0 -p <term> 44Print all information about <term> 45 46Usage: $0 -r <term> 47Print all relations from and to <term> 48EOF 49 exit(0); 50} 51 52my $command = $ARGV[0]; 53my $tca = $ARGV[1]; 54my $tcb = $ARGV[2]; 55 56open(FIN, "termcap.src"); 57my @lines = <FIN>; 58chomp(@lines); 59close(FIN); 60 61my %tcs = (); 62 63my $tc = ""; 64foreach my $l (@lines) { 65 next if ($l =~ /^#/); 66 next if ($l eq ""); 67 68 $tc .= $l; 69 next if ($l =~ /\\$/); 70 71 $tc =~ s/:\\\s+:/:/g; 72 73 my @a = split(/:/, $tc); 74 next if ($#a < 0); 75 my @b = split(/\|/, $a[0]); 76 if ($#b >= 0) { 77 $tcs{$b[0]} = $tc; 78 } else { 79 $tcs{$a[0]} = $tc; 80 } 81 if (length($tc) - length($a[0]) > 1023) { 82 print "$a[0] has a length of ", length($tc) - length($a[0]), "\n"; 83 exit(0); 84 } 85 $tc = ""; 86} 87 88my %tc = (); 89my %keys = (); 90my %len = (); 91my %refs = (); 92 93for my $tcs (keys(%tcs)) { 94 $len{$tcs} = 0; 95 my $first = 0; 96 foreach my $tc (split(/:/, $tcs{$tcs})) { 97 if ($first++ == 0) { 98 foreach my $ref (split(/\|/, $tc)) { 99 $refs{$ref} = $tcs; 100 } 101 next; 102 } 103 next if ($tc =~ /^\\/); 104 $tc{$tcs}{$tc} = 0 if (!defined $tc{$tcs}{$tc}); 105 $tc{$tcs}{$tc}++; 106 $len{$tcs} += length($tc) + 1; 107 $keys{$tc} = 0; 108 } 109} 110 111$tca = $refs{$tca} if (defined $tca && defined $refs{$tca}); 112$tcb = $refs{$tcb} if (defined $tcb && defined $refs{$tca}); 113 114die "Cannot find definitions for $tca" if (defined $tca && !defined $tcs{$tca}); 115die "Cannot find definitions for $tcb" if (defined $tcb && !defined $tcs{$tcb}); 116 117if ($command eq "-c") { 118 foreach my $key (sort(keys(%keys))) { 119 next if (!defined $tc{$tca}{$key} && !defined $tc{$tcb}{$key}); 120 printf("%-3s %-3s %s\n", 121 defined $tc{$tca}{$key} ? "+" : "", 122 defined $tc{$tcb}{$key} ? "+" : "", 123 $key, 124 ); 125 } 126 127 print "$len{$tca} - $len{$tcb}\n"; 128} 129 130if ($command eq "-l") { 131 foreach my $tcs (sort(keys(%tcs))) { 132 next if (defined $tca && $tcs !~ /$tca/); 133 printf("%4d %s\n", $len{$tcs}, $tcs); 134 } 135} 136 137if ($command eq "-p") { 138 printf("%s (%d bytes)\n", $tca, $len{$tca}); 139 foreach my $key (sort(keys(%keys))) { 140 next if (!defined $tc{$tca}{$key}); 141 printf("%s\n", $key); 142 } 143} 144 145if ($command eq "-r") { 146 foreach my $key (keys(%{$tc{$tca}})) { 147 next if ($key !~ /^tc=/); 148 $key =~ s/tc=//; 149 print "Links to:\t$key\n"; 150 } 151 my $first = 0; 152 foreach my $ref (sort(keys(%refs))) { 153 next if ($refs{$ref} ne $tca); 154 foreach my $tc (sort(keys(%tcs))) { 155 if (defined $tc{$tc}{"tc=$ref"}) { 156 if ($first++ == 0) { 157 print "Links from:\t"; 158 } else { 159 print "\t\t"; 160 } 161 print "$ref -> $tc\n"; 162 } 163 } 164 } 165} 166