Subject: du that doesn't traverse filesystems

From: [email-masked] (Wayne Thompson)
Date: 26 Dec 91 16:06:31 GMT

I wrote this one morning when I discovered that my root partition was full.
It is a du(1) clone(BSD) that only reports on directories/files on the same
filesystem as the root node.

The -h flag will display a non-*roff man page.

Wayne

#! /usr/bin/perl
#
#     @(#)dux,v1.1                      ([email-masked]) 12/16/91
#
$PATHNAME    = 'anywhere.EBay:/usr/local/bin/dux';
($MYNAME     = $0) =~ s|.*/||;
#
# Author:
#     Wayne Thompson
#
# Synopsis:
($usage = <<endusage) =~ s/^ *//;
      usage: $MYNAME [ -h ] [[ -s ] [ -a ] [ filename ... ]]
endusage
#
# Description:
#     Display the number of disk blocks used per directory or file
#     on same filesystem as the initial node.
#
# Options:
#     -h        print command description.
#     -s        Only display the grand total for each of the  specified
#               filenames.
#     -a        Generate an entry for each file.
#
#     Entries are generated only for each directory in the absence
#     of options.
#
# Environment:
#
# Files:
#
# Diagnostics:
#     Exit Status:
#         0     normal termination
#         1     abnormal termination
#
#     Errors (stderr):
#         usage
#
#     Warnings (stderr):
#
#     Info (stdout):
#
# Dependencies:
#
# Caveats:
#
# Bugs:
#

# >> BEGIN parse options >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> #

$flags = 1;
OPTION: for ($_ = 0; $_ <= $#ARGV; $_++) {
    CASE: {
        $ARGV[$_] eq '-h' && do {               # help
            seek(DATA, 0, 0);
            while (<DATA>) {
                exit if /^$/;
                next if /(^#!|running_under_some_shell)/;
                s/\$MYNAME/$MYNAME/o;
                chop;
                print(substr($_, 2), "\n") if /^[# ]/;
            }
        };

        $ARGV[$_] eq '-s' && do {               # silent
            $flags = 0;
            next OPTION;
        };

        $ARGV[$_] eq '-a' && do {               # all
            $flags |= 2;
            next OPTION;
        };

        $ARGV[$_] eq '--' && do {               # end of options
            splice(@ARGV, $_, 1);
            last OPTION;
        };

        $ARGV[$_] =~ /^-/ && do {               # unknown option
            die("$MYNAME: error: $ARGV[$_]: unknown option.\n$usage");
        };

        DEFAULT: {                              # end of options
            last OPTION;
        }
    }
}
splice(@ARGV, 0, $_);

# << END parse options <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< #

# >> BEGIN initialization >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> #

## >> BEGIN subroutine: Package >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> ##

# Subroutine:
#     Package
#
# Description:
#     This subroutine returns the current package namespace.
#
# Usage:
#     $current_package = &Package;
#
# Return:
#     Current package
#
# Dependencies:
#
# Bugs:
#

sub Package {
    (caller)[0];
}

## << END subroutine: Package <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< ##

## >> BEGIN subroutine: Du >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> ##

# Subroutine:
#     Du
#
# Description:
#     Display/return the number of disk blocks used per directory or
#         or file on same filesystem.
#
#     flagbits:
#         0 = print nothing.
#         1 = print directories.
#         2 = print files.
#         3 = print directories and files.
#
# Usage:
#     $size = &Du($flagbits, @filenames);
#
# Return:
#     size in 1k blocks
#
# Dependencies:
#
# Bugs:
#

sub Du {
    package Du;
    local($caller, $sub);
    eval('$MYNAME = "${' . ($caller = (caller)[0]) . '\'MYNAME}"');
    $MYNAME .= "'$sub" unless $caller eq ($sub = &'Package);

    local($bits, @nodes) = @_;
    local($dflg, $fflg) = ($bits&1, $bits&2);
    local(@dirents, $dirent, $path, $total, $node);

    for $node (@nodes) {
        $node =~ s|/+|/|g;
        if (opendir(DIR, $node)) {
            @dirents = readdir(DIR);
            closedir(DIR);
            $dev = $dev || (lstat($node))[0];
            for $dirent (@dirents) {
                next if (lstat($path = "$node/$dirent"))[0] != $dev || $dirent eq '..';
                if (-d $path && $dirent ne '.' && ! -l $path) {
                    $total += &'Du($bits, $path);
                }
                else {
                    $total += $size = (lstat($path))[12] / 2;
                    print "$size\t$path\n" if $fflg;
                }
            }
            print "$total\t$node\n" if $dflg;
        }
        else {
            $total += $size = (lstat($node))[12] / 2;
            print "$size\t$node\n" if $fflg;
        }
    }
    $total;
}

## << END subroutine: Du <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< ##

# << END initialization <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< #

# >> BEGIN main >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> #

for $arg (scalar(@ARGV) ? @ARGV : '.') {
    if ($flags) {
        &Du($flags, $arg);
    }
    else {
        print(&Du($flags, $arg), "\t$arg\n");
    }
}

# << END main <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< #

__END__