#!/usr/bin/perl

# -----------------------------------------------------------------------------
#
# perl-info
#
# date        : 2007-02-06
# author      : Christian Hartmann <ian@gentoo.org>
# version     : 0.14
# license     : GPL-2
# description : 'emerge --info' for perl
#
# header      : $Header: $
#
# -----------------------------------------------------------------------------
#
# This program is free software; you can redistribute it and/or modify it under
# the terms of the GNU General Public License as published by the Free Software
# Foundation; either version 2 of the License, or (at your option) any later
# version.
#
# -----------------------------------------------------------------------------

# - modules >
use warnings;
use strict;
use Term::ANSIColor;
use PortageXS;

# - init vars & constants >
my $VERSION			= "0.14";
my $pxs				= PortageXS->new();
my @perlGetVars			= qw(osname osvers archname uname useposix usethreads use5005threads
				     useithreads usemultiplicity useperlio uselargefiles usesocks use64bitint
				     use64bitall uselongdouble usemymalloc bincompat5005 cc ccflags optimize
				     cppflags ccversion gccversion gccosandver intsize longsize ptrsize doublesize
				     byteorder d_longlong longlongsize d_longdbl longdblsize ivtype ivsize nvtype
				     nvsize Off_t lseeksize alignbytes prototype ld ldflags libpth libs perllibs
				     libc so useshrplib libperl gnulibc_version dlsrc dlext d_dlsymun ccdlflags
				     cccdlflags lddlflags);

# - Print header >
print "\n".color('green bold')." perl-info".color('reset')." version ".$VERSION." - brought to you by the Gentoo perl-herd-maintainer ;-)\n";
print "                          Distributed under the terms of the GPL-2\n\n";

# - Do some basic checks >
if (!-d $pxs->getPortdir()) {
	print_err("PORTDIR not set or incorrect! Aborting..\n");
	exit(0);
}

# - Start system analysis >
$pxs->print_ok("Systeminfo:\n");
print "   Arch   : ".$pxs->getArch()."\n";
print "   Perl   : ".($pxs->searchInstalledPackage("dev-lang/perl"))[0]." USE=\"".join(" ",$pxs->getUseSettingsOfInstalledPackage("dev-lang/perl"))."\"\n";
print "   libperl: ".($pxs->searchInstalledPackage("sys-devel/libperl"))[0]." USE=\"".join(" ",$pxs->getUseSettingsOfInstalledPackage("sys-devel/libperl"))."\"\n";
print "\n";

$pxs->print_ok("Perl configuration:\n");
foreach (sort(@perlGetVars)) {
	print "   ".`perl -V:$_`;
}
print "\n";

$pxs->print_ok("INC:\n");
foreach (@INC) {
	print "   ".$_."\n";
}
print "\n";

foreach my $this_category ($pxs->getPortageXScategorylist('perl')) {
	my $category_str_length = length($this_category)+1;
	$pxs->print_ok("Installed packages from category ".$this_category.":\n");
	foreach($pxs->searchInstalledPackage($this_category."/*")) {
		print "   ".substr($_,$category_str_length,length($_)-$category_str_length)." USE=\"".join(" ",$pxs->getUseSettingsOfInstalledPackage($_))."\"\n";
	}
	print "   none\n" if (!($pxs->searchInstalledPackage($this_category."/*"))[0]);
	print "\n";
}

$pxs->print_ok("eclasses:\n");
foreach my $eclassName ("perl-app","perl-module","perl-post") {
	my $eclass = $pxs->getFileContents($pxs->getPortdir()."/eclass/".$eclassName.".eclass");
	$eclass =~ s/\$Header: ([a-zA-Z0-9\/\.,-]+) ([0-9\.]+)/$2/g;
	print "   ".$eclassName.": ".$2."\n";
}
print "\n";
exit(0);

# - Here comes the POD >

=head1 NAME

perl-info - gather systems perl info

=head1 VERSION

This document refers to version 0.14 of perl-info

=head1 SYNOPSIS

perl-info

=head1 DESCRIPTION

perl-info shall help developers getting sufficient information about the
users perl installation when needed.

=head1 AGRUMENTS

perl-info does not have any arguments yet.

=head1 AUTHOR

Christian Hartmann <ian@gentoo.org>

=head1 TODO

Put your stuff here and poke me.

=head1 REPORTING BUGS

Please report bugs via http://bugs.gentoo.org/ or https://bugs.gentoo.org/

=head1 LICENSE

perl-info - gather systems perl info
Copyright (C) 2006, 2007  Christian Hartmann

This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA

=cut
