=**************************************
= Name: Disk Usage Pie Chart
= Description:pie chart representing dis
= k usage for a directory
= By: Found on the World Wide Web
=**************************************
#!/usr/bin/perl -w
# ###########################################################################
# dupie - pie chart representing disk usage for a directory
#
# ###########################################################################
# (c) Mark J Hewitt. January 1997
#
# $Author: mjh $ $Date: 1998/10/06 22:36:53 $ $Revision: 1.4 $
#
# History
#
# $Log: dupie.pl,v $
# Revision 1.4 1998/10/06 22:36:53 mjh
# Oops! Teach me to include a one line patch in with the POD!
#
# Revision 1.3 1998/10/06 22:35:30 mjh
# Added POD documentation suitable for submission to CPAN
#
# Revision 1.2 1998/10/06 21:09:32 mjh
# Added $VERSION
#
# Revision 1.1 1998/10/06 21:01:13 mjh
# Initial revision
#
# 06-Oct-1998
# * transfer into RCS
# 28-Jul-1998 (mjh)
# * Replaced listbox with HList directory browser
# * Arranged for segments to be outst when selected
# * Added .dupierc config file
# * Improved resize behaviour
# * Generally tidied up for perl 5.005_01
# 31-Jul-1998 (mjh)
# * Added AutoUpdate feature
#
# ###########################################################################
#
# Todo
#
# [1] Add current directory label above piechart (Leave this in title bar)
# [8] Sort out resize operations for the pie
# [9] Write pod documentation
# [12] Re-write using a piechart widget
# [13] Add a fast-select directory
# [14] Add a file viewer
#
require 5.002;
use strict;
use Getopt::Std;
use File::Basename;
use Cwd;
use Tk;
use Tk::WaitBox;
use Tk::DialogBox;
use Tk::Table;
use Tk::HList;
use Tk::ErrorDialog;
# ###########################################################################
=head1 NAME
dupie - Provides a Tk-based piechart browser to UNIX directories
=head1 SYNTAX
dupie [C<-t> sec] ][directory]
=head1 DESCRIPTION
Dupie has two panes: A pie chart indicating the filesystem occupancy of
elements below a directory and a hierachical list pane for navigating.
In fact, the pie segments are sensitive to mouse clicks, so the piechart
also has an active function too. Additionally, there are four buttons.
A command line parameter determines which directory it will start at; no
parameter implies the current directory.
An optional B<-t> B<sec> parameter will cause B<dupie> to collect and
redraw the piechart and browser panes every B<sec> seconds.
=head2 Buttons
Four buttons, activated with a left mouse click are available:
=over 4
=item
B<Close> Closes the dupie window and exits.
=item
B<Redraw> Re-scans the directory and redraws the piechart and directory
browser.
=item
B<Up> Move the focus to the parent directory of that currently under
examination.
=item
B<Details> Pops up a I<details> dialog box for the currently selected element.
The dialog box gives all the basic information available for the file system
element (from stat(2) and provides) and provides a I<Remove> button to delete
the selected file or directory if required.
=back
=head2 List Browser
The right hand pane is a scrollable hierarchical list browser. This is
the only pane that dynamically resizes if the containing frame is itself
resized. Single left clicking on any element will select it, and the
corresponding pie segment will slip out of the piechart indicating which
it is. Double clicking on a directory will change the focus there and
redraw both pie and browser. Double clicking on a file will pop up the
I<details> dialog, from which the file may be removed if desired.
=head2 Piechart
The piechart in the left pane is composed of a cycle of rotating
colours. These colours are configurable (see below). Left clicking on
any segment will select the corresponding item in the browser, which
will adjust itself to bring that item into view if necessary. Double
clicking on a segment corresponding to a directory will change the focus
to that directory and redraw the piechart and browser. Double clicking
on a file will pop up the I<details> dialog box. Right clicking will
pop up a I<details> box for all filesystem element, that is, it does not
change the current focus into a directory, but rather displays the
stat(2) details of it.
=head2 Configuration
The file F<.dupierc> in the user's home account will be eval'd by dupie
if it exists. Note this is as big a security hole as .cshrc or .bashrc
files - they should not be writable by anyone other than the owner,
especially if that owner is root! The following values may currently be set
in F<~/.dupierc>:
=over
=item
$DiskUsageCmd = 'du -ks'; # Disk usage - sum and in kB
=item
$PieRadius = 5; # Starting pie radius (in cm)
=item
$PieMargin = 0.5; # Blank space left around pie (in cm)
=item
$SegOutStep = 0.075; # Proportion of radius segments step out
=item
$IconDir = '/usr/share/images/icons/appl/desktop/file/cl';
=item
$OpenDirIcon = 'dir_open.xpm';
=item
$ClosedDirIcon = 'dir.xpm';
=item
$FileIcon = 'file.xpm';
=item
$AutoUpdate = 20; # Automatically update after this many seconds
=item
@Colours = qw(gold red blue orange green);
=back
=head1 FILES
=over
=item
F<~/dupierc> Configuration file
=item
F<TK Icon Directory/file.xpm> File icon for browser pane
=item
F<TK Icon Directory/folder.xpm> Closed directory icon for browser pane
=item
F<TK Icon Directory/openfolder.xpm> Open directory icon for browser pane
=back
=head1 TODO
=over
=item
It would be nice to have this work for Win32 also. There are problems with
Tk::WaitBox for this, amongst other file attribute issues.
=item
A full Pie widget should be provided so that the display can be more
attractive and generalised.
=item
Browsing file contents by typee.
=back
=head1 README
=head1 PREREQUISITES
C<strict>
C<Getopt::Std>
C<File::Basename>
C<Cwd>
C<Tk 402.003>
C<Tk::WaitBox>
C<Tk::DialogBox>
C<Tk::Table>
C<Tk::HList>
C<Tk::ErrorDialog>;
=head1 COREQUISITES
None.
=head1 OSNAMES
UNIX
=pod SCRIPT CATEGORIES
UNIX/DiskAdmin
File/Admin
Tk/DiskAdmin
=cut
# ###########################################################################
# ###########################################################################
# Configuration - These variables are assumed to be global
#
use vars qw($DiskUsageCmd $PieRadius $PieMargin $SegOutStep @Colours
$IconDir $OpenDirIcon $ClosedDirIcon $FileIcon $AutoUpdate);
my $VERSION = '$Revision: 1.4 $';
$VERSION =~ m/^.*: (.*) \$$/;
my ($main, $dir, %size, $total, %icons, $wait, $waitmsg);
my $rcfile = ".dupierc"; # For per-user configuration
# ###########################################################################
# ###########################################################################
#
# Initialise
#
init($rcfile);
#
# Handle events
#
MainLoop;
# ###########################################################################
# ###########################################################################
# Initialise
#
sub init
{
my $rcfile = $_[0];
init_rc($rcfile);
init_opts();
init_config();
init_state();
init_win();
}
# ###########################################################################
# Set up initialisation values from per-user rc file. Syntax is perl, and
# any global parameter may be changed
#
sub init_rc
{
my $file = $_[0];
#
#Find the user's home directory, and look for rc file in there.
#
my $homedir = (getpwuid($<))[7];
$file = $homedir . "/" . $file;
#
#Read it in, and exec it (Danger, Will Robinson!)
#
open RC, "<$file" or return;
my @rc = <RC>;
eval join ' ', @rc;
close RC;
}
# ###########################################################################
# Initialise command line options
#
sub init_opts
{
my %opt = ();
getopts('t:', \%opt);
if (defined $opt{'t'})
{
$AutoUpdate = $opt{'t'};
}
else
{
$AutoUpdate = 0;
}
$dir = defined $ARGV[0] ? $ARGV[0] : cwd; # Directory currently in focus
#
#Only useful to execute this over a directory
#
die "Not a directory: $dir" unless -d $dir;
}
# ###########################################################################
# Initialise configuration
#
sub init_config
{
$DiskUsageCmd = 'du -ks' unless defined $DiskUsageCmd; # Disk usage - sum and in kB
$PieRadius = 5unless defined $PieRadius;# Starting pie radius (in cm)
$PieMargin = 0.5 unless defined $PieMargin;# Blank space left around pie (in cm)
$SegOutStep = 0.075unless defined $SegOutStep;# Proportion of radius segments
#step out
$FileIcon= 'file.xpm'unless defined $FileIcon;
$ClosedDirIcon = 'folder.xpm' unless defined $ClosedDirIcon;
$OpenDirIcon = 'openfolder.xpm' unless defined $OpenDirIcon;
unless(defined $IconDir)
{
for (@INC)
{
my $try = "$_/Tk";
$IconDir = $try, last if -f "$try/$ClosedDirIcon";
}
}
die "Cannot find Tk icon directory\n" unless defined $IconDir;
#
# Colour cycle
#
@Colours = qw(Cyan Green LightSlateBlue Orange DeepSkyBlue4
FireBrick Gold DarkViolet Gray10 Khaki LightBlue
Gray30 MistyRose Grey65 Red Grey80 Navy LightGoldenRod
Black LightSlateGrey Moccasin LightSteelBlue Thistle
MediumSlateBlue PaleGreen MidnightBlue Wheat CadetBlue
Yellow SteelBlue LightSkyBlue DarkSlateBlue) unless defined @Colours;
}
# ###########################################################################
# just for debugging - show configuration parameters
#
sub print_config
{
print "Version: $VERSION\n";
print "Disk usage command: $DiskUsageCmd\n";
print "Pie radius: $PieRadius\n";
print "Pie margin: $PieMargin\n";
print "Icon directory: $IconDir\n";
print "File icon:$FileIcon\n";
print "Directory icon$ClosedDirIcon\n";
print "Open directory icon: $OpenDirIcon\n";
print "Colour cycle:(", join ' ', @Colours, ")\n";
}
# ###########################################################################
# Initialise starting state
#
sub init_state
{
$main = ''; # Handle on main window
$wait = ''; # Handle on wait box
$waitmsg = ''; # Message displayed on waitbox
%size = (); # Size information for $dir subtree
$total = 0; # Total blocks allocated in $dir subtree
%icons = (); # Icon pixmaps
}
# ###########################################################################
# Initialise window
#
sub init_win
{
$main = MainWindow->new; # Main window
die "Cannot get handle on main window!\n" unless $main;
#
#build some icon pixmaps for filesystem elements
#
$icons{"open"}= $main->Pixmap(-file => "$IconDir/$OpenDirIcon");
$icons{"closed"} = $main->Pixmap(-file => "$IconDir/$ClosedDirIcon");
$icons{"file"} = $main->Pixmap(-file => "$IconDir/$FileIcon");
#
#Set up a waitbox
#
$waitmsg = "Initializing...";
$wait = $main->WaitBox(-bitmap =>'hourglass',
-txt1 => 'Collecting data',
-txt2 => 'Please be patient',
-title => 'Disk data',
-canceltext => 'Quit',
-cancelroutine => sub { $waitmsg = undef; }
);
my $u = $wait->Subwidget('uframe');
$u->pack(-expand =>1, -fill => 'both');
$u->Label(-textvariable => \$waitmsg)->pack(-expand => 1, -fill => 'both');
#
#Set up the window
# First, titles and names
$main->title("Disk usage of $dir"); # Add title
$main->iconname($dir); # name the icon
#
#Add the frames to the window
#
# Button frame
#
my $buttons = $main->Frame;
$buttons->pack(qw(-side bottom -fill x -pady 2m));
#
#Create a frame for the piechart
#
my $pie_frame = $main->Frame();
$pie_frame->pack(-side => 'left', -fill => 'both', -expand => 'no');
#
#Insert the canvas on which to draw the piechart in the frame
#
my $pie_canvas = create_canvas($pie_frame, $PieRadius + $PieMargin);
$pie_canvas->pack(-expand => 'no', -fill => 'both');
#
#Create a directory browser on which to display directory entries
#
my $browser = create_browser($main,
$pie_canvas,
$PieRadius,
$PieMargin,
$PieRadius * $SegOutStep);
$wait->Show;
#
#Start to gather du data. This will fill a buffer before we read it, so
#the we have a little more time to build the display and to make the
#startup appear to be a little faster than it really is.
#
my $duhandle = start_du($dir);
#
#Add buttons to the button frame
#
# Button to close the main window
#
my $close = $buttons->Button(-text=> 'Close',
-command => [$main => 'destroy']
)->pack(-side => 'left', -expand => 1);
#
#Button to redraw the piechart
#
my $redraw = $buttons->Button(-text=> 'Redraw',
-command => [\&redraw;,
\$dir,
$pie_canvas,
$browser,
$PieRadius,
$PieMargin]
)->pack(-side => 'left', -expand => 1);
#
#Button to move up a directory
#
my $up = $buttons->Button(-text=> 'Up',
-command => [\&cdup;,
\$dir,
$pie_canvas,
$browser,
$PieRadius,
$PieMargin]
)->pack(-side => 'left', -expand => 1);
#
#Button to pop-up details on object
#
my $details = $buttons->Button(-text=> 'Details',
-command => [\&details;,
$browser,
$pie_canvas,
$PieRadius,
$PieMargin]
)->pack(-side => 'left', -expand => 1);
#
# Now retrieve the disk data
#
$waitmsg = "Reading data";
$wait->update;
%size = du_data($duhandle, \$total, \$waitmsg);
#
# Now finished with disk usage command
#
close $duhandle;
#
# Make the piechart and populate the directory browser
#
$waitmsg = "Building display";
$wait->update;
build_piechart(\%size, $total, $pie_canvas, $PieRadius, $PieMargin, $browser);
$wait->unShow;
$main->repeat($AutoUpdate*1000,
[\&redraw;, \$dir, $pie_canvas, $browser,
$PieRadius, $PieMargin]) if $AutoUpdate > 0;
}
# ###########################################################################
# Start to gather disk usage data for the given directory
#
sub start_du
{
my ($dir) = @_;
my $cmd = "$DiskUsageCmd $dir/* 2>/dev/null |";
open DU, $cmd or die "Cannot execute $DiskUsageCmd on $dir: $!";
return \*DU;
}
# ###########################################################################
# Return the disk usage data
#
sub du_data
{
my($du, $total, $msg) = @_;
my %data = ();
while (<$du>)
{
exit 0 unless defined $$msg;
my($s, $n) = split;
$data{$n} = $s;
$$total += $s;
$$msg = basename($n) . " (" . $s . "k)\nTotal " . $$total . "k";
$wait->update;
}
return %data;
}
# ###########################################################################
# Create and return the canvas on which we build the piechart
#
sub create_canvas
{
my ($frame, $radius) = @_;
my $x = $radius*2;
my $y = $radius*2;
my $canvas = $frame->Canvas(
-scrollregion => ['0c', '0c', $x . 'c', $y . 'c'],
-width=> $x . 'c',
-height=> $y . 'c',
-relief=> 'sunken',
-bd => 2,
);
return $canvas;
}
# ###########################################################################
# Build the piechart on the canvas, and populate the directory browser as
# we go
#
sub build_piechart
{
my ($data, $total, $canvas, $radius, $margin, $list) = @_;
my $pathname;
my $start = 0;
my $sweep = 0;
my $colour = 0;
my $item = 0;
my $sizewidth = length $total;
#
#Add base directory
#
my @pi = split('/', $dir);
my $path = '';
$list->add('/', -itemtype => 'text', -text => '/', -data => $pathname);
for (@pi)
{
next unless $_;
$path .= "/$_";
$list->add($path,
-itemtype => 'imagetext',
-image => $path eq $dir ? $icons{"open"} : $icons{"closed"},
-text => $path,
-data => $path);
}
#
#Loop though the paths making segments and inserting into directory
#browser
#
for $pathname (sort {$data->{$b} <=> $data->{$a}} keys %$data)
{
my $val = $data->{$pathname};
# my $tag = sprintf("%" . $sizewidth . "dk %s", $val, basename($pathname));
my $tag = sprintf("%s (%s)", basename($pathname), fmt_num($val*1024));
$sweep = 360*$val/$total;
my $seg = create_segment($canvas,
$radius,
$margin,
$Colours[$colour],
$start,
$sweep,
$pathname,
$list);
$list->add($pathname,
-itemtype => 'imagetext',
-image => -d $pathname ? $icons{"closed"} : $icons{"file"},
-text => $tag,
-data => $seg);
$item++;
$start += $sweep;
$colour++;
$colour %= $#Colours + 1;
}
$list->update;
}
# ###########################################################################
# Create a segment on the piechart
#
sub create_segment
{
my($canvas, $radius, $margin, $colour, $start, $sweep, $file, $list) = @_;
my $diam = $radius*2;
my $seg;
if ($sweep == 360)
{
$seg = $canvas->createOval($margin . 'c', $margin . 'c',
$diam . 'c', $diam . 'c',
-fill => $colour,
-outline => "black",
-tags => [$file, 'JustMe']);
}
else
{
$seg = $canvas->createArc($margin . 'c', $margin . 'c',
$diam . 'c', $diam . 'c',
-fill => $colour,
-outline => "black",
-start => $start,
-extent => $sweep,
-style => "pieslice",
-tags => [$file]);
}
$canvas->bind($file, '<1>' => [\&highlight;_list, $list]);
$canvas->bind($file, '<2>' => [\&show;_details, $list, $radius, $margin]);
$canvas->bind($file, '<3>' => [\&show;_details, $list, $radius, $margin]);
$canvas->bind($file, '<Double-1>' => [\&cd;_or_details_segment, $list, $radius, $margin]);
return $seg;
}
# ###########################################################################
# If the selected item on the piechart is a directory, change directory
# focus to it. If a file, pop up a details box.
#
sub cd_or_details_segment
{
my ($canvas, $list, $radius, $margin, $path) = @_;
$path = get_name($canvas) if !defined $path;
highlight_list($canvas, $list);
cd_or_show_details($canvas, $list, $radius, $margin, $path);
}
# ###########################################################################
# change directory or show details box
#
sub cd_or_show_details
{
my ($canvas, $list, $radius, $margin, $path) = @_;
if(-d $path)
{
$dir = $path;
redraw(\$dir, $canvas, $list, $radius, $margin);
}
else
{
details_box($path, $canvas, $list, $radius, $margin);
}
}
# ###########################################################################
# Highlight an iten in the directory browser, then build a details box for
# that entry.
#
sub show_details
{
my ($canvas, $list, $radius, $margin) = @_;
my $path = get_name($canvas);
highlight_list($canvas, $list);
details_box($path, $canvas, $list, $radius, $margin);
}
# ###########################################################################
# pop up a details box on an entry
#
sub details_box
{
my($path, $canvas, $list, $radius, $margin) = @_;
return unless defined $path;
my $type = type_name($path);
#
#Create a new window
#
my $w = $main->DialogBox(-title => $path, -buttons => ["Cancel", "Remove"]);
my $path_label = $w->add("Label",
-relief => 'raised',
-text => "$type: " . basename($path))->pack(-expand => 1, -fill => 'both');
my $t = $w->add("Table",
-relief => 'sunken',
-fixedcolumns => 2,
-fixedrows => 8);
my ($dev, $ino, $mode, $nlink, $uid, $gid, $rdev, $size, $atime,
$mtime, $ctime, $blksize, $blocks) = stat($path);
my ($user, $group);
($user, undef) = getpwuid($uid);
($group, undef) = getgrgid($gid);
$user = $uid unless defined $user;
$group = $gid unless defined $group;
$t->put(0, 0, $t->Label(-text => "Size", -anchor => 'e'));
$t->put(0, 1, $t->Label(-text => "$size bytes", -anchor => 'w'));
$t->put(1, 0, $t->Label(-text => "Links", -anchor => 'e'));
$t->put(1, 1, $t->Label(-text => $nlink, -anchor => 'w'));
$t->put(2, 0, $t->Label(-text => "Mode", -anchor => 'e'));
$t->put(2, 1, $t->Label(-text => sprintf("0%04o", $mode), -anchor => 'w'));
$t->put(3, 0, $t->Label(-text => "Owner", -anchor => 'e'));
$t->put(3, 1, $t->Label(-text => $user, -anchor => 'w'));
$t->put(4, 0, $t->Label(-text => "Group", -anchor => 'e'));
$t->put(4, 1, $t->Label(-text => $group, -anchor => 'w'));
$t->put(5, 0, $t->Label(-text => "Last access", -anchor => 'e'));
$t->put(5, 1, $t->Label(-text => scalar localtime($atime), -anchor => 'w'));
$t->put(6, 0, $t->Label(-text => "Last modified", -anchor => 'e'));
$t->put(6, 1, $t->Label(-text => scalar localtime($mtime), -anchor => 'w'));
$t->put(7, 0, $t->Label(-text => "Last Inode change", -anchor => 'e'));
$t->put(7, 1, $t->Label(-text => scalar localtime($ctime), -anchor => 'w'));
$t->pack(-expand => 1, -fill => 'both');
my $button = $w->Show;
remove_with_confirm($path, "Confirm remo
= ve $type", $canvas, $list, $radius, $mar
= gin)
if $button eq 'Remove';
}
# ###########################################################################
# Get the filesystem name corresponding to the currently selected piechart
# segment
#
sub get_name
{
my ($canvas) = @_;
my $name;
tag:
foreach ($canvas->gettags($canvas->find('withtag', 'current')))
{
next tag if $_ eq 'current';
$name = $_;
last tag;
}
return $name;
}
# ###########################################################################
# Get the segment ID corresponding to a filesystem name
#
sub get_seg
{
my ($canvas, $file) = @_;
return $canvas->find('withtag', $file);
}
# ###########################################################################
# Create an empty directory browser
#
sub create_browser
{
my ($p, $canvas, $radius, $margin, $segstep) = @_;
my @font =(-font => '-*-courier-Medium-R-Normal--*-100-*-*-*-*-*-*');
my $hlist;
$hlist = $p->Scrolled('HList',
-itemtype => 'text',
-separator => '/',
-relief => 'sunken',
-selectmode => 'browse',
-browsecmd => sub
{
my $file = shift;
highlight_segment($canvas,
\$hlist,
$radius,
$margin,
$segstep,
$file);
},
-command => sub
{
my $file = shift;
cd_or_details_browser($canvas,
\$hlist,
$radius,
$margin,
$file);
},
)->pack(-fill => 'both', -expand => 'y');
return $hlist;
}
# ###########################################################################
# Highlight an enty in the file list
#
sub highlight_list
{
my ($canvas, $list) = @_;
my $path = get_name($canvas);
$list->selection('clear');
$list->selection('set', $path);
$list->see($path);
$list->update();
}
# ###########################################################################
# Highlight a segment in the piechart
#
sub highlight_segment
{
my ($canvas, $list, $radius, $margin, $segstep, $path) = @_;
unhighlight_segment(@_);
my $seg = $$list->info('data', $path);
for my $tag ($canvas->gettags($seg))
{
return if $tag eq 'JustMe';
}
my($dx, $dy) = dxdy($canvas->itemcget($seg, '-start'),
$canvas->itemcget($seg, '-extent'),
$segstep);
$canvas->move($seg, $dx . 'c', $dy . 'c');
$canvas->addtag('*moved', 'withtag', $seg);
}
# ###########################################################################
# Remove highlighting from all segments
#
sub unhighlight_segment
{
my ($canvas, $list, $radius, $margin, $segstep, $path) = @_;
for my $seg ($canvas->find('withtag', '*moved'))
{
my($dx, $dy) = dxdy($canvas->itemcget($seg, '-start'),
$canvas->itemcget($seg, '-extent'),
-$segstep);
$canvas->move($seg, $dx . 'c', $dy . 'c');
$canvas->dtag($seg, '*moved');
}
}
# ###########################################################################
# dxdy - calculate delta X and delta Y for radial move of segment
#
sub dxdy
{
my($start, $sweep, $delta) = @_;
$start = 0 unless defined $start;
$sweep = 0 unless defined $sweep;
$delta = 0 unless defined $delta;
my $phi = 3.141592654 / 180.0 * ($start + ($sweep/2));
return ($delta*cos($phi), -$delta*sin($phi));
}
# ###########################################################################
# Return a textual description of the type of a filesystem element
#
sub type_name
{
my $entry = $_[0];
if(-f $entry)
{
return "Executable" if -x $entry;
return "File";
}
return "Directory" if -d $entry;
return "Symlink" if -l $entry;
return "FIFO" if -p $entry;
return "Block special file" if -b $entry;
return "Character special file" if -c $entry;
return "Socket" if -S $entry;
return "File";
}
# ###########################################################################
# Unlink a file, recursively delete a directory.
# Remove element from %size hash and redraw the screen. Do not issue
# another du (it takes too long!)
#
sub remove
{
my($path, $canvas, $list, $data, $radius, $margin) = @_;
my $remove_ok = 0;
if(-d $path)
{
system "rm -rf $path 2>/dev/null";
$remove_ok++ unless $?;
}
else
{
$remove_ok++ if (unlink $path) == 1;
}
if($remove_ok)
{
$total -= $data->{$path};
delete $data->{$path};
$list->delete('all');
$canvas->delete('all');
build_piechart($data, $total, $canvas, $radius, $margin, $list);
}
return $remove_ok;
}
# ###########################################################################
# Issue a confirm box, then call remove to delete directories or files and
# update the display as required
#
sub remove_with_confirm
{
my ($path, $msg, $canvas, $list, $radius, $margin) = @_;
my $w = $main->DialogBox(-title => "Remove $path", -buttons => ["Cancel", "OK"]);
my $path_label = $w->add("Label",
-relief => 'raised',
-text => $msg . " " . basename($path) . "?")->pack(-expand => 1, -fill => 'both');
my $button = $w->Show;
return unless $button eq 'OK';
unless (remove($path, $canvas, $list, \%size, $radius, $margin))
{
my $fail = $main->DialogBox(-title => "Failed Remove $path", -buttons => ["OK"]);
my $path_label = $fail->add("Label",
-relief => 'raised',
-text => "Could not remove " . basename($path))->pack(-expand => 1, -fill => 'both');
$fail->Show;
}
}
# ###########################################################################
# Change focus directory up one level, and redraw the display
#
sub cdup
{
my($dir, $canvas, $list, $radius, $margin) = @_;
$$dir =~ s%/[^/]+$%% if $$dir and $$dir ne '/';
redraw($dir, $canvas, $list, $radius, $margin);
}
# ###########################################################################
# Gather disk information again, and redisplay it
#
sub redraw
{
my($dir, $canvas, $list, $radius, $margin) = @_;
my $duhandle = start_du($$dir);
$waitmsg = "Re-reading disk data...";
$wait->Show;
$main->title("Disk usage of $$dir"); # Add title
$main->iconname($$dir); # name the icon
$waitmsg = "Reading data";
$wait->update;
$total = 0;
%size = du_data($duhandle, \$total, \$waitmsg);
close $duhandle;
$waitmsg = "Building display";
$wait->update;
$list->delete('all');
$canvas->delete('all');
build_piechart(\%size, $total, $canvas, $radius, $margin, $list);
$wait->unShow;
}
# ###########################################################################
# Enter show_details dialog from the directory browser
#
sub details
{
my($list, $canvas, $radius, $margin) = @_;
my $path = $list->info('anchor');
details_box($path, $canvas, $list, $radius, $margin)
}
# ###########################################################################
# If the selected element on the browser is a file, pop up a details box.
# If it is a directory, change focus directory into it
#
sub cd_or_details_browser
{
my($canvas, $list, $radius, $margin, $path) = @_;
cd_or_show_details($canvas, $$list, $radius, $margin, $path);
}
# ###########################################################################
# Format a number using k/M/G suffixes
#
sub fmt_num
{
my $n = $_[0];
return sprintf("%d Bytes", $n) if $n < 1024;
$n /= 1024;
return sprintf("%d kB", $n) if( ($n >= 1) && ($n <= 1000));
$n /= 1000;
return sprintf("%d MB", $n) if( ($n >= 1) && ($n <= 1000));
$n /= 1000;
return sprintf("%d GB", $n);
}
|
