#  Copyright (c) 1997-2009
#  Ewgenij Gawrilow, Michael Joswig (Technische Universitaet Darmstadt, Germany)
#  http://www.polymake.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 9298 2009-09-02 23:10:56Z gawrilow $

use strict;
use namespaces;

package Polymake::Core::Customize;

use Polymake::Enum qw( state: undefined saved=1 default=2 config=4 changed=8 tied=128 hidden=256 );

# A combination of state flags:
# undefined:		reading customize.pl: usual variable; later on: normal execution
# default:		loading the rules
# config:		reading customize.pl: config variable
# config|changed:	reading customize.pl: config variable manually changed
# config|saved: 	executing CONFIGURE clause in the rules
# config|changed|saved:	manually setting config variable in a CONFIGURE clause
#
declare $configure_state=0;

declare $reconfigure;

use Polymake::Ext;

sub CONFIGURED {
   !$reconfigure && $_[0] eq $Arch
   and $configure_state=$state_config
}
sub ARCH {
   $_[0] eq $Arch
   and $configure_state=$state_config|$state_changed
}

sub help2comment {
   my ($text)=@_;
   $text =~ s/^\s*$//mg;
   $text =~ s/^/\# /mg;
   enforce_nl($text) if length($text);
   $text;
}

#################################################################################
package Polymake::Core::Customize::Var;
use Polymake::Struct (
   [ new => '$$;$' ],
   [ '$name' => '#1' ],
   [ '$state' => '#2' ],
   [ '$help' => '#3' ],
   '$appendix',
);

sub state_after_set {
   my $self=shift;
   $self->state &= ~$state_default;
   $self->state |= $state_saved | ($self->state & $state_config)<<1;
}

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

sub TIESCALAR {
   my $self=shift;
   if (is_object($self)) {
      $self->state |= $state_tied;
   } else {
      $self=_new($self, undef, $configure_state|$state_saved|$state_tied);
      $self->saved_value=$_[0];
      $configure_state=0;
   }
   $self;
}

sub un_tie {
   my $self=shift;
   $self->state &= ~$state_tied;
   no strict 'refs';
   untie $ {$self->name};
   $ {$self->name}=$self->saved_value;
}

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

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

sub new {
   no strict 'refs';
   my $self=tied ${$_[1]};
   if ($self) {
      $self->name=$_[1];
      $self->state|=$_[2];
      $self->help=$_[3];
   } else {
      $self=&_new;
      if (declared_scalar(*{$self->name})) {
	 if (!($self->state & $state_config) and defined ($self->default_value=$ {$self->name})) {
	    $self->state|=$state_default;
	 } else {
	    tie $ {$self->name}, $self;
	 }
      } else {
	 croak( "undefined custom variable \$", $self->name );
      }
   }
   $self;
}

sub set {
   my $self=$_[0];
   if (($self->state & ($state_config|$state_changed))==$state_config) {
      $self->default_value=$self->saved_value;
   }
   &state_after_set;
   no strict 'refs';
   if (@_) {
      $ {$self->name}=$self->saved_value=$_[0];
   } else {
      $self->saved_value=$ {$self->name};
   }
}

sub reset {
   my $self=shift;
   no strict 'refs';
   if ($self->state & $state_changed) {
      $self->state &= ~$state_changed;
      $self->saved_value=$self->default_value;
      $ {$self->name}=$self->default_value;
   } elsif ($self->state & $state_saved) {
      $self->state &= ~$state_saved;
      $self->state |= $state_default;
      undef $self->saved_value;
      $ {$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 Polymake::Core::Customize::Array;
use Polymake::Struct (
   [ '@ISA' => 'Var' ],
   '@saved_value',
   '@default_value',
);

sub TIEARRAY {
   my $self=shift;
   if (is_object($self)) {
      $self->state |= $state_tied;
   } else {
      $self=_new($self, undef, $configure_state|$state_saved|$state_tied);
      @{$self->saved_value}=@{$_[0]};
      $configure_state=0;
   }
   $self;
}


sub un_tie {
   my $self=shift;
   $self->state &= ~$state_tied;
   no strict 'refs';
   untie @{$self->name};
   @{$self->name}=@{$self->saved_value};
}

sub _set_array {
   my $self=shift;
   if ($configure_state & $state_default) {
      $self->default_value;
   } else {
      if ($configure_state & $state_changed && !($self->state & $state_changed)) {
	 @{$self->default_value}=@{$self->saved_value};
      }
      $self->state |= $configure_state|$state_saved;
      $self->saved_value;
   }
}

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

sub FETCHSIZE { $#{$_[0]->saved_value}+1 }

sub EXTEND {
   my $n=pop;
   $#{&_set_array}=$n-1;
}

*STORESIZE=\&EXTEND;

sub STORE {
   my $arr=&_set_array;
   $arr->[$_[0]]=$_[1];
}

sub PUSH {
   my $arr=&_set_array;
   push @$arr, @_;
}

sub UNSHIFT {
   my $arr=&_set_array;
   unshift @$arr, @_;
}

sub SPLICE {
   my $arr=&_set_array;
   splice @$arr, @_;
}

sub POP {
   pop @{&_set_array};
}

sub SHIFT {
   shift @{&_set_array};
}

sub new {
   no strict 'refs';
   my $self=tied @{$_[1]};
   if ($self) {
      $self->name=$_[1];
      $self->state|=$_[2];
      $self->help=$_[3];
   } else {
      $self=&_new;
      if (defined *{$self->name}{ARRAY}) {
	 if (!($self->state & $state_config) and @{$self->default_value}=@{$self->name}) {
	    $self->state|=$state_default;
	 } else {
	    tie @{$self->name}, $self;
	    $self->state|=$state_tied;
	 }
      } else {
	 croak( "undefined custom variable \@", $self->name );
      }
   }
   $self;
}

sub set {
   my $self=$_[0];
   if (($self->state & ($state_config|$state_changed))==$state_config) {
      @{$self->default_value}=@{$self->saved_value};
   }
   &state_after_set;
   no strict 'refs';
   if (@_) {
      @{$self->name}=@_;
      @{$self->saved_value}=@_;
   } else {
      @{$self->saved_value}=@{$self->name};
   }
}

sub reset {
   my $self=shift;
   no strict 'refs';
   if ($self->state & $state_changed) {
      $self->state &= ~$state_changed;
      @{$self->saved_value}=@{$self->default_value};
      @{$self->name}=@{$self->default_value};
   } elsif ($self->state & $state_saved) {
      $self->state &= ~$state_saved;
      $self->state |= $state_default;
      undef @{$self->saved_value};
      @{$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 Polymake::Core::Customize::Hash;
use Polymake::Struct (
   [ '@ISA' => 'Var' ],
   '%saved_value',
   '%default_value',
);

sub TIEHASH {
   my $self=shift;
   if (is_object($self)) {
      $self->state |= $state_tied;
   } else {
      $self=_new($self, undef, $configure_state|$state_saved|$state_tied);
      %{$self->saved_value}=%{$_[0]};
      $configure_state=0;
   }
   $self;
}

sub un_tie {
   my $self=shift;
   $self->state &= ~$state_tied;
   no strict 'refs';
   untie %{$self->name};
   %{$self->name}=%{$self->saved_value};
}

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

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

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

*NEXTKEY=\&FIRSTKEY;

sub STORE {
   my $self=shift;
   if ($configure_state & $state_default) {
      unless ($self->state & $state_saved && exists $self->saved_value->{$_[0]}) {
	 $self->saved_value->{$_[0]}=$_[1];
      }
      $self->default_value->{$_[0]}=$_[1];
   } else {
      if ($configure_state & $state_changed && !($self->state & $state_changed)) {
	 %{$self->default_value}=%{$self->saved_value};
      }
      $self->state |= $configure_state | $state_saved;
      $self->saved_value->{$_[0]}=$_[1];
   }
}

sub DELETE {
   my $self=shift;
   if ($configure_state & $state_default) {
      unless ($self->state & $state_saved) {
	 delete $self->saved_value->{$_[0]};
      }
      delete $self->default_value->{$_[0]};
   } else {
      if ($configure_state & $state_changed && !($self->state & $state_changed)) {
	 %{$self->default_value}=%{$self->saved_value};
      }
      $self->state |= $configure_state | $state_saved;
      delete $self->saved_value->{$_[0]};
   }
}

sub CLEAR {
   my $self=shift;
   if ($configure_state & $state_default) {
      unless ($self->state & $state_saved) {
	 %{$self->saved_value}=();
      }
      %{$self->default_value}=();
   } else {
      if ($configure_state & $state_changed && !($self->state & $state_changed)) {
	 %{$self->default_value}=%{$self->saved_value};
      }
      $self->state |= $configure_state | $state_saved;
      %{$self->saved_value}=();
   }
}

sub new {
   no strict 'refs';
   my $self=tied %{$_[1]};
   if ($self) {
      $self->name=$_[1];
      $self->state|=$_[2];
      $self->help=$_[3];
   } else {
      $self=&_new;
      if (defined *{$self->name}{HASH}) {
	 if (!($self->state & $state_config) and
	     do { %{$self->default_value}=%{$self->name}; keys %{$self->default_value} }) {
	    $self->state |= $state_default;
	 } else {
	    tie %{$self->name}, $self;
	    $self->state|=$state_tied;
	 }
      } elsif (!$self->state) {
	 die "undefined custom variable %", $self->name, "\n";
      }
   }
   $self;
}

sub set {
   my $self=$_[0];
   if (($self->state & ($state_config|$state_changed))==$state_config) {
      %{$self->default_value}=%{$self->saved_value};
   }
   &state_after_set;
   no strict 'refs';
   if (@_==0) {
      %{$self->saved_value}=%{$self->name};
   } elsif (@_==1) {
      $self->saved_value->{$_[0]}=$self->name->{$_[0]};
   } elsif (@_==2) {
      $self->saved_value->{$_[0]}=$_[1];
      $self->name->{$_[0]}=$_[1];
   } else {
      %{$self->saved_value}=@_;
      %{$self->name}=@_;
   }
}

sub reset {
   my $self=shift;
   no strict 'refs';
   if (@_) {
      foreach 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};
	    }
	 }
      }
   } else {
      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 | $state_config) ? "" : "# ") . ");\n"
}

#################################################################################
package Polymake::Core::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=( '$' => 'Polymake::Core::Customize::Scalar',
		      '@' => 'Polymake::Core::Customize::Array',
		      '%' => 'Polymake::Core::Customize::Hash' );
sub new {
   $prefix_dispatch{substr($_[1],0,1)}->new(substr($_[1],1), $_[2], $_[3] || "undocumented");
}

sub full_name {
   my ($self, $default_pkg)=@_;
   my $l;
   defined($default_pkg)  &&  rindex($self->name,"::")==($l=length($default_pkg))  &&  substr($self->name,0,$l) eq $default_pkg
   ? $self->prefix . substr($self->name,$l+2)
   : $self->prefix . $self->name
}

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

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

my ($config_prefix, $config_changed_prefix);

sub printable_decl {
   my $self=$_[0];
   ( $self->state & $state_changed
     ? $config_changed_prefix :
     $self->state & $state_config
     ? $config_prefix :
     $self->state & $state_saved ? "" : "# " ) .
   &full_name . "=" 
}

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

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

#################################################################################
package Polymake::Core::Customize::perApplication;

use Polymake::Struct (
   [ new => '$$' ],
   [ '$handler' => 'weak( #1 )' ],
   '%per_pkg',			# package_name->{"$var_name"}->Var
   '%pkg_help',			# package_name => help text
   [ '$default_pkg' => '#2' ],
   '@tied_vars',
);

sub new {
   my $self=&_new;
   if (defined (my $text=$self->handler->pieces->{$self->default_pkg})) {
      { no strict 'refs';
	*{$self->default_pkg."::CONFIGURED"}=\&CONFIGURED;
	*{$self->default_pkg."::ARCH"}=\&ARCH;
      }
      local $configure_state=0;
      compile_start();
      eval $text;
      compile_end();
      { no strict 'refs';
	unimport_function(*{$self->default_pkg."::CONFIGURED"});
        unimport_function(*{$self->default_pkg."::ARCH"});
      }
      die $@ if $@;
   } else {
      $self->handler->need_save=1;
   }
   $self;
}

#################################################################################
sub add {
   my ($self, $name, $help_text, $state)=@_;
   my ($pkg);
   my $pkg_end=rindex($name, "::");
   if ($pkg_end>=0) {
      $pkg= $pkg_end>0 ? substr($name,1,$pkg_end-1) : "main";
   } else {
      $pkg=caller;
      substr($name,1,0).="$pkg\::";
   }
   sanitize_help($help_text);
   my $var= ( $self->per_pkg->{$pkg}->{$name} &&= croak( "multiple definition of custom variable '$name'" ) )
        ||= new Var($name,$state,$help_text);
   if ($var->state & $state_tied) {
      push @{$self->tied_vars}, $var;
   }
}
#################################################################################
sub add_package_help {
   my ($self, $pkg, $text)=@_;
   sanitize_help($text);
   $self->pkg_help->{$pkg}=$text;
}
#################################################################################
sub find {
   my ($self, $name)=@_;
   my $pkg_end=rindex($name, "::");
   my $dict;
   if ($pkg_end>0) {
      $dict=$self->per_pkg->{substr($name,1,$pkg_end-1)};
   } else {
      $dict=$self->per_pkg->{$self->default_pkg};
      substr($name,1,0)=$self->default_pkg."::";
   }
   $dict && $dict->{$name};
}
#################################################################################
sub list_completions_in_pkg {
   my ($dict, $type, $prefix)=@_;
   grep { !($dict->{$_}->state & $state_hidden) }
      do {
	 if ($type eq "\$") {
	    grep { /^[%\$]\Q$prefix\E/ } keys %$dict;
	 } else {
	    grep { /^\Q$type$prefix\E/ } keys %$dict;
	 }
      };
}

sub list_completions {
   my ($self, $type, $prefix, $skip_default)=@_;
   my @answer;
   my $l=length($self->default_pkg);
   if (!$skip_default) {
      my $last_qual=rindex($prefix,"::");
      if (defined (my $dict=$self->per_pkg->{$self->default_pkg . ($last_qual>0 && "::".substr($prefix,0,$last_qual))})) {
	 push @answer, map { substr($_,$l+3) } list_completions_in_pkg($dict, $type, $self->default_pkg."::$prefix");
      }
   }
   while (my ($pkg, $dict)=each %{$self->per_pkg}) {
      if ($prefix =~ /^$pkg (?: : (?: : [^:]*)?)? $/x) {
	 push @answer, map { substr($_,1) } list_completions_in_pkg($dict,$type,$prefix);
      }
      my $remove_default_prefix= !$skip_default && substr($pkg,0,$l) eq $self->default_pkg && substr($pkg,$l,2) eq "::";
      if ($remove_default_prefix ? substr($pkg,$l+2) =~ /^$prefix/ : $pkg ne $self->default_pkg && $pkg =~ /^$prefix/) {
	 while ((undef, my $var)=each %$dict) {
	    unless ($var->state & $state_hidden) {
	       push @answer, ($remove_default_prefix ? substr($pkg,$l+2) : $pkg)."::";
	       keys %$dict;  # reset the iterator!
	       last;
	    }
	 }
      }
   }
   @answer;
}
#################################################################################
sub set {
   my ($self, $name)=splice @_, 0, 2;
   if (defined (my $var=$self->find($name))) {
      $var->set(@_);
      $self->handler->need_save=1;
   } else {
      croak( "unknown custom variable $name" );
   }
}
#################################################################################
sub reset {
   my ($self, $name)=splice @_, 0, 2;
   if (defined (my $var=$self->find($name))) {
      $var->reset(@_);
      $self->handler->need_save=1;
   } else {
      croak( "unknown custom variable $name" );
   }
}
#################################################################################
sub cleanup {
   my $self=shift;
   $_->un_tie for @{$self->tied_vars};
   @{$self->tied_vars}=() if @_==0;	# called directly
}
#################################################################################
sub printMe {
   my ($self, $cf, $old_text)=@_;
   print $cf "package ".$self->default_pkg.";\n\n";
   if (length($old_text)) {
      local $_=$old_text;
      recycle_piece($cf,$self);
   }
   foreach my $pkg (sort { $a eq $self->default_pkg ? -1 : $b eq $self->default_pkg ? 1 : $a cmp $b } keys %{$self->per_pkg}) {
      if (defined (my $h=$self->pkg_help->{$pkg})) {
	 print $cf help2comment($h), "\n";
      }
      while (my ($name, $var)=each %{$self->per_pkg->{$pkg}}) {
	 print $cf $var->printable($self->default_pkg), $var->appendix, "\n";
	 $var->state &= ~$state_changed;
      }
   }
}
#################################################################################
sub create_help_topics {
   my ($self, $root_topic)=@_;
   my $l=length($self->default_pkg)+2;
   while (my ($pkg, $dict)=each %{$self->per_pkg}) {
      if ($pkg eq $self->default_pkg) {
	 while (my ($name, $var)=each %{$self->per_pkg->{$pkg}}) {
	    $root_topic->add(['custom', $var->prefix.substr($var->name,$l) ], $var->help);
	 }
      } else {
	 my ($group, $suffix)= index($pkg,$self->default_pkg) ? ($pkg,0) : (substr($pkg,$l),$l);
	 if (defined (my $h=$self->pkg_help->{$pkg})) {
	    $root_topic->add(['custom', $group."::"], $h);
	 }
	 while (my ($name, $var)=each %{$self->per_pkg->{$pkg}}) {
	    $root_topic->add(['custom', $group."::", $var->prefix.substr($var->name,$suffix)], $var->help);
	 }
      }
   }
}
#################################################################################
package Polymake::Core::Customize::File;
use Polymake::Struct (
   [ new => '$;$' ],
   [ '$filename' => '#1' ],	# where to save custom variables
   '%pieces',			# package => file fragment
   '$version',			# version of polymake which has created this custom file
);

sub new {
   my $self=&_new;
   my $preamble_pkg=$_[1] || "main";
   my $filename=$self->filename;
   open my $cf, $filename
      or die "can't read customization file \"$filename\": $!\n";
   local $_;
   my ($pkg, $body, $version)=("BEGIN", <<".");
no namespaces; no strict 'vars';
package $preamble_pkg;
#line 1 "$filename"
.
   while (<$cf>) {
      if (/^\s* (?: (?:application|module) \s+ ($id_re) | package \s+ ($qual_id_re)); \s*$/xo) {
	 $self->pieces->{$pkg}=$body;
         if (defined $2) {
            $pkg=$2;
	    $body= <<".";
no namespaces; no strict 'vars';
#line $. "$filename";
.
         } else {
	    $pkg=$1;
	    my $l=$.+1;
	    $body=<<".";
#line $l "$filename";
.
            next;
	 }
      } else {
	 # convert from old style
	 s/\bCONFIGURE:/CONFIGURED and/;
      }
      $body.=$_;
   }
   $self->pieces->{$pkg}=$body;

   my $preamble=delete $self->pieces->{BEGIN};
   # delete old global flags
   $preamble =~ s/(?:CONFIGURED|ARCH)(?:\(.*?\))?/0/gm;
   my $version=v0.0;
   eval $preamble;
   if ($@) {
      err_print( beautify_error() );
      return;
   }
   $self->version=$version;

   if ($version le v2.9.5 && $version gt v2.3) {
      if (defined ($body=delete $self->pieces->{"Poly::User"})) {
	 $body =~ s/\bPoly::User\b/Polymake::User/g;
	 $self->pieces->{"Polymake::User"}=$body;
      }
      if (defined ($body=delete $self->pieces->{"Poly::CPlusPlus"})) {
	 $body =~ s/\bPoly::CPlusPlus\b/Polymake::Core::CPlusPlus/g;
	 $self->pieces->{"Polymake::Core::CPlusPlus"}=$body;
      }
   }

   $self;
}
#################################################################################
package Polymake::Core::Customize;

use Polymake::Struct (
   [ new => '$' ],
   [ '$file' => 'undef' ],	# Customize::File
   '@applications',		# Application
   '%pieces',			# package => file fragment
   '$need_save',		# boolean
);

sub new {
   my $self=&_new;
   my $user_filename=shift;
   if (-f $user_filename) {
      if (defined ($self->file=new File($user_filename))) {
	 $self->pieces=$self->file->pieces;
	 $self->need_save= defined $Version && $self->file->version lt $VersionNumber;
	 add AtEnd("Customize", sub { $self->save if $self->need_save });
      } else {
	 return;	# error in the user's custom file
      }
   } else {
      $self->need_save=1;
      add AtEnd("Customize", sub { $self->save($user_filename) });
   }
   $self;
}

sub app_handler {
   my ($self, $app, $pkg)=@_;
   $pkg ||= $app->pkg;
   my $per_app=new perApplication($self,$pkg);
   push @{$self->applications}, $app || bless $per_app, "Polymake::Core::Customize::PseudoApp";
   $per_app
}

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 call the user function 'set_custom'.
#  To revert to the default values later, simply comment out
#  the corresponding assignments or call the user function 'reset_custom'.
#
#  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.
#  Their assignments are guarded by the `CONFIGURED' condition.
#  If you manually change some setting afterwards and want it to survive
#  the `polymake --reconfigure' run, please remove this condition.
#  If your change should take effect on one architecture only,
#  change the word CONFIGURE to ARCH.
#
#  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.
#
#########################################################################
#
# 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 introduced new custom variables in the rules and want them
# to appear here right now, comment out the following line and run polymake.
\$version=v$Version;

.

# dummy module for parsing the preamble
package Polymake::Core::Customize::Preamble;
sub find { shift }
sub appendix : lvalue { $ {shift()} }
sub new { my $text=""; bless \$text; }
sub default_pkg { undef }

package Polymake::Core::Customize::PseudoApp;
use Polymake::Struct (
   [ '@ISA' => 'perApplication' ],
);
sub custom { shift }
sub pkg { (shift)->default_pkg }
sub help { undef }

package Polymake::Core::Customize;

# protected:
sub recycle_piece {
   my ($cf, $ch)=@_;
   s/\A(?s:.*?)^\#line.*\n^\s*package\s+$qual_id_re;[ \t]*\n//mo;

   while (pos() < length()) {
      /\G (?: ^\s*\n )+ /xmgc;		# empty lines
      my $start_comments=pos();
      /\G (?: ^[ \t]* \#.*\n )+ /xmgc;	# leading comments

      if (/\G ^[ \t]* $assignment_re .*\n /xomgc) {
	 # unconditional assignment - either stored in the application's dictionary or obsolete
	 next;
      }

      my $print_nl="";
      my $start_stmt=pos();
      my $saved_comments="";

      while (/\G ^[ \t]* (?:CONFIGURED|ARCH) (?: \((['"]) (.*?) \1\) )? \s*and\s*
                 ^[ \t]* $assignment_re .*\n /xomgc) {
	 my ($arch, $varname)=($2, $3);
	 if ($arch) {
	    if ($arch ne $Arch) {
	       # value configured for other architecture
	       if (defined($ch->default_pkg) && index($varname, "::")<0) {
		  substr($varname,0,1) .= $ch->default_pkg . "::";
	       }
	       if (my $var=$ch->find($varname)) {
		  $var->appendix .= substr($_,$start_stmt,pos()-$start_stmt);
	       } else {
		  print $cf $saved_comments, substr($_,$start_comments,pos()-$start_comments);
		  $saved_comments="";
		  $print_nl="\n";
	       }
	    } else {
	       $saved_comments=substr($_,$start_comments,$start_stmt-$start_comments);
	    }
	 }
	 $start_comments=$start_stmt=pos();
      }
      print $cf $print_nl;

      if (/\G ^[ \t]* [^\#\s] .* \n/xmgc) {
	 warn_print( "suspicious code in custom file: ", $& );
	 print $cf $&;
      }
   }
}

sub save {
   my ($self, $filename)=@_;
   if (!defined($filename)) {
      die "no customization file to save\n" unless $self->file;
      $filename=$self->file->filename;
   }

   $config_prefix= "CONFIGURED('$Arch') and\n";
   $config_changed_prefix= "ARCH('$Arch') and\n";

   my ($cf, $cf_k)=new OverwriteFile($filename);
   print $cf $preface;

   foreach my $app (@{$self->applications}) {
      $app->custom->cleanup;
      print $cf $sep_line;
      $app->custom->printMe($cf, delete $self->pieces->{$app->pkg});
   }

   while (my ($pkg, $orphan)=each %{$self->pieces}) {
      if ($pkg !~ /^(?:Modules|Apps)::/) {
	 $orphan =~ s/\A(?s:.*?)^\#line.*\n^\s*package\s+$qual_id_re;[ \t]*\n//mo;
	 print $cf "package $pkg;\n", $orphan;
      }
   }

   close $cf;
   $self->need_save=0;
}

1
