|
Perl/FAQ/Пользовательский интерфейс
Материал из Wiki.crossplatform.ru
Parsing Program Arguments
#-----------------------------
use Getopt::Std;
# -v ARG, -D ARG, -o ARG, sets $opt_v, $opt_D, $opt_o
getopt("vDo");
# -v ARG, -D ARG, -o ARG, sets $args{v}, $args{D}, $args{o}
getopt("vDo", \%args);
getopts("vDo:"); # -v, -D, -o ARG, sets $opt_v, $opt_D, $opt_o
getopts("vDo:", \%args); # -v, -D, -o ARG, sets $args{v}, $args{D}, $args{o}
#-----------------------------
use Getopt::Long;
GetOptions( "verbose" => \$verbose, # --verbose
"Debug" => \$debug, # --Debug
"output=s" => \$output ); # --output=string or --output=string
#-----------------------------
#% rm -r -f /tmp/testdir
#-----------------------------
#% rm -rf /tmp/testdir
#-----------------------------
use Getopt::Std;
getopts("o:");
if ($opt_o) {
print "Writing output to $opt_o";
}
#-----------------------------
use Getopt::Std;
%option = ();
getopts("Do:", \%option);
if ($option{D}) {
print "Debugging mode enabled.\n";
}
# if not set, set output to "-". opening "-" for writing
# means STDOUT
$option{o} = "-" unless defined $option{o};
print "Writing output to file $option{o}\n" unless $option{o} eq "-";
open(STDOUT, "> $option{o}")
or die "Can't open $option{o} for output: $!\n";
#-----------------------------
#% gnutar --extract --file latest.tar
#-----------------------------
#% gnutar --extract --file=latest.tar
#-----------------------------
use Getopt::Long;
GetOptions( "extract" => \$extract,
"file=s" => \$file );
if ($extract) {
print "I'm extracting.\n";
}
die "I wish I had a file" unless defined $file;
print "Working on the file $file\n";
#-----------------------------
Testing Whether a Program Is Running Interactively
#-----------------------------
sub I_am_interactive {
return -t STDIN && -t STDOUT;
}
#-----------------------------
use POSIX qw/getpgrp tcgetpgrp/;
sub I_am_interactive {
local *TTY; # local file handle
open(TTY, "/dev/tty") or die "can't open /dev/tty: $!";
my $tpgrp = tcgetpgrp(fileno(TTY));
my $pgrp = getpgrp();
close TTY;
return ($tpgrp == $pgrp);
}
#-----------------------------
while (1) {
if (I_am_interactive()) {
print "Prompt: ";
}
$line = <STDIN>;
last unless defined $line;
# do something with the line
}
#-----------------------------
sub prompt { print "Prompt: " if I_am_interactive() }
for (prompt(); $line = <STDIN>; prompt()) {
# do something with the line
}
#-----------------------------
Clearing the Screen
#-----------------------------
use Term::Cap;
$OSPEED = 9600;
eval {
require POSIX;
my $termios = POSIX::Termios->new();
$termios->getattr;
$OSPEED = $termios->getospeed;
};
$terminal = Term::Cap->Tgetent({OSPEED=>$OSPEED});
$terminal->Tputs('cl', 1, STDOUT);
#-----------------------------
system("clear");
#-----------------------------
$clear = $terminal->Tputs('cl');
$clear = `clear`;
#-----------------------------
print $clear;
#-----------------------------
Determining Terminal or Window Size
#-----------------------------
use Term::ReadKey;
($wchar, $hchar, $wpixels, $hpixels) = GetTerminalSize();
#-----------------------------
use Term::ReadKey;
($width) = GetTerminalSize();
die "You must have at least 10 characters" unless $width >= 10;
$max = 0;
foreach (@values) {
$max = $_ if $max < $_;
}
$ratio = ($width-10)/$max; # chars per unit
foreach (@values) {
printf("%8.1f %s\n", $_, "*" x ($ratio*$_));
}
#-----------------------------
Changing Text Color
#-----------------------------
use Term::ANSIColor;
print color("red"), "Danger, Will Robinson!\n", color("reset");
print "This is just normal text.\n";
print colored("<BLINK>Do you hurt yet?</BLINK>", "blink");
#-----------------------------
use Term::ANSIColor qw(:constants);
print RED, "Danger, Will Robinson!\n", RESET;
#-----------------------------
# rhyme for the deadly coral snake
print color("red on_black"), "venom lack\n";
print color("red on_yellow"), "kill that fellow\n";
print color("green on_cyan blink"), "garish!\n";
print color("reset");
#-----------------------------
print colored("venom lack\n", "red", "on_black");
print colored("kill that fellow\n", "red", "on_yellow");
print colored("garish!\n", "green", "on_cyan", "blink");
#-----------------------------
use Term::ANSIColor qw(:constants);
print BLACK, ON_WHITE, "black on white\n";
print WHITE, ON_BLACK, "white on black\n";
print GREEN, ON_CYAN, BLINK, "garish!\n";
print RESET;
#-----------------------------
END { print color("reset") }
#-----------------------------
$Term::ANSIColor::EACHLINE = $/;
print colored(<<EOF, RED, ON_WHITE, BOLD, BLINK);
This way
each line
has its own
attribute set.
EOF
#-----------------------------
Reading from the Keyboard
#-----------------------------
use Term::ReadKey;
ReadMode('cbreak');
$key = ReadKey(0);
ReadMode('normal');
#-----------------------------
# download the following standalone program
#!/usr/bin/perl -w
# sascii - Show ASCII values for keypresses
use Term::ReadKey;
ReadMode('cbreak');
print "Press keys to see their ASCII values. Use Ctrl-C to quit.\n";
while (1) {
$char = ReadKey(0);
last unless defined $char;
printf(" Decimal: %d\tHex: %x\n", ord($char), ord($char));
}
ReadMode('normal');
#-----------------------------
Ringing the Terminal Bell
#-----------------------------
print "\aWake up!\n";
#-----------------------------
use Term::Cap;
$OSPEED = 9600;
eval {
require POSIX;
my $termios = POSIX::Termios->new();
$termios->getattr;
$OSPEED = $termios->getospeed;
};
$terminal = Term::Cap->Tgetent({OSPEED=>$OSPEED});
$vb = "";
eval {
$terminal->Trequire("vb");
$vb = $terminal->Tputs('vb', 1);
};
print $vb; # ring visual bell
#-----------------------------
Using POSIX termios
#-----------------------------
# download the following standalone program
#!/usr/bin/perl -w
# demo POSIX termios
use POSIX qw(:termios_h);
$term = POSIX::Termios->new;
$term->getattr(fileno(STDIN));
$erase = $term->getcc(VERASE);
$kill = $term->getcc(VKILL);
printf "Erase is character %d, %s\n", $erase, uncontrol(chr($erase));
printf "Kill is character %d, %s\n", $kill, uncontrol(chr($kill));
$term->setcc(VERASE, ord('#'));
$term->setcc(VKILL, ord('@'));
$term->setattr(1, TCSANOW);
print("erase is #, kill is @; type something: ");
$line = <STDIN>;
print "You typed: $line";
$term->setcc(VERASE, $erase);
$term->setcc(VKILL, $kill);
$term->setattr(1, TCSANOW);
sub uncontrol {
local $_ = shift;
s/([\200-\377])/sprintf("M-%c",ord($1) & 0177)/eg;
s/([\0-\37\177])/sprintf("^%c",ord($1) ^ 0100)/eg;
return $_;
}
#-----------------------------
# HotKey.pm
package HotKey;
@ISA = qw(Exporter);
@EXPORT = qw(cbreak cooked readkey);
use strict;
use POSIX qw(:termios_h);
my ($term, $oterm, $echo, $noecho, $fd_stdin);
$fd_stdin = fileno(STDIN);
$term = POSIX::Termios->new();
$term->getattr($fd_stdin);
$oterm = $term->getlflag();
$echo = ECHO | ECHOK | ICANON;
$noecho = $oterm & ~$echo;
sub cbreak {
$term->setlflag($noecho); # ok, so i don't want echo either
$term->setcc(VTIME, 1);
$term->setattr($fd_stdin, TCSANOW);
}
sub cooked {
$term->setlflag($oterm);
$term->setcc(VTIME, 0);
$term->setattr($fd_stdin, TCSANOW);
}
sub readkey {
my $key = '';
cbreak();
sysread(STDIN, $key, 1);
cooked();
return $key;
}
END { cooked() }
1;
#-----------------------------
Checking for Waiting Input
#-----------------------------
use Term::ReadKey;
ReadMode ('cbreak');
if (defined ($char = ReadKey(-1)) ) {
# input was waiting and it was $char
} else {
# no input was waiting
}
ReadMode ('normal'); # restore normal tty settings
#-----------------------------
Reading Passwords
#-----------------------------
use Term::ReadKey;
ReadMode('noecho');
$password = ReadLine(0);
#-----------------------------
# download the following standalone program
#!/usr/bin/perl -w
# checkuser - demonstrates reading and checking a user's password
use Term::ReadKey;
print "Enter your password: ";
ReadMode 'noecho';
$password = ReadLine 0;
chomp $password;
ReadMode 'normal';
print "\n";
($username, $encrypted) = ( getpwuid $< )[0,1];
if (crypt($password, $encrypted) ne $encrypted) {
die "You are not $username\n";
} else {
print "Welcome, $username\n";
}
#-----------------------------
Editing Input
#-----------------------------
use Term::ReadLine;
$term = Term::ReadLine->new("APP DESCRIPTION");
$OUT = $term->OUT || *STDOUT;
$term->addhistory($fake_line);
$line = $term->readline(PROMPT);
print $OUT "Any program output\n";
#-----------------------------
# download the following standalone program
#!/usr/bin/perl -w
# vbsh - very bad shell
use strict;
use Term::ReadLine;
use POSIX qw(:sys_wait_h);
my $term = Term::ReadLine->new("Simple Shell");
my $OUT = $term->OUT() || *STDOUT;
my $cmd;
while (defined ($cmd = $term->readline('$ ') )) {
my @output = `$cmd`;
my $exit_value = $? >> 8;
my $signal_num = $? & 127;
my $dumped_core = $? & 128;
printf $OUT "Program terminated with status %d from signal %d%s\n",
$exit_value, $signal_num,
$dumped_core ? " (core dumped)" : "";
print @output;
$term->addhistory($seed_line);
}
#-----------------------------
$term->addhistory($seed_line);
#-----------------------------
$term->remove_history($line_number);
#-----------------------------
@history = $term->GetHistory;
#-----------------------------
Managing the Screen
#-----------------------------
#% rep ps aux
#% rep netstat
#% rep -2.5 lpq
#-----------------------------
# download the following standalone program
#!/usr/bin/perl -w
# rep - screen repeat command
use strict;
use Curses;
my $timeout = 10;
if (@ARGV && $ARGV[0] =~ /^-(\d+\.?\d*)$/) {
$timeout = $1;
shift;
}
die "usage: $0 [ -timeout ] cmd args\n" unless @ARGV;
initscr(); # start screen
noecho();
cbreak();
nodelay(1); # so getch() is non-blocking
$SIG{INT} = sub { done("Ouch!") };
sub done { endwin(); print "@_\n"; exit; }
while (1) {
while ((my $key = getch()) ne ERR) { # maybe multiple keys
done("See ya") if $key eq 'q'
}
my @data = `(@ARGV) 2>&1`; # gather output+errors
for (my $i = 0; $i < $LINES; $i++) {
addstr($i, 0, $data[$i] || ' ' x $COLS);
}
standout();
addstr($LINES-1, $COLS - 24, scalar localtime);
standend();
move(0,0);
refresh(); # flush new output to display
my ($in, $out) = ('', '');
vec($in,fileno(STDIN),1) = 1; # look for key on stdin
select($out = $in,undef,undef,$timeout);# wait up to this long
}
#-----------------------------
keypad(1); # enable keypad mode
$key = getch();
if ($key eq 'k' || # vi mode
$key eq "\cP" || # emacs mode
$key eq KEY_UP) # arrow mode
{
# do something
}
#-----------------------------
# Template Entry Demonstration
#
# Address Data Example Record # ___
#
# Name: [________________________________________________]
# Addr: [________________________________________________]
# City: [__________________] State: [__] Zip: [\\\\\]
#
# Phone: (\\\) \\\-\\\\ Password: [^^^^^^^^]
#
# Enter all information available.
# Edit fields with left/right arrow keys or "delete".
# Switch fields with "Tab" or up/down arrow keys.
# Indicate completion by pressing "Return".
# Refresh screen with "Control-L".
# Abort this demo here with "Control-X".
#-----------------------------
Controlling Another Program with Expect
#-----------------------------
use Expect;
$command = Expect->spawn("program to run")
or die "Couldn't start program: $!\n";
# prevent the program's output from being shown on our STDOUT
$command->log_stdout(0);
# wait 10 seconds for "Password:" to appear
unless ($command->expect(10, "Password")) {
# timed out
}
# wait 20 seconds for something that matches /[lL]ogin: ?/
unless ($command->expect(20, -re => '[lL]ogin: ?')) {
# timed out
}
# wait forever for "invalid" to appear
unless ($command->expect(undef, "invalid")) {
# error occurred; the program probably went away
}
# send "Hello, world" and a carriage return to the program
print $command "Hello, world\r";
# if the program will terminate by itself, finish up with
$command->soft_close();
# if the program must be explicitly killed, finish up with
$command->hard_close();
#-----------------------------
$which = $command->expect(30, "invalid", "succes", "error", "boom");
if ($which) {
# found one of those strings
}
#-----------------------------
Creating Menus with Tk
#-----------------------------
use Tk;
$main = MainWindow->new();
# Create a horizontal space at the top of the window for the
# menu to live in.
$menubar = $main->Frame(-relief => "raised",
-borderwidth => 2)
->pack (-anchor => "nw",
-fill => "x");
# Create a button labeled "File" that brings up a menu
$file_menu = $menubar->Menubutton(-text => "File",
-underline => 1)
->pack (-side => "left" );
# Create entries in the "File" menu
$file_menu->command(-label => "Print",
-command => \&Print);
#-----------------------------
$file_menu = $menubar->Menubutton(-text => "File",
-underline => 1,
-menuitems => [
[ Button => "Print",-command => \&Print ],
[ Button => "Save",-command => \&Save ] ])
->pack(-side => "left");
#-----------------------------
$file_menu->command(-label => "Quit Immediately",
-command => sub { exit } );
#-----------------------------
$file_menu->separator();
#-----------------------------
$options_menu->checkbutton(-label => "Create Debugging File",
-variable => \$debug,
-onvalue => 1,
-offvalue => 0);
#-----------------------------
$debug_menu->radiobutton(-label => "Level 1",
-variable => \$log_level,
-value => 1);
$debug_menu->radiobutton(-label => "Level 2",
-variable => \$log_level,
-value => 2);
$debug_menu->radiobutton(-label => "Level 3",
-variable => \$log_level,
-value => 3);
#-----------------------------
# step 1: create the cascading menu entry
$format_menu->cascade (-label => "Font");
# step 2: get the new Menu we just made
$font_menu = $format_menu->cget("-menu");
# step 3: populate that Menu
$font_menu->radiobutton (-label => "Courier",
-variable => \$font_name,
-value => "courier");
$font_menu->radiobutton (-label => "Times Roman",
-variable => \$font_name,
-value => "times");
#-----------------------------
$format_menu = $menubar->Menubutton(-text => "Format",
-underline => 1
-tearoff => 0)
->pack;
$font_menu = $format_menu->cascade(-label => "Font",
-tearoff => 0);
#-----------------------------
my $f = $menubar->Menubutton(-text => "Edit", -underline => 0,
-menuitems =>
[
[Button => 'Copy', -command => \&edit_copy ],
[Button => 'Cut', -command => \&edit_cut ],
[Button => 'Paste', -command => \&edit_paste ],
[Button => 'Delete', -command => \&edit_delete ],
[Separator => ''],
[Cascade => 'Object ...', -tearoff => 0,
-menuitems => [
[ Button => "Circle", -command => \&edit_circle ],
[ Button => "Square", -command => \&edit_square ],
[ Button => "Point", -command => \&edit_point ] ] ],
])->grid(-row => 0, -column => 0, -sticky => 'w');
#-----------------------------
Creating Dialog Boxes with Tk
#-----------------------------
use Tk::DialogBox;
$dialog = $main->DialogBox( -title => "Register This Program",
-buttons => [ "Register", "Cancel" ] );
# add widgets to the dialog box with $dialog->Add()
# later, when you need to display the dialog box
$button = $dialog->Show();
if ($button eq "Register") {
# ...
} elsif ($button eq "Cancel") {
# ...
} else {
# this shouldn't happen
}
#-----------------------------
# download the following standalone program
#!/usr/bin/perl -w
# tksample3 - demonstrate dialog boxes
use Tk;
use Tk::DialogBox;
$main = MainWindow->new();
$dialog = $main->DialogBox( -title => "Register",
-buttons => [ "Register", "Cancel" ],
);
# the top part of the dialog box will let people enter their names,
# with a Label as a prompt
$dialog->add("Label", -text => "Name")->pack();
$entry = $dialog->add("Entry", -width => 35)->pack();
# we bring up the dialog box with a button
$main->Button( -text => "Click Here For Registration Form",
-command => \®ister) ->pack(-side => "left");
$main->Button( -text => "Quit",
-command => sub { exit } ) ->pack(-side => "left");
MainLoop;
#
# register
#
# Called to pop up the registration dialog box
#
sub register {
my $button;
my $done = 0;
do {
# show the dialog
$button = $dialog->Show;
# act based on what button they pushed
if ($button eq "Register") {
my $name = $entry->get;
if (defined($name) && length($name)) {
print "Welcome to the fold, $name\n";
$done = 1;
} else {
print "You didn't give me your name!\n";
}
} else {
print "Sorry you decided not to register.\n";
$done = 1;
}
} until $done;
}
#-----------------------------
# download the following standalone program
#!/usr/bin/perl -w
# tksample4 - popup dialog boxes for warnings
use Tk;
use Tk::DialogBox;
my $main;
# set up a warning handler that displays the warning in a Tk dialog box
BEGIN {
$SIG{_ _WARN_ _} = sub {
if (defined $main) {
my $dialog = $main->DialogBox( -title => "Warning",
-buttons => [ "Acknowledge" ]);
$dialog->add("Label", -text => $_[0])->pack;
$dialog->Show;
} else {
print STDOUT join("\n", @_), "n";
}
};
}
# your program goes here
$main = MainWindow->new();
$main->Button( -text => "Make A Warning",
-command => \&make_warning) ->pack(-side => "left");
$main->Button( -text => "Quit",
-command => sub { exit } ) ->pack(-side => "left");
MainLoop;
# dummy subroutine to generate a warning
sub make_warning {
my $a;
my $b = 2 * $a;
}
#-----------------------------
Responding to Tk Resize Events
#-----------------------------
use Tk;
$main = MainWindow->new();
$main->bind('<Configure>' => sub {
$xe = $main->XEvent;
$main->maxsize($xe->w, $xe->h);
$main->minsize($xe->w, $xe->h);
});
#-----------------------------
$widget->pack( -fill => "both", -expand => 1 );
$widget->pack( -fill => "x", -expand => 1 );
#-----------------------------
$mainarea->pack( -fill => "both", -expand => 1);
#-----------------------------
$menubar->pack( -fill => "x", -expand => 1 );
#-----------------------------
$menubar->pack (-fill => "x",
-expand => 1,
-anchor => "nw" );
#-----------------------------
Removing the DOS Shell Window with Windows Perl/Tk
#-----------------------------
# download the following standalone program
#!/usr/bin/perl -w
# loader - starts Perl scripts without the annoying DOS window
use strict;
use Win32;
use Win32::Process;
# Create the process object.
Win32::Process::Create($Win32::Process::Create::ProcessObj,
'C:/perl5/bin/perl.exe', # Whereabouts of Perl
'perl realprogram', #
0, # Don't inherit.
DETACHED_PROCESS, #
".") or # current dir.
die print_error();
sub print_error() {
return Win32::FormatMessage( Win32::GetLastError() );
}
#-----------------------------
Program: Small termcap program
#-----------------------------
# download the following standalone program
#!/usr/bin/perl -w
# tcapdemo - show off direct cursor placement
use POSIX;
use Term::Cap;
init(); # Initialize Term::Cap.
zip(); # Bounce lines around the screen.
finish(); # Clean up afterward.
exit();
# Two convenience functions. clear_screen is obvious, and
# clear_end clears to the end of the screen.
sub clear_screen { $tcap->Tputs('cl', 1, *STDOUT) }
sub clear_end { $tcap->Tputs('cd', 1, *STDOUT) }
# Move the cursor to a particular location.
sub gotoxy {
my($x, $y) = @_;
$tcap->Tgoto('cm', $x, $y, *STDOUT);
}
# Get the terminal speed through the POSIX module and use that
# to initialize Term::Cap.
sub init {
$| = 1;
$delay = (shift() || 0) * 0.005;
my $termios = POSIX::Termios->new();
$termios->getattr;
my $ospeed = $termios->getospeed;
$tcap = Term::Cap->Tgetent ({ TERM => undef, OSPEED => $ospeed });
$tcap->Trequire(qw(cl cm cd));
}
# Bounce lines around the screen until the user interrupts with
# Ctrl-C.
sub zip {
clear_screen();
($maxrow, $maxcol) = ($tcap->{_li} - 1, $tcap->{_co} - 1);
@chars = qw(* - / | \ _ );
sub circle { push(@chars, shift @chars); }
$interrupted = 0;
$SIG{INT} = sub { ++$interrupted };
$col = $row = 0;
($row_sign, $col_sign) = (1,1);
do {
gotoxy($col, $row);
print $chars[0];
select(undef, undef, undef, $delay);
$row += $row_sign;
$col += $col_sign;
if ($row == $maxrow) { $row_sign = -1; circle; }
elsif ($row == 0 ) { $row_sign = +1; circle; }
if ($col == $maxcol) { $col_sign = -1; circle; }
elsif ($col == 0 ) { $col_sign = +1; circle; }
} until $interrupted;
}
# Clean up the screen.
sub finish {
gotoxy(0, $maxrow);
clear_end();
}
#-----------------------------
#* _ / | \ -
# * _ \ - / | / | \ - *
# * _ \ - / | / | \ - *
# * \ - | / | - *
# _ * \ - | / / | - \ *
# _ * \ - | / / | - \ *
#* * \ - | / / | - \ *
# * * \ - | / / | - \ *
# * * \ - | / / | - \ *
# * * \ - | / / | - \ *
# * * \ - | / / | - \ *
# * * \ - | / / | - \
# * - \ | / / - \
# * - * - \ | / | / - \
# * - * - \ | / | / - \ _
# - - \ | / _
#-----------------------------
Program: tkshufflepod
#-----------------------------
#% tkshufflepod chap15.pod
#-----------------------------
# download the following standalone program
#!/usr/bin/perl -w
# tkshufflepod - reorder =head1 sections in a pod file
use Tk;
use strict;
# declare variables
my $podfile; # name of the file to open
my $m; # main window
my $l; # listbox
my ($up, $down); # positions to move
my @sections; # list of pod sections
my $all_pod; # text of pod file (used when reading)
# read the pod file into memory, and split it into sections.
$podfile = shift || "-";
undef $/;
open(F, "< $podfile")
or die "Can't open $podfile : $!\n";
$all_pod = <F>;
close(F);
@sections = split(/(?==head1)/, $all_pod);
# turn @sections into an array of anonymous arrays. The first element
# in each of these arrays is the original text of the message, while
# the second element is the text following =head1 (the section title).
foreach (@sections) {
/(.*)/;
$_ = [ $_, $1 ];
}
# fire up Tk and display the list of sections.
$m = MainWindow->new();
$l = $m->Listbox('-width' => 60)->pack('-expand' => 1, '-fill' => 'both');
foreach my $section (@sections) {
$l->insert("end", $section->[1]);
}
# permit dragging by binding to the Listbox widget.
$l->bind( '<Any-Button>' => \&down );
$l->bind( '<Any-ButtonRelease>' => \&up );
# permit viewing by binding double-click
$l->bind( '<Double-Button>' => \&view );
# 'q' quits and 's' saves
$m->bind( '<q>' => sub { exit } );
$m->bind( '<s>' => \&save );
MainLoop;
# down(widget): called when the user clicks on an item in the Listbox.
sub down {
my $self = shift;
$down = $self->curselection;;
}
# up(widget): called when the user releases the mouse button in the
# Listbox.
sub up {
my $self = shift;
my $elt;
$up = $self->curselection;;
return if $down == $up;
# change selection list
$elt = $sections[$down];
splice(@sections, $down, 1);
splice(@sections, $up, 0, $elt);
$self->delete($down);
$self->insert($up, $sections[$up]->[1]);
}
# save(widget): called to save the list of sections.
sub save {
my $self = shift;
open(F, "> $podfile")
or die "Can't open $podfile for writing: $!";
print F map { $_->[0] } @sections;
close F;
exit;
}
# view(widget): called to display the widget. Uses the Pod widget.
sub view {
my $self = shift;
my $temporary = "/tmp/$$-section.pod";
my $popup;
open(F, "> $temporary")
or warn ("Can't open $temporary : $!\n"), return;
print F $sections[$down]->[0];
close(F);
$popup = $m->Pod('-file' => $temporary);
$popup->bind('<Destroy>' => sub { unlink $temporary } );
}
#-----------------------------
|