Don't set PATH when running external shell command.
[techtalk-pse.git] / techtalk-pse.pl
1 #!/usr/bin/perl -w
2 # -*- perl -*-
3 # @configure_input@
4 #
5 # Tech Talk PSE
6 # Copyright (C) 2010 Red Hat Inc.
7 #
8 # This program is free software; you can redistribute it and/or modify
9 # it under the terms of the GNU General Public License as published by
10 # the Free Software Foundation; either version 2 of the License, or
11 # (at your option) any later version.
12 #
13 # This program is distributed in the hope that it will be useful,
14 # but WITHOUT ANY WARRANTY; without even the implied warranty of
15 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
16 # GNU General Public License for more details.
17 #
18 # You should have received a copy of the GNU General Public License
19 # along with this program; if not, write to the Free Software
20 # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
21
22 use warnings;
23 use strict;
24 use utf8;
25
26 use POSIX qw(setsid);
27 use Pod::Usage;
28 use Getopt::Long;
29 use Cwd qw(getcwd abs_path);
30 use Glib qw(TRUE FALSE);
31 use Gtk2 -init;
32 use Gtk2::MozEmbed;
33
34 =encoding utf8
35
36 =head1 NAME
37
38 techtalk-pse - superior technical demonstration software
39
40 =head1 SYNOPSIS
41
42  cd /path/to/talk/; techtalk-pse
43
44  techtalk-pse /path/to/talk/
45
46 =head1 DESCRIPTION
47
48 Tech Talk "Platinum Supreme Edition" (PSE) is Linux Presentation
49 Software designed by technical people to give technical software
50 demonstrations to other technical people.  It is designed to be simple
51 to use (for people who know how to use an editor and the command line)
52 and powerful, so that you can create informative, technically accurate
53 and entertaining talks and demonstrations.
54
55 Tech Talk PSE is good at opening editors at the right place, opening
56 shell prompts with preloaded history, compiling and running things
57 during the demonstration, displaying text, photos, figures and video.
58
59 Tech Talk PSE is I<bad> at slide effects, chart junk and bullet
60 points.
61
62 This manual page covers all the documentation you will need to use
63 Tech Talk PSE.  The next section covers running the tool from the
64 command line.  After that there is a L</TUTORIAL> section to get you
65 started.  Then there is a detailed L</REFERENCE> section.  Finally
66 there is a discussion on L<WHAT MAKES A GOOD TALK>.
67
68 =head1 RUNNING THE TOOL FROM THE COMMAND LINE
69
70 A Tech Talk PSE talk is not a single file, but a directory full of
71 files.  (If you want to start a new talk, see the L</TUTORIAL> section
72 below).  To display or run the talk, change into the directory
73 containing all those files and run the C<techtalk-pse> command:
74
75  cd /path/to/talk/; techtalk-pse
76
77 You can also run C<techtalk-pse> without changing directory, instead
78 specifying the path to the talk:
79
80  techtalk-pse /path/to/talk/
81
82 =head2 OPTIONS
83
84 =over 4
85
86 =cut
87
88 my $help;
89
90 =item B<--help>
91
92 Display brief help and exit.
93
94 =cut
95
96 my $last;
97
98 =item B<--last>
99
100 Start at the last slide.
101
102 You cannot use this with the B<-n> / B<--start> option.
103
104 =cut
105
106 my $start;
107
108 =item B<-n SLIDE> | B<--start SLIDE>
109
110 Start at the named slide.  I<SLIDE> is the shortest unique prefix of
111 the slide name, so to start at a slide named
112 I<00010-introduction.html>, you could use I<-n 00010> or I<-n 00010-intro>,
113 or give the full filename I<-n 00010-introduction.html>.
114
115 The default is to start at the first slide in the talk.
116
117 =cut
118
119 my $splash = 1;
120
121 =item B<--no-splash>
122
123 Don't display the initial "splash" screen which advertises Tech Talk
124 PSE to your audience.  Just go straight into the talk.
125
126 =cut
127
128 my $verbose;
129
130 =item B<--verbose>
131
132 Display verbose messages, useful for debugging or tracing
133 what the program is doing.
134
135 =cut
136
137 my $version;
138
139 =item B<--version>
140
141 Display version number and exit.
142
143 =cut
144
145 my $mozembed;
146 my $mozembed_first;
147 my $mozembed_last;
148
149 GetOptions ("help|?" => \$help,
150             "last" => \$last,
151             "mozembed" => \$mozembed,
152             "mozembed-first" => \$mozembed_first,
153             "mozembed-last" => \$mozembed_last,
154             "n=s" => \$start,
155             "splash!" => \$splash,
156             "start=s" => \$start,
157             "verbose" => \$verbose,
158             "version" => \$version,
159     ) or pod2usage (2);
160
161 =back
162
163 =cut
164
165 pod2usage (1) if $help;
166 if ($version) {
167     print "@PACKAGE@ @VERSION@\n";
168     exit
169 }
170 die "techtalk-pse: cannot use --start and --last options together\n"
171     if defined $last && defined $start;
172
173 # Run with --mozembed: see below.
174 run_mozembed () if $mozembed;
175
176 # Normal run of the program.
177 die "techtalk-pse: too many arguments\n" if @ARGV >= 2;
178
179 # Get the true name of the program.
180 $0 = abs_path ($0);
181
182 # Locate the talk.
183 if (@ARGV > 0) {
184     my $d = $ARGV[0];
185     if (-d $d) {
186         chdir $d or die "techtalk-pse: chdir: $d: $!";
187     } else {
188         # XXX In future allow people to specify an archive and unpack
189         # it for them.
190         die "techtalk-pse: argument is not a directory"
191     }
192 }
193
194 # Get the files.
195 my @files;
196 my %files;
197 sub reread_directory
198 {
199     @files = ();
200
201     my $i = 0;
202     foreach (glob ("*")) {
203         if (/^(\d+)(?:-.*)\.(html|sh)$/) {
204             print STDERR "reading $_\n" if $verbose;
205
206             my $seq = $1;
207             my $ext = $2;
208             warn "techtalk-pse: $_: command file is not executable (+x)\n"
209                 if $ext eq "sh" && ! -x $_;
210
211             my $h = { name => $_, seq => $1, ext => $2, i => $i };
212             push @files, $h;
213             $files{$_} = $h;
214             $i++;
215         } else {
216             print STDERR "ignoring $_\n" if $verbose;
217         }
218     }
219
220     if (@files > 0) {
221         $files[0]->{first} = 1;
222         $files[$#files]->{last} = 1;
223     }
224 }
225 reread_directory ();
226 print STDERR "read ", 0+@files, " files\n" if $verbose;
227 if (@files == 0) {
228     warn "techtalk-pse: no files found, continuing anyway ...\n"
229 }
230
231 # Work out what slide we're starting on.
232 my $current;
233 if (defined $current) {
234     die "start slide not implemented yet XXX"
235 }
236 elsif (@files) {
237     $current = $files[0];
238 }
239 # else $current is undefined
240
241 if ($splash) {
242     my $w = Gtk2::AboutDialog->new;
243     $w->set_authors ("Richard W.M. Jones");
244     $w->set_comments (
245         "Superior technical demonstration software\n".
246         "\n".
247         "Keys\n".
248         "↑ — Go back one slide\n".
249         "↓ — Go forward one slide\n"
250         );
251     $w->set_program_name ("Tech Talk Platinum Supreme Edition (PSE)");
252     $w->set_version ("@VERSION@");
253     $w->set_website ("http://people.redhat.com/~rjones");
254     $w->set_license ("GNU General Public License v2 or above");
255     $w->run;
256     print STDERR "calling \$w->destroy on about dialog\n" if $verbose;
257     $w->destroy;
258 }
259
260 MAIN: while (1) {
261     if (defined $current) {
262         my $go = show_slide ($current);
263         if (defined $go) {
264             print STDERR "go = $go\n" if $verbose;
265             last MAIN if $go eq "QUIT";
266
267             my $i = $current->{i};
268             print STDERR "i = $i\n" if $verbose;
269             $i-- if $go eq "PREV" && $i > 0;
270             $i++ if $go eq "NEXT" && $i+1 < @files;
271             $current = $files[$i];
272         }
273     } else {
274         print "No slides found.  Press any key to reload directory ...\n";
275         $_ = <STDIN>;
276     }
277
278     # Reread directory between slides.
279     reread_directory ();
280
281     if (defined $current && !exists $files{$current->{name}}) {
282         # Current slide was deleted.
283         undef $current;
284         $current = $files[0] if @files;
285     }
286 }
287
288 sub show_slide
289 {
290     my $slide = shift;
291
292     # Display an HTML page.
293     if ($slide->{ext} eq "html") {
294         # MozEmbed is incredibly crashy, so we run ourself as a
295         # subprocess, so when it segfaults we don't care.
296         my @cmd = ($0, "--mozembed");
297         push @cmd, "--mozembed-first" if exists $slide->{first};
298         push @cmd, "--mozembed-last" if exists $slide->{last};
299         my $cwd = getcwd;
300         my $url = "file://" . $cwd . "/" . $slide->{name};
301         push @cmd, $url;
302         system (@cmd);
303         die "failed to execute subcommand: ", join(" ", @cmd), ": $!\n"
304             if $? == -1;
305         if ($? & 127) {
306             # Subcommand probably segfaulted, just continue to next slide.
307             return "NEXT";
308         } else {
309             my $r = $? >> 8;
310             if ($r == 0) {
311                 return "NEXT";
312             } elsif ($r == 1) {
313                 return "PREV";
314             } elsif ($r == 2) {
315                 return "QUIT";
316             }
317         }
318     }
319     # Run a shell command.
320     elsif ($slide->{ext} eq "sh") {
321         my $pid;
322         # http://docstore.mik.ua/orelly/perl/cookbook/ch10_17.htm
323         local *run_process = sub {
324             $pid = fork ();
325             die "fork: $!" unless defined $pid;
326             unless ($pid) {
327                 # Child.
328                 POSIX::setsid ();
329                 exec ("./".$slide->{name});
330                 die "failed to execute command: ", $slide->{name}, ": $!";
331             }
332             # Parent returns.
333         };
334         local *kill_process = sub {
335             print STDERR "sending TERM signal to process group $pid\n"
336                 if $verbose;
337             kill "TERM", -$pid;
338         };
339         run_process ();
340
341         my $r = "NEXT";
342
343         my $w = Gtk2::Window->new ();
344
345         my $s = $w->get_screen;
346         $w->set_default_size ($s->get_width, -1);
347         $w->move (0, 0);
348         $w->set_decorated (0);
349
350         my $bbox = Gtk2::HButtonBox->new ();
351         $bbox->set_layout ('start');
352
353         my $bnext = Gtk2::Button->new ("Next slide");
354         $bnext->signal_connect (clicked => sub { $r = "NEXT"; $w->destroy });
355         $bnext->set_sensitive (!(exists $slide->{last}));
356         $bbox->add ($bnext);
357
358         my $bback = Gtk2::Button->new ("Back");
359         $bback->signal_connect (clicked => sub { $r = "PREV"; $w->destroy });
360         $bback->set_sensitive (!(exists $slide->{first}));
361         $bbox->add ($bback);
362
363         my $brestart = Gtk2::Button->new ("Kill & restart");
364         $brestart->signal_connect (clicked => sub {
365             kill_process ();
366             run_process ();
367         });
368         $bbox->add ($brestart);
369
370         my $bquit = Gtk2::Button->new ("Quit");
371         $bquit->signal_connect (clicked => sub { $r = "QUIT"; $w->destroy });
372         $bbox->add ($bquit);
373         $bbox->set_child_secondary ($bquit, 1);
374
375         $w->add ($bbox);
376
377         $w->signal_connect (destroy => sub {
378             Gtk2->main_quit;
379             return FALSE;
380         });
381         $w->show_all ();
382
383         Gtk2->main;
384
385         kill_process ();
386         print STDERR "returning r=$r\n" if $verbose;
387         return $r;
388     }
389 }
390
391 # If invoked with the --mozembed parameter then we just display a
392 # single page.  This is just to prevent crashes in MozEmbed from
393 # killing the whole program.
394 sub run_mozembed
395 {
396     my $r = 0;
397
398     my $w = Gtk2::Window->new ();
399     my $vbox = Gtk2::VBox->new ();
400     my $moz = Gtk2::MozEmbed->new ();
401
402     my $bbox = Gtk2::HButtonBox->new ();
403     $bbox->set_layout ('start');
404
405     $vbox->pack_start ($bbox, 0, 0, 0);
406     $vbox->add ($moz);
407     $w->fullscreen ();
408     #$w->set_default_size (640, 480);
409     $w->add ($vbox);
410
411     my $bnext = Gtk2::Button->new ("Next slide");
412     $bnext->signal_connect (clicked => sub { $r = 0; $w->destroy });
413     $bnext->set_sensitive (!$mozembed_last);
414     $bbox->add ($bnext);
415
416     my $bback = Gtk2::Button->new ("Back");
417     $bback->signal_connect (clicked => sub { $r = 1; $w->destroy });
418     $bback->set_sensitive (!$mozembed_first);
419     $bbox->add ($bback);
420
421     my $bquit = Gtk2::Button->new ("Quit");
422     $bquit->signal_connect (clicked => sub { $r = 2; $w->destroy });
423     $bbox->add ($bquit);
424     $bbox->set_child_secondary ($bquit, 1);
425
426     $w->signal_connect (destroy => sub {
427         Gtk2->main_quit;
428         return FALSE;
429     });
430     $w->show_all ();
431
432     $moz->load_url ($ARGV[0]);
433     Gtk2->main;
434
435     exit $r;
436 }
437
438 1;
439
440 =head1 TUTORIAL
441
442 =head1 REFERENCE
443
444 =head1 WHAT MAKES A GOOD TALK
445
446 =head1 SEE ALSO
447
448 The Cognitive Style of PowerPoint, Tufte, Edward R.
449
450 =head1 AUTHOR
451
452 Richard W.M. Jones L<http://people.redhat.com/~rjones/>
453
454 =head1 COPYRIGHT
455
456 Copyright (C) 2010 Red Hat Inc.
457
458 This program is free software; you can redistribute it and/or modify
459 it under the terms of the GNU General Public License as published by
460 the Free Software Foundation; either version 2 of the License, or
461 (at your option) any later version.
462
463 This program is distributed in the hope that it will be useful,
464 but WITHOUT ANY WARRANTY; without even the implied warranty of
465 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
466 GNU General Public License for more details.
467
468 You should have received a copy of the GNU General Public License
469 along with this program; if not, write to the Free Software
470 Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.