1#!/usr/bin/env perl 2 3# @configure_input@ 4 5# Copyright (C) 2008,2013 Micah Cowan <micah@addictivecode.org> 6# 7# Copying and distribution of this file, with or without modification, 8# are permitted in any medium without royalty provided the copyright 9# notice and this notice are preserved. 10 11use strict; 12use warnings; 13 14use Getopt::Long; 15 16use POSIX; 17use Time::HiRes qw(gettimeofday); 18 19our $VERSION = '@VERSION@'; 20 21our $inf; 22our $outf; 23our $replay = 0; 24our $last_time; 25our $halts = 0; 26our $timings; 27our $divisor = 1.0; 28 29our $timingsf; 30our $last_delay = undef; 31our $last_last_delay = 0.0; 32our $count; 33 34our $termios; 35our $orig_lflag; 36our $orig_ccmin; 37our $orig_cctime; 38 39our @controls = ( 40 "NUL", "SOH", "STX", "ETX", 41 "EOT", "ENQ", "ACK", "BEL", 42 "BS", "HT", "LF", "VT", 43 "FF", "CR", "SO", "SI", 44 "DLE", "DC1", "DC2", "DC3", 45 "DC4", "NAK", "SYN", "ETB", 46 "CAN", "EM", "SUB", "ESC", 47 "IS4", "IS3", "IS2", "IS1" 48); 49our %controls; 50$controls{$controls[$_]} = chr($_) for (0 .. $#controls); 51$controls{'DEL'} = chr(0x7f); 52 53sub usage { 54 my $status = shift; 55 my $f = $status == 0 ? \*STDOUT : \*STDERR; 56 57 print $f <<END_USAGE; 58Usage: reseq [-t FILE] INPUT OUTPUT 59 or: reseq --replay [--halts] INPUT [OUTPUT] 60 or: reseq -h | --help 61 or: reseq -V | --version 62Reverse the translations made by teseq. 63 64 -h, --help Print usage information (this message). 65 -V, --version Display version and warrantee 66 --replay Obey delay lines for video-style playback. 67 --halts In addition to obeying delay lines, also obey 68 "halt" lines (starting with "@@@"), pausing 69 further processing until the user hits a key. 70 -d DIVISOR Play back at DIVISOR times the normal speed. 71 -t, --timings=FILE Output timing data to FILE, in the format used 72 by script -t and scriptreplay. 73 74Report bugs to bug-teseq\@gnu.org 75END_USAGE 76 exit ($status); 77} 78 79sub version { 80 print <<END_VERSION; 81reseq (GNU teseq) $VERSION 82Copyright (C) 2008,2013 Micah Cowan <micah\@cowan.name>. 83Copying and distribution of this file, with or without modification, 84are permitted in any medium without royalty provided the copyright 85notice and this notice are preserved. 86There is NO WARANTEE, to the extent permitted by law. 87END_VERSION 88 exit (0); 89} 90 91sub emit { 92 my $str = join ($, ? $, : '', @_); 93 $count += length ($str); 94 print $outf $str; 95} 96 97sub process_control { 98 my $control = shift; 99 if ($control =~ /^x([[:xdigit:]]{2})/) { 100 &emit(chr (hex ($1))); 101 } 102 else { 103 $control =~ s#/.*$##; 104 unless (exists $controls{$control}) { 105 print STDERR ("reseq: line $.: unrecognized \"control\": " 106 . "\"\Q$control\E\"\n"); 107 } else { 108 &emit($controls{$control}); 109 } 110 } 111} 112 113sub process_sequence { 114 my $stuff = shift; 115 if ($stuff eq 'Esc') { 116 &emit("\033"); 117 } 118 elsif ($stuff eq 'Spc') { 119 &emit(' '); 120 } 121 else { 122 &emit("$stuff"); 123 } 124} 125 126sub process_delay { 127 if ($replay) { 128 my $lt = $last_time; 129 $last_time = gettimeofday; 130 my $delay = $_[0]; 131 return if !defined($delay); 132 $delay /= $divisor; 133 $delay -= ($last_time - $lt); 134 return if $delay <= 0.0001; 135 select (undef, undef, undef, $delay); 136 } 137 elsif ($timings) { 138 # Why must we wait until we've seen a second delay line before 139 # emitting the first one? The answer is that "script" emits its 140 # delays such that they are counted _before_ the read, rather than 141 # after. So we need to wait until the second delay line before 142 # we know how large a character-count we should place in the first 143 # line (which should get a zero-sized delay). 144 if (defined $last_delay) { 145 $last_last_delay = 0.0 unless defined $last_last_delay; 146 printf $timingsf ("%f %u\n", $last_last_delay, $count); 147 } 148 $count = 0; 149 $last_last_delay = $last_delay; 150 $last_delay = $_[0]; 151 } 152} 153 154sub process_halt { 155 return unless $replay and $halts; 156 my $data; 157 158 # read any already-available data 159 sysread(STDIN, $data, 65535); 160 161 # Now block til we get one more char. 162 $termios->setcc( VMIN, 1 ); 163 $termios->setattr( 0, &POSIX::TCSANOW ); 164 sysread(STDIN, $data, 1); 165 $termios->setcc( VMIN, 0 ); 166 $termios->setattr( 0, &POSIX::TCSANOW ); 167} 168 169sub process_line { 170 local $_ = shift; 171 if (/^-?\|(.*)\|([-.]?)$/) { 172 &emit("$1"); 173 &emit( "\n") if $2 eq '.'; 174 } 175 elsif (/^\./g) { 176 &process_control ($1) while /\G\s*(\S+)/g; 177 } 178 elsif (/^:/g) { 179 &process_sequence ($1) while /\G\s*(\S+)/g; 180 } 181 elsif (/^@ +(.*)$/) { 182 &process_delay ($1); 183 } 184 elsif (/^@@@/) { 185 &process_halt; 186 } 187 elsif (/^[!\$+\[\/=\\^\{~]/) { 188 die "Unknown semantic line prefix, line $.: $&\n"; 189 } 190 else { 191 # Acceptable line prefix with no crucial semantic value. 192 # This includes label (&) and description (") lines. 193 } 194} 195 196sub restore_term { 197 my $signal = shift; 198 $termios->setlflag( $orig_lflag ); 199 $termios->setcc( VMIN, $orig_ccmin ); 200 $termios->setcc( VTIME, $orig_cctime ); 201 $termios->setattr( 0, &POSIX::TCSANOW ); 202 if (defined $signal) { 203 undef $SIG{$signal}; 204 raise $signal; 205 } 206} 207 208sub setup_signals { 209 for my $sig (qw(TERM INT TSTP)) { 210 $SIG{$sig} = \&restore_term; 211 } 212 $SIG{'CONT'} = \&comeback; 213} 214 215sub rawish_term { 216 my $new_lflag = $termios->getlflag; 217 $new_lflag &= ~(ECHO | ECHONL | ICANON | IEXTEN); 218 $termios->setlflag($new_lflag); 219 $termios->setcc( VMIN, 0 ); 220 $termios->setcc( VTIME, 0 ); 221 222 $termios->setattr( 0, &POSIX::TCSANOW ) or die "setattr: $!"; 223} 224 225sub comeback { 226 &setup_signals; 227 &rawish_term; 228} 229 230### main ### 231 232&Getopt::Long::Configure ('bundling'); 233&GetOptions ('help|h' => sub { &usage (0); }, 234 'version|V' => \&version, 235 'replay' => \$replay, 236 'halts' => \$halts, 237 'timings|t=s' => \$timings, 238 'd=f' => \$divisor) || &usage (1); 239 240if ($replay) { 241 die "Divisor cannot be zero.\n" unless $divisor; 242 &usage (1) unless @ARGV == 1 || @ARGV == 2; 243} 244else { 245 &usage (1) unless @ARGV == 2; 246} 247 248if ($replay && $halts) { 249 # Put the terminal into raw mode, with no echo, and install signal 250 # handler to restore terminal settings. 251 unless ( -t STDIN ) { 252 die "Specified --halts, but STDIN is not a terminal.\n"; 253 } 254 255 $termios = POSIX::Termios->new or die "Termios->new"; 256 $termios->getattr( 0 ) or die "getattr: $!"; 257 $orig_lflag = $termios->getlflag; 258 $orig_ccmin = $termios->getcc( VMIN ); 259 $orig_cctime = $termios->getcc( VTIME ); 260 261 &setup_signals; 262 &rawish_term; 263} 264 265if ($ARGV[0] eq '-') { 266 $inf = \*STDIN; 267} 268else { 269 open ($inf, '<', $ARGV[0]) or die "Couldn't open $ARGV[0]: $!\n"; 270} 271 272if ($replay && @ARGV < 2 || $ARGV[1] eq '-') { 273 $outf = \*STDOUT; 274} 275else { 276 open ($outf, '>', $ARGV[1]) or die "Couldn't open $ARGV[1]: $!\n"; 277} 278 279if ($timings) { 280 die "Can't do both --replay and --timings.\n" if ($replay); 281 open ($timingsf, '>', $timings) or die "Couldn't open ${timings}: $!\n"; 282} 283 284my $line; 285select $outf; 286$| = 1; 287if ($replay) { 288 $last_time = gettimeofday; 289} 290while (defined ($line = <$inf>)) { 291 &process_line ("$line"); 292} 293&process_delay (undef); 294&restore_term if $termios; 295