chart,representing,disk,usage,directory
Quick Search for:  in language:    
chart,representing,disk,usage,directory
   Code/Articles » |  Newest/Best » |  Community » |  Jobs » |  Other » |  Goto » | 
CategoriesSearch Newest CodeCoding ContestCode of the DayAsk A ProJobsUpload
Perl Stats

 Code: 56,870 lines
 Jobs: 87 postings

 
Sponsored by:

 

You are in:

 
Login



Latest Code Ticker for Perl.
[[ A import of any database from any server to your site.
By Pamela RAI on 10/25


imgLeech
By Benjamin Tilley on 10/23


Even Odd Guessing Game
By Jason DeLuca on 10/15


Include Function
By -Oz on 10/13


Click here to put this ticker on your site!


Add this ticker to your desktop!


Daily Code Email
To join the 'Code of the Day' Mailing List click here!





Affiliate Sites



 
 
   

Disk Usage Pie Chart

Print
Email
 
VB icon
Submitted on: 7/30/2000 12:51:50 AM
By: Found on the World Wide Web 
Level: Intermediate
User Rating: By 2 Users
Compatibility:5.0 (all versions), Active Perl specific, 4.0 (all versions), 3.0 (all versions)

Users have accessed this code 6700 times.
 
 
     pie chart representing disk usage for a directory
 
code:
Can't Copy and Paste this?
Click here for a copy-and-paste friendly version of this code!

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


Other 103 submission(s) by this author

 

 
Report Bad Submission
Use this form to notify us if this entry should be deleted (i.e contains no code, is a virus, etc.).
Reason:
 
Your Vote!

What do you think of this code(in the Intermediate category)?
(The code with your highest vote will win this month's coding contest!)
Excellent  Good  Average  Below Average  Poor See Voting Log
 
Other User Comments

 There are no comments on this submission.
 
Add Your Feedback!
Note:Not only will your feedback be posted, but an email will be sent to the code's author in your name.

NOTICE: The author of this code has been kind enough to share it with you.  If you have a criticism, please state it politely or it will be deleted.

For feedback not related to this particular code, please click here.
 
Name:
Comment:

 

Categories | Articles and Tutorials | Advanced Search | Recommended Reading | Upload | Newest Code | Code of the Month | Code of the Day | All Time Hall of Fame | Coding Contest | Search for a job | Post a Job | Ask a Pro Discussion Forum | Live Chat | Feedback | Customize | Perl Home | Site Home | Other Sites | About the Site | Feedback | Link to the Site | Awards | Advertising | Privacy

Copyright© 1997 by Exhedra Solutions, Inc. All Rights Reserved.  By using this site you agree to its Terms and Conditions.  Planet Source Code (tm) and the phrase "Dream It. Code It" (tm) are trademarks of Exhedra Solutions, Inc.