###
###  Copyright 2000-2007 University of Illinois Board of Trustees
###  All rights reserved. 
###
###  PSGConf::Util - utility functions for psgconf
###
###  Campus Information Technologies and Educational Services
###  University of Illinois at Urbana-Champaign
###


package PSGConf::Util;

use strict;

use File::Find;
use Net::hostent;
use POSIX;
use Socket;

our @ISA = qw(Exporter);

our @EXPORT = qw(
	get_addrs
	platform_name
);


###############################################################################
###  _expand_tokens - Generic method to expand tokens of the form
###                   %{directive} to their value, only really works
###                   with String/Integer data types.
###############################################################################
sub _expand_tokens
{
     my ($psgconf, $text) = @_;
     my ($start_idx, $newtext, $end_idx, $token, $val);

     $start_idx = 0;
	$newtext = $text;
     while ($start_idx != -1)
     {
          $start_idx = index($text, "%{", $start_idx);
          next
               if ($start_idx == -1);
          $end_idx = index($text, "}", $start_idx);

          $token = substr($text, $start_idx + 2,
                         $end_idx - $start_idx - 2);
		$val = $psgconf->data_obj($token)->get();
		$token = "%{" . $token . "}";

		$newtext =~ s/$token/$val/g;

          $start_idx = $end_idx;
     }
	return $newtext;
}

###############################################################################
###  get_addrs(FQDN) - get all IP addresses associated with FQDN
###############################################################################

sub get_addrs
{
	my ($psgconf, $fqdn) = @_;
	my ($hent, @res);

	### First see if we have the IP address from our configs
	if ( defined $psgconf->data_obj('host_addrs')->find($fqdn) ) {
		@res = $psgconf->data_obj('host_addrs')->find($fqdn);

	} else {
		### Now check to make sure we do not have a host_alias set either
		map { 
			if ( defined $psgconf->data_obj('host_aliases')->find($_)->{$fqdn} ) {
				if ( defined $psgconf->data_obj('host_addrs')->find($_) ) {
					@res = $psgconf->data_obj('host_addrs')->find($_);

				### Save new name to look up in DNS
				} else {
					$fqdn = $_;
				}
			}
		} keys %{$psgconf->data_obj('host_aliases')->get()};

		if ( ! scalar @res ) {
			if ($hent = gethostbyname($fqdn)) {
				@res = sort map { inet_ntoa($_) } @{$hent->addr_list};
			}
		}
	}

	die "unknown host \"$fqdn\""
		if (! scalar @res);

	return @res;
}


###############################################################################
###  RunCommand(command) - Run a command using system(3).
###############################################################################

sub RunCommand
{  
     my ($cmd, $nowarn) = @_;
	my ($rc);
     
	if (($rc=system($cmd))) {

		### OK, so the program was killed by a signal.
		if ( WIFSIGNALED($?) ) {
         		warn "\t!!! command '$cmd' terminated on signal " 
				. WTERMSIG($?)
				. ($? & 128)? ", with": ", without"
				. " coredump\n"
				if ( ! $nowarn );
			$rc= WTERMSIG($?);

		### Otherwise we had some other error...
		} elsif ( $rc || WIFEXITED($?) ) {
         		warn "\t!!! command '$cmd' failed: $!\n"
				if ( ! $nowarn );
			$rc = WEXITSTATUS($?);
		}
	}
 
     return $rc;
}


###############################################################################
###  platform_name() - return platform name for current host
###############################################################################

sub platform_name
{
	my ($sysname, $nodename, $release, $version, $machine);
	my ($platform, @suffixes);

	($sysname, $nodename, $release, $version, $machine) = POSIX::uname();

	if ($sysname eq 'AIX')
	{
		my $os_level;

		$os_level = `oslevel`;
		chomp($os_level);
		$os_level =~ s/^(\d+\.\d+\.\d+)\.\d+$/$1/;

		$platform = "rs6000-aix$os_level";
	}

	elsif ($sysname eq 'HP-UX')
	{
		### assume pa, since we can't get at _SC_CPU_VERSION
		$release =~ s/^[^\d]+//;
		$platform = "pa-hpux$release";
	}

	elsif ($sysname =~ m/^IRIX.*/)
	{
		### assume mips, since we don't have an interface to sysinfo()
		$platform = "mips-irix$release";
	}

	elsif ($sysname eq 'Linux')
	{
		### only save the first two digits of the kernel version
		$release =~ s/^(\d+\.\d+)\..*$/$1/;
		$platform = (($machine =~ m/^i\d86$/) ? 'ix86' : $machine);

		### set the other arches we can support (i686 will support
		### i386 to i686 as well athlon).
		if ( $platform eq 'ix86' ) {
			my ($x);
			grep (/i([3-9])86/o && ($x=$1), $machine);
			for (my($i) = 3; $i <= $x; $i++) {
				push @suffixes, "i${i}86";
			}

			### FIXME.  Need to add the athlon arch tag
			### for those systems (output of uname -p).
		} elsif ( $platform eq 'x86_64' ) {
			push @suffixes, ( 'x86_64', 'i386' );
		} else {
			push @suffixes, $platform;
		}

		$platform .= "-linux$release";

		if ( -f '/etc/redhat-release' ) {
			my ($distro, $x);
			if (open (FP, '/etc/redhat-release')) {
				$distro=<FP>;
				close FP;
				chomp $distro;
				if ( $distro =~ /Fedora Core/o ) {
					$x="fc-";
     			} elsif ( $distro =~ /Red Hat Enterprise Linux ([^ ]*)/o ) {
          			$x="rhel-$1-";
     			} elsif ( $distro =~ /Red Hat Linux/o ) {
          			$x="rhl-";
     			} 

				if ( length $x ) {
     				$x .= $1
          				if ( $distro =~ / release ([0-9\.]+)/o );

     				$x .= '.' . $1
          				if ( $distro =~ / Update ([0-9]+)/o );

					$platform .= "-$x";
				}
			}
		}
	}

	elsif ($sysname eq 'FreeBSD')
	{
		### only save the major number of the kernel version
		$release =~ s/^(\d+)\..*$/$1/;
		$platform = (($machine =~ m/^i\d86$/) ? 'ix86' : $machine);
		$platform .= "-freebsd$release";
	}

	elsif ($sysname eq 'SunOS')
	{
		my $bits;

		$platform = (($machine eq 'i86pc') ? 'ix86' : $machine);
		my ($maj, $min) = split (/\./, $release);
		$platform .= '-' . (($maj >= 5) ? 'solaris' : 'sunos' . $maj . '.');
		$platform .= '2.'
			if ($min <= 6);
		$platform .= $min;

		### set 32-bit vs 64-bit suffix
		$bits = `isainfo -b`;
		chomp($bits);
		@suffixes = ("${bits}bit");
	}

	elsif ($sysname eq 'Darwin')
	{
		$platform = (($machine eq 'Power Macintosh') ? 'powerpc' : $machine);
		$platform .= "-darwin$release";
	}

	return ($platform, @suffixes);
}

###############################################################################
###  documentation
###############################################################################

1;

__END__

=head1 NAME

PSGConf::Util - Extra Utility functions for PSGConf Modules.

=head1 SYNOPSIS

  use PSGConf::Util;

=head1 DESCRIPTION

The B<PSGConf::Util> module defines the following useful methods:

=over 4

=item get_addrs($psgconf, $fqdn)

This will return a B<PSGConf::Data::List> of IP Addresses for the
host $fqdn.

=item platform_name()

Returns the architechture name of the system psgconf is running on.

=item RunCommand($cmd, $nowarn)

Creates a consistant look and feel for running external commands
within L<PSGConf>.  If $nowarn is set, it will not print out any
error messages on failures.  Returns the status code of the command
run.

=back

It also defines the following internal methods:

=over 4

=item _expand_tokens($psgconf, $text)

Converts any form of %{directive} within the $text string to the
value that is return from $psgconf->data_obj('directive')->get().
Mainly works well with B<PSGConf::Data::Boolean>, B<PSGConf::Data::Enum>
B<PSGConf::Data::Integer> and B<PSGConf::Data::String> directives.

=back

=head1 SEE ALSO

L<perl>

L<PSGConf>

=cut