#!/usr/bin/perl

use strict qw(vars subs refs);

use Getopt::Long;

$^W = 1;	### enable warning from here on

my $quiet = 0;
my $sparse = 0;
my $help = 0;
my $explain = 1;
my $debug = 0;
my $reasondir = '/usr/share/vrms/reasons/';

GetOptions('q|quiet' => \$quiet,
	   's|sparse' => \$sparse,
	   'e|explain!' => \$explain,
	   'reason-dir=s' => \$reasondir,
	   'd|debug+' => \$debug,
	   'h|help' => \$help);

if ($help) {
	print <<EOF;
Usage: vrms [OPTIONS] ...

--quiet, -q		Do nothing if there are no non-free packages installed.
--explain, -e		Give a brief explanation of why a package is non-free,
			  if available.
--sparse, -s		Just list non-free packages, nothing else.
--reason-dir=DIR	Use DIR as the reason directory.
--help, -h		Display this help.
--debug, -d		Generate debugging information.

All options can be prefixed with "no" (eg: --noexplain) to turn them off.
EOF
	exit 0;
}

my %reason = ();

sub parse_reason_file {
	my $file = shift;
	print "Parsing reason file $file\n" if $debug >= 1;
	open(REASON, "<", $file) or
	  die "Can't open FILE [$file]: $!\n";

	while (my $line = <REASON>) {
		chomp $line;
		# Grab a line of the form 'package: reason', skip if we don't match
		my ($pkg, $reason) = ($line =~ /^(\S+):\s+(.*)\s*$/) or next;
		print "'$pkg' because '$reason'\n" if $debug >= 1;

		# If this is _our_ master file, then prefer anything
		# else (so that package maintainers can override)
		next if exists $reason{$pkg} and $file =~ /\/vrms$/;

		$reason{$pkg} = $reason;
	}

	close REASON or
	  die "Can't close FILE [$file]: $!\n";
}

opendir(REASONDIR, $reasondir) or
  die "Can't open DIR [$reasondir]: $!\n";
 # Parse all the reason files in $reasondir except those beginning with
 #  a . or ending with a ~
 parse_reason_file("$reasondir/$_") foreach (grep {!/~$/ && !/^\./} readdir(REASONDIR));
closedir REASONDIR or
	  die "Can't close DIR [$reasondir]: $!\n";

my $statusfile = '/var/lib/dpkg/status';
my $is_nonfree = 0;			###  preset none found, yet
my %nonfree = ();
my $is_other_nonfree = 0;	###  preset none found, yet
my %other_nonfree = ();
my %pkg_status = ();
my $pkgcnt = 0;
my $clumpcnt = 0;

my $sysname = "";
chop($sysname = `uname -n`);

	open(PKG_SOURCE, "< $statusfile") or 
		  die "Can't open FILE [$statusfile]: $!\n";

	$/ = "";  ###  snarf a paragraph at a time
	while(<PKG_SOURCE>) {
		my $clump = $_;
		$clumpcnt++;
		my (@pkglines) = split(/\n/, $clump);
		###  iff more than for lines, package is installed, so process it
		###   (speed-up by skipping don't-care entries)
		if(@pkglines > 4) {
			my $pkg = "";			###  name of this package
			my $pkgstatus = "";		###  status
			my $plan = "";			###  install plan (hold, deinstall, purge, install, etc.)
			my $state = "";			###  state (ok or ???)
			my $status = "";		###  status (installed, not-installed, etc.)
			my $section = "";		###  section this is where non-free is marked
			my $shortdescr = "";	###  one-liner description of pkg
			my $linenbr = 0;		###  current line number of this pkackag's info
			my $label = "";			###  junk field (not used, except to catch split values)
			my $has_pkg = 0;			###  reset the markers
			my $has_status = 0;
			my $has_section = 0;
			foreach(@pkglines) {
				chomp;
				$linenbr++;
				if(/^Package:/) {
					($label, $pkg) =  split(/:\s+/,$_,2);
					$pkgcnt++;
					printf "pkg(%4.4d) pkg=[%s]\n",$pkgcnt,$pkg if $debug >= 1;
					$has_pkg = 1;	###  we have necessary section
					next;
				}
				if(/^Status:/) {
					my $label = "";
					($label,  $pkgstatus) = split(/:\s+/,$_,2);
					print "\tpkgstatus=[$pkgstatus]\n" if $debug >= 1;
					$pkg_status{$pkg} = $pkgstatus;
					($plan, $state, $status) = split(/\s+/,$pkgstatus);
					print "\t\tplan=[$plan]\n" if $debug >= 1;
					print "\t\tstate=[$state]\n" if $debug >= 1;
					print "\t\tstatus=[$status]\n" if $debug >= 1;
					$has_status = 1;	###  we have necessary section
					next;
				}
				if(/^Section:/) {
					my $label = "";
					($label, $section) = split(/:\s+/,$_,2);
					print "\tsection=[$section]\n" if $debug >= 1;
					$has_section = 1;	###  we have necessary section
		         	if($section =~ /non-free/) {
						###  read thru rest of array to find descr instead of waiting for it
						my $found_descr =0;
						while(! $found_descr) {
							if ($linenbr > $#pkglines) {
								###  iff badly formed entry ensure blank description
								print "\tEEEE shortdescr=[$shortdescr]\n" if $debug >= 1;
								last;
							}
						    my $dline = $pkglines[$linenbr++];
							if($dline =~ /^Description:/) {
						        ($label, $shortdescr) = split(/:\s+/,$dline,2);
								print "\tshortdescr=[$shortdescr]\n" if $debug >= 1;
								$found_descr = 1;
							}
						}
				        if(lc $status eq 'installed') {
							$is_nonfree = 1;
							$nonfree{$pkg} = $shortdescr;
						} 
						else {
							$is_other_nonfree = 1;
							$other_nonfree{$pkg} = $shortdescr;
						}
					}
					last;	### this is last desriptor of package we care about so end loop
				}
				else {
					###  un-processed lines from package info
					if($debug >= 1) {
						print "\t\t--- $_\n";
					}
				}
			}
			if(!$has_section or !$has_status or !$has_pkg) {
				print STDERR "vrms: ERROR- Badly formed dpkg-status entry #$clumpcnt!\n";
				print STDERR "             pkg=[$pkg], pkgstatus=[$pkgstatus], section=[$section] \n";
			}
		}
		else {
			###  Entries which are 2 or 4 lines are not-installed 
			if($debug >= 1) {
				###  emit debug so can veryify parsing
			    my $lineCt = @pkglines;
				print " SKIPPED <5: $lineCt lines\n";
				foreach (@pkglines) {
				    my $spacer = ($_ =~ /Package:/) ? "" : "   ";
					print " SKIPPED <5:$spacer [$_]\n";
				}
			}
		}
	}
	close (PKG_SOURCE) or
		die "Can't close FILE [$statusfile]: $!\n";

#print "$pkgcnt packages installed\n";

my $nfcnt = 0;
my $pkgname = "";

my $nonfreecnt = (keys %nonfree);

if($is_nonfree) {
	if($sparse) {
		foreach $pkgname (sort keys (%nonfree)) {
			$nfcnt++;
			print "$pkgname\n";
		}
	}
	else {
		$~ = "head";
		write ;
		$~ = "nfp";
		foreach $pkgname (sort keys(%nonfree) ) {
			$nfcnt++;
			write ;
			print "  Reason: $reason{$pkgname}\n" if(exists $reason{$pkgname} and $explain);
		}
	}
}

my $pnfcnt = 0;
my $other_nonfreecnt = (keys %other_nonfree);
if($is_other_nonfree) {
	if($sparse) {
		foreach $pkgname (sort keys(%other_nonfree)) {
			$pnfcnt++;
			print "$pkgname\n";
		}
	}
	else {
		$~ = "partialhead";
		write;
		$~ = "pnf";
		foreach $pkgname (sort keys(%other_nonfree)) {
			$pnfcnt++;
			write;
			print "  Reason: $reason{$pkgname}\n" if(exists $reason{$pkgname} and $explain);
		}
	}
}

if(!$quiet and $nfcnt == 0 and $pnfcnt == 0) {
	print "No non-free packages installed on $sysname!  rms would be proud.\n"
} elsif(!$quiet and !$sparse) {
	my $total_nonfree = $nonfreecnt + $other_nonfreecnt;
	my $total_installed = $pkgcnt;
	my $percentage = $total_nonfree * 100 / $total_installed;
	printf "\n  %d non-free packages, %2.1f%% of %d installed packages.\n", 
		$total_nonfree, $percentage, $total_installed;
}


format head =
@||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
"Non-free packages installed on $sysname"

.
format partialhead =

@||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
"Non-free packages with status other than installed on $sysname"

.

format nfp =
@<<<<<<<<<<<<<<<<<<<<<<<< @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
$pkgname, $nonfree{$pkgname}
.

format pnf =
@<<<<<<<<<<<<<<<<<<<<<<<< @<@<<@< @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
$pkgname, '(', $pkg_status{$pkgname},')', $other_nonfree{$pkgname}
.

