#!/usr/bin/perl -w
#
# Creates common environment for distributions
#
# $Id$
#

package ProjectBuilder::Distribution;

use strict;
use Data::Dumper;
use ProjectBuilder::Base;

# Inherit from the "Exporter" module which handles exporting functions.
 
use Exporter;
 
# Export, by default, all the functions into the namespace of
# any code which uses this module.
 
our @ISA = qw(Exporter);
our @EXPORT = qw(pb_distro_init pb_get_distro);

=pod

=head1 NAME

ProjectBuilder::Distribution, part of the project-builder.org - module dealing with distribution detection

=head1 DESCRIPTION

This modules provides functions to allow detection of Linux distributions, and giving back some attributes concerning them.

=head1 SYNOPSIS

  use ProjectBuilder::Distribution;

  # 
  # Return information on the running distro
  #
  my ($ddir, $dver, $dfam, $dtype, $pbsuf) = pb_distro_init();
  print "distro tuple: ".Dumper($ddir, $dver, $dfam, $dtype, $pbsuf)."\n";
  # 
  # Return information on the requested distro
  #
  my ($ddir, $dver, $dfam, $dtype, $pbsuf) = pb_distro_init("ubuntu","7.10");
  print "distro tuple: ".Dumper($ddir, $dver, $dfam, $dtype, $pbsuf)."\n";
  # 
  # Return information on the running distro
  #
  my ($ddir,$dver) = pb_get_distro();
  my ($ddir, $dver, $dfam, $dtype, $pbsuf) = pb_distro_init($ddir,$dver);
  print "distro tuple: ".Dumper($ddir, $dver, $dfam, $dtype, $pbsuf)."\n";

=head1 USAGE

=over 4


=item B<pb_get_distro>

This function returns a list of 2 parameters indicating the distribution name and version of the underlying Linux distribution. The value of those 2 fields may be "unknown" in case the function was unable to recognize on which distribution it is running.

On my home machine it would currently report ("mandriva","2008.0").

=cut

sub pb_distro_init {

my $ddir = shift || undef;
my $dver = shift || undef;
my $dfam = "unknown";
my $dtype = "unknown";
my $dsuf = "unknown";

# If we don't know which distribution we're on, then guess it
($ddir,$dver) = pb_get_distro() if ((not defined $ddir) || (not defined $dver));

# There should be unicity of names between ddir dfam and dtype
# In case of duplicate, bad things can happen
if (($ddir =~ /debian/) ||
	($ddir =~ /ubuntu/)) {
	$dfam="du";
	$dtype="deb";
	$dsuf=".$ddir$dver";
} elsif ($ddir =~ /gentoo/) {
	$dfam="gen";
	$dtype="ebuild";
	$dver="nover";
	$dsuf=".$ddir";
} elsif ($ddir =~ /slackware/) {
	$dfam="slack";
	$dtype="tgz";
	$dsuf=".$dfam$dver";
} elsif (($ddir =~ /suse/) ||
		($ddir =~ /sles/)) {
	if ($ddir =~ /opensuse/) {
		$ddir = "suse";
	}
	$dfam="novell";
	$dtype="rpm";
	$dsuf=".$ddir$dver";
} elsif (($ddir =~ /redhat/) ||
		($ddir =~ /rhel/) ||
		($ddir =~ /fedora/) ||
		($ddir =~ /vmware/) ||
		($ddir =~ /centos/)) {
	$dfam="rh";
	$dtype="rpm";
	my $dver1 = $dver;
	$dver1 =~ s/\.//;
	if ($ddir =~ /fedora/) {
		$dsuf=".fc$dver1";
	} elsif ($ddir =~ /redhat/) {
		$dsuf=".rh$dver1";
	} elsif ($ddir =~ /vmware/) {
		$dsuf=".vwm$dver1";
	} else {
		$dsuf=".$ddir$dver1";
	}
} elsif (($ddir =~ /mandrake/) ||
		($ddir =~ /mandrakelinux/) ||
		($ddir =~ /mandriva/)) {
	$dfam="md";
	$dtype="rpm";
	if ($ddir =~ /mandrakelinux/) {
		$ddir = "mandrake";
	}
	if ($ddir =~ /mandrake/) {
		my $dver1 = $dver;
		$dver1 =~ s/\.//;
		$dsuf=".mdk$dver1";
	} else {
		$dsuf=".mdv$dver";
	}
} elsif ($ddir =~ /freebsd/) {
	$dfam="bsd";
	$dtype="port";
	my $dver1 = $dver;
	$dver1 =~ s/\.//;
	$dsuf=".$dfam$dver1";
} else {
	$dfam="unknown";
	$dtype="unknown";
	$dsuf="unknown";
}

return($ddir, $dver, $dfam, $dtype, $dsuf);
}

=item B<pb_distro_init>

This function returns a list of 5 parameters indicating the distribution name, version, family, type of build system and suffix of packages of the underlying Linux distribution. The value of the 5 fields may be "unknown" in case the function was unable to recognize on which distribution it is running.

As an example, Ubuntu and Debian are in the same "du" family. As well as RedHat, RHEL, CentOS, fedora are on the same "rh" family.
Mandriva, Open SuSE and Fedora have all the same "rpm" type of build system. Ubuntu ad Debian have the same "deb" type of build system. 
And "fc" is the extension generated for all Fedora packages (Version will be added by pb).

When passing the distribution name and version as parameters, the B<pb_distro_init> function returns the parameter of that distribution instead of the underlying one.

Cf: http://linuxmafia.com/faq/Admin/release-files.html
Ideas taken from http://search.cpan.org/~kerberus/Linux-Distribution-0.14/lib/Linux/Distribution.pm

=cut

sub pb_get_distro {

my $base="/etc";

# List of files that unambiguously indicates what distro we have
my %single_rel_files = (
# Tested
	'gentoo'			=>	'gentoo-release',		# >= 1.6
	'slackware'			=>	'slackware-version',	# >= 10.2
	'mandriva'			=>	'mandriva-release',		# >=2006.0
	'mandrakelinux'		=>	'mandrakelinux-release',# = 10.2
	'fedora'			=>	'fedora-release',		# >= 4
	'vmware'			=>	'vmware-release',		# >= 3
	'sles'				=>	'sles-release',			# Doesn't exist as of 10
# Untested
	'knoppix'			=>	'knoppix_version',		#
	'yellowdog'			=>	'yellowdog-release',	#
	'esmith'			=>	'e-smith-release',		#
	'turbolinux'		=>	'turbolinux-release',	#
	'blackcat'			=>	'blackcat-release',		#
	'aurox'				=>	'aurox-release',		#
	'annvix'			=>	'annvix-release',		#
	'cobalt'			=>	'cobalt-release',		#
	'redflag'			=>	'redflag-release',		#
	'ark'				=>	'ark-release',			#
	'pld'				=>	'pld-release',			#
	'nld'				=>	'nld-release',			#
	'lfs'				=>	'lfs-release',			#
	'mk'				=>	'mk-release',			#
	'conectiva'			=>	'conectiva-release',	#
	'immunix'			=>	'immunix-release',		#
	'tinysofa'			=>	'tinysofa-release',		#
	'trustix'			=>	'trustix-release',		#
	'adamantix'			=>	'adamantix_version',	#
	'yoper'				=>	'yoper-release',		#
	'arch'				=>	'arch-release',			#
	'libranet'			=>	'libranet_version',		#
	'valinux'			=>	'va-release',			#
	'yellowdog'			=>	'yellowdog-release',	#
	'ultrapenguin'		=>	'ultrapenguin-release',	#
	);

# List of files that ambiguously indicates what distro we have
my %ambiguous_rel_files = (
	'mandrake'			=>	'mandrake-release',		# <= 10.1
	'debian'			=>	'debian_version',		# >= 3.1
	'suse'				=>	'SuSE-release',			# >= 10.0
	'redhat'			=>	'redhat-release',		# >= 7.3
	'lsb'				=>	'lsb-release',			# ???
	);

# Should have the same keys as the previous one.
# If ambiguity, which other distributions should be checked
my %distro_similar = (
	'mandrake'			=> ['mandrake', 'mandrakelinux'],
	'debian'			=> ['debian', 'ubuntu'],
	'suse'				=> ['suse', 'sles', 'opensuse'],
	'redhat'			=> ['redhat', 'rhel', 'centos', 'mandrake', 'vmware'],
	'lsb'				=> ['ubuntu', 'lsb'],
	);

my %distro_match = (
# Tested
	'gentoo'				=> '.* version (.+)',
	'slackware'			 	=> 'S[^ ]* (.+)$',
# There should be no ambiguity between potential ambiguous distro
	'mandrakelinux'			=> 'Mandrakelinux release (.+) \(',
	'mandrake'				=> 'Mandr[^ ]* release (.+) \(',
	'mandriva'				=> 'Mandr[^ ]* [^ ]* release (.+) \(',
	'fedora'				=> 'Fedora .*release (\d+) \(',
	'vmware'				=> 'VMware ESX Server (\d+) \(',
	'rhel'					=> 'Red Hat Enterprise Linux .*release (.+) \(',
	'centos'				=> '.*CentOS .*release (.+) ',
	'redhat'				=> 'Red Hat Linux release (.+) \(',
	'sles'					=> 'SUSE .* Enterprise Server (\d+) \(',
	'suse'					=> 'SUSE LINUX (\d.+) \(',
	'opensuse'				=> 'openSUSE (\d.+) \(',
	'lsb'					=> '.*[^Ubunt].*\nDISTRIB_RELEASE=(.+)',
# Ubuntu includes a /etc/debian_version file that cretaes an ambiguity with debian
# So we need to look at distros in reverse alphabetic order to treat ubuntu always first
	'ubuntu'				=> '.*Ubuntu.*\nDISTRIB_RELEASE=(.+)',
	'debian'				=> '(.+)',
# Not tested
	'arch'					=> '.* ([0-9.]+) .*',
	'redflag'				=> 'Red Flag (?:Desktop|Linux) (?:release |\()(.*?)(?: \(.+)?\)',
);

my $release;
my $distro;

# Begin to test presence of non-ambiguous files
# that way we reduce the choice
my ($d,$r);
while (($d,$r) = each %single_rel_files) {
	if (-f "$base/$r" && ! -l "$base/$r") {
		my $tmp=pb_get_content("$base/$r");
		# Found the only possibility. 
		# Try to get version and return
		if (defined ($distro_match{$d})) {
			($release) = $tmp =~ m/$distro_match{$d}/m;
		} else {
			print STDERR "Unable to find $d version in $r\n";
			print STDERR "Please report to the maintainer bruno_at_project-builder.org\n";
			$release = "unknown";
		}
		return($d,$release);
	}
}

# Now look at ambiguous files
# Ubuntu includes a /etc/debian_version file that creates an ambiguity with debian
# So we need to look at distros in reverse alphabetic order to treat ubuntu always first via lsb
foreach $d (reverse keys %ambiguous_rel_files) {
	$r = $ambiguous_rel_files{$d};
	if (-f "$base/$r" && !-l "$base/$r") {
		# Found one possibility. 
		# Get all distros concerned by that file
		my $tmp=pb_get_content("$base/$r");
		my $found = 0;
		my $ptr = $distro_similar{$d};
		pb_log(2,"amb: ".Dumper($ptr)."\n");
		$release = "unknown";
		foreach my $dd (@$ptr) {
			pb_log(2,"check $dd\n");
			# Try to check pattern
			if (defined $distro_match{$dd}) {
				pb_log(2,"cmp: $distro_match{$dd} - vs - $tmp\n");
				($release) = $tmp =~ m/$distro_match{$dd}/m;
				if ((defined $release) && ($release ne "unknown")) {
					$distro = $dd;
					$found = 1;
					last;
				}
			}
		}
		if ($found == 0) {
			print STDERR "Unable to find $d version in $r\n";
			print STDERR "Please report to the maintainer bruno_at_project-builder.org\n";
			$release = "unknown";
		} else {
			return($distro,$release);
		}
	}
}
return("unknown","unknown");
}

=back 

=head1 WEB SITES

The main Web site of the project is available at L<http://www.project-builder.org/>. Bug reports should be filled using the trac instance of the project at L<http://trac.project-builder.org/>.

=head1 USER MAILING LIST

None exists for the moment.

=head1 AUTHORS

The Project-Builder.org team L<http://trac.project-builder.org/> lead by Bruno Cornec L<mailto:bruno@project-builder.org>.

=head1 COPYRIGHT

Project-Builder.org is distributed under the GPL v2.0 license
described in the file C<COPYING> included with the distribution.

=cut


1;
