#!/usr/bin/perl
#
# slackdeptrack v0.1.3 -- Slackware Linux dependencies tracking utility
# (w)by Pawel Stolowski <pawel.stolowski@wp.pl>
#
##########################################################################
use Data::Dumper;
use Getopt::Long;

my $cachedir = '/var/cache/slackdeptrack';

my $providesdir = "$cachedir/provides";
my $requiresdir = "$cachedir/requires";
my $pkgdir = '/var/log/packages';

my %provides; #hasz biblioteka => pakiet
my %requires; #hasz pakiet => lista wymaganych bibliotek
my %depend;   #hasz pakiet => pakiety od ktorych zalezy
my %namemap;  #hasz pakiet => nazwa ktora pokazywac (skrocona lub pelna)

my $verbose = 0;
my $longnames = 0;
my $txtfilename;
my $dotfilename;
my $htmlfilename;
my $xmlfilename;
my $usehref = 0;
my $help = 0;
my $sweepcache = 0;

my $homepage = 'http://linux.bydg.org/~yogin';

#
# zwraca skrocona nazwe pakietu
sub shortname ($)#{{{
{
	return @_[0] =~ /(.+?)-[0-9\.]+/ ? $1 : @_[0];
}#}}}

#
# zwraca liste plikow wykonywalnych i bibliotek
# nalezacych do pakietu, z pelnymi sciezkami
sub get_package_files ($)#{{{
{
	my @files;
	my $filelist = 0;
	if (open(PKG, "$pkgdir/".$_[0]))
	{
		while (<PKG>)
		{
			if ($filelist ne 0)
			{
				chop;
				$_ = "/$_";
				unless ( -d $_ )
				{
					push @files, $_ if -x $_;
				}
			}
			elsif ( /^FILE LIST:/ )
			{
				$filelist = 1;
			}
		}
		close(PKG);
	}
	return @files;
}#}}}

#
# dopisuje biblioteki wymagane przez pakiet
# do hasza %requires
sub insert_requirehash ($@)#{{{
{
	@req = (); #lista bibliotek wymaganych przez pakiet
	my %reqh; #pomocniczy hasz dla unikniecia duplikatow bibliotek
	my $pkg = shift @_;
	
	if ( do "$requiresdir/$pkg" ) #sprobouj wczytac z cacheu
	{
		print "loading cached requires for $pkg\n" if $verbose;
	}
	else
	{
		foreach $f (@_) #przetwarzaj kazdy plik
		{
			@out = `readelf -d $f 2>&1`;
			#@out = `ldd $f`;
			foreach $l (@out) #przetwarzaj kazda linie wyjscia ldd
			{
				#$reqh{$1} = 1 if $l =~ /\s+(.*\.so)\..*=>/;
				$reqh{$1} = 1 if $l =~ /Shared library: \[(.*\.so)\..*\]/;
			}
		}
		@req = sort keys %reqh;
		if (open(FILE, ">$requiresdir/$pkg"))
		{
			print FILE Data::Dumper->Dump([\@req], ['*req']);
			close(FILE);
		}
	}
	$requires{$pkg} = [ @req ];
}#}}}

#
# zwraca liste zainstalowanych pakietow
sub get_packages#{{{
{
	my $dir = `pwd`;
	chomp $dir;
	chdir '/var/log/packages';
	my @files = <*>;
	chdir $dir;
	return @files;
}#}}}

#
# zwraca liste nazw pakietow z podkatalogow cache'u
sub get_cached_names#{{{
{
	my %fhash;
	my $dir = `pwd`;
	chomp $dir;
	chdir "$cachedir/requires";
	my @files = <*>;
	foreach $f (@files)
	{
		$fhash{$f} = 1;
	}
	chdir "$cachedir/provides";
	@files = <*>;
	foreach $f (@files)
	{
		$fhash{$f} = 1;
	}
	chdir $dir;
	return sort keys %fhash;
}#}}}

#
# dopisuje biblioteki dostarczone przez pakiet
# do hasza %provides
sub insert_providehash ($@)#{{{
{
	my $pkg = shift @_; #pierwszy argument to nazwa pakietu
	@prov = (); #liste bibliotek ktorych dostarcza pakiet

	if ( do "$providesdir/$pkg" ) #sprobouj wczytac z cacheu
	{
		print "loading cached provides for $pkg\n" if $verbose;
	}
	else
	{
		foreach $f (@_) #przetwarzaj kazdy plik z listy
		{
			push @prov, $1 if $f =~ /\/([^\/]+\.so)/;
		}
		if (open(FILE, ">$providesdir/$pkg"))
		{
			print FILE Data::Dumper->Dump([\@prov], ['*prov']);
			close(FILE);
		}
	}
	foreach $l (@prov)
	{
		$provides{$l} = $pkg;
	}
}#}}}

#
# wyznacza nazwy wymaganych pakietow na podstawie wymaganych
# bibliotek i dopisuje je do hasza %depend
sub create_dependlist ($)#{{{
{
	my $pkg = @_[0];
	my %deps; #hasz ktorego klucze beda zawierac nazwy wymaganych pakietow
	foreach $lib ( @{$requires{$pkg}} )
	{
		if ( exists $provides{$lib})
		{
			$deps{$provides{$lib}} = 1 if $provides{$lib} ne $pkg;
		}
	}
	$depend{$pkg} = [ sort keys %deps ];
}#}}}

#
# utworz hasz zaleznosci dla listy pakietow
sub build_dependencies (@)#{{{
{
	my @pkgs = @_;
	foreach $pkg (@pkgs)
	{
		@files = get_package_files($pkg);
		insert_providehash($pkg, @files);
		insert_requirehash($pkg, @files);
	}
	foreach $pkg (@pkgs)
	{
		create_dependlist($pkg);
		$namemap{$pkg} = $longnames ? $pkg : shortname($pkg);
	}
}#}}}

###########################################################################
$req = GetOptions(
	"-l"     => \$longnames,
	"-p=s"   => \$txtfilename,
	"-t=s"   => \$htmlfilename,
	"-x=s"   => \$xmlfilename,
	"-d=s"   => \$dotfilename,
	"-c=s"   => \$cachedir,
	"-a"     => \$usehref,
	"-s"     => \$sweepcache,
	"-v"     => \$verbose,
	"-h"     => \$help
);

$help = 1 unless $xmlfilename || $htmlfilename || $dotfilename || $txtfilename || $sweepcache;

#
# usun z cache'u pliki dla nieistniejacych juz pakietow
if ( $sweepcache )#{{{
{
	my @cached = get_cached_names;
	foreach $pkg (@cached)
	{
		unless ( -f "$pkgdir/$pkg" )
		{
			print "removing cached data for non-existing package $pkg\n" if $verbose;
			unlink "$cachedir/provides/$pkg";
			unlink "$cachedir/requires/$pkg";
		}
	}
	exit 0;
}#}}}

if ( $help )#{{{
{
	print << '_ENDHELP';
slackdeptrack 0.1.3
(w)by Pawel Stolowski <pawel.stolowski@wp.pl>

Usage: slackdeptrack [-s] | [[-t file | -x file | -d file | -p file] [-a] [-l]] [-c dir] [package ...]
Options:
   -t file      create html file
   -x file      create xml file
   -d file      create dot file for graphviz graph
   -p file      create text file
   -a           create links in html output
   -l           use full package names in output
   -s           sweep cache
   -c dir       use this cache directory instead of default
   -h           this help
_ENDHELP
	exit 0;
}#}}}

#
# sprawdz istnienie i uprawniania do katalogu cache
unless ( -d $cachedir && -w $cachedir && -r $cachedir )#{{{
{
	die "Can't access cache directory $cachedir\n";
}
else
{
	mkdir $providesdir unless -d $providesdir;
	mkdir $requiresdir unless -d $requiresdir;
}#}}}

my @pkgs = get_packages;
build_dependencies(@pkgs);

#
# jesli przekazano nazwy pakietow, pokaz tylko te pakiety
if ( $#ARGV >= 0 )#{{{
{
	my %wanted;
	my @newpkgs; #nowa lista pakietow
	foreach $p (@ARGV)
	{
		$wanted{$p} = 1;
	}
	foreach $p (@pkgs)
	{
		push @newpkgs, $p if $wanted{$p} || $wanted{shortname($p)};
	}
	@pkgs = @newpkgs;
}#}}}

#
# zapis do pliku tekstowego
if ( $txtfilename )#{{{
{
	open(FILE, ">$txtfilename") or die "Can't write text file: $!";
	foreach $pkg (@pkgs)
	{
		print FILE "$namemap{$pkg} :";
		foreach $p (@{$depend{$pkg}})
		{
			print FILE " $namemap{$p}";
		}
		print FILE "\n";
	}
	close(FILE);
}#}}}

#
# zapis do HTML
if ( $htmlfilename )#{{{
{
	open(FILE, ">$htmlfilename") or die "Can't write HTML file: $!";
	
	my $sys = `cat /etc/slackware-version`;
	my $date = `date`;

	print FILE "<HTML>\n<HEAD>\n<STYLE TYPE=\"text/css\">\n<!--\n";
	print FILE "TR.col0 { background-color: \#FEFEFE }\n";
	print FILE "TR.col1 { background-color: \#CFCFCF }\n";
	print FILE "-->\n</STYLE>\n</HEAD>\n";
	print FILE "<BODY><CENTER><H1>Package dependencies for $sys</H1>Created on $date</CENTER><BR>\n";
	print FILE "<table border=\"0\" cellpadding=\"2\" cellspacing=\"2\">";
	my $cnt = 0;
	foreach $pkg (@pkgs)
	{
		$cnt = 1-$cnt;
		print FILE "<TR CLASS=col$cnt>\n<TD><A NAME=\"$namemap{$pkg}\">$namemap{$pkg}</A></TD><TD>";
		foreach $p (@{$depend{$pkg}})
		{
			print FILE $usehref ? "<A HREF=\"\#$namemap{$p}\">$namemap{$p} " : $namemap{$p}.' ';
		}
		print FILE "</TR>\n";
	}
	print FILE "</TABLE><BR><FONT SIZE=-2><I>Created with <A HREF=\"$homepage\">slackdeptrack</A> (w)by Pawel Stolowski</I></FONT>\n</BODY>\n</HTML>\n";
	close(FILE);
}#}}}

#
# zapis do XML
if ( $xmlfilename )#{{{
{
	open(FILE, ">$xmlfilename") or die "Can't write XML file: $!";
	print FILE "<?xml version=\"1.0\" ?>\n";
	print FILE "<!DOCTYPE slackdeptrack [\n";
	print FILE "\t<!ELEMENT package (req)>\n";
	print FILE "\t<!ATTLIST package name NMTOKEN #REQUIRED\n";
	print FILE "\t                count NMTOKEN #REQUIRED>\n";
	print FILE "\t<!ELEMENT req (#PCDATA)>\n";
	print FILE "]>\n\n<slackdeptrack>\n";
	foreach $pkg (@pkgs)
	{
		$cnt = @{$depend{$pkg}};
		print FILE "\t<package name=\"$namemap{$pkg}\" count=\"$cnt\">\n";
		foreach $p (@{$depend{$pkg}})
		{
			print FILE "\t\t<req>$namemap{$p}</req>\n";
		}
		print FILE "\t\t</package>\n";
	}
	print FILE "</slackdeptrack>\n";
	close(FILE);
}#}}}

#
# zapis do dot
if ( $dotfilename )#{{{
{
	open(FILE, ">$dotfilename") or die "Can't write dot file: $!";
	print FILE "digraph G {\n";
	foreach $pkg (@pkgs)
	{
		my $spkg = shortname($pkg);
		foreach $p (@{$depend{$pkg}})
		{
			$sp = shortname($p);
			print FILE "\"$spkg\" -> \"$sp\";\n";
		}
	}
	print FILE "}\n";
	close(FILE);
}#}}}

