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