Recipe 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 } );               }