source-git / lynx

Clone
Source Code
GIT

Blame scripts/tbl2html.pl

c8 master
  1.   f574b8572d425522f7650516c5446350faa77c2d
  2.   scripts
  3.   tbl2html.pl
Blob History Raw
Packit f574b8 
#!/usr/bin/perl -w
Packit f574b8 
# $LynxId: tbl2html.pl,v 1.5 2011/05/21 15:18:16 tom Exp $
Packit f574b8 
#
Packit f574b8 
# Translate one or more ".tbl" files into ".html" files which can be used to
Packit f574b8 
# test the charset support in lynx.  Each of the ".html" files will use the
Packit f574b8 
# charset that corresponds to the input ".tbl" file.
Packit f574b8
Packit f574b8 
use strict;
Packit f574b8
Packit f574b8 
use Getopt::Std;
Packit f574b8 
use File::Basename;
Packit f574b8 
use POSIX qw(strtod);
Packit f574b8
Packit f574b8 
sub field($$) {
Packit f574b8 
	my $value = $_[0];
Packit f574b8 
	my $count = $_[1];
Packit f574b8
Packit f574b8 
	while ( $count > 0 ) {
Packit f574b8 
		$count -= 1;
Packit f574b8 
		$value =~ s/^\S*\s*//;
Packit f574b8 
	}
Packit f574b8 
	$value =~ s/\s.*//;
Packit f574b8 
	return $value;
Packit f574b8 
}
Packit f574b8
Packit f574b8 
sub notes($) {
Packit f574b8 
	my $value = $_[0];
Packit f574b8
Packit f574b8 
	$value =~ s/^[^#]*//;
Packit f574b8 
	$value =~ s/^#//;
Packit f574b8 
	$value =~ s/^\s+//;
Packit f574b8
Packit f574b8 
	return $value;
Packit f574b8 
}
Packit f574b8
Packit f574b8 
sub make_header($$$) {
Packit f574b8 
	my $source   = $_[0];
Packit f574b8 
	my $charset  = $_[1];
Packit f574b8 
	my $official = $_[2];
Packit f574b8
Packit f574b8 
	printf FP "\n";
Packit f574b8 
	printf FP "<HTML>\n";
Packit f574b8 
	printf FP "<HEAD>\n";
Packit f574b8 
	printf FP "\n";
Packit f574b8 
	printf FP "<TITLE>%s table</TITLE>\n", &escaped($official);
Packit f574b8 
	printf FP "<META HTTP-EQUIV=\"Content-Type\" CONTENT=\"text/html; charset=%s\">\n", &escaped($charset);
Packit f574b8 
	printf FP "</HEAD>\n";
Packit f574b8 
	printf FP "\n";
Packit f574b8 
	printf FP "<BODY> \n";
Packit f574b8 
	printf FP "\n";
Packit f574b8 
	printf FP "
%s table
 \n", &escaped($charset);
Packit f574b8 
	printf FP "\n";
Packit f574b8 
	printf FP "
\n";
Packit f574b8 
	printf FP "Code  Char  Entity   Render          Description\n";
Packit f574b8 
}
Packit f574b8
Packit f574b8 
sub make_mark() {
Packit f574b8 
	printf FP "----  ----  ------   ------          -----------------------------------\n";
Packit f574b8 
}
Packit f574b8
Packit f574b8 
sub escaped($) {
Packit f574b8 
	my $result = $_[0];
Packit f574b8 
	$result =~ s/&/&/g;
Packit f574b8 
	$result =~ s/</</g;
Packit f574b8 
	$result =~ s/>/>/g;
Packit f574b8 
	return $result;
Packit f574b8 
}
Packit f574b8
Packit f574b8 
sub make_row($$$) {
Packit f574b8 
	my $old_code = $_[0];
Packit f574b8 
	my $new_code = $_[1];
Packit f574b8 
	my $comments = $_[2];
Packit f574b8
Packit f574b8 
	# printf "# make_row %d %d %s\n", $old_code, $new_code, $comments;
Packit f574b8 
	my $visible = sprintf("&#%d;      ", $new_code);
Packit f574b8 
	if ($old_code < 256) {
Packit f574b8 
		printf FP "%4x    %c   %.13s  &#%d;             %s\n",
Packit f574b8 
			$old_code, $old_code,
Packit f574b8 
			$visible, $new_code,
Packit f574b8 
			&escaped($comments);
Packit f574b8 
	} else {
Packit f574b8 
		printf FP "%4x    .   %.13s  &#%d;             %s\n",
Packit f574b8 
			$old_code,
Packit f574b8 
			$visible, $new_code,
Packit f574b8 
			&escaped($comments);
Packit f574b8 
	}
Packit f574b8 
}
Packit f574b8
Packit f574b8 
sub null_row($$) {
Packit f574b8 
	my $old_code = $_[0];
Packit f574b8 
	my $comments = $_[1];
Packit f574b8
Packit f574b8 
	if ($old_code < 256) {
Packit f574b8 
		printf FP "%4x    %c                     %s\n",
Packit f574b8 
			$old_code, $old_code,
Packit f574b8 
			&escaped($comments);
Packit f574b8 
	} else {
Packit f574b8 
		printf FP "%4x    .                     %s\n",
Packit f574b8 
			$old_code,
Packit f574b8 
			&escaped($comments);
Packit f574b8 
	}
Packit f574b8 
}
Packit f574b8
Packit f574b8 
sub make_footer() {
Packit f574b8 
	printf FP "\n";
Packit f574b8 
	printf FP "</BODY>\n";
Packit f574b8 
	printf FP "</HTML>\n";
Packit f574b8 
}
Packit f574b8
Packit f574b8 
# return true if the string describes a range
Packit f574b8 
sub is_range($) {
Packit f574b8 
	return ($_[0] =~ /.*-.*/);
Packit f574b8 
}
Packit f574b8
Packit f574b8 
# convert the U+'s to 0x's so strtod() can convert them.
Packit f574b8 
sub zeroxes($) {
Packit f574b8 
	my $result = $_[0];
Packit f574b8 
	$result =~ s/^U\+/0x/;
Packit f574b8 
	$result =~ s/-U\+/-0x/;
Packit f574b8 
	return $result;
Packit f574b8 
}
Packit f574b8
Packit f574b8 
# convert a string to a number (-1's are outside the range of Unicode).
Packit f574b8 
sub value_of($) {
Packit f574b8 
	my ($result, $oops) = strtod($_[0]);
Packit f574b8 
	$result = -1 if ($oops ne 0);
Packit f574b8 
	return $result;
Packit f574b8 
}
Packit f574b8
Packit f574b8 
# return the first number in a range
Packit f574b8 
sub first_of($) {
Packit f574b8 
	my $range = &zeroxes($_[0]);
Packit f574b8 
	$range =~ s/-.*//;
Packit f574b8 
	return &value_of($range);
Packit f574b8 
}
Packit f574b8
Packit f574b8 
# return the last number in a range
Packit f574b8 
sub last_of($) {
Packit f574b8 
	my $range = &zeroxes($_[0]);
Packit f574b8 
	$range =~ s/^.*-//;
Packit f574b8 
	return &value_of($range);
Packit f574b8 
}
Packit f574b8
Packit f574b8 
sub one_many($$$) {
Packit f574b8 
	my $oldcode = $_[0];
Packit f574b8 
	my $newcode = &zeroxes($_[1]);
Packit f574b8 
	my $comment = $_[2];
Packit f574b8
Packit f574b8 
	my $old_code = &value_of($oldcode);
Packit f574b8 
	if ( $old_code lt 0 ) {
Packit f574b8 
		printf "? Problem with number \"%s\"\n", $oldcode;
Packit f574b8 
	} else {
Packit f574b8 
		&make_mark if (( $old_code % 8 ) == 0 );
Packit f574b8
Packit f574b8 
		if ( $newcode =~ /^#.*/ ) {
Packit f574b8 
			&null_row($old_code, $comment);
Packit f574b8 
		} elsif ( &is_range($newcode) ) {
Packit f574b8 
			my $first_item = &first_of($newcode);
Packit f574b8 
			my $last_item  = &last_of($newcode);
Packit f574b8 
			my $item;
Packit f574b8
Packit f574b8 
			if ( $first_item lt 0 or $last_item lt 0 ) {
Packit f574b8 
				printf "? Problem with one:many numbers \"%s\"\n", $newcode;
Packit f574b8 
			} else {
Packit f574b8 
				if ( $comment =~ /^$/ ) {
Packit f574b8 
					$comment = sprintf("mapped: %#x to %#x..%#x", $old_code, $first_item, $last_item);
Packit f574b8 
				} else {
Packit f574b8 
					$comment = $comment . " (range)";
Packit f574b8 
				}
Packit f574b8 
				for $item ( $first_item..$last_item) {
Packit f574b8 
					&make_row($old_code, $item, $comment);
Packit f574b8 
				}
Packit f574b8 
			}
Packit f574b8 
		} else {
Packit f574b8 
			my $new_code = &value_of($newcode);
Packit f574b8 
			if ( $new_code lt 0 ) {
Packit f574b8 
				printf "? Problem with number \"%s\"\n", $newcode;
Packit f574b8 
			} else {
Packit f574b8 
				if ( $comment =~ /^$/ ) {
Packit f574b8 
					$comment = sprintf("mapped: %#x to %#x", $old_code, $new_code);
Packit f574b8 
				}
Packit f574b8 
				&make_row($old_code, $new_code, $comment);
Packit f574b8 
			}
Packit f574b8 
		}
Packit f574b8 
	}
Packit f574b8 
}
Packit f574b8
Packit f574b8 
sub many_many($$$) {
Packit f574b8 
	my $oldcode = $_[0];
Packit f574b8 
	my $newcode = $_[1];
Packit f574b8 
	my $comment = $_[2];
Packit f574b8
Packit f574b8 
	my $first_old = &first_of($oldcode);
Packit f574b8 
	my $last_old  = &last_of($oldcode);
Packit f574b8 
	my $item;
Packit f574b8
Packit f574b8 
	if (&is_range($newcode)) {
Packit f574b8 
		my $first_new = &first_of($newcode);
Packit f574b8 
		my $last_new  = &last_of($newcode);
Packit f574b8 
		for $item ( $first_old..$last_old) {
Packit f574b8 
			&one_many($item, $first_new, $comment);
Packit f574b8 
			$first_new += 1;
Packit f574b8 
		}
Packit f574b8 
	} else {
Packit f574b8 
		for $item ( $first_old..$last_old) {
Packit f574b8 
			&one_many($item, $newcode, $comment);
Packit f574b8 
		}
Packit f574b8 
	}
Packit f574b8 
}
Packit f574b8
Packit f574b8 
sub approximate($$$) {
Packit f574b8 
	my $values = $_[0];
Packit f574b8 
	my $expect = sprintf("%-8s", $_[1]);
Packit f574b8 
	my $comment = $_[2];
Packit f574b8 
	my $escaped = &escaped($expect);
Packit f574b8 
	my $left;
Packit f574b8 
	my $this;
Packit f574b8 
	my $next;
Packit f574b8
Packit f574b8 
	$escaped =~ s/\\134/\\/g;
Packit f574b8 
	$escaped =~ s/\\015/\
;/g;
Packit f574b8 
	$escaped =~ s/\\012/\
;/g;
Packit f574b8
Packit f574b8 
	while ( $escaped =~ /^.*\\[0-7]{3}.*$/ ) {
Packit f574b8 
		$left = $escaped;
Packit f574b8 
		$left =~ s/\\[0-7]{3}.*//;
Packit f574b8 
		$this = substr $escaped,length($left)+1,3;
Packit f574b8 
		$next = substr $escaped,length($left)+4;
Packit f574b8 
		$escaped = sprintf("%s&#%d;%s", $left, oct $this, $next);
Packit f574b8 
	}
Packit f574b8
Packit f574b8 
	my $visible = sprintf("&#%d;      ", $values);
Packit f574b8 
	if ($values < 256) {
Packit f574b8 
		printf FP "%4x    %c   %.13s  &#%d;             approx: %s\n",
Packit f574b8 
			$values, $values,
Packit f574b8 
			$visible,
Packit f574b8 
			$values,
Packit f574b8 
			$escaped;
Packit f574b8 
	} else {
Packit f574b8 
		printf FP "%4x    .   %.13s  &#%d;             approx: %s\n",
Packit f574b8 
			$values,
Packit f574b8 
			$visible,
Packit f574b8 
			$values,
Packit f574b8 
			$escaped;
Packit f574b8 
	}
Packit f574b8 
}
Packit f574b8
Packit f574b8 
sub doit($) {
Packit f574b8 
	my $source = $_[0];
Packit f574b8
Packit f574b8 
	printf "** %s\n", $source;
Packit f574b8
Packit f574b8 
	my $target = basename($source, ".tbl");
Packit f574b8
Packit f574b8 
	# Read the file into an array in memory.
Packit f574b8 
	open(FP,$source) || do {
Packit f574b8 
		print STDERR "Can't open input $source: $!\n";
Packit f574b8 
		return;
Packit f574b8 
	};
Packit f574b8 
	my (@input) = <FP>;
Packit f574b8 
	chomp @input;
Packit f574b8 
	close(FP);
Packit f574b8
Packit f574b8 
	my $n;
Packit f574b8 
	my $charset = "";
Packit f574b8 
	my $official = "";
Packit f574b8 
	my $empty = 1;
Packit f574b8
Packit f574b8 
	for $n (0..$#input) {
Packit f574b8 
		$input[$n] =~ s/\s*$//; # trim trailing blanks
Packit f574b8 
		$input[$n] =~ s/^\s*//; # trim leading blanks
Packit f574b8 
		$input[$n] =~ s/^#0x/0x/; # uncomment redundant stuff
Packit f574b8
Packit f574b8 
		next if $input[$n] =~ /^$/;
Packit f574b8 
		next if $input[$n] =~ /^#.*$/;
Packit f574b8
Packit f574b8 
		if ( $empty
Packit f574b8 
		  and ( $input[$n] =~ /^\d/
Packit f574b8 
		     or $input[$n] =~ /^U\+/ ) ) {
Packit f574b8 
			$target = $charset . ".html";
Packit f574b8 
			printf "=> %s\n", $target;
Packit f574b8 
			open(FP,">$target") || do {
Packit f574b8 
				print STDERR "Can't open output $target: $!\n";
Packit f574b8 
				return;
Packit f574b8 
			};
Packit f574b8 
			&make_header($source, $charset, $official);
Packit f574b8 
			$empty = 0;
Packit f574b8 
		}
Packit f574b8
Packit f574b8 
		if ( $input[$n] =~ /^M.*/ ) {
Packit f574b8 
			$charset = $input[$n];
Packit f574b8 
			$charset =~ s/^.//;
Packit f574b8 
		} elsif ( $input[$n] =~ /^O.*/ ) {
Packit f574b8 
			$official = $input[$n];
Packit f574b8 
			$official =~ s/^.//;
Packit f574b8 
		} elsif ( $input[$n] =~ /^\d/ ) {
Packit f574b8
Packit f574b8 
			my $newcode = &field($input[$n], 1);
Packit f574b8
Packit f574b8 
			next if ( $newcode eq "idem" );
Packit f574b8 
			next if ( $newcode eq "" );
Packit f574b8
Packit f574b8 
			my $oldcode = &field($input[$n], 0);
Packit f574b8 
			if ( &is_range($oldcode) ) {
Packit f574b8 
				&many_many($oldcode, $newcode, &notes($input[$n]));
Packit f574b8 
			} else {
Packit f574b8 
				&one_many($oldcode, $newcode, &notes($input[$n]));
Packit f574b8 
			}
Packit f574b8 
		} elsif ( $input[$n] =~ /^U\+/ ) {
Packit f574b8 
			if ( $input[$n] =~ /^U\+\w+:/ ) {
Packit f574b8 
				my $values = $input[$n];
Packit f574b8 
				my $expect = $input[$n];
Packit f574b8
Packit f574b8 
				$values =~ s/:.*//;
Packit f574b8 
				$values = &zeroxes($values);
Packit f574b8 
				$expect =~ s/^[^:]+://;
Packit f574b8
Packit f574b8 
				if ( &is_range($values) ) {
Packit f574b8 
					printf "fixme:%s(%s)(%s)\n", $input[$n], $values, $expect;
Packit f574b8 
				} else {
Packit f574b8 
					&approximate(&value_of($values), $expect, &notes($input[$n]));
Packit f574b8 
				}
Packit f574b8 
			} else {
Packit f574b8 
				my $value = $input[$n];
Packit f574b8 
				$value =~ s/\s*".*//;
Packit f574b8 
				$value = &value_of(&zeroxes($value));
Packit f574b8 
				if ($value gt 0) {
Packit f574b8 
					my $quote = $input[$n];
Packit f574b8 
					my $comment = &notes($input[$n]);
Packit f574b8 
					$quote =~ s/^[^"]*"//;
Packit f574b8 
					$quote =~ s/".*//;
Packit f574b8 
					&approximate($value, $quote, $comment);
Packit f574b8 
				} else {
Packit f574b8 
					printf "fixme:%d(%s)\n", $n, $input[$n];
Packit f574b8 
				}
Packit f574b8 
			}
Packit f574b8 
		} else {
Packit f574b8 
			# printf "skipping line %d:%s\n", $n + 1, $input[$n];
Packit f574b8 
		}
Packit f574b8 
	}
Packit f574b8 
	if ( ! $empty ) {
Packit f574b8 
		&make_footer();
Packit f574b8 
	}
Packit f574b8 
	close FP;
Packit f574b8 
}
Packit f574b8
Packit f574b8 
sub usage() {
Packit f574b8 
	print <
Packit f574b8 
Usage: $0 [tbl-files]
Packit f574b8
Packit f574b8 
The script writes a new ".html" file for each input, using
Packit f574b8 
the same name as the input, stripping the ".tbl" suffix.
Packit f574b8 
USAGE
Packit f574b8 
	exit(1);
Packit f574b8 
}
Packit f574b8
Packit f574b8 
if ( $#ARGV < 0 ) {
Packit f574b8 
	usage();
Packit f574b8 
} else {
Packit f574b8 
	while ( $#ARGV >= 0 ) {
Packit f574b8 
		&doit ( shift @ARGV );
Packit f574b8 
	}
Packit f574b8 
}
Packit f574b8 
exit (0);

Powered by Pagure 5.14.1

SSH Hostkey/Fingerprint | Documentation