Example 15.10: tkshufflepod

#!/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 } );
}