Program: tkshufflepod (Perl Cookbook, 2nd Edition)

## 15.22. Program: tkshufflepod

This short program uses Tk to list the `=head1` sections in the file using the Listbox widget, and it lets you drag the sections around to reorder them. When you're done, press "`s`" or "`q`" to save or quit. You can even double-click a section to view it with the Pod widget. It writes the section text to a temporary file in /tmp and removes the file when the Pod widget is destroyed.

Call it with the name of the Pod file to view:

>     % tkshufflepod chap15.pod

We used this a lot when we wrote this book.

The program text is shown in Example 15-9.

#### Example 15-9. tkshufflepod

>       #!/usr/bin/perl -w
>       # tkshufflepod - reorder =head1 sections in a pod file

>       use Tk;
>       use Tk::Pod;
>       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 } );

>       }

Copyright © 2003 O'Reilly & Associates. All rights reserved.