#! /usr/bin/perl

#
# my %section (
#	lines		= \@lines,
#	next		= \%section,
#   colflag		= $bool,
#	weight		= $real,
#	repeat		= $bool,
#	minwidth	= $bool,
#	halign		= $number,
#	valign		= $number,
# );
#

use IO::Handle;
use Sys::Hostname;


$dbg  = 0;
$prog = "Signify";
$vers = "1.10";
srand();


# If there is no $ENV{HOME}, set it from /etc/passwd.
$ENV{HOME} = (getpwuid($<))[7] unless exists $ENV{HOME};


%vars			= %ENV;
$vars{PROGRAM}	= "$prog v$vers";
$vars{SIGWIDTH}	= 79;
$vars{WEBSITE}	= "http://www.debian.org/";
$vars{DOLSIGN}	= "\$";
$vars{BLANK}	= "";
$perlvarnam		= "_perl_";
$perlvarnum		= 1;
$CurFile		= "";
$CurPath		= "";
@OpenFiles		= ();
@OpenPaths		= ();
$OutputFifo		= "";
$InputFile		= "$ENV{HOME}/.signify";
$FifoName		= undef;
$FifoLock		= undef;


sub Error {
	die "$CurFile:$.:$_[0]\n";
}



sub SubstituteVars {
	my($line) = @_;
	$line =~ s/\$\$/\$DOLSIGN;/gs;
	$line =~ s/\$(\w+);?/$vars{$1}/gs;
	return $line;
}



sub DefaultSection {
	my %section;
	my @lines;

	$section{lines}		= \@lines;
	$section{weight}	= 1;
	$section{colflag}	= 0;
	$section{repeat}	= 0;
	$section{minwidth}	= 0;
	$section{halign}	=-1;
	$section{valign}	=-1;

	return %section;
}



sub OpenFile {
	my($file) = @_;

	if ($CurPath || $CurFile) {
		push @OpenPaths,$CurPath;
		push @OpenFiles,$CurFile;
	}

	if (grep(/^\Q$file\E$/,@OpenFiles)) {
		die "Signify: File '$file' is read recursively\n";
	}

	$CurFile = $file;
	$CurPath = new IO::Handle;
	open($CurPath,"<$file") || die "Signify: Could not read file '$file' -- $!\n";
	print STDERR "Starting file '$CurFile'\n" if $dbg;
}

sub ReadLine {
	my $line = <$CurPath>;

	while (!defined $line || $line eq "") {
		print STDERR "Finished file '$CurFile'\n" if $dbg;
		close($CurPath);
		$CurPath = pop @OpenPaths;
		$CurFile = pop @OpenFiles;
		last if !defined $CurPath || !defined $CurFile;
		$line = <$CurPath>;
	}

	print STDERR "$CurFile: $line" if $dbg && $CurFile;
	$line =~ s/^\#.*$//;
	if ($line =~ m/\`([^\`]+?)\`/) {
		my $pvar = "$perlvarnam$perlvarnum";
		$line =~ s/\`([^\`]+?)\`/\$$pvar;/g;
		$vars{$pvar} = eval $1;
		$perlvarnum++;
	}

	if ($line =~ m/^\%\s*include\s+[\'\"]?(.*?)[\"\']?$/i) {
		my $newfile;
		$newfile = SubstituteVars($1);
		$newfile =~s!^~/!$ENV{HOME}/!;
		OpenFile($newfile);
		$line = ReadLine();
	}

	return $line;
}



sub ReadCommand {
	my($line) = @_;
	if ($line =~ m/^\%\s*\$(\w+)=(.*)$/) {
		$vars{$1} = SubstituteVars($2);
		print STDERR "var '$1' = '$vars{$1}'\n" if $dbg;
		return 1;
	}
	return;
}



sub ReadSection {
	my($line) = @_;
	my %section = DefaultSection();
	my $secttype;

	Error "Unknown section identifier" unless $line=~m/^\%\s*[\{\(\|]/;
	($secttype) = ($line =~ m/^\%\s*(.)/);
	$section{colflag} = ($secttype eq "(");

	$line =~ s/^\%\s*[\{\(\|]\s*//;
	foreach (split(/,\s*/,$line)) {
		if (/^bottom$/i)		{ $section{valign}	= -2; next; }
		if (/^center$/i)		{ $section{halign}	=  0; next; }
		if (/^center=(\d+)$/i)	{ $section{halign}	= $1; next; }
		if (/^left$/i)			{ $section{halign}	= -1; next; }
		if (/^minwidth$/i)		{ $section{minwidth}=  1; next; }
		if (/^repeat$/i)		{ $section{repeat}	=  1; next; }
		if (/^right$/i)			{ $section{halign}	= -2; next; }
		if (/^top$/i)			{ $section{valign}	= -1; next; }
		if (/^vcenter$/i)		{ $section{valign}	=  0; next; }
		if (/^weight=(.*)$/i)	{ $section{weight}	= $1; next; }
		if (/^exec$/i)			{ $section{exec}	=  1; next; }

		Error "Unknown option '$_'";
	}

	while (1) {
		$line = ReadLine();
		Error "Unexpected end-of-file" unless $line;
		chomp $line;
		next if !$line || $line =~ m/^\#/;

		if ($line =~ m/^\%/) {
			return \%section if $line =~ m/^\%\s*\}/ && !$section{colflag};
			return \%section if $line =~ m/^\%\s*\)/ &&  $section{colflag};
#			print STDERR "colflag=$section{colflag}\n" if $dbg;
			Error "Incorrect section terminator" if $line =~ m/^\%\s*[\}\)]/;
#			Error "Cannot nest columns within another section" if $line =~ m/^\%\s*\(/;
#			Error "Cannot nest 'alternate' sections" if $line =~ m/^\%\s*\{/ && !$section{colflag};

			if ($line =~ m/^\%\s*[\{\(]/) {
				push @{$section{lines}},ReadSection($line);
				next;
			} elsif ($line =~ m/^\%\s*\|/) {
				$line =~ s/\|/$secttype/;
				$section{next} = ReadSection($line);
				return \%section;
			}

			next if ReadCommand($line);

			Error "Unknown command";
		} else {
			print STDERR "Adding (section) line '$line'\n" if $dbg;
			push @{$section{lines}},SubstituteVars($line);
		}
	}
}



sub ReadFile {
	my($file) = @_;
	my $handle  = new IO::Handle;
	my $oldfile = $CurFile;
	my %section = DefaultSection();

	OpenFile($file);

	while ($_ = ReadLine()) {
		chomp;
		next if !$_;

		if (/^\%\s*[\{\(]/) {
			push @{$section{lines}},ReadSection($_);
			print STDERR "finished reading section\n" if $dbg;
		} elsif (/^\%/) {
			Error "Unknown command" unless ReadCommand($_);
		} else {
			print STDERR "Adding (base) line '$_'\n" if $dbg;
			push @{$section{lines}},SubstituteVars($_);
		}
	}

	return \%section;
}



sub GenerateSig {
	my($sect) = @_;
	my(@lines,$line,$i);
	my($status,$signal);

	if ($$sect{colflag}) {

		my @cols;
		my $csect    = $sect;
		my $minwidth = 0;
		my $maxheight= 0;
		my $padcols  = 0;
		my $lastpad  = 0;

		while ($csect) {
			my @clines;
			my $count = 0;
			my $width = 0;
			push @cols,\@clines;

			foreach (@{$$csect{lines}}) {
			    if (ref) {
					print STDERR "creference\n" if $dbg;
					push @clines,GenerateSig($_);
			    } elsif ($$csect{exec}) {
					print STDERR "Executing shell command '$_'\n" if $dbg;
					@output = `$_`;
					$status = $? >> 8;
					$signal = $? & 255;
					if ($?) {
						print STDERR ("Shell command returned $status exit status",
									  $signal ? " (killed on signal $signal)" : "",
									  "\n") if $dbg;
					} else {
						chomp @output;
						if ($dbg) {
							foreach (@output) {
								print STDERR "Shell command output '$_'\n";
							}
						}
						push @clines,@output;
					}
			    } else {
					print STDERR "cline '$_'\n" if $dbg;
					push @clines,$_;
			    }
 			}

			foreach (@clines) {
				my $length = length;
				$count++;
				$width = $length if $length > $width;
			}

			$minwidth += $width;
			$maxheight = $count if $count > $maxheight;
			if ($$csect{minwidth}) {
				$lastpad = 0;
			} else {
				$padcols += 2 - $lastpad;
				$lastpad  = 1;
			}

			$csect = $$csect{next};
			print STDERR "minwidth=$minwidth, width=$width, maxheight=$maxheight, count=$count, varcols=$varcols\n" if $dbg;
		}

		my $padding = $vars{SIGWIDTH} - $minwidth;
		$csect = $sect;
		$lastpad = 0;
		foreach $col (@cols) {
			my $width  = 0;

			if (!$$csect{minwidth}) {
				my $spaces = 0;
				$spaces = int($padding / $padcols) if $padcols && !$lastpad;
				for ($i=0; $i < $maxheight; $i++) {
					$lines[$i] .= " " x $spaces;
				}
				$padding -= $spaces;
				$padcols--;
			}

			foreach (@$col) {
				my $length = length;
				$width = $length if $length > $width;
			}
			if ($$csect{halign} == -1) {
				foreach (@$col) {
					my $length = length;
					$_ = $_ . " " x ($width - $length);
				}
			}
			if ($$csect{halign} == -2) {
				foreach (@$col) {
					my $length = length;
					$_ = " " x ($width - $length) . $_;
				}
			}
			if ($$csect{halign} >= 0) {
				foreach (@$col) {
					my $length = length;
					$_ = " " x (($width - $length + 1) / 2) . $_ . " " x (($width - $length) / 2);
				}
			}

			$i = 0;
			if ($$csect{valign} == -2 && !$$csect{repeat}) {
				my $skip = int($maxheight - scalar(@$col));
				while ($i < $skip) {
					$lines[$i++] .= " " x $width;
				}
			}
			if ($$csect{valign} >= 0 && !$$csect{repeat}) {
				my $skip = int(($maxheight - scalar(@$col)) / 2);
				while ($i < $skip) {
					$lines[$i++] .= " " x $width;
				}
			}
			foreach $line (@$col) {
				$lines[$i++] .= $line;
			}
			while ($i < $maxheight && $$csect{repeat}) {
				foreach $line (@$col) {
					last if $i >= $maxheight;
					$lines[$i++] .= $line;
				}
			}
			while ($i < $maxheight) {
				$lines[$i++] .= " " x $width;
			}

			if (!$$csect{minwidth}) {
				my $spaces = 0;
				$spaces = int($padding / $padcols) if $padcols;
				for ($i=0; $i < $maxheight; $i++) {
					$lines[$i] .= " " x $spaces;
				}
				$padding -= $spaces;
				$padcols--;
				$lastpad = 1;
			} else {
				$lastpad = 0;
			}

			$csect = $$csect{next};
		}

	} else { # !colflag

		if ($$sect{next}) {
			my $total = 0.0;
			my $sptr  = $sect;

			while ($sptr) {
				$total += $$sptr{weight};
				$sptr   = $$sptr{next};
			}

			my $index = rand($total);

			while ($$sect{weight} < $index) {
				$index -= $$sect{weight};
				$sect   = $$sect{next};
			}
		}

		foreach (@{$$sect{lines}}) {
			if (ref) {
				print STDERR "reference\n" if $dbg;
				push @lines,GenerateSig($_);
		    } elsif ($$sect{exec}) {
				print STDERR "Executing shell command '$_'\n" if $dbg;
				@output = `$_`;
				$status = $? >> 8;
				$signal = $? & 255;
				if ($?) {
					print STDERR ("Shell command returned $status exit status",
								  $signal ? " (killed on signal $signal)" : "",
								  "\n") if $dbg;
				} else {
					chomp @output;
					if ($dbg) {
						foreach (@output) {
							print STDERR "Shell command output '$_'\n";
						}
					}
					push @lines,@output;
				}
		    } else {
				print STDERR "line '$_'\n" if $dbg;
				push @lines,$_;
			}
		}

		if ($$sect{halign} >= 0) {
			my $center = $$sect{halign};
			$center = ($vars{SIGWIDTH}+1)/2 unless $center;

			for ($i=0; $i < @lines; $i++) {
				my $length = length($lines[$i]);
				my $prefix = int($center - $length/2);
				$lines[$i] = " " x $prefix . $lines[$i];
			}
		}
		if ($$sect{halign} == -2) {
			for ($i=0; $i < @lines; $i++) {
				my $length = length($lines[$i]);
				$lines[$i] = " " x ($vars{SIGWIDTH} - $length) . $lines[$i];
			}
		}

	} # colflag

	return @lines;
}



sub MakeFifo {
	my ($fifo) = @_;
	$fifo =~ s!^~/!$ENV{HOME}/!;

	$FifoName = $fifo;
	die "Signify: '$fifo' already exists and is not a FIFO\n" if (-e $fifo && ! -p $fifo);
	system("mkfifo -m 644 $fifo") if (! -p $fifo);
	die "Signify: Could not make FIFO '$fifo'\n" if (! -p $fifo);
}



sub LockFifo {
	my($fifo) = @_;
	my $pid;

	$FifoLock = "$fifo.lock-$hostnam";


	if (! -e $FifoLock) {
		open(LOCK,">>$FifoLock") || die "Signify: Could not create file '$FifoLock' -- $!\n";
		close(LOCK);
	}

	open(LOCK,"+<$FifoLock") || die "Signify: Could not update file '$FifoLock' -- $!\n";
	flock(LOCK,2) || die "Signify: could not lock file '$FifoLock' -- $!\n";
	$pid = <LOCK>;
	chomp $pid;
	kill 14,$pid if ($pid > 1 && $pid != $$);
	sleep(1);

	if (! -e $FifoLock) {
		open(LOCK,">>$FifoLock") || die "Signify: Could not create file '$FifoLock' -- $!\n";
		close(LOCK);
	}

	seek LOCK,0,0;
	print LOCK $$,"\n";
	close(LOCK);
}



###############################################################################



foreach (@ARGV) {
	if (/^--fifo=(.*)$/) {
		$OutputFifo = $1;
		MakeFifo($OutputFifo);
		next;
	}
	if (/^--input=(.*)$/) {
		$InputFile = $1;
		next;
	}
	if (/^--debug$/) {
		$dbg = 1;
		next;
	}

	die "Signify: Unknown parameter '$_'\n";
}


$sectref = ReadFile($InputFile);
$nowtime = 840000000;
$hostnam = hostname();


sub ExitProg
{
#	unlink $FifoName if ($FifoName);	# may be in use across multiple machines
	unlink $FifoLock if ($FifoLock);
	exit(0);
}

$SIG{ALRM}	= sub { exit(0); };
$SIG{HUP}	= sub { $sectref = ReadFile($InputFile); };
$SIG{INT}	= \&ExitProg;
$SIG{KILL}	= \&ExitProg;
$SIG{TERM}	= \&ExitProg;
$SIG{ABRT}	= \&ExitProg;
$SIG{QUIT}	= \&ExitProg;


if ($OutputFifo) {
	local $SIG{PIPE} = sub {};
	LockFifo($OutputFifo);
	while (1) {
		utime $nowtime,$nowtime,$OutputFifo;
		open(FIFO,">$OutputFifo") || die "Signify: Could not write to '$OutputFifo' -- $!\n";
		@lines = GenerateSig($sectref);
		foreach (@lines) {
			s/\s+$// unless m/^--/;
			print FIFO $_,"\n";
		}
		close(FIFO);
		utime $nowtime,$nowtime,$OutputFifo;
		sleep(1);
	}
} else {
	@lines = GenerateSig($sectref);
	foreach (@lines) {
		s/\s+$// unless m/^--/;
		print $_,"\n";
	}
}
