#  Copyright (c) 1997-2004
#  Ewgenij Gawrilow, Michael Joswig (Technische Universitaet Berlin, Germany)
#  http://www.math.tu-berlin.de/polymake,  mailto:polymake@math.tu-berlin.de
#
#  This program is free software; you can redistribute it and/or modify it
#  under the terms of the GNU General Public License as published by the
#  Free Software Foundation; either version 2, or (at your option) any
#  later version: http://www.gnu.org/licenses/gpl.txt.
#
#  This program is distributed in the hope that it will be useful,
#  but WITHOUT ANY WARRANTY; without even the implied warranty of
#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#  GNU General Public License for more details.
#----------------------------------------------------------------------------
#  $Project: polymake $$Id: Customize.pm,v 1.13 2004/11/26 19:04:24 gawrilow Exp $

use strict;
use namespaces;

package Poly::Customize;
use Enum qw( state: undefined saved default changed=4 config=8 global=16 );

sub help2comment {
   my ($text)=@_;
   $text =~ s/^\s*$//mg;
   $text =~ s/^/\# /mg;
   $text .= "\n" if length($text) && substr($text,-1) ne "\n";
   $text;
}

sub printable_scalar {
   defined($_[0]) ? is_numeric($_[0]) ? $_[0] : "'$_[0]'" : "undef";
}

sub printable_decl {
   my $self=$_[0];
   ( $self->state & $state_global ? "#*** set globally ***\n" : "" ) .
   ( $self->state & $state_saved ? $self->state & $state_config ? "CONFIGURE:\n" : "" : "# " ) .
   $self->full_name . "=" 
}
#################################################################################
package Poly::Customize::Var;
use Struct (
   [ new => '$$' ],
   [ '$name' => '#1' ],
   [ '$state' => '#2' ],
   '$help',
);

#################################################################################
package Poly::Customize::Scalar;
use Struct (
   [ '@ISA' => 'Poly::Customize::Var' ],
   [ '$saved_value' => 'undef' ],
   [ '$default_value' => 'undef' ],
);

sub TIESCALAR {
   my $self=&_new;
   no strict 'refs';
   $self->saved_value=$ {$self->name};
   $self->state |= $state_saved;
   $self;
}

sub un_tie {
   my $self=shift;
   no strict 'refs';
   if ($self->state & $state_saved) {
      untie $ {$self->name};
      $ {$self->name}=$self->saved_value;
      $self->state & $state_changed;
   } else {
      $self->state & $state_config
         and defined( $self->saved_value=$ {$self->name} )
         and $self->state |= $state_saved;	# return TRUE enforcing the customization file to be rewritten
   }
}

sub FETCH {
   $_[0]->saved_value;
}

sub STORE {
   my $self=$_[0];
   if ($self->state & $state_config) {
      $self->state |= $state_changed | $state_saved;
      $self->saved_value=$_[1];
   } else {
      $self->default_value=$_[1];
   }
}

sub new {
   my $self=&_new;
   no strict 'refs';
   if (defined ($self->default_value=$ {$self->name})) {
      $self->state |= $state_default;
   } elsif (!$self->state) {
      die "undefined custom variable \$", $self->name, "\n";
   }
   $self;
}

sub set {
   my $self=shift;
   ($self->state |= $state_saved | $state_changed) &= ~$state_config;
   no strict 'refs';
   $self->saved_value=$ {$self->name};
}

sub reset {
   my $self=shift;
   undef $self->saved_value;
   no strict 'refs';
   if ($self->state & $state_config) {
      $self->state=$state_config;
      undef $ {$self->name};
   } else {
      $self->state=$state_default;
      $ {$self->name}=$self->default_value;
   }
}

sub prefix { "\$" }

sub printable_value {
   my $self=$_[0];
   printable_scalar($self->state & $state_saved ? $self->saved_value : $self->default_value)
}

#################################################################################
package Poly::Customize::Array;
use Struct (
   [ '@ISA' => 'Poly::Customize::Var' ],
   '@saved_value',
   '@default_value',
);

sub TIEARRAY {
   my $self=&_new;
   no strict 'refs';
   @{$self->saved_value}=@{$self->name};
   $self->state |= $state_saved;
   $self;
}

sub un_tie {
   my $self=shift;
   no strict 'refs';
   if ($self->state & $state_saved) {
      untie @{$self->name};
      @{$self->name}=@{$self->saved_value};
      $self->state & $state_changed;
   } else {
      $self->state & $state_config
         and @{$self->saved_value}=@{$self->name}
         and $self->state |= $state_saved;	# return TRUE enforcing the customization file to be rewritten
   }
}

sub FETCH {
   $_[0]->saved_value->[$_[1]];
}

sub EXTEND {
   my ($self, $n)=@_;
   if ($self->state & $state_config) {
      $self->state |= $state_changed | $state_saved;
      $#{$self->saved_value}=$n-1;
   } else {
      $#{$self->default_value}=$n-1;
   }
}

sub STORE {
   my $self=$_[0];
   ($self->state & $state_config ? $self->saved_value : $self->default_value)->[$_[1]]=$_[2];
}

sub new {
   my $self=&_new;
   no strict 'refs';
   if (defined *{$self->name}{ARRAY}) {
      @{$self->default_value}=@{$self->name};
      $self->state |= $state_default;
   } elsif (!$self->state) {
      die "undefined custom variable \@", $self->name, "\n";
   }
   $self;
}

sub set {
   my $self=shift;
   ($self->state |= $state_saved | $state_changed) &= ~$state_config;
   no strict 'refs';
   @{$self->saved_value}=@{$self->name};
}

sub reset {
   my $self=shift;
   undef @{$self->saved_value};
   no strict 'refs';
   if ($self->state & $state_config) {
      $self->state=$state_config;
      undef @{$self->name};
   } else {
      $self->state=$state_default;
      @{$self->name}=@{$self->default_value};
   }
}

sub prefix { '@' }

sub printable_value {
   my $self=$_[0];
   "( " .
      join(", ", map { printable_scalar($_) }
	   @{ $self->state & $state_saved ? $self->saved_value : $self->default_value }) .
   " )"
}

#################################################################################
package Poly::Customize::Hash;
use Struct (
   [ '@ISA' => 'Poly::Customize::Var' ],
   '%saved_value',
   '%default_value',
);

sub TIEHASH {
   my $self=&_new;
   no strict 'refs';
   %{$self->saved_value}=%{$self->name};
   $self->state |= $state_saved;
   $self;
}

sub un_tie {
   my $self=shift;
   no strict 'refs';
   if ($self->state & $state_saved) {
      untie %{$self->name};
      %{$self->name}=(%{$self->default_value}, %{$self->saved_value});
      $self->state & $state_changed;
   } else {
      $self->state & $state_config
         and do { %{$self->saved_value}=%{$self->name};  keys %{$self->saved_value} }
         and $self->state |= $state_saved;	# return TRUE enforcing the customization file to be rewritten
   }
}

sub FETCH {
   $_[0]->saved_value->{$_[1]};
}

sub STORE {
   my $self=$_[0];
   if ($self->state & $state_config) {
      $self->state |= $state_changed | $state_saved;
      $self->saved_value->{$_[1]}=$_[2];
   } else {
      $self->default_value->{$_[1]}=$_[2];
   }
}

sub EXISTS {
   exists $_[0]->saved_value->{$_[1]};
}

sub FIRSTKEY {
   each %{$_[0]->saved_value};
}

*NEXTKEY=\&FIRSTKEY;

sub DELETE {
   my $self=$_[0];
   if ($self->state & $state_config) {
      $self->state |= $state_changed;
      delete $self->default_value->{$_[1]};
   } else {
      delete $self->default_value->{$_[1]};
   }
}

sub CLEAR {
   my $self=$_[0];
   if ($self->state & $state_config) {
      $self->state |= $state_changed;
      %{$self->saved_value}=();
   } else {
      %{$self->default_value}=();
   }
}

sub new {
   my $self=&_new;
   no strict 'refs';
   if (defined *{$self->name}{HASH}) {
      %{$self->default_value}=%{$self->name};
      if (keys %{$self->default_value}) {
	 $self->state |= $state_default;
      }
   } elsif (!$self->state) {
      die "undefined custom variable %", $self->name, "\n";
   }
   $self;
}

sub set {
   my ($self, $key)=@_;
   ($self->state |= $state_saved | $state_changed) &= ~$state_config;
   no strict 'refs';
   if (@_==2) {
      $self->saved_value->{$key}=$self->name->{$key};
   } else {
      %{$self->saved_value}=%{$self->name};
   }
}

sub reset {
   my $self=shift;
   no strict 'refs';
   if (my ($key)=@_) {
      delete $self->saved_value->{$key};
      if (keys %{$self->saved_value}) {
	 if (exists $self->default_value->{$key}) {
	    $self->name->{$key}=$self->default_value->{$key};
	 } else {
	    delete $self->name->{$key};
	 }
	 return;
      }
   }
   undef %{$self->saved_value};
   if ($self->state & $state_config) {
      $self->state=$state_config;
      undef %{$self->name};
   } else {
      $self->state=$state_default;
      %{$self->name}=%{$self->default_value};
   }
}

sub prefix { '%' }

sub printable_value {
   my ($self)=@_;
   my $h=$self->help;
   ( join("", map {
                 my $quoted= /\W/ ? "'$_'" : $_;
                 ($self->state & $state_saved)  &&  exists $self->saved_value->{$_}
		 ? "   $quoted => " . printable_scalar($self->saved_value->{$_}) . " ,"
		 : "#  $quoted => " . printable_scalar($self->default_value->{$_}) . " ," ,

		 $h =~ s/^\s* $_ \s* => \s* (.*)$//xm
	         ? "  " . help2comment($1)
		 : "\n"
	      } sorted_uniq( sort keys %{$self->saved_value}, keys %{$self->default_value} )
     ) .
     do {
	my $rest="";
	while ($h =~ s/^\s* (?: (\w+) | (['"])([^"']+)\2) (\s* => .*)$//xm) {
	   my ($key, $value)=($1 || $2.$3.$2, $4);
	   $rest .= help2comment(" $key $value");
	}
	$rest
     },

     help2comment($h)
   );
}

sub printable {
   my ($self)=@_;
   my ($v, $h)=&printable_value;
   $h .= "# \n" if $h =~ /^.*[^\#\s]\s*\E/m;
   $h . &printable_decl . "(\n" . $v .
   ($self->state & $state_saved ? "" : "# ") . ");\n"
}

#################################################################################
package Poly::Customize::Var;

# A custom variable is tied if it was loaded from the customization file.
# This way we can catch its default value which would otherwise overwrite
# the customized one.

my %prefix_dispatch=( "\$" => 'Poly::Customize::Scalar',
		      '@' => 'Poly::Customize::Array',
		      '%' => 'Poly::Customize::Hash' );
sub new {
   $prefix_dispatch{substr($_[1],0,1)}->new(substr($_[1],1), $_[2] && $state_config);
}

sub full_name {
   my $self=$_[0];
   @_>1  &&  $self->name =~ /^$_[1]::/
   ? "our " . $self->prefix . $'
   : $self->prefix . $self->name
}

sub CLEAR { }	# precedes the initialization of array or hash, but everything is already prepared in TIE

#################################################################################
sub printable {
   my $self=$_[0];
   help2comment($self->help) . &printable_decl . $self->printable_value . ";\n";
}
#################################################################################
package Poly::Customize::perModule;

use Struct (
   [ new => '$' ],
   [ '$handler' => '#1' ],
   '%per_pkg',			# package_name->var_name->Var
);

# Constructor: (handler, module_name, file fragments ... )
sub new {
   my $self=&_new;
   shift; my $default_pkg=shift;
   my $per_pkg=$self->per_pkg;
   my $user_file=1;
   foreach my $piece (@_) {
      $piece =~ s/^\s*\#.*$//mg;
      while ($piece =~ /(?: ^ | ; ) \s* (^CONFIGURE: \s*)? (?:our \s+)? ([\$\@%] (?!\d)[\w:]+) \s* =/xmg) {
	 my ($full_name, $config)=($2, $user_file ? $1 && $state_config : $state_config | $state_global);
	 my ($pkg, $name);
	 if ($full_name =~ /^.(.*)::([^:]+)$/) {
	    $pkg=$1;
	    $name=substr($full_name,0,1) . $2;
	 } else {
	    $pkg=$default_pkg;
	    $name=$full_name;
	    substr($full_name,1,0).="$pkg\::";
	 }
	 ( $per_pkg->{$pkg}->{$name} &&=
	   err_print( "multiple definition of custom variable '$full_name'" )
	 ) ||= do {
	    no strict 'refs';
	    if (substr($full_name,0,1) eq '$') {
	       tie ${$full_name}, 'Poly::Customize::Scalar', substr($full_name,1), $config;
            } elsif (substr($full_name,0,1) eq '@') {
               tie @{$full_name}, 'Poly::Customize::Array', substr($full_name,1), $config;
            } else {
	       tie %{$full_name}, 'Poly::Customize::Hash', substr($full_name,1), $config;
            }
	 }
      }
      if (!$user_file) {
         while (my ($pkg, $add_dict)=each %$per_pkg) {
	    my $dict=($self->per_pkg->{$pkg} ||= $add_dict);
	    if ($dict != $add_dict) {
	       while (my ($name, $add_var)=each %$add_dict) {
		  my $var=($dict->{$name} ||= $add_var);
		  if ($var != $add_var  and  $var->state & $state_config) {
		     $dict->{$name}=$add_var;
		     $self->handler->need_save=1;
		     if (is_hash($var->saved_value)) {
			push %{$var->saved_value}, %{$add_var->saved_value};
			$add_var->saved_value=$var->saved_value;
		     }
		  }
	       }
            } else {
	       $self->handler->need_save=1;
	    }
         }
      }
      $per_pkg={ };
      $user_file=0;
   }
   $self;
}
#################################################################################
sub add {
   my ($self, $full_name, $help_text, $config_mode)=@_;
   my ($pkg, $name);
   if ($full_name =~ /^.(.*)::([^:]+)$/) {
      $pkg=$1 || "main";
      $name=substr($full_name,0,1).$2;
   } else {
      $pkg=caller;
      $name=$full_name;
      substr($full_name,1,0).="$pkg\::";
   }

   my $var=$self->per_pkg->{$pkg}->{$name} ||= new Poly::Customize::Var($full_name, $config_mode);
   $help_text =~ s{^\#\s+}{}mg;
   $var->help= $help_text || "undocumented";
}
#################################################################################
sub find {
   my ($self, $name, $pkg)=@_;
   if ($name =~ s/^(.)(.*)::([^:]+)$/$1$3/) {
      $pkg=$2;
   }
   $self->per_pkg->{$pkg}->{$name};
}
#################################################################################
sub set {
   my ($self, $name)=@_;
   if (defined (my $var=$self->find($name))) {
      $var->set(@_[2..$#_]);
      $self->handler->need_save=1;
   } else {
      die "unknown custom variable $name\n";
   }
}
#################################################################################
sub reset {
   my ($self, $name)=@_;
   if (defined (my $var=$self->find($name))) {
      $var->reset(@_[2..$#_]);
      $self->handler->need_save=1;
   } else {
      die "unknown custom variable $name\n";
   }
}
#################################################################################
sub refresh {
   my $self=shift;
   my $changed;
   foreach my $dict (values %{$self->per_pkg}) {
      foreach my $var (values %$dict) {
	 $changed |= $var->un_tie;
      }
   }
   $self->handler->need_save ||= $changed;
}
#################################################################################
package Poly::Customize::File;
use Struct (
   [ new => '$;$' ],
   [ '$filename' => '#1' ],	# where to save custom variables
   '$version',
   '%orphans',			# package => file fragment
);

sub new {
   my $self=&_new;
   local $/;
   my $filename=$self->filename;
   open my $cf, $filename
      or die "can't read customization file \"$filename\": $!\n";
   my $text=<$cf>;
   if ($Switches::reconfigure) {
      $text =~ s/^CONFIGURE: (?s: .*? ) (?= ^\s*$ )//xmg;
   }

   my $version;
   eval <<"_#_#_#_";
no namespaces;
#line 1 "$filename"
$text
_#_#_#_
   if ($@) {
      err_print( process_eval_errors($@) );
      return undef;
   }
   (undef, %{$self->orphans})=split /^\s* package \s+ ((?!\d)[\w:]+) \s*; \s*$/mx, $text;
   $self->version=$version;
   $self;
}
#################################################################################
package Poly::Customize;

use Struct (
   '@files',			# ( Poly::Customize::File )
   '@modules',			# Module or Application
   '$need_save',		# boolean
);

sub import {
   if (@_<2) {
      croak( "usage: use Customize \"filename\", ..." );
   }
   my $pkg=caller;
   if (do { no strict 'refs'; exists &{"$pkg\::custom_handler"} }) {
      croak( "attempt to install multiple customization handlers in package \"$pkg\"" );
   }
   my $self=&_new;
   my $user_filename=shift;
   define_function($pkg, "custom_handler", sub { $self });
   my $user_mtime;

   if (-f $user_filename  and
       my $user_file=new Poly::Customize::File($user_filename)) {
      push @{$self->files}, $user_file;
      $user_mtime=(stat _)[9];
      $self->need_save= defined $main::Version &&
                        (!defined($user_file->version)  ||  $user_file->version lt $main::VersionNumber);
      eval "package $pkg; END { \$self->save if \$self->need_save }";
   } else {
      $self->need_save=1;
      eval "package $pkg; END { \$self->save(\$user_filename) }";
   }

   foreach (@_) {
      if (-f  and  $Switches::reconfigure || !defined($user_mtime) || (stat _)[9]>$user_mtime  and
	  my $system_file=new Poly::Customize::File($_)) {
	 push @{$self->files}, $system_file;
	 $self->need_save=1;
      }
   }
}
#################################################################################
# protected:
# before compiling the rules
sub begin_module {
   my ($self, $module)=@_;
   new Poly::Customize::perModule(weak($self), $module->pkg,
				  grep { defined || !($self->need_save=1) }
				  map { delete $_->orphans->{$module->pkg} } @{$self->files});
}
#################################################################################
# protected:
# after compiling the rules
sub end_module {
   my ($self, $module)=@_;
   push @{$self->modules}, $module;
   $module->custom->refresh;
}
#################################################################################

my $sep_line="########################\n";

my $preface=<<'.';
#########################################################################
#
#  This file contains copies of all customizable variables
#  scattered across the rule files.
#
#  The assignments can stay commented out as long as you are satisfied
#  with the default settings.  To change them, either edit this file
#  directly or use the interactive 'customize' command.
#  To revert to the default values later, simply comment out
#  the corresponding assignments or execute 'customize NAME=default'.
#
#  Elements of hash arrays can be activated selectively,
#  entries with default values may stay commented as long as needed.
#  But don't forget the last line with the closing parenthesis!
#
#  Be sure to edit this file only after you have finished the
#  interactive polymake session, otherwise your changes can be lost.
#
#  Some variables come from the rule autoconfiguration sections.
#  They are prefixed by the label `CONFIGURE'.
#  If you manually change some setting afterwards and want it to survive
#  the `polymake --reconfigure' run, please remove this label.
#
#  Please be aware that this file is loaded as the very first,
#  before any rule file. It gives the settings made here a chance
#  to be compiled in the rule code.
#  But you cannot refer here to any objects created in the course of parsing
#  the rule files, e.g. applications, object types, or preference lists.
#  Please use another file in this directory "prefer.pl" for these
#  purposes.
#
#########################################################################

.
if (defined $main::Version) {
   $preface .= <<"." . $sep_line;
# The rule files are rescanned for new custom variables as soon as you
# run a polymake version newer than recorded here, or use an application
# for the first time.
# If you have added new custom variables and want them to appear here
# right now, comment out the following line and run polymake.
\$version=v$main::Version;

.
}

sub save {
   my ($self, $filename)=@_;
   unless (defined($filename)) {
      die "no customization files to save\n" unless @{$self->files};
      $filename=$self->files->[0]->filename;
   }
   open my $cf, ">", $filename
      or die "can't store user settings in \"$filename\": $!\n";
   print $cf $preface;

   foreach my $module (@{$self->modules}) {
      my ($tree, $mod_pkg, $hh)=($module->custom->per_pkg, $module->pkg, $module->help);
      print $cf "package $mod_pkg;\n\n";

      foreach my $pkg (sort { $a eq $mod_pkg ? -1 : $b eq $mod_pkg ? 1 : $a cmp $b } keys %$tree) {
	 if (defined (my $pkg_help=$hh->get([ 'customize', $pkg ]))) {
	    print $cf help2comment($pkg_help), "\n";
	 }
	 while (my ($name, $var)=each %{$tree->{$pkg}}) {
	    print $cf $var->printable($mod_pkg), "\n";
	    $var->state &= ~$state_changed;
	 }
      }

      print $cf $sep_line;
   }

   if (@_==1) {
      while (my ($pkg, $text)=each %{$self->files->[0]->orphans}) {
	 print $cf "package $pkg;\n\n$text";
      }
   }

   $self->need_save=0;
}

1
