Source Code 1992 March/Source_Code_CD-ROM_Walnut_Creek_March_1992.iso/usenet/altsrcs/2/2887

Internet Message Format | 1991-03-01 | 18.9 KB

From: [e-mail] (Johan Vromans)
Newsgroups: comp.lang.perl,alt.sources
Subject: dusage.pl (Was: Re: monitoring disk usage...)
Message-ID: <[e-mail]>
Date: 28 Feb 91 10:48:05 GMT

In article <[e-mail]> [e-mail] (Jon Allen Boone) writes:

   Not having recieved my copy of Programming perl yet, can anyone send me
   a program which will find the free space on mounted volumes (via df?),
   sort them (so that the output is the same regardless of machine run
   from), compare the free space left with the amount last reported (from
   the end of a file), return the percentage change (up or down) in disk
   usage for individual file systems, percentage change (up or down) in
   total disk usage, and report the raw amount (stdout & append to file
   mentioned earlier).

Reposting time ... (actually, this is an updated version).

Submitted-by: [e-mail]
Archive-name: dusage/part01

---- Cut Here and feed the following to sh ----
#!/bin/sh
# This is dusage, a shell archive (produced by shar 3.49)
# To extract the files from this archive, save it to a file, remove
# everything above the "!/bin/sh" line above, and type "sh file_name".
#
# made 02/28/1991 10:46 UTC by [e-mail]
# Source directory /u1/users/jv/src/dusage
#
# existing files WILL be overwritten
#
# This shar contains:
# length  mode       name
# ------ ---------- ------------------------------------------
#    278 -rw-r--r-- Makefile
#  10109 -r--r--r-- dusage.pl
#   5139 -r--r--r-- dusage.1
#    397 -rw-r--r-- dusage.ctl
#
# ============= Makefile ==============
echo 'x - extracting Makefile (Text)'
sed 's/^X//' << 'SHAR_EOF' > 'Makefile' &&
SHELL    = /bin/sh
SRC    = Makefile dusage.pl dusage.1 dusage.ctl
X
dusage:    dusage.ctl
X    cp dusage.pl dusage
X    chmod 0755 dusage
X
install:    dusage
X    install -c -m 0755 dusage /usr/local/bin/dusage
X
DOMAIN    = .mh.nl
shar:
X    shar -acxf -ndusage -sjv@`hostname`$(DOMAIN) -o dusage.shar $(SRC)
SHAR_EOF
chmod 0644 Makefile ||
echo 'restore of Makefile failed'
Wc_c="`wc -c < 'Makefile'`"
test 278 -eq "$Wc_c" ||
    echo 'Makefile: original size 278, current size' "$Wc_c"
# ============= dusage.pl ==============
echo 'x - extracting dusage.pl (Text)'
sed 's/^X//' << 'SHAR_EOF' > 'dusage.pl' &&
#!/usr/bin/perl
#
# dusage.pl -- gather disk usage statistics
# SCCS Status     : @(#)@ dusage    1.9
# Author          : Johan Vromans
# Created On      : Sun Jul  1 21:49:37 1990
# Last Modified By: Johan Vromans
# Last Modified On: Tue Feb 19 16:41:23 1991
# Update Count    : 3
# Status          : OK
#
# This program requires perl version 3.0, patchlevel 12 or higher.
#
# Copyright 1990,1991 Johan Vromans, all rights reserved.
# This program may be used, modified and distributed as long as
# this copyright notice remains part of the source. It may not be sold, or
# be used to harm any living creature including the world and the universe.
X
$my_name = $0;
X
################ usage ################
X
sub usage {
X  local ($help) = shift (@_);
X  local ($usg) = "usage: $my_name [-afghruD][-i input][-p dir] ctlfile";
X  die "$usg\nstopped" unless $help;
X  print STDERR "$usg\n";
X  print STDERR <<EndOfHelp
X
X    -D          - provide debugging info
X    -a          - provide all statis
X    -f          - also report file statistics
X    -g          - gather new data
X    -h          - this help message
X    -i input    - input data as obtained by 'du dir' [def = 'du dir']
X    -p dir      - path to which files in the control file are relative
X    -r          - do not discard entries which don't have data
X    -u          - update the control file with new values
X    ctlfile     - file which controls which dirs to report [def = dir/.du.ctl]
EndOfHelp
X  ;
X  exit 1;
}
X
################ main stream ################
X
&do_get_options;        # process options
&do_parse_ctl;            # read the control file
&do_gather if $gather;        # gather new info
&do_report_and_update;        # report and update
X
################ end of main stream ################
X
################ other subroutines ################
X
sub do_get_options {
X
X  # Default values for options
X
X  $debug = 0;
X  $noupdate = 1;
X  $retain = 0;
X  $gather = 0;
X  $allfiles = 0;
X  $allstats = 0;
X
X  # Command line options. We use a modified version of getopts.pl.
X
X  do "getopts.pl" || die "Cannot load getopts.pl, stopped";
X  die $@ if $@;
X
X  &usage (0) if !&Getopts ("Dafghi:p:ru");
X  &usage (1) if $opt_h;
X  &usage (0) if $#ARGV > 0;
X
X  $debug    |= $opt_D if defined $opt_D;    # -D -> debug
X  $allstats |= $opt_a if defined $opt_a;    # -a -> all stats
X  $allfiles |= $opt_f if defined $opt_f;    # -f -> report all files
X  $gather   |= $opt_g if defined $opt_g;    # -g -> gather new data
X  $retain   |= $opt_r if defined $opt_r;    # -r -> retain old entries
X  $noupdate = !$opt_u if defined $opt_u;    # -u -> update the control file
X  $du        = $opt_i if defined $opt_i;    # -i input file
X  if ( defined $opt_p ) {            # -p path
X    $root = $opt_p;
X    $root = $` while ($root =~ m|/$|);
X    $prefix = "$root/";
X    $root = "/" if $root eq "";
X  }
X  else {
X    $prefix = $root = "";
X  }
X  $table    = ($#ARGV == 0) ? shift (@ARGV) : "$prefix.du.ctl";
X  $runtype = $allfiles ? "file" : "directory";
X  if ($debug) {
X    print STDERR "@(#)@ dusage    1.9 - dusage.pl\n";
X    print STDERR "Options:";
X    print STDERR " debug" if $debug;    # silly, isn't it...
X    print STDERR $noupdate ? " no" : " ", "update";
X    print STDERR $retain ? " " : " no", "retain";
X    print STDERR $gather ? " " : " no", "gather";
X    print STDERR $allstats ? " " : " no", "allstats";
X    print STDERR "\n";
X    print STDERR "Root = $root [prefix = $prefix]\n";
X    print STDERR "Control file = $table\n";
X    print STDERR "Input data = $du\n" if defined $du;
X    print STDERR "Run type = $runtype\n";
X    print STDERR "\n";
X  }
}
X
sub do_parse_ctl {
X
X  # Parsing the control file.
X  #
X  # This file contains the names of the (sub)directories to tally,
X  # and the values dereived from previous runs.
X  # The names of the directories are relative to the $root.
X  # The name may contain '*' or '?' characters, and will be globbed if so.
X  # An entry starting with ! is excluded.
X  #
X  # To add a new dir, just add the name. The special name '.' may
X  # be used to denote the $root directory. If used, '-p' must be
X  # specified.
X  #
X  # Upon completion:
X  #  - %oldblocks is filled with the previous values,
X  #    colon separated, for each directory.
X  #  - @targets contains a list of names to be looked for. These include
X  #    break indications and globs info, which will be stripped from
X  #    the actual search list.
X
X  open (tb, "<$table") || die "Cannot open control file $table, stopped";
X  @targets = ();
X  %oldblocks = ();
X  %newblocks = ();
X
X  while ($tb = <tb>) {
X    chop ($tb);
X
X    # preferred syntax: <dir><TAB><size>:<size>:....
X    # allowable          <dir><TAB><size> <size> ...
X    # possible          <dir>
X
X    if ( $tb =~ /^-/ ) {    # break
X      push (@targets, "$tb");
X      printf STDERR "tb: *break* $tb\n" if $debug;
X      next;
X    }
X
X    if ( $tb =~ /^!/ ) {    # exclude
X      $excl = $';        #';
X      @a = grep ($_ ne $excl, @targets);
X      @targets = @a;
X      push (@targets, "*$tb");
X      printf STDERR "tb: *excl* $tb\n" if $debug;
X      next;
X    }
X
X    if ($tb =~ /^(.+)\t([\d: ]+)/) {
X      $name = $1;
X      @blocks = split (/[ :]/, $2);
X    }
X    else {
X      $name = $tb;
X      @blocks = ("","","","","","","","");
X    }
X
X    if ($name eq ".") {
X      if ( $root eq "" ) {
X    printf STDERR "Warning: \".\" in control file w/o \"-p path\" - ignored\n";
X    next;
X      }
X      $name = $root;
X    } else {
X      $name = $prefix . $name unless ord($name) == ord ("/");
X    }
X
X    # Check for globs ...
X    if ( $gather && $name =~ /\*|\?/ ) {
X      print STDERR "glob: $name\n" if $debug;
X      foreach $n ( <${name}> ) {
X    next unless $allfiles || -d $n;
X    # Globs never overwrite existing entries
X    if ( !defined $oldblocks{$n} ) {
X      $oldblocks{$n} = ":::::::";
X      push (@targets, $n);
X    }
X    printf STDERR "glob: -> $n\n" if $debug;
X      }
X      # Put on the globs list, and terminate this entry
X      push (@targets, "*$name");
X      next;
X    }
X
X    push (@targets, "$name");
X    # Entry may be rewritten (in case of globs)
X    $oldblocks{$name} = join (":", @blocks[0..7]);
X
X    print STDERR "tb: $name\t$oldblocks{$name}\n" if $debug;
X  }
X  close (tb);
}
X
sub do_gather {
X
X  # Build a targets match string, and an optimized list of directories to
X  # search.
X  $targets = "//";
X  @list = ();
X  $last = "///";
X  foreach $name (sort (@targets)) {
X    next if $name =~ /^[-*]/;
X    next unless $allfiles || -d $name;
X    $targets .= "$name//";
X    next if ($name =~ m|^$last/|);
X    push (@list, $name);
X    ($last = $name) =~ s/(\W)/\\$1/g; # protect regexp chars in dir names
X  }
X
X  print STDERR "targets: $targets\n" if $debug;
X  print STDERR "list: @list\n" if $debug;
X  print STDERR "reports: @targets\n" if $debug;
X
X  $du = "du " . ($allfiles ? "-a" : "") . " @list|"
X    unless defined $du; # in which case we have a data file
X
X  # Process the data. If a name is found in the target list,
X  # %newblocks will be set to the new blocks value.
X
X  open (du, "$du") || die "Cannot get data from $du, stopped";
X  while ($du = <du>) {
X    chop ($du);
X    ($blocks,$name) = split (/\t/, $du);
X    if (($i = index ($targets, "//$name//")) >= 0) {
X      # tally and remove entry from search list
X      $newblocks{$name} = $blocks;
X      print STDERR "du: $name $blocks\n" if $debug;
X      substr ($targets, $i, length($name) + 2) = "";
X    }
X  }
X  close (du);
}
X
X
# Report generation
X
format std_hdr =
Disk usage statistics@<<<<<<<<<<<<<<<<<<<<<@<<<<<<<<<<<<<<<
$subtitle, $date
X
X blocks    +day     +week  @<<<<<<<<<<<<<<<
$runtype
-------  -------  -------  --------------------------------
.
format std_out =
@>>>>>> @>>>>>>> @>>>>>>>  ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<..
$blocks, $d_day, $d_week, $name
.
X
format all_hdr =
Disk usage statistics@<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<           @<<<<<<<<<<<<<<<
$subtitle, $date
X
X --0--    --1--    --2--    --3--    --4--    --5--    --6--    --7--   @<<<<<<<<<<<<<<<
$runtype
-------  -------  -------  -------  -------  -------  -------  -------  --------------------------------
.
format all_out =
@>>>>>> @>>>>>>> @>>>>>>> @>>>>>>> @>>>>>>> @>>>>>>> @>>>>>>> @>>>>>>>  ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<..
$a[0],  $a[1],   $a[2],   $a[3],   $a[4],   $a[5],   $a[6],   $a[7],    $name
.
X
sub do_report_and_update {
X
X  # Prepare update of the control file
X  if ( !$noupdate ) {
X    if ( !open (tb, ">$table") ) {
X      print STDERR "Warning: cannot update control file $table - continuing\n";
X      $noupdate = 1;
X    }
X  }
X
X  if ( $allstats ) {
X    $^ = "all_hdr";
X    $~ = "all_out";
X  }
X  else {
X    $^ = "std_hdr";
X    $~ = "std_out";
X  }
X  $date = `date`;
X  chop ($date);
X
X  # In one pass the report is generated, and the control file rewritten.
X
X  foreach $name (@targets) {
X    if ($name =~ /^-/ ) {
X      $subtitle = $';                #';
X      print tb "$name\n" unless $noupdate;
X      print STDERR "tb: $name\n" if $debug;
X      $- = -1;
X      next;
X    }
X    if ($name  =~ /^\*$prefix/ ) {
X      print tb "$'\n" unless $noupdate;        #';
X      print STDERR "tb: $'\n" if $debug;    #';
X      next;
X    }
X    @a = split (/:/, $oldblocks{$name});
X    unshift (@a, $newblocks{$name}) if $gather;
X    $name = "." if $name eq $root;
X    $name = $' if $name =~ /^$prefix/;        #';
X    print STDERR "Warning: ", 1+$#a, " entries for $name\n"
X      if ($debug && $#a != 8);
X
X    # check for valid data
X    $try = join(":",@a[0..7]);
X    if ( $try eq ":::::::") {
X      if ($retain) {
X    @a = ("","","","","","","","");
X      }
X      else {
X    # Discard
X    print STDERR "--: $name\n" if $debug;
X    next;
X      }
X    }
X
X    $line = "$name\t$try\n";
X    print tb $line unless $noupdate;
X    print STDERR "tb: $line" if $debug;
X
X    $blocks = $a[0];
X    if ( !$allstats ) {
X      $d_day = $d_week = "";
X      if ($blocks ne "") {
X    if ($a[1] ne "") {        # dayly delta
X      $d_day = $blocks - $a[1];
X      $d_day = "+" . $d_day if $d_day > 0;
X    }
X    if ($a[7] ne "") {        # weekly delta
X      $d_week = $blocks - $a[7];
X      $d_week = "+" . $d_week if $d_week > 0;
X    }
X      }
X    }
X    write;
X  }
X
X  # Close control file, if opened
X  close (tb) unless $noupdate;
}
X
# Emacs support
# Local Variables:
# mode:perl
# eval:(headers)
# End:
SHAR_EOF
chmod 0444 dusage.pl ||
echo 'restore of dusage.pl failed'
Wc_c="`wc -c < 'dusage.pl'`"
test 10109 -eq "$Wc_c" ||
    echo 'dusage.pl: original size 10109, current size' "$Wc_c"
# ============= dusage.1 ==============
echo 'x - extracting dusage.1 (Text)'
sed 's/^X//' << 'SHAR_EOF' > 'dusage.1' &&
.TH DUSAGE 1
.SH NAME
dusage \- provide disk usage statistics
.SH SYNOPSIS
.B dusage
.RB [ \-afghruD ]
.RI "[\fB\-i\fR" " input" ]
.RI "[\fB\-p\fR" " dir" ]
.RI [ "control file" ]
.SH DESCRIPTION
.I Dusage
is a perl script which produces disk usage statistics. These
statistics include the number of blocks, the increment since the previous run
(which is assumed to be yesterday if run daily), and the increment
since 7 runs ago (which could be interpreted as a week if run daily).
.I Dusage
is driven by a
.IR "control file" ,
which describes the names of the files (directories) to be reported,
and which also contains the results of previous runs.
.PP
When
.I dusage
is run, it reads the
.IR "control file" ,
[optionally] gathers new disk usage values by calling
.IR du (1),
prints the report, and [optionally] updates the
.I control file
with the new information.
.PP
Filenames in the control file may have wildcards. In this case, the
wildcards are expanded, and all entries reported. Both the expanded
names as the wildcard info are maintained in the control file. New
files in these directories will automatically show up, deleted files
will disappear when they have run out of data in the control file (but
see the
.B \-r
option).
.br
Wildcard expansion only adds filenames which are not already on the list.
.PP
The control file may also contain filenames preceded with an
exclamation mark ``!''; these entries are skipped. This is meaningful
in conjunction with wildcards, to exclude entries which result from a
wildcard expansion.
.PP
The control file may have lines starting with a dash ``\-'',
which causes the report to start on a new page. Any text following the
dash is placed in the page header, immediately following the text
``Disk usage statistics''.
.PP
The available command line options are:
.TP 5
.B \-D
Turns on debugging, which yields lots of trace information.
.TP
.B \-a
Reports the statistics for this and all previous runs, as opposed to
the normal case, which is to generate the statistics for this run, and
the differences between the previous and 7th previous run.
.TP
.B \-f
Reports file statistics also. Default is to only report directories.
.TP
.B \-g
Gathers new data by calling
.IR du (1).
.TP
.B \-h
Provides a help message. No work is done.
.TP
.BI \-i " input"
Uses
.I input
as data obtained by calling
.IR du (1).
.TP
.BI \-p " dir"
All filenames in the control file are interpreted relative to this
directory.
.TP
.B \-r
Retains entries which don't have any data anymore. If this option is
not used, entries without data are not reported, and removed from the
control file.
.TP
.B \-u
Update the control file with new values.
.PP
The default name for the control file is
.BR .du.ctl ,
optionally preceded by the name supplied with the
.B \-p
option.
.SH EXAMPLES
Given the following control file:
.sp
.nf
.ne 3
.in +.5i
\- for manual page
maildir
maildir/*
!maildir/unimportant
src
.in
.fi
.sp
This will generate the following (example) report when running the
command ``dusage -gu controlfile'':
.sp
.nf
.ne 7
.in +.5i
Disk usage statistics for manual page      Wed Jan 10 13:38
X
X blocks    +day     +week  directory
-------  -------  -------  --------------------------------
X   6518                    maildir
X      2                    maildir/dirent
X    498                    src
.in
.fi
.sp
After updating the control file, it will contain:
.sp
.nf
.ne 4
.in +.5i
\- for manual page
maildir 6518::::::
maildir/dirent  2::::::
maildir/*
!maildir/unimportant
src     498::::::
.in
.fi
.sp
The names in the control file are separated by the values with a TAB;
the values are separated with colons. Also, the entries found by
expanding the wildcard are added. If the wildcard expansion had
generated a name ``maildir/unimportant'' it would have been skipped.
.br
When the program is rerun after one day, it could print the following
report:
.sp
.nf
.ne 7
.in +.5i
Disk usage statistics for manual page      Wed Jan 10 13:38
X
X blocks    +day     +week  directory
-------  -------  -------  --------------------------------
X   6524       +6           maildir
X      2        0           maildir/dirent
X    486      -12           src
.in
.fi
.sp
The control file will contain:
.sp
.nf
.ne 4
.in +.5i
\- for manual page
maildir 6524:6518:::::
maildir/dirent  2:2:::::
maildir/*
!maildir/unimportant
src     486:498:::::
.in
.fi
.sp
It takes very little fantasy to imagine what will happen on subsequent
runs...
.PP
When the contents of the control file are to be changed, e.g. to add
new filenames, a normal text editor can be used. Just add or remove
lines, and they will be taken into account automatically.
.PP
When run without
.B \-g
or
.B \-u
options, it actually reproduces the report from the previous run.
.PP
When multiple runs are required, save the output of
.IR du (1)
in a file, and pass this file to
.I dusage
using the
.BI \-i "file"
option.
.SH BUGS
Running the same control file with different values of the
.B \-f
and
.B \-r
options may cause strange results.
.SH AUTHOR
Johan Vromans, Multihouse Research, Gouda, The Netherlands.
.sp
Send bugs and remarks to <[e-mail]> .
SHAR_EOF
chmod 0444 dusage.1 ||
echo 'restore of dusage.1 failed'
Wc_c="`wc -c < 'dusage.1'`"
test 5139 -eq "$Wc_c" ||
    echo 'dusage.1: original size 5139, current size' "$Wc_c"
# ============= dusage.ctl ==============
echo 'x - extracting dusage.ctl (Text)'
sed 's/^X//' << 'SHAR_EOF' > 'dusage.ctl' &&
- for /usr/spool
/usr/spool/batch    2:2:2:2:2:2:2:2
/usr/spool/cron    16:16:16:16:16:16:16:16
/usr/spool/locks    2:2:2:2:2:2:2:2
/usr/spool/lp    570:570:570:570:570:244:240:238
/usr/spool/mqueue    2:2:2:2:2:2:2:2
/usr/spool/news    2:2:2:2:2:2:2:2
/usr/spool/rwho    20:20:20:20:20:20:20:20
/usr/spool/uucp    3188:2964:3484:2836:2890:2222:2128:2072
/usr/spool/uucppublic    14:14:16:16:16:16:16:16
!/usr/spool/oldnews
SHAR_EOF
chmod 0644 dusage.ctl ||
echo 'restore of dusage.ctl failed'
Wc_c="`wc -c < 'dusage.ctl'`"
test 397 -eq "$Wc_c" ||
    echo 'dusage.ctl: original size 397, current size' "$Wc_c"
exit 0
--
Johan Vromans                       [e-mail] via internet backbones
Multihouse Automatisering bv               uucp: ..!{uunet,hp4nl}!mh.nl!jv
Doesburgweg 7, 2803 PL Gouda, The Netherlands  phone/fax: [phone]/62500
------------------------ "Arms are made for hugging" -------------------------