package SystemName;

require Exporter;

@ISA = qw(Exporter);
@EXPORT_OK = qw(
  determine
);

use Entity qw( %ENTITY );
use POSIX();
use strict;

my @DIST_FILE = (
  [ 'redhat', '/etc/redhat-release', \&dist_ver_name_number, 'rpm' ],
  [ 'debian', '/etc/debian_version', \&dist_ver_debian, 'deb' ],
  [ 'suse', '/etc/SuSE-release', \&dist_ver_name_number, 'rpm' ],
  [ 'slackware', '/etc/slackware-version', \&dist_ver_name_number ],
  [ 'gentoo', '/etc/gentoo-release', \&dist_ver_name_number ],
  [ 'cobalt', '/etc/cobalt-release', \&dist_ver_name_number, 'rpm' ]
);

my %ASM = (
  'alpha' => [ '#', '(ret|halt)' ],
  'i386'  => [ ';', '(ret|hlt)' ],
  'sparc' => [ '!', '(restore|unimp)' ]
);

my %PROC_EXE = (
  'Linux' => '/proc/self/exe',
  'FreeBSD' => '/proc/curproc/file',
  'SunOS' => '/proc/self/object/a.out'
);
my %PROC_MEM = (
  'Linux' => '/proc/self/mem',
  'FreeBSD' => '/proc/curproc/mem'
);

#
# read_first_line
#
sub read_first_line($)
{
  my $filename = shift;
  ( -e $filename ) || return undef;
  open(FILE, '<' . $filename) || die "Can't open $filename: $!";
  my $file = <FILE>;
  $file =~ s/\s+$//;
  close FILE;
  return $file;
}

#
# dist_ver_name_number
#
# Decodes a line containing a number like "Slackware 8.1"
# or "SuSE Linux 7.3 (SPARC)".
#
sub dist_ver_name_number($)
{
  my $line = shift;
  $line =~ m/([0-9]+\.[0-9])/;
  return ( $1, $line );
}

#
# dist_ver_debian
#
sub dist_ver_debian()
{
  my $line = shift;
  my $full = sprintf('Debian GNU/Linux %s', $line);
  return ( $line , $full );
}

#
# linux_distribution
#
sub linux_distribution()
{
  for my $dist(@DIST_FILE)
  {
    my $line = read_first_line($$dist[1]);
    next if (!defined($line));

    $PackageTool::PATH{'DISTID'} = $$dist[1];
    
    my $vendor = $$dist[0];
    $ENTITY{'OS_VENDOR'} = $vendor;

    my $pkgtool = $$dist[3];
    $pkgtool = $vendor if (!defined($pkgtool));
    $ENTITY{'OS_PKG_SYS'} = $pkgtool;

    my $func = $$dist[2];
    return $vendor, &$func($line);
  }
  print "Can't determine distribution name (uname says this is Linux).\n";
  $ENTITY{'OS_PKG_SYS'} = 'unknown';
  return $ENTITY{'OS_VENDOR'} = 'unknown', '0', 'unknown';
}

#
# determine
#
sub determine()
{
  my ($uname, $nodename, $release, $version, $machine) = POSIX::uname();
  $ENTITY{'UNAME'} = $uname;

  my $arch;
  if ($uname eq 'Linux')
  {
    # gcc can't produce 64-bit sparc code, so treat all sparc as 32-bit
    $machine = 'sparc' if ($machine eq 'sparc64');
    $arch = $machine;
  }
  else
  { # SunOS will return 'sparc' for -p, and something like 'sun4u' for -m.
    # OTOH Linux distributions return 'unknown' for -p
    # and one infamous Linux box refuses a 'uname -p' at all
    $arch = `uname -p`;
    chomp $arch;
  }
  my $msg = sprintf("uname=%s machine=%s uname-p=%s",
    $uname, $machine, $arch);

  if ($arch =~ m/^i[3-9]86/ || $arch =~ m/^AMD/)
  {
    $arch = 'i386';
    $ENTITY{'ASM_STYLE'} = 'intel';
    $ENTITY{'ASM_OBJDUMP'} = '-Mintel';
    $ENTITY{'ASM_FLAVOR'} = 'set disassembly-flavor intel';
  }
  else
  {
    $ENTITY{'ASM_STYLE'} = 'att';
    $ENTITY{'ASM_OBJDUMP'} = '';
    $ENTITY{'ASM_FLAVOR'} = '';
  }
  printf "%s arch=%s\n", $msg, $arch;

  $ENTITY{'ARCH'} = $arch;
  my $asm = $ASM{$arch}
  || die "No entry for architecture $arch in \%ASM";
  $ENTITY{'ASM_COMMENT'} = $$asm[0] || die;

  $ENTITY{'ASM_RETURN'} = $$asm[1] || die;

  my $exe = $PROC_EXE{$uname};
  $ENTITY{'PROC_EXE'} = $exe if (defined($exe));
  my $mem = $PROC_MEM{$uname};
  $ENTITY{'PROC_MEM'} = $mem if (defined($mem));

  $ENTITY{'HOSTTYPE'} = $uname . '/' . $arch;
  if ($uname eq 'Linux')
  {
    my ( $vendor, $version, $fullname ) = linux_distribution;

    $ENTITY{'OS_VERSION'} = $version;
    $ENTITY{'OS_NAME'} = $fullname;
    $ENTITY{'OS_CODE'} = lc sprintf('%s-%s%s-%s',
      $arch, $vendor, $version, $uname
    );
  }
  else
  {
    $ENTITY{'OS_VERSION'} = $release;
    $ENTITY{'OS_NAME'} = $uname . ' ' . $release;
    $ENTITY{'OS_PKG_SYS'} = $uname;

    # On FreeBSD I don't care about "4.6.1-RELEASE-p10"
    $release =~ s/-.*//;
    $ENTITY{'OS_CODE'} = lc($arch . '-' . $uname . $release);

    if ($uname eq 'SunOS')
    {
      $PackageTool::PATH{'DISTID'} = '/etc/release';
    }
  }
  printf $ENTITY{'OS_CODE'} . "\n";
}

#
# dont_have_nasm
#
sub dont_have_nasm()
{
  $ENTITY{'ASM_STYLE'} = 'att';
  $ENTITY{'ASM_COMMENT'} = '#';
}

1;
