#! /usr/bin/perl -w # Copyright (C) 2000 Stéphane Levant # This file is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2, or (at your option) # any later version. # This file is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # You should have received a copy of the GNU General Public License # along with GNU Emacs; see the file COPYING. If not, write to # the Free Software Foundation, Inc., 59 Temple Place - Suite 330, # Boston, MA 02111-1307, USA. # eval 'exec perl -S $0 ${1+"$@"}' # if $running_under_some_shell; # total = option # doc ANSI: http://en.wikipedia.org/wiki/ANSI_escape_code # ChangeLog: # 17-07-18 v0.38 add a -a option (already) # 10-05-12 v0.37 do not exit if a non readable directory is found # use high intensity color with -B option # 10-05-12 v0.36 add an option to use bold color # 10-05-05 v0.35 make the du option (-dh) to work with all options # 10-02-17 v0.34 make the du option (-dh) to work and add human total # adapt the length of the size zone # 10-02-14 v0.33 add options -z -M -P use strict; # our $foobar; my $VERSION=0.38; use Pod::Usage; use Getopt::Long; # Options my ($version,$man,$help,$use_color,$use_log,$limit_size,$bold); my ($percent,$reverse,$sort,$intel,$max_depth,$limit_percent); my ($recursive,$recursiveS,$file,$normal) = (0,0,0,0); # Murf adding already my ($already) = (0); my ($all, $h) = ('', ''); my $char = '_'; # The program name my $prog = $0; $prog =~ s:/.+/::; # The directories my %dir; my %sizes; # gives the size of the line for a given directory/file sub line { my ($size, $max) = @_; if ($use_log) { # abs prevent some precision errors return abs (1 - log(($size ? $size : 1)) / log($max)); } else { return (1 - $size / $max); } } # protect all char in a string sub protect { my ($string) = @_; $string =~ s:([^-a-zA-Z0-9/.]):\\$1:g; return $string; } # Use to sort by size sub subsort { return -1 if ($sizes{"$a"} < $sizes{"$b"}); return 1; } # Print an error message and exit sub error { my ($message) = @_; print STDERR "$prog: $message\n"; exit 2; } sub version { print "$prog $VERSION This is free software; see the source for copying conditions. There is NO warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. "; exit 0; } # Treat options Getopt::Long::Configure ("bundling"); GetOptions ( 'version|v' => \$version, 'normal|n' => \$normal, 'man|m' => \$man, 'max-depth|M=n' => \$max_depth, 'help|h|?' => \$help, 'nocolor|b' => \$use_color, 'bold|B' => \$bold, 'char|c=s' => \$char, 'log|l' => \$use_log, 'recursive|R' => \$recursive, 'recursive-S|S' => \$recursiveS, 'du|d:s' => \$h, 'percent|p' => \$percent, 'limit-percent|P=f' => \$limit_percent, 'limit-size|z=n' => \$limit_size, 'file|F' => \$file, 'reverse|r' => \$reverse, 'sort|s' => \$sort, 'intelligent|i' => \$intel, # Murf adding "already run" file 'already|a' => \$already, ) || pod2usage(2); pod2usage(1) if $help; pod2usage(-verbose => 2) if $man; version if ($version); error 'options -F -R -S and -n must be used separately' if ($recursive+$recursiveS+$file+$normal > 1); $h =~ s/[^bDhklLmx]//g if (!$normal); $h = $h ? "-$h" : ""; my $c = 1; # the color to display (1-6) my $max = 0; # the maximum size of a directory/file my $tot = 0; # the total size my %human; # A bad way to avoid division by zero my $min = 0.000001; $human{"T"} = 1024 ** 3; $human{"G"} = 1024 ** 2; $human{"M"} = 1024; $human{"K"} = 1; $human{"k"} = 1; # If there is only on arg which is a directory, # this content is displayed my $oneDir = 0; if (@ARGV == 1 && -d $ARGV[0]) { $oneDir = 1; chdir $ARGV[0]; $ARGV[0] =~ s:/$::; while ($ARGV[0] =~ s:/(\.)$::g) {} } # Constructs list of arguments my $args=""; for (my $i=0;$i<@ARGV;$i++) { $args=$args." ".protect($ARGV[$i]); } $args="." if ($args eq ""); # Constructs command # call to du is must faster than a perl function my $cmde; if ($normal) { if ($max_depth) { $h = "$h --max-depth=$max_depth" } $cmde="du $h -- $args"; # Murf adding already run file } elsif ($already) { $cmde="cat $args "; } elsif ($file) { my $find_max_depth=""; if ($max_depth) { $find_max_depth = "-maxdepth $max_depth"; } $cmde="find $args $find_max_depth -type f -print0 | xargs -0 du -s $h"; } elsif ($recursiveS) { if ($max_depth) { $h = "$h --max-depth=$max_depth" } $cmde="du -S $h -- $args"; } elsif ($recursive) { if ($max_depth) { $h = "$h --max-depth=$max_depth" } if (@ARGV == 0 || $oneDir) { $cmde="du $h -- $args ; du -sS $args "; } else { $cmde="du $h -- $args "; } } elsif ($oneDir || @ARGV == 0) { $cmde='for dir in */ .?*/; do [ ! "$dir" = ../ -a -d "$dir" -a ! -L "${dir%/}" ] && du -s '.$h.' -- "$dir"; done; du -sS '.$h.' .'; } else { $cmde="du -s $h -- $args"; } # Read du output my @nlist; my %kilosize; for (`$cmde`) { $_ =~ /^([0-9.,]+)([KMGT]?)[ \t]+([^ \t].*)\n/; my ($rsize, $unit, $file) = ($1, $2, $3); my $size = "$rsize$unit"; # replace , to . for foreign LC_ALL like french $rsize =~ s/,/./; $rsize = $rsize * $human{$unit} if ($unit); $sizes{"$file"} = $rsize; # printf "%-8s %-8s %s\n",$size,$rsize,$file; # if (@ARGV == 1 && $ARGV[0] !~ /^\.$/) { # $file = "$ARGV[0]/$file"; # } $dir{"$file"} = $size; $kilosize{"$file"} = $rsize; push @nlist, $file if ($normal); if ($rsize > $max) { $max = $rsize; } $tot += $rsize; } # dont exit if somes directories are not readable #exit ($?) if ($?); $max=$tot if $percent; $tot=$min if ($tot==0); $max=$min if ($max==0); # length of the size zone my $tot_length = length("$tot") + 1; $tot_length = 7 if ($h =~ /h/); #$tot_length = 7 if ($tot_length < 7); # Construct list of key (file name) my @keys; if ($sort) { @keys = sort subsort (keys %dir); @keys = reverse @keys if ($reverse); } else { if ($normal) { @keys = @nlist; } else { @keys = sort (keys %dir); } } # printing... my $linesize = 20; my $linesize2 = $linesize; $linesize2 += 8 if (!$use_color);# 8 = size of some special ascii form \033 $linesize2 += 6 if ($bold);# 8 = size of some special ascii form \033 my $line = $char x $linesize; # the line to display foreach my $key (@keys) { my $size=$dir{"$key"}; my $rsize=$kilosize{"$key"}; if ($intel) { $c = int(&line($rsize,$max) * 6 + 1.01); } else { $c = $c % 6 + 1; } # Print the line my ($c1, $c2, $c3) = ("", "", ""); if (!$use_color) { if ($bold) { $c1 = "\033[9${c};1m"; $c3 = "\033[0;10${c};9${c}m"; } else { $c1 = "\033[3${c}m"; $c3 = "\033[4${c}m"; } $c2 = "\033[m"; } my $print = 1; my $p = $rsize / $tot * 100; if ($limit_percent && $p < $limit_percent) { $print = 0; } if ($limit_size && $rsize < $limit_size) { $print = 0; } if ($print) { printf "$c1%${tot_length}s %${linesize2}s $c1%s$c2\n", $percent ? sprintf ("%.2f", $p) : $size, "$c3". substr($line, $linesize*&line($rsize,$max))."$c2","$key"; } } # Print the "Total" line if (! $normal) { # Need to calculate size for this case if ($recursive) { my @keys; @keys = sort (keys %sizes); my $old = ''; $tot = $sizes{shift @keys}; foreach my $key (@keys) { if ($old eq '' || index ($key, "$old/") == -1) { $tot += $sizes{"$key"}; $old = $key; } } } $tot=0 if ($tot==$min); # if total is given with human option if ($h =~ /h/) { my $htot = ""; if ($tot > $human{"T"}) { $htot = sprintf("%.2fT", $tot / $human{"T"}); } elsif ($tot > $human{"G"}) { $htot = sprintf("%.2fG", $tot / $human{"G"}); } elsif ($tot > $human{"M"}) { $htot = sprintf("%.2fM", $tot / $human{"M"}); } elsif ($tot > $human{"K"}) { $htot = sprintf("%.2fK", $tot / $human{"K"}); } else { $htot = sprintf("%.2f", $tot); } $tot = $htot; } if (!$use_color) { printf "\033[1m%${tot_length}s %20s Total\n\033[m", $percent ? "100.00" : $tot, ""; } else { printf "%${tot_length}s %20s Total\n", $percent ? "100.00" : $tot, ""; } } __END__ { =head1 NAME cdu - estimate file space usage =head1 SYNOPSIS B [I] [I] =head1 DESCRIPTION B reports the amount of disk space used by the specified I and display a color histogram. With no arguments, B reports the disk space for all subdirectories of the current directory. With only one directory argument, B reports the disk space for all subdirectories of the given directory. NB: B use the du command. =head1 OPTIONS =over 8 =item B<-a>, B<--already> FILE read the "du" ouptut from FILE. =item B<-b>, B<--nocolor> don't uses color. =item B<-B>, B<--bold> uses bold font and high intensity colors (only if color is activated). =item B<-c>, B<--char> I The character to use to display line. This character is visible when color isn't used. The default is '_'. =item B<-d>, B<--du> I