From: toivo@uniwa.uwa.edu.au (Toivo Pedaste)
Newsgroups: news.software.b
Subject: INN News expiry adjustment script (perl)
Date: 28 Sep 1992 17:32:38 +0800
Organization: The University of Westrn Australia
NNTP-Posting-Host: uniwa.uwa.edu.au

The purpose of this script is to adjust to expire.ctl file to 
attempt to mentain a constant ammount of free space on the
news partition.

The expire.ctl file is copied to expire.proto and the script
is run by cron each night before expire is run. It will
multiply all the values in expire.proto by a multiplier to
produce a new expire.clt. It keeps a record of the previous
multiplier it used in expire.adj and will vary this up or
down to try and mentain the correct ammount of free space.

The expire.adj file also contains records of how much the
last couple of adjustments of the multiplier affected the
free space and uses this to estimate if an adjustment is
required.

------------- cut here -----------------
#!/usr/local/bin/perl
#
# Adjust the expiry file to try and mentain a constant anmount
# of free space 
#                             Toivo Pedaste,
#                             toivo@ucs.uwa.edu.au
#
$wanted_free = 25;	#number of megabytes free space wanted
$min_scale = .5;	#minimum allowable scaling value
$max_scale = 5;		#maximum allowable scaling value
$change_max = 60;	#numbers above this value are not changed
$adjustment = 1.03;	#The fraction by which adjustment occurs
$min_free = 5;		#space below which to allways do an adjustment up

$initial_adj = 10;	#initial value for number of meg
			#corresponding to an adjustment
$top_adj = 50;          #assume ajustment will be no more than this

$spool_dir = "/usr/spool/news";      #the news spool directory
$lib_dir = "/usr/local/news";        #the news control directory

$df = '/bin/df';        #the df command

sub update_adj {
	open(a,">expire.adj.tmp") || die "cann`t open expire.adj.tmp:$!";
	$f_adjust = 1;
	if ($nscale != $scale) {
	printf a ("free %s/%s/%s %.0f\n",$mday,$mon,$year,$curr_free);
	}
	printf a ("scale %s/%s/%s %.2f\n",$mday,$mon,$year,$nscale);
	if (@adj) {
		for ($i=0; $i<3; $i++) {
			print a "inc ".shift(@date).' '.shift(@adj).' '.shift(@val)."\n";
		}
	} else {
		for ($i=0; $i<3; $i++) {
			print a "inc $mday/$mon/$year ".$initial_adj." 1\n";
		}
	}
	close(a);
}

sub do_df{

    open (df,"$df $_[0]|") || die "Cann't execute df";

#   note - sunos has 1 header line, ultrix has 2
    while (<df>) {
	$ln = $_;
    }

    ($dev,$tot,$used,$free) = split(' ',$ln);
    $free/1000;
}

$curr_free = &do_df("$spool_dir");

($sec,$min,$hour,$mday,$mon,$year) = localtime(time);
$mon++;

chdir $lib_dir;

($dev,$ino,$mode,$nlink,$uid,$rdev,$size,$atime,$ctime) = stat("expire.ctl");
($dev,$ino,$mode,$nlink,$uid,$rdev,$size,$atime,$pctime) = stat("expire.proto");


if (open(a,"expire.adj")) {
	while (<a>) {
		chop;
		($type,$sdate,$sadj,$sval) = split(' ');
		if ($type eq 'inc') {
			push(@date,$sdate);
			push(@adj,$sadj);
			push(@val,$sval);
		} elsif ($type eq 'scale') {
			$scale = $sadj; 
			($smday,$smon,$syear) = split(/\//,$sdate);
		} elsif ($type eq 'free') {
			$ofree = $sadj;
			$fdate = $sdate;
		}
	}
	close(a);
	if ($mday == $smday && $mon == $smon && $year == $syear) {
		die "Script already run today";
	}
	if ($fdate) {
		unshift(@date,$fdate);
		unshift(@adj,$curr_free - $ofree);
		unshift(@val,$scale);
	}
	$a0 = $adj[0];
	if ($a0 <0) { $a0 = $adj[0] * -1;}
	$a1 = $adj[1];
	if ($a1 <0) { $a1 = $adj[1] * -1;}
	$a2 = $adj[2];
	if ($a2 <0) { $a2 = $adj[2] * -1;}
	$diff = (4*$a0 + 2*$a1 + $a2)/7;
	if ($diff >$top_adj) {
	    $diff = $top_adj;
	}
} else {
	print "No expire.adj:$!\n";
	$diff = $initial_adj;
	$scale = 1;
	$init_adj = 1;
}

if (($curr_free - $wanted_free) > $diff) {	
	$nscale = $scale * $adjustment;
} elsif ((($wanted_free - $curr_free) > $diff) || ($curr_free < $min_free)) {
	$nscale = $scale / $adjustment;
} else {
	$nscale = $scale;
}
if ($nscale > $max_scale) {
	print "Scale $nscale > $max_scale, setting back to $max_scale\n";
	$nscale = $max_scale;
} elsif ($nscale < $min_scale) {
	print "Scale $nscale < $min_scale, setting back to $min_scale\n";
	$nscale = $min_scale;
}

if (($nscale != $scale) || ($pctime>$ctime)) {
	do update_adj();

	open(f,"expire.proto") || die "cann`t open expire.proto:$!";
	open(t,">expire.ctl.tmp") || die "cann`t open expire:$!";
	$f_expire = 1;

	while(<f>) {
	    chop;
	    ($group,$x,$f,$d,$l) = split(':');
	    if ($group =~ /^#/ || $group eq '' || $group eq '/remember/' || $group eq
		'/bounds/' || $d eq 'never') {
		print t "$_\n";
	    } else {
		if ($d < $change_max) {
		    $d = $d * $nscale;
		    $l = $l * $nscale;
		    $f = $f * $nscale;
		}
		print t "$group:$x:";
		if ($f > 0) {printf t ("%.1f:",$f);}
		printf t ("%.1f",$d);
		if ($l > 0) {printf t (":%.1f",$l);}
		print t "\n";
	    }
	}

	close(f);
	close(t);
	print "Updating: diff=$diff scale: $scale\>$nscale\n";
} elsif ($fdate || $init_adj) {
	do update_adj();
}			

if ($f_expire) {
	rename("expire.ctl","expire.ctl.old");
	if (rename("expire.ctl.tmp","expire.ctl")) {
		if (!rename("expire.adj.tmp","expire.adj")) {
			rename("expire.ctl.old","expire.ctl");
			die "Cannt rename expire.adj.tmp\n";
		}
	}
} elsif ($f_adjust) {
	rename("expire.adj.tmp","expire.adj") || die "Cannt rename expire.adj.tmp:$!\n";
}




-- 
 Toivo Pedaste                        Email:  toivo@ucs.uwa.oz.au
 University Computing Services,       Phone:  +61 9 380 2605
 University of Western Australia      Fax:    +61 9 380 1014

Newsgroups: news.software.b,news.software.nntp