#!/usr/local/bin/perl
#
# mklabel 2.0 - Sun Jun 20 22:01:24 EDT 1993
#
# new and improved perl version of mklabel b ward, http://www.o--o.net/
# perhaps I did this because heron.mcs.anl.gov was down and I had no
# J Machine work to do, because the J files are there, but you never know.
# I mean, I must be a masochist or something for writing this dumb program.
#
# there is only one option: -f(filename)
#

$version = "2.0";

($file, $org1, $org2, $tape_type) =
    ("label.ps",
     "Penn State University Math Department",
     "Computing Systems Group",
     "BACKUP TAPE");

$machine = `hostname`;
chop $machine;		# someone should do this to anagram.mcs.anl.gov
$level = "0";
$preview = "gs";
$lpr = "lpr";
$num_dumps = 0;
@dump_l = ();
$idiotic = 0;
$verbose = 1;

sub show_help {
print <<"DONE-HELP";
mklabel v$version written by Brian Ward (http://www.o--o.net/)
 command	what it does 	(commands can be abbreviated)

 new		start a new label, zinging any existing thing
 insert	[n]	insert some entries before entry [n]
 delete	[n]	delete entry [n]
 add		add some more entries to the end of the label
 change	[n]	change entry [n]
 side		change date and level-of-dump information
 stat		show current working label
 preview	attempt to preview with $preview
 lpr		print out the label (with $lpr)
 file [fn]      change name of output file [to fn], or if [fn] begins
		with ! or |, it will be piped to the command [fn]
 idiot		toggle idiotic temporary files on/off. some commands for
		[fn] (above) want those things. (sigh)
 output, save	write output file or pipe to command
 help, ?	this stupid listing

anything between a [ ] above will be prompted for, if omitted.

DONE-HELP
}

($sec, $min, $hour, $mday, $month, $year, $wday, $yday, $isdst)
 = localtime(time);     # yeah, I need that stuff

@DoW = ("Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat");
@MoY = ('Jan','Feb','Mar','Apr','May','Jun',	# need that, too..
	'Jul','Aug','Sep','Oct','Nov','Dec'); 

($day, $amonth) = ($mday, $MoY[$month]);

@arg_vec = reverse(@ARGV);	# not too bad...

format STDOUT_TOP =
file no machine name      raw device     mount point                size(MB)
------- ----------------- -------------- -------------------------- ---------
.

format STDOUT =
@###    @<<<<<<<<<<<<<<<< @<<<<<<<<<<<   @<<<<<<<<<<<<<<<<<<<<<<   @#####.##
$c_num  $c_name          $c_dev          $c_mp     $c_size
.

sub match_cmd {
	local($cmd,$typed) = @_;
	$typed && return($typed eq substr($cmd, 0, length($typed)));
}

if (@arg_vec) {
	while (@arg_vec) {
		$cur_cmd = pop(@arg_vec); # take "compressed" options
		$cur_option = substr($cur_cmd,0,2);
		if (substr($cur_option,0,1) eq ";") {
			die $0, ": Invalid option: ", $cur_option, "\n";
		} elsif ($cur_option eq "-f") {
			$file = substr($cur_cmd,2,length($cur_cmd)-2);
			if (!$file) {
				die $0, ": Null files are not allowed.\n";
				# don't pull this one on me
			}
			$cur_cmd = "";
		} else {
			die $0, ": Invalid option: ", $cur_option, "\n";
		}
		$new_option = "-" . substr($cur_cmd,2,length($cur_cmd)-2);
		if ($new_option ne "-") {
			push(@arg_vec,$new_option);
		}
	}	
}

sub readln {
	local($prompt, $def_val) = @_;
	print "$prompt";
	while (<STDIN>) {
		chop;
		s/\s*//g;
		$user_s = $_;
		last;
	}
	if (!$user_s && $def_val) {
		$user_s = $def_val;
	}
	return $user_s;
}

&print_stats;

$verbose && print "mklabel> ";

while (<STDIN>) {
	chop;
	$typed = $_;
	@cmd = split(/\s+/,$typed);

	if (&match_cmd("new",$typed)) {
		&mk_newlabel;
	} elsif (&match_cmd("side",$typed)) {
		&ch_lhead;
	} elsif (&match_cmd("add",$typed)) {
		if (!$num_dumps) {
			&mk_newlabel;
		} else {
			($nd, @new_stuff) = &take_some_dumps;
			@dump_l = (@dump_l, @new_stuff);
			$num_dumps += $nd;
		}
	} elsif (&match_cmd("delete",$cmd[0])) {
		# i'm sorry it had to come to this
		if ($cmd[1] eq "") {
			&print_stats;
			&zing_dump(&readln("\nwhich one do you want to zap? "));
		} else {
			&zing_dump($cmd[1]);
		}
	} elsif (&match_cmd("insert",$cmd[0])) {
		if ($cmd[1] eq "") {
			&print_stats;
			&insert_dump(&readln("\ninsert before which? "));
		} else {
			&insert_dump($cmd[1]);
		}
	} elsif (&match_cmd("change",$cmd[0])) {
		if ($cmd[1] eq "") {
			&print_stats;
			&change_dump(&readln("\nchange which one? "));
		} else {
			&change_dump($cmd[1]);
		}
	} elsif (&match_cmd("file",$cmd[0])) {
		if (!$cmd[1]) {
			$file = &readln("New filename [$file]: ", $file);
		} else {
			$file = $cmd[1];
		}
	} elsif (&match_cmd("idiotic",$typed)) {
		$idiotic = !$idiotic;
		if ($idiotic) {
			print "idiotic mode on.\n";
		} else {
			print "idiotic mode off.\n";
		}
	} elsif (&match_cmd("preview",$typed)) {
		($oi, $of) = ($idiotic, $file);
		($idiotic, $file) = (1, "!$preview");
		&do_output;
		($idiotic, $file) = ($oi, $of);
	} elsif (&match_cmd("lpr",$typed)) {
		($oi, $of) = ($idiotic, $file);
		($idiotic, $file) = (0, "!$lpr");
		&do_output;
		($idiotic, $file) = ($oi, $of);
	} elsif (&match_cmd("output",$typed) || &match_cmd("save",$typed)) {
		&do_output;
	} elsif (&match_cmd("stat",$typed)) {
		&print_stats;
	} elsif (&match_cmd("quit",$typed)) {
		$verbose && print "byebye.. thanks for quitting..\n";
		exit(0);
	} elsif (&match_cmd("help",$typed) || &match_cmd("?",$typed)) {
		&show_help;
	} elsif ($typed eq "") {} 	# twiddle thumbs impatiently
	else {
		print "you typed something I didn\'t like, understand, or much less care about.\n";
	}

	$verbose && print "mklabel> ";	# pretty boring prompt
}

$verbose && print "\neeks! byebye..\n";	# zoiks! EOF!

sub mk_newlabel {
	#this somehow got really short
	&ch_lhead;
	($num_dumps, @dump_l) = &take_some_dumps;
}

sub ch_lhead {
	$day   = &readln("day of dump [$day]: ", $day);
	$amonth = &readln("dump [$amonth]: ", $amonth);
	$year  = &readln("year of dump [$year]: ", $year);
	$level = &readln("level of dump [$level]: ", $level);

	# now THIS is really, really dumb. sigh!
	if (!$level) {
		$level = "0";
	}
}

sub take_some_dumps {
	@d_l = ();
	$n_dumps = 0;
	while (1) {
		$machine = &readln("machine name [$machine]: ", $machine);
		$device = &readln("raw device: ");
		$mount_point = &readln("mount point: ");
		$size_fs = &readln("filesystem size: ");
		$d_l[$n_dumps++] =
		     join("::",$machine,$device,$mount_point,$size_fs);
		if (&readln("another one [y]? ") eq "n") {
			last;
		}
	}
	return ($n_dumps, @d_l);
}

sub print_stats {
	print "file = $file, org = $org1, $org2, tape = $tape_type\n";
 	print "$day $amonth $year - level $level\n";
	$- = 0;
	$c_num = 0;
	foreach $d_entry (@dump_l) {
		($c_name, $c_dev, $c_mp, $c_size) = 
			split("::",$d_entry);
		write;
		$c_num++;
	}
}

sub zing_dump {
	local($dead_meat) = @_;
	if ($dead_meat < 0 || $dead_meat > $num_dumps) {
		print "file $dead_meat is out of range.\n";
	} else {
		$num_dumps--;
		splice(@dump_l, $dead_meat, 1);
	}
}

sub insert_dump {
	local($before_this) = @_;
	if ($before_this < 0 || $before_this > $num_dumps) {
		print "file $before_this is out of range.\n";
	} else {
		($nd, @new_dumps) = &take_some_dumps;
		splice(@dump_l, $before_this, 0, @new_dumps);
		$num_dumps += $nd;
	}
}

sub change_dump {
	local($dump) = @_;
	if ($dump < 0 || $dump > $num_dumps) {
		print "file $dump is out of range.\n";
	} else {
		($machine, $device, $mount_point, $size_fs) =
		    split("::",$dump_l[$dump]);
		$machine = &readln("machine name [$machine]: ", $machine);
		$device = &readln("raw device [$device]: ", $device);
		$mount_point = &readln("mount point [$mount_point]: ",
		    $mount_point);
		$size_fs = &readln("filesystem size [$size_fs]: ", $size_fs);
		$dump_l[$dump] =
		    join("::",$machine,$device,$mount_point,$size_fs);
	}
}

sub do_output {
	if ($file =~ m/^[!|]/) {
		$is_command = 1;
		if ($idiotic) {
			$ofile = "/tmp/mklabel.$$";
			$out_file = ">$ofile";
			$cmd = $file;
			$cmd =~ s/^.//;
		} else {
			$file =~ s/^./|/;
			$out_file = "$file";
		}
	} else {
		$is_command = 0;
		$out_file = ">$file";
	}
	open (FD, "$out_file");
	print FD <<"DONE-PS";
%!
%
% This program is output of a small perl program written by Brian Ward
% (http://www.o--o.net/) when his fileserver was down so he couldn't get
% any "real" work done. Sigh.
%
% So send lots of money to him. He's probably broke.
% (I'm serious!)
%


% the date 'n stuff

40 40 translate % where to start out
/Times-BoldItalic findfont 17 scalefont setfont
10 369 moveto ( Level  $level    $day - $amonth - $year ) show

% Brian Ward, http://www.o--o.net/, 10/22/91
% silly routine that Jim Duncan made me do to make tick marks
% in PostScript.
%
% 12/24/91 ward - streamlined.
%
% 
% usage: o1 o2 o3 o4 lt w h x y tickit
% o1 - o4 are :       
%  o1            o2   - value is an intensity from 0 to 1; 0 being black
%                       and 1 being white. they are with respect to the 
%  o3            o4     corners in the diagram to the left.
%  lt - length of tickmark
%  w  - width of box to be ticked
%  h  - height of box to tick
%  x  - x coord to start
%  y  - y coord to start
%


/tickit {
gsave translate                               % move to the point in
					      % question but save current 

/theight exch def               % width of the thing
/twidth exch def                % length of aforementioned
/tlt exch def                   % length of the tick
/to4 exch def                   % grey value of o4
/to3 exch def                   % grey value of o3
/to2 exch def                   % grey value of o2
/to1 exch def                   % grey value of o1


% lower right hand corner
0 0 moveto
to4 setgray                    % set the tick's color
twidth 3 add 0 rmoveto         % move over width + 3
tlt 0 rlineto                  % right length 
tlt neg 3 sub -3 rmoveto        % left length -3 down 3
0 tlt neg rlineto              % down length
stroke

% lower left hand corner (easy one)
0 0 moveto
to3 setgray                              % set the tick's color
-3 0 rmoveto                             % move left 3
tlt neg 0 rlineto                        % left length 
tlt 3 add -3 rmoveto                     % right length + 3
0 tlt neg rlineto                        % down length
stroke

% top righthand corner
0 0 moveto
to2 setgray                                   % set the tick's color
twidth 3 add theight rmoveto                  % move over and up width + 3
tlt 0 rlineto                                 % right length 
tlt neg 3 sub 3 rmoveto                       % left length -3
0 tlt rlineto                                 % up length
stroke

% upper left hand corner
0 0 moveto
to1 setgray                                   % set the tick's color
-3 theight rmoveto                            % move up height 3
tlt neg 0 rlineto                             % left length 
tlt 3 add 3 rmoveto                           % right length +3 up three
0 tlt rlineto                                 % up length
stroke                                        % draw it

grestore                                      % restore everthing to "normal"
} def

% end of tickit

% --------------------------------------------------------------------------


.5 setlinewidth
0 0 0 0 5 267.84 432 0 0 tickit                 % cut marks

% time to draw the lines between the entries
gsave                   % make sure we save current matrix
[3 1.5] 0 setdash
0 9 translate          % the lines start a little above the bottom
1 1 26               % there are 26 lines
	{ 
	 0 0 moveto 267.85 0 lineto stroke
	 0 12.825 translate                 % move up to next line
	 pop
        } for
[] 0 setdash
grestore

% Make a cute little front panel

gsave
267.84 432 translate
180 rotate               % move to top right corner and turn upside down
.7 setgray
0 0 moveto 267.84 0 lineto 267.84 38 lineto 0 38 lineto 0 0 lineto
closepath fill           % the big grey box
0 setgray
3 3 moveto 264.84 3 lineto 264.84 34 lineto 3 34 lineto 3 3 lineto
closepath fill           % the black box inside of it
1 setgray
/Times-Roman findfont 10 scalefont setfont
9 21 moveto ($org1) show
/Times-BoldItalic findfont 10 scalefont setfont
9 9 moveto ($org2) show
/Helvetica-Bold findfont 12 scalefont setfont
175 14 moveto ($tape_type) show

grestore

0 175.725 moveto 267.84 175.725 lineto stroke 
0 342 moveto 267.84 342 lineto stroke 
0 355.5 moveto 267.84 355.5 lineto stroke  % seperator lines

% box around the narrow label
1 setlinewidth
5 360.5 moveto 262.5 360.5 lineto 262.5 389 lineto 5 389 lineto 5 360.5 lineto
closepath stroke

% triangles
0 355.5 moveto 0 394 lineto 10 374.75 lineto 0 355.5 lineto closepath fill
267.84 355.5 moveto 267.84 394 lineto 257.75 374.75 lineto 267.84 355.5
closepath fill

/Times-Italic findfont 7 scalefont setfont
3 344 moveto (File) show
20 344 moveto (Machine) show
63 344 moveto (device) show
90 344 moveto (Mount Point) show
216 344 moveto (Size \(MB\)) show

/Times-Italic findfont 6 scalefont setfont
5 2 moveto (Written 1991 Brian Ward http://www.o--o.net/) show

% start the actual dump writing now

gsave
0 331.175 translate
/Times-Roman findfont 7 scalefont setfont

DONE-PS

	$c_num = 0;
	foreach $d_entry (@dump_l) {
		($c_name, $c_dev, $c_mp, $c_size) = 
			split("::",$d_entry);
			print FD <<"DONE-PS";
5 0 moveto ($c_num) show
20 0 moveto ($c_name) show
63 0 moveto ($c_dev) show
90 0 moveto ($c_mp) show
216 0 moveto ($c_size) show
0 -12.825 translate
DONE-PS
		$c_num++;
	}


	print FD <<"DONE-PS";
grestore

% put any other crap here

showpage
DONE-PS

	close(FD);

	if ($idiotic && $is_command) {
		system("$cmd $ofile");
		unlink("$ofile");
	}
}