1#!/usr/bin/env perl
2
3# reseq.  Generated from reseq.in by configure.
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 = '1.1.1';
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