package Misc;

require Exporter;

@ISA = qw(Exporter);
@EXPORT_OK = qw(
  %ENTITY
  get_env
  split_hex
  parse_file
  parse_file_set
  write_sh_variables
);

use strict;

#
# global variables
#
use vars qw( %ENTITY $GLOBAL_PRE );
$GLOBAL_PRE = 'TEVWH_';
my $HAVE_PRE = $GLOBAL_PRE . 'HAVE_';

#
# get_env
#
sub get_env($)
{
  my $name = shift;
  my $val = $ENV{$name}
  || die "Environment variable '$name' not defined.";
  return $val;
}

#
# split_hex
#
sub split_hex($)
{
  my @n = split(/\s+/, shift());

  for my $n(@n)
  {
    $n =~ s/^0x//;

    # this is necessary for SunOS 5.7 where objdump insists on
    # writing 64-bit even for 32-bit executables
    $n =~ s/^0+([0-9a-fA-f])/$1/;
  }
  return @n;
}

#
# parse_file
#
sub parse_file($$;@)
{
  my $fn = shift;
  my $filename = shift;

  open(FILE, $filename) || return "Can't open $filename: $!";
  my @line;
  while(<FILE>)
  {
    s/\s*$//;
    push @line, $_;
  }
  close FILE;
  return "$filename is empty\n" if ($#line < 0);

  $fn = '::' . $fn if (!($fn =~ m/::/));
  # my $ref = eval "\\&$fn";
  my $ref = \&{$fn};

  my $msg = &$ref(\@line, @_, $filename);
  return undef if (!defined($msg));
  return "$fn(\"$filename\"): $msg\n";
}

#
# parse_file_set
#
sub parse_file_set($@)
{
  my $only_one = shift;
  for my $file(@_)
  {
    my $msg = &parse_file(@$file);
    if (defined($msg))
    {
      print $msg . "\n" if (defined($msg));
      next;
    }
    return if ($only_one);
  }
}

#
# open_config_file
#
sub open_config_file($$;$$)
{
  my $FILE = shift;
  my $name = shift;
  my $header_pre = shift;
  my $header_post = shift;

  $header_pre = '# ' if (!defined($header_pre));
  $header_post = '' if (!defined($header_post));

  open($FILE, '>' . $name) || die "Can't open $name for writing: $!";
  printf $FILE "%sGenerated by configure.pl, do not edit.%s\n\n",
    $header_pre, $header_post;
}

#
# open_xml_file
#
sub open_xml_file($$)
{
  open_config_file(shift(), shift(), '<!-- ', ' -->');
}

#
# write_sh_variables
#
sub write_sh_variables($$$$$$$;$)
{
  my $r_hash = shift;
  my $SH = shift;
  my $CSH = shift;
  my $MAK = shift;
  my $SED = shift;
  my $H = shift;
  my $XML = shift;
  my $prefix = shift;
  $prefix = '' if (!defined($prefix));

  my $entity_pre = 'config.' . $prefix;
  $entity_pre =~ y#-/_#.#;

  my $path_pre = $GLOBAL_PRE . $prefix;
  my $have_pre = $HAVE_PRE . $prefix;

  my $export = ''; 
  while (my ($entity, $value) = each %$r_hash)
  {
    die "\$r_hash{$entity} is undefined." if (!defined($value));
    my $name = $GLOBAL_PRE . $prefix . $entity;

    printf $SH "%s='%s'\n", $name, $value;
    $export .= ' ' . $name;
    printf $CSH "setenv %s '%s'\n", $name, $value;
    printf $MAK "%s=%s\n", $name, $value;
    printf $MAK "%s=%s\n", $have_pre . $entity, lc($entity);

    $entity =~ y#-/_#.#;
    printf $XML "<!ENTITY %s%s \"%s\">\n", $entity_pre, $entity, $value;

    $value =~ s/([#\\\[\]])/\\$1/g;
    printf $SED "s#\${%s}#%s#g\n", $name, $value;

    # Hexadecimal values are output without leading '0x' to enable
    # echo "ibase=16; ELF_BASE" | bc
    # For C this is a PITA, so try to add the prefix
    # $value =~ s/^0x(\d+)$/$1/;

    $value = '0x' . $value
    if ($entity =~ m/^ELF\./ && $value =~ m/^[\dA-Fa-f]+$/);
    printf $H "#define %s %s\n", $name, $value;
  }
  printf($SH "\nexport%s\n\n", $export) if (length($export) > 0);
}

#
# write_xml_table
#
sub write_xml_table($$;$$@)
{
  my $FILE = shift;
  my $r_hash = shift;

  my $prefix = shift;
  $prefix = '' if (!defined($prefix));
  my $pivot_len = shift;
  $pivot_len = 26 if (!defined($pivot_len));

  my %hash = %$r_hash;
  for my $key(@_) { delete $hash{$key}; }

  # index 0 is the two-column table (long values)
  # index 2 is the four-column table (short values)
  my @table = ( '', '' ); # XML to print
  my @nr = ( 0, 0);       # number of printed items  
  my @new_row = ( 1, 2 );

  my @key = sort(keys(%hash));
  for my $key(@key)
  {
    my $value = $hash{$key};
    my $index = (length($value) > $pivot_len) ? 0 : 1;

    my $table = \$table[$index];
    my $nr = \$nr[$index];
    my $new_row = \$new_row[$index];

    $$table .= "  </row><row>\n" if ($$nr % $$new_row == 0 && $$nr > 0);
    $$table .= sprintf(
      "    <entry><literal>%s%s</literal></entry>\n",
      $prefix, $key
    );
    $$table .= sprintf("    <entry><literal>%s</literal></entry>\n", $value);
    $$nr++;
  }

  for(my $index = 0; $index <= $#table; $index++)
  {
    my $table = \$table[$index];
    my $nr = \$nr[$index];
    my $new_row = \$new_row[$index];

    next if (length($$table) == 0);
  
    printf $FILE "<tgroup cols=\"%d\">\n", $$new_row * 2;
    print $FILE "  <thead>\n";
    print $FILE "    <row>\n";
    for(my $i = 0; $i < $$new_row; $i++)
    {
      print $FILE "      <entry>Variable name</entry>\n";
      print $FILE "      <entry>Value on this platform</entry>\n";
    }
    print $FILE "    </row>\n";
    print $FILE "  </thead>\n";
    print $FILE "  <tbody><row>\n";
    print $FILE $$table;
    print $FILE "  </row></tbody>\n</tgroup>\n";
  }
}

1;
