# use perl                                  -*- mode: Perl; -*-
eval 'exec perl -S $0 "$@"'
  if $running_under_some_shell;

use vars qw($running_under_some_shell);         # no whining!

# grepmail

$VERSION = 0.1;

# This program is a prototype program specialization tool. Tags in the input
# file, similar to <TAGNAME1 && TAGNAME2 || TAGNAME3>, are used to create a
# specialized program. The user specifies the values of the variables subject
# to the constraints set by the programmer.

use vars qw($VERSION);

use strict;

#------------------------------- MAIN PROGRAM --------------------------------

PrintGreeting();

my $filename = pop @ARGV;
die "$filename must be of the form filename.in\n" if $filename !~ /\.in$/;

open IN,$filename or die "Can't open $filename: $!";
my $file = join '',<IN>;
close IN;

# Get tag information, setting the tag values to 0 by default.
# %tags tells us which tags exist in the file, and their values.
my (%tagInfo,%tags);
$file =~ /<INFO>.*<TAGS>\s*(.*)\s*<\/TAGS>.*<\/INFO>/s;
my @temp = split /\n+/,$1;

foreach my $keyData (@temp)
{
  if ($keyData =~ /^(.*?)\s*:\s*(.*)$/)
  {
    $tagInfo{$1} = $2;
    $tags{$1} = 0;
  }
  else
  {
    $tagInfo{$keyData} = '';
    $tags{$keyData} = 0;
  }
}

# Get constraints information, putting it in the array @constraints
# @constraints contains all the constraints on the tags.
$file =~ /<INFO>.*<CONSTRAINTS>\s*(.*)\s*<\/CONSTRAINTS>.*<\/INFO>/s;
my @constraints = split /\n/,$1;

# Get the default tag values, setting the values for %tags
$file =~ /<INFO>.*<DEFAULT>\s*(.*)\s*<\/DEFAULT>.*<\/INFO>/s;
foreach my $value (split /\s+/,$1)
{
  die "A default was provided for \"$value\", but that tag was not declared\n",
      "in the <TAGS> block.\n"
    unless exists $tags{$value};
  $tags{$value} = 1;
}

# Get any command-line -DBLAH and -DBLAH=0 values
%tags = GetCommandLineFlags(%tags);

# Double-check that the defaults are satisfiable
CheckConstraints(\%tags,\@constraints);

# Let the user change the values
%tags = EditValues(\%tags,\%tagInfo,\@constraints);

# Delete the preamble, leaving only the marked-up text.
$file =~ s/<INFO>.*?<\/INFO>\s*//s;

Specialize(\%tags,\$filename,\$file);

# Create a log file
open LOG,">OPTIONS";
foreach my $key (keys %tags)
{
  print LOG "$key = $tags{$key}\n";
}
close LOG;

# ------------------------------------------------------------------------------

sub PrintGreeting
{
print<<EOF;
Hi! This is a prototype specialization program, built to evaluate a research
idea I've been working on. One of the problems software developers face is
that certain design decisions can not be made at development time given
uncertainty in the user's requirements. By pushing the resolution of those
decisions until installation time (or run time), we can allow the user to
participate in the decision process. Many approaches, like dynamic linking,
fail because these design decisions span multiple implementation modules. I'm
hoping that my approach will allow developers to delay such "cross-cutting"
design decisions.

So... This program will present you with a list of options and some
constraints on those options. You can change the values of the options,
subject to the constraints. When you are done, a specialized program will be
generated that conforms to the requirements that you have specified.

The constraints have been specified using predicate logic. For example, "A &&
B" means both A and B must be enabled. "A || B" means A or B must be enabled.
"A -> B" means that B must be enabled if A is. A <-> B means both A and B must
be enabled, or both must be disabled. Unconstrained options can have any
value.

Please send any questions or suggestions to coppit\@cs.virginia.edu

EOF

print "Press enter...";
<STDIN>
}

# ------------------------------------------------------------------------------

sub Specialize
{
my %tags = %{shift @_};
my $filename = ${shift @_};
my $file= ${shift @_};

my $numTags = 0;

$filename =~ s/\.in$//;
open OUT,">$filename" or die "Can't open $filename: $!";

# For each tag...
while ($file =~ /<([A-Z0-9 _|!&\(\)]+)>(\n?)/s)
{
  my $predicate = $1;

  print OUT $`;
  $file = $';

  my $endpattern = $predicate;
  $endpattern =~ s#([\|\(\)])#\\$1#gs;

  if ($file =~ /(\n?)<\/$endpattern>(\n?)/s)
  {
    $numTags++;
    my $newline1 = $1;
    my $newline2 = $2;
    my $text = $`.$newline1;
    $file = $';

    if (EvalPredicate(\%tags,\$predicate))
    {
      if ($newline1 ne "\n" && $newline2 eq "\n")
      {
        $file = $text.$newline2.$file;
      }
      else
      {
        $file = $text.$file;
      }
    }
    else
    {
      if ($newline1 ne "\n" && $newline2 eq "\n")
      {
        $file = $newline2.$file;
      }
    }
  }
  elsif (($file =~ /<(\/?)$endpattern>/s) &&
         ($1 ne '/'))
  {
    die "It looks like you specified <$endpattern> twice, but no </$endpattern>\n";
  }
  else
  {
    die "Can't find closing tag </$endpattern>\n";
  }
}

print OUT $file;
close OUT;

chmod 0755,$filename;

print "A file called \"$filename\" has been created in the current directory. Enjoy!\n";
}

# ------------------------------------------------------------------------------

# Get any command-line -DBLAH and -DBLAH=0 values
sub EditValues
{
  my %tags = %{shift @_};
  my %tagInfo = %{shift @_};
  my @constraints = @{shift @_};

  my $done = 0;
  my @tags = sort keys %tags;
  do
  {
    print "\n","-"x75,"\n\n";
    print "Constraints are:\n";
    local $" = "\n";
    print "@constraints\n\n";

    print "Values are:\n";
    my $i = 0;
    foreach my $key (@tags)
    {
      $i++;
      print "$i) ";
      print "X" if $tags{$key} == 1;
      print " " if $tags{$key} == 0;
      print " $key: $tagInfo{$key}\n";
    }

    print "\n";

    CheckConstraints(\%tags,\@constraints);

    print "\nEnter the number of the value to flip, or enter to continue.\n";

    my $response = <STDIN>;
    chomp $response;

    if ($response eq '')
    {
      if (CheckConstraints(\%tags,\@constraints))
      {
        print "\nYou must choose features such that the constraints are satisfied before you can\nquit.\n";
      }
      else
      {
        $done = 1;
      }
    }
    elsif ($response-1 <= $#tags)
    {
      $tags{$tags[$response-1]} = !$tags{$tags[$response-1]};
    }
  } until $done;

  return %tags;
}

# ------------------------------------------------------------------------------

# Get any command-line -DBLAH and -DBLAH=0 values
sub GetCommandLineFlags
{
  my %tags = @_;

  while ($#ARGV != -1)
  {
    my $flag = shift @ARGV;

    if ($flag =~ /-D([^=]*)=?(.*)/)
    {
      my $tag = $1;
      my $value = $2;
      $value = 1 if $value eq '';

      $tags{$tag} = $value;
    }
  }

  return %tags;
}

#------------------------------------------------------------------------------

sub EvalPredicate
{
  my %tags = %{shift @_};
  my $predicate = ${shift @_};

  $predicate =~ s/([A-Z0-9_]+)/(\$tags{$1} == 1)/gs;
  if ($predicate =~ /^(.*?)\s*<->\s*(.*?)$/)
  {
    return eval "if (($1) && ($2) || !($1) && !($2)) {return 1} else {return 0}";
  }
  elsif ($predicate =~ /^(.*?)\s*->\s*(.*?)$/)
  {
    return eval "if (($1) && !($2)) {return 0} else {return 1}";
  }
  else
  {
    return eval "if ($predicate) {return 1} else {return 0}";
  }
}

# ------------------------------------------------------------------------------

sub CheckConstraints
{
  my %tags = %{shift @_};
  my @constraints = @{shift @_};

  my $failedConstraint = 0;
  foreach my $constraint (@constraints)
  {
    if(EvalPredicate(\%tags,\$constraint) == 0)
    {
      print "Constraint \"$constraint\"\n";
      print "  is not satisfiable for the values of its tags.\n";

      $failedConstraint = 1;
    }
  }

  return $failedConstraint;
}
