Figure C-2. Tk::MacCopy, shown with the CollapsableFrame both hidden and viewable

Here's the code:

$Tk::MacCopy::VERSION = '1.0';

package Tk::MacCopy;

use File::Copy;
use Tk::widgets qw/CollapsableFrame LabEntry MacProgressBar/;

use base qw/Tk::Toplevel/;
use strict;

Construct Tk::Widget 'MacCopy';

sub Populate {

    # Create an instance of a MacCopy widget.  Instance variables are:
    #
    # {bytes_msg}      = a string showing how many bytes copied,
    #                    as well as the total byte count.
    # {file}           = current file being copied.
    # {file_count}     = number of files left to copy.
    # {from}           = source directory path.
    # {to}             = destination directory path.

    my($self, $args) = @_;

    $self->withdraw;
    $self->SUPER::Populate($args);

    $args->{-width} = 300 unless exists $args->{-width};
    my $pb = $self->MacProgressBar(%$args)->pack;
    
    # Populate the top Frame of the MacProgessBar.

    my $tf = $pb->Subwidget('tframe');
    $tf->Label(-text => 'Items remaining to be copied:  ')->
        pack(qw/-side left -anchor w/);
    $tf->Label(-textvariable => \$self->{file_count})->
        pack(qw/-side right -anchor e/);
    
    # Populate the right Frame of the MacProgessBar.

    my $rf = $pb->Subwidget('rframe');
    $rf->Button(-text => 'Stop', -command => sub {$self->destroy})->pack;
    
    # Populate the bottom Frame of the MacProgessBar with a CollapsableFrame.

    my $bf = $pb->Subwidget('bframe');
    my $cf = $bf->CollapsableFrame(-height => 110);
    $cf->pack(qw/-fill x -expand 1/);
    my $cf_frame = $cf->Subwidget('colf');

    # Populate the CollapsableFrame with detail information.

    foreach my $item (
         ['Copying', \$self->{file}],
         ['From', \$self->{from}],
         ['To', \$self->{to}],
         ['Bytes Copied', \$self->{bytes_msg}],
        ) {
	my $l = $item->[0] . ':';
	my $le = $cf_frame->LabEntry(
            -label        => ' ' x (13 - length $l) . $l,
            -labelPack    => [qw/-side left -anchor w/],
            -labelFont    => '9x15bold',
            -relief       => 'flat',
            -state        => 'disabled',
            -textvariable => $item->[1],
	    -width        => 35,
        );
	$le->pack(qw/ -fill x -expand 1/);
    }

    $self->Advertise('collapsableframe' => $cf);
    $self->Advertise('progressbar'      => $pb);

} # end Populate

sub mcopy {

    # Perform the copy, updating copy information on-the-fly. Because
    # this is just a demo, we don't recursively copy subdirectories.

    my($self, $from, $to) = @_;
    
    $self->{from} = $from;
    $self->{to} = $to;
    $self->deiconify;

    opendir D, $from;
    my(@files) = grep(! -d $_, readdir D);
    closedir D;

    my $total_bytes = 0;
    foreach my $f (@files) {
        $total_bytes += -s $f;
    }

    $self->{file_count} = scalar @files;
    $self->update;

    my $filen = 0;
    my $bytes = 0;

    foreach my $f (@files) {
        $filen++;
        $self->{file} = $f;
        my $size = -s $f;
        my $stat = copy($f, "$to/$f");
        $self->messageBox(
                -title   => 'MacCopy Failure', 
                -icon    => 'warning', 
                -type    => 'OK', 
                -message => "Copy of '$f' failed: $!",
            ) unless $stat;
        $bytes += $size;
        $self->{bytes_msg} = $bytes . " of $total_bytes";
        $self->{file_count}--;
        $self->Subwidget('collapsableframe')->configure(-text =>
                "Time Remaining:  About " . $self->{file_count} . " seconds");
            $self->Subwidget('progressbar')->set($filen / scalar(@files) * 100);
            $self->after(1000);
    }

    $self->destroy;

} # end mcopy

1;

__END__

=head1 NAME

Tk::MacCopy - simulate a Macintosh copy dialog.

=head1 SYNOPSIS

S<    >I<$cd> = I<$parent>-E<gt>B<MacCopy>(I<-option> =E<gt> I<value>);

=head1 DESCRIPTION

This widget simulates a Macintosh copy dialog using a MacProgressBar
and a CollapsableFrame.  It does not truly emulate a real Macintosh
copy, since it doesn't:

 . check that the destination has enough room for the copy.
 . recursively copy subdirectories.
 . compute a time remaining figure.

=head1 METHODS

=over 4

=item B<mcopy($to, $from)>

Copies all files from $to directory to $from directory.

=back

=head1 ADVERTISED WIDGETS

Component subwidgets can be accessed via the B<Subwidget> method.
Valid subwidget names are listed below.

=over 4

=item Name: progressbar, Class:  MacProgressBar

  MacProgressBar widget reference.

=item Name: collapsableframe, Class:  CollapsableFrame

  CollapsableFrame widget reference.

=back

=head1 EXAMPLE

 use Cwd;
 use Tk;
 use Tk::MacCopy;

 my $mw = MainWindow->new;

 my $mc = $mw->MacCopy;
 my $cwd = cwd;

 $mw->Button(
     -text    => "Push me to copy all files in '$cwd' to '/tmp'.",
     -command => sub {$mc->mcopy($cwd,  '/tmp'); exit},
 )->pack;

=head1 AUTHOR and COPYRIGHT

[email protected]

Copyright (C) 2000 - 2001, Stephen O.Lidie

This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.

=head1 KEYWORDS

CollapsableFrame, MacCopy, MacProgressBar

=cut

C. Complete Program Listings		C.3. Tk::ExecuteCommand