#!/usr/bin/perl
;#
;# Name: rotate-1.1
;#   Copyright (c) 1995, 1996 by Ikuo Nakagawa. All rights reserved.
;#
;# Author: Ikuo Nakagawa <ikuo@intec.co.jp>
;#
;# Last update: 1996/03/10
;#
;# History:
;#	1996/03/10 Replace `my' by 'local' for older perl(4.xxx)
;#	1995/10/13 Add options, `-z', `-Z' for compress old files.
;#	1995/06/22 Add some options, `-o', `-g', `-m' and so on.
;#	1995/06/10 First edition.
;#

;# get program name
($program) = ($0 =~ m%([^/]+)$%);

;# show usage and exit
sub usage {
	die "Usage: $program [options] path [suffix suffix ...]\n";
}

;# show debug log to STDOUT
sub debug {
	grep((print "$_\n"), @_) if $vflag;
}

;# default is "do"
$do = 1;

;# parsing options
while (@ARGV) {
	$_ = shift;
	s/^-// || do { $target = $_; last };
	$_ eq 'v' && do { $vflag = 1; next };
	$_ eq 'n' && do { $do = 0; $vflag = 1; next };
	$_ eq 'z' && do { $zcmd = 'gzip'; next };
	$_ eq 'Z' && do { $zcmd = 'compress'; next };
	$_ eq 'o' && @ARGV && do { $owner = shift; next };
	$_ eq 'g' && @ARGV && do { $group = shift; next };
	$_ eq 'm' && @ARGV && do { $mode = shift; next };
	&usage;
}

;# check target name
defined($target) || &usage;
&debug("rotating \"$target\"");

;# default suffix is 'old'
@ARGV = ('old') if @ARGV == 0;

;# remove oldest one
$y = $target.'.'.shift(@ARGV);
&safe_unlink($y);
&safe_unlink($y.'.Z');
&safe_unlink($y.'.gz');

;# loop to rotate files
while (@ARGV) {
	$x = $target.'.'.shift(@ARGV);
	&safe_rename($x, $y);
	&safe_rename($x.'.Z', $y.'.Z');
	&safe_rename($x.'.gz', $y.'.gz');
	$y = $x;
}

;# rotate last one
$x = $target;
&safe_rename($x, $y);
if ($zcmd) {
	if ($zcmd eq 'compress' && -z $y) { # compress fails in this case
		&debug("we don't compress zero-sized file: \"$y\"");
	} else {
		&debug("compressing \"$y\"");
		if ($do) {
			system $zcmd, $y;
			warn "system($zcmd, $y) returns $?\n" if $?;
		}
	}
}

;# touch to new one
&debug("touch \"$target\"");
if ($do) {
	open(FILE, '>>'.$target) || die "open($target): $!";
	close(FILE) || die "close($target): $!";
}

;# set owner and group
if (defined($owner) || defined($group)) {
	($uid, $gid) = (stat($target))[$[ + 4, $[ + 5];
	if (defined($owner)) {
		defined($uid = getpwnam($owner))
			|| die "getpwnam($owner): $!";
	}
	if (defined($group)) {
		defined($gid = getgrnam($group))
			|| die "getgrnam($group): $!";
	}
	&debug("chown $uid, $gid, \"$target\"");
	chown $uid, $gid, $target || die "chown($target): $!" if $do;
}

;# set file mode
if (defined($mode)) {
	$mode =~ /^\d+$/ || die "illegal mode: $mode\n";
	$mode = '0'.$mode if $mode !~ /^0/;
	$mode = eval $mode;
	die "eval: $@" if $@;
	&debug("chmod ".sprintf("%04o", $mode).", \"$target\"");
	chmod $mode, $target || die "chmod($target): $!" if $do;
}

;# normal terminate
exit;

;#
sub safe_unlink {
	local($x) = @_;

	if (-e $x) {
		&debug("unlink \"$x\"");
		unlink($x) || die "unlink($x): $!" if $do;
	}
}

;#
sub safe_rename {
	local($x, $y) = @_;

	if (-e $x) {
		&debug("rename \"$x\" to \"$y\"");
		rename($x, $y) || die "rename($x, $y): $!" if $do;
	}
}


syntax highlighted by Code2HTML, v. 0.9.1