package SystemName;

require Exporter;

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

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

my @DIST_REDHAT = (
  'redhat', '/etc/redhat-release', \&dist_ver_name_number, 'rpm'
);
my @DIST_DEBIAN = (
  'debian', '/etc/debian_version', \&dist_ver_debian, 'deb'
);
my @DIST_SUSE = (
  'suse', '/etc/SuSE-release', \&dist_ver_name_number, 'rpm'
);
my @DIST_SLACKWARE = (
  'slackware', '/etc/slackware-version', \&dist_ver_name_number
);
my @DIST_FILE = (
  \@DIST_REDHAT, \@DIST_DEBIAN, \@DIST_SUSE, \@DIST_SLACKWARE
);

my %ASM = (
  'alpha' => [ '#', 'ret' ],
  '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));
    
    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);
  }
  die "Can't determine distribution name though uname says this is Linux."
}

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

  $ENTITY{'UNAME'} = $uname;
  # SunOS will return 'sparc' for -p, and something like 'sun4u' for -m.
  # OTOH Linux distributions return 'unknown' for -p
  my $arch = `uname -p`;
  chomp $arch;

  my $msg = sprintf("uname=%s machine=%s uname-p=%s",
    $uname, $machine, $arch);
  $arch = $machine if ($arch eq 'unknown');

  if ($arch =~ m/i[0-9]86/)
  {
    $arch = 'i386';
    $ENTITY{'ASM_STYLE'} = 'intel';
    $ENTITY{'ASM_FLAVOR'} = 'set disassembly-flavor intel';
  }
  else
  {
    $ENTITY{'ASM_STYLE'} = 'att';
    $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);
  }
}

1;
