#  Copyright (c) 1997-2010
#  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: Application.pm 9570 2010-03-15 23:21:23Z gawrilow $

use strict;
use namespaces;

package Polymake::Core::Application;

declare @lookup=($InstallTop, @User::lookup_applications);
declare (%from_suffix, $extension, @reconfigure_rules);
declare $plausibility_checks=1;

my (%repository, %forward, $partial_reconfig_re);

#################################################################################
#
#  Constructor:
#
#  new Application('name', [ rules to load ]);
#
use Polymake::Struct (
   [ new => '$' ],
   [ '$name' => '#1' ],
   [ '$pkg' => '"Polymake::" . #1' ],
   [ '$top' => 'undef' ],	  # application top directory (beneath apps/)
   [ '$installTop' => 'undef' ],  # installation directory
   '%rulefiles',		  # 'basename' => load errors
   [ '$configured' => 'undef' ],  # 'basename' => configuration result
   '@myINC',			  # directories with perl modules
   '@rulepath',			  # directories with rules
   '@scriptpath',		  # directories with scripts
   '@object_types',		  # ObjectType
   '$default_type',
   '@rules',			  # Rule
   '@rules_to_finalize',	  # Rule - production rules defined in the rulefiles being currently read
   '%credits',			  # product name => Rule::Credit
   [ '$cur_credit' => 'undef' ],	# Rule::Credit
   [ '$custom' => 'undef' ],	  # Customize::perApplication
   [ '$prefs' => 'undef' ],	  # Preference::perApplication
   [ '$temp_prefs' => '0' ],	  # prefer_now in action
   [ '$help' => 'new Help' ],
   '%used',			  # 'name' => Application
   '%imported',			  # 'name' => 1
   '@import_sorted',		  # 'name', ... : flattened list in DFS order
   '%EXPORT',			  # names and attributes of user functions and methods
   [ '$compile_scope' => 'undef' ],
   '&eval_expr',		  # eval'uating the given source code in the application-specific lexical context
   [ '$cpp' => 'undef' ],	  # CPlusPlus::perAplication
   [ '$declared' => '0' ],
   [ '$file_suffix' => 'undef' ], # default file suffix
   '@extensions',		  # Extension : extensions contributing to this application
);

sub new {
   my @load_rules=splice @_, 2;
   init_full(&init_forw, @load_rules);
}

sub init_forw {
   my $self=&_new;
   define_function($self->pkg, "self",	# for the rule parser
		   sub {
		      if (my $what=shift) {
			 if ($what<0) {
			    # providing help path for scopes without own prototype object
			    my $pkg=caller;
			    $self->help->find("objects", $pkg) || $self->help->add(["objects", $pkg]);
			 } else {
			    croak( "This declaration is only allowed in the object type scope" );
			 }
		      } else {
			 $self;
		      }
		   }, 1);
   $self;
}

sub init_full {
   my $self=shift;
   my ($dir, $top);
   my $name=$self->name;
 DIR:
   foreach (@lookup) {
      if (-d ($dir="$_/apps/$name")) {
	 $top=$dir;
	 if (@_) {
	    foreach (@_) { -f "$top/rules/$_" or next DIR; }
	 } else {
	    -f "$top/rules/main.rules" or next;
	 }
	 $self->installTop=$_;
	 $self->top=$top;
	 last;
      }
   }
   if (!defined($self->top)) {
      if (defined($top)) {
	 croak( @_>1 ? "rule files ".join(", ",@_) : "rule file ".($_[0] || "main.rules"),
		" not found for application $name" );
      } else {
	 croak( "unknown application $name" );
      }
   }
   if ($self->installTop ne $InstallTop) {
      add Extension($self->installTop);
   }
   if (-d ($dir=$self->top."/perllib")) {
      push @{$self->myINC}, $dir;
   }
   if (-d ($dir=$self->top."/scripts")) {
      push @{$self->scriptpath}, $dir;
   }

   push @{$self->rulepath}, $self->top."/rules";

   local $plausibility_checks=$DeveloperMode || $self->installTop ne $InstallTop;
   if (@reconfigure_rules && !defined($partial_reconfig_re)) {
      foreach (@reconfigure_rules) {
	 if (/(?:^|\w)\*|\*$/) {
	    # looks like a shell glob
	    s/\./\\./g; s/\*/.*/g;
	 }
	 unless (/(?:\.\w+|\*)$/) {
	    $_ .= "(?:\\.rules?|[._]config(?:ure)?)?";
	 }
	 $_="(?:$_)";
      }
      local $"="|";
      $partial_reconfig_re=qr{^@reconfigure_rules$};
   }

   $self->configured=namespaces::declare_var($self->pkg, "%rulefiles");
   $self->custom=$Custom->app_handler($self);
   $self->custom->add('%'.$self->pkg.'::rulefiles', <<'.', $Customize::state_config | $Customize::state_hidden);
Rulefiles with autoconfiguration sections and their exit codes.
Value 0 denotes configuration failure, which disables the corresponding rulefile.
.
   while (my ($rulename, $good)=each %{$self->configured}) {
      if (defined($partial_reconfig_re) && $rulename =~ $partial_reconfig_re) {
	 delete $self->configured->{$rulename};
      } elsif (!$good) {
	 $self->rulefiles->{$rulename}=0;
      }
   }
   $self->prefs=$Prefs->app_handler($self);
   $self->cpp=CPlusPlus::app_handler($self);

   include_rules($self, @_ ? @_
		           : ( ($Help::gather ? "?help.rules" : ()),
			       "main.rules") );
   $self->cpp->end_loading;

   if (defined $self->file_suffix) {
      $from_suffix{$self->file_suffix}=$self;
   }

   if (@lookup>1) {
      foreach my $ext_dir (@lookup) {
	 if ($ext_dir ne $self->installTop && -d (my $my_dir="$ext_dir/apps/$name")) {
	    load_extension($self, $my_dir, add Extension($ext_dir));
	 }
      }
   }

   $self->prefs->end_loading($self);
   if (length($self->prefs->user_commands))
   {
      local $User::application=$self;
      local_unshift(\@INC, $self);
      $self->eval_expr->("package Polymake::User; ".$self->prefs->user_commands);
      if ($@) {
         die "Error executing commands stored in $UserSettings::dir/prefer.pl:\n$@\n";
      }
   }

   if ($Help::gather) {
      $Prefs->custom->create_help_topics($self->help);
      $self->custom->create_help_topics($self->help);
      $self->help->topics->{custom}->text ||= <<'.';
All customizable variables defined in application $name, ordered by packages.
Please remember that the changed made by direct assignment will be lost after the session end.
To make perpetual changes, please use the commands set_custom and reset_custom, or edit the
file ~/.polymake/customize.pl manually (but only after finishing the interactive session!)
.
   }

   $self;
}
#################################################################################
sub load_extension {
   local $extension=pop;
   my ($self, $my_dir)=@_;
   push @{$self->rulepath}, "$my_dir/rules";
   push @{$self->myINC}, "$my_dir/perllib";
   push @{$self->scriptpath}, "$my_dir/scripts";

   $self->cpp->loading_extension($extension);
   include_rules($self, ($Help::gather ? "?$my_dir/rules/help.rules" : ()),
		        "?$my_dir/rules/main.rules");
   $self->cpp->end_loading;
   push @{$self->extensions}, $extension;
}
#################################################################################
sub add {
   $repository{$_[1]} ||= init_full( &forward );
}
sub forward {
   $forward{$_[1]} ||= &init_forw;
}
sub lookup { $repository{$_[1]} }
#################################################################################
sub list {
   values %repository;
}
sub known {
   keys %repository;
}
#################################################################################
sub lookup_rule {
   my ($self, $rulename)=@_;
   foreach (@{$self->rulepath}) {
      my $filename="$_/$rulename";
      return $filename if -f $filename;
   }
   undef;
}
#################################################################################
sub include_rule {
   my ($self, $basename)=@_;
   my $may_fail= $basename =~ s/^\?//;
   my $everywhere= $basename =~ s/^\*:://;
   if (!defined($extension) && defined (my $rc=$self->rulefiles->{$basename})) {
      return $rc;
   }
   my $filename=$basename;
   if (index($filename,"/")>=0 && -f $filename		# don't lookup for rules in the cwd unless explicitly asked for
       or  defined ($filename=lookup_rule($self,$basename))) {
      if (defined $extension) {
	 if (defined (my $rc=$self->rulefiles->{$filename})) {
	    return $rc;
	 }
	 $self->rulefiles->{$filename}=1;
      } else {
	 $self->rulefiles->{$basename}=1;
      }
      local_save_scalar($self->cur_credit);
      dbg_print( "reading rules from $filename" ) if $Verbose::rules>1;
      require "rules:$filename";

   } elsif ($basename =~ /^($id_re)::(.*)/o) {
      my $app=$self->used->{$1} or croak( "application $1 is not declared as USE'd - may not load its rules here" );
      $app->include_rules($may_fail ? "?$2" : $2);

   } elsif ($everywhere) {
      foreach my $app (values %{$self->imported}) {
	 if (defined (my $rc=$app->include_rules("?$basename"))) {
	    return $rc;
	 }
      }
      $may_fail ? undef : croak( "rule file $basename does not exist in any application" );
   } else {
      $may_fail ? undef : croak( "rule file ", ($basename =~ m{^/} ? $basename : $self->name."::$basename"), " does not exist" );
   }
}
#################################################################################
sub include_rules {
   my $self=shift;
   is_code($INC[0]) ? $User::application==$self ? undef : local_unshift(\@INC, $self) :
   is_object($INC[0]) ? $INC[0]==$self || (local $INC[0]=$self) : local_unshift(\@INC, $self);
   local $Customize::configure_state=$Customize::state_default;
   local_array($self->custom->tied_vars, []);
   local_scalar($self->compile_scope, new Scope());
   $self->compile_scope->cleanup->{$self->custom}=undef;
   my $rc_all=0;
   eval {
      my $parse_embedded;
      foreach my $rulename (@_) {
	 my $is_main= $extension ? $rulename =~ m{/main\.rules$} : $rulename eq "main.rules" and
         $parse_embedded=1;
	 if (defined (my $rc=include_rule($self, $rulename))) {
	    if ($rc) {
	       ++$rc_all;
	    } elsif ($is_main) {
               $parse_embedded=0;
            } else {
	       err_print( "rule file ", ($extension ? $rulename : $self->name."::$rulename"), " is excluded by autoconfiguration" );
	    }
	 }
      }
      if ($parse_embedded && $self->cpp->embedded_rules_cnt > 0) {
	 local_save_scalar($self->cur_credit);
	 my $so_name=$self->cpp->shared_modules->{$extension ? $extension->dir : $self->installTop}->so_name;
	 dbg_print( "reading rules embedded in shared module $so_name" ) if $Verbose::rules>1;
	 $so_name="c++:$so_name";
	 $self->rulefiles->{$so_name}=1;
	 require $so_name;
         ++$rc_all;
      }
      $_->finalize for @{$self->rules_to_finalize};
   };
   if ($@) {
      undef $reconfigure_hint;
      die beautify_error();
   }
   @{$self->rules_to_finalize}=();
   $rc_all;
}
#################################################################################
sub eval_type {
   my ($self, $expr)=@_;
   translate_type($expr);
   $self->eval_expr->($expr) || report_type_error($_[1])
}

declare @type_args;

sub eval_cpp_type {	# called from C++ clients
   (my ($self, $expr), @type_args)=@_;
   translate_type($expr);
   $expr =~ s/\Q(*)\E$/(\@Polymake::Core::Application::type_args)/;
   $self->eval_expr->($expr) || report_type_error($_[1])
}
#################################################################################
#
#  methods needed to fill up the application
#  primarily expected to be called from the transformed rules

declare $reconfigure_hint;

sub store_configured {
   my ($self, $filename, $what)=@_;
   local $Customize::configure_state=$Customize::state_config|$Customize::state_saved;
   if (is_code($what)) {
      include_rules($self, "?*::configure.rules");
      $what=eval { &$what };
      if ($@) {
	 warn_print( (defined $extension ? $filename : $self->name."::$filename"), " - autoconfiguration failed:\n", $@ );
	 unless ($reconfigure_hint || $Customize::reconfigure || @reconfigure_rules) {
	    $reconfigure_hint= <<'.';
 * Remember to run `polymake --reconfigure-rules RULENAME ... '
 * or just `polymake --reconfigure'
 * as soon as you have installed the missing software!
.
            add AtEnd("reconfigure", sub { warn $reconfigure_hint if defined($reconfigure_hint) }, after=>["Customize"]);
	 }
	 $@="";
      }
   }

   $self->custom->handler->need_save=1;
   $self->configured->{$filename}=
   $self->rulefiles->{$filename}= $what ? 1 : 0;	# normalize to bool
}

sub disabled_rules {
   my ($self, $rulefile)=@_;
   if (exists $self->rulefiles->{$rulefile}) {
      !$self->rulefiles->{$rulefile};
   } elsif (exists $self->configured->{$rulefile}) {
      !$self->configured->{$rulefile};
   } else {
      my $answer;
      foreach my $app (values %{$self->used}) {
	 defined($answer=disabled_rules($app,$rulefile)) and last;
      }
      $answer;
   }
}

sub config_makefile {
   if (defined $extension) {
      (shift)->cpp->config_makefile($extension)
   } else {
      croak( "config_makefile may only be used in extensions" );
   }
}

#################################################################################
sub use_apps {
   my ($self, $import)=splice @_,0,2;
   my ($i, $app);

   my @apps=map {
      if (my ($appname, $start_rules)= m/^\s* ($id_re) (?: \s*\(\s* (.*?) \s*\) )? \s*$/xo) {
	 $app=add Application($appname);
	 if (defined $start_rules) {
	    $app->include_rules(split /\s*,\s*/, $start_rules);
	 }
	 $app;
      } else {
	 croak( "invalid application name '$_'" );
      }
   } @_;

   if ($import) {
      my $ord=-1;
      my %order=map { $_ => ++$ord } @{$self->import_sorted};

    APPS:
      for ($i=0; $i<=$#apps; ++$i) {
	 $app=$apps[$i];
	 if (exists $self->imported->{$app->name}) {
	    splice @apps, $i--, 1;  next;
	 }
	 for (my $j=$i+1; $j<=$#apps; ++$j) {
	    if (exists $apps[$j]->imported->{$app->name}) {
	       splice @apps, $i--, 1; next APPS;
	    }
	 }

	 push @{$self->myINC}, @{$app->myINC};
	 push %{$self->EXPORT}, %{$app->EXPORT};
	 push %{$self->credits}, %{$app->credits};

	 $self->prefs->inherit($app->prefs);

	 namespaces::using($self->pkg, $app->pkg);
	 namespaces::using($self->pkg."::objects", $app->pkg."::objects");
	 namespaces::using($self->pkg."::props", $app->pkg."::props");

	 $self->imported->{$app->name}=$app;
	 $order{$app->name}=++$ord;

	 # IMPORT relation is transitive
	 while (my ($other_app_name, $other_app)=each %{$app->imported}) {
	    $self->imported->{$other_app_name}=$other_app;
	    assign_min($order{$other_app_name},$ord);
	 }
      }

      @{$self->import_sorted}=map { $_->name } sort {
	 exists $a->imported->{$b->name} ? -1 :
	 exists $b->imported->{$a->name} ? 1 :
	 $order{$a} <=> $order{$b}
      } values %{$self->imported};

      @{$self->help->related}=map { $_->help } values %{$self->imported};
   }

   foreach $app (@apps) {
      $self->used->{$app->name}=$app;
      # flatten the %used
      push %{$self->used}, %{$app->used};
   }
}

sub common {
   my ($self, $other)=@_;
   if ($self==$other || exists $self->used->{$other->name}) {
      $self;
   } elsif (exists $other->used->{$self->name}) {
      $other;
   } else {
      undef;
   }
}

#################################################################################
sub find_custom_var {
   my ($self, $name, $alt)=@_;
   my $var;
   if (!defined ($var=$self->custom->find($name))) {
      foreach my $app (values %{$self->used}) {
	 $var=$app->custom->find($name) and last;
      }
   }
   if (defined($var)) {
      $self->custom->handler->need_save=1;
   } elsif (defined($alt) && defined ($var=$alt->find($name))) {
      $alt->handler->need_save=1;
   } else {
      croak( "unknown custom variable $name" );
   }
   $var;
}

sub _set_custom {
   (my ($self, $name, $alt, @tail)=@_)>1 or croak( "custom variable, array, hash, or hash element assignment expected" );
   find_custom_var($self,$name,$alt)->set(@tail);
}

sub set_custom {
   _set_custom($_[0], name_of_custom_var(1));
}

sub _reset_custom {
   (my ($self, $name, $alt, @tail)=@_)>1 or croak( "custom variable, array, hash, or hash element expected" );
   find_custom_var($self,$name,$alt)->reset(@tail);
}

sub reset_custom {
   _reset_custom($_[0], name_of_custom_var(0));
}

#################################################################################
sub prefer {
   my $self=shift;
   $self->prefs->add_preference(@_);
}

sub prefer_now {
   my $self=shift;
   unless ($self->temp_prefs) {
      $Scope->begin_locals;
      local_incr($self->temp_prefs);
      $Scope->end_locals;
   }
   $self->prefs->set_temp_preference($Scope, @_);
}

# an alias, for the sake of symmetry
*set_preference=\&prefer;

sub reset_preference {
   my $self=shift;
   if ($_[0] eq "all" || $_[0] eq "*") {
      $self->prefs->handler->reset_all;
   } else {
      $self->prefs->reset(@_);
   }
}

#################################################################################
sub found_extension {
   my ($self, $extension)=@_;
   $_ == $extension && die( "extension ", $extension->app_dir($self), " already exists\n") for @{$self->extensions};
   my $ext_dir=$extension->dir;
   my $top_new;
   -d "$ext_dir/apps" or mkdir($top_new="$ext_dir/apps", 0755) or die "Can't create directory $ext_dir/apps: $!\n";
   my $dir=$extension->app_dir($self);
   foreach ($dir, map { "$dir/$_" } qw(src include perllib rules scripts)) {
      -d $_ or do { $top_new ||= $_; mkdir($_,0755) } or die "Can't create directory $_: $!\n";
   }
   if (-d "$ext_dir/.svn") {
      system("svn add $top_new")
         and warn_print( "svn add $top_new failed!\nPlease investigate the reason and run it manually\n" );
   }
   CPlusPlus::create_extension_build_dir($self, $ext_dir);
   CPlusPlus::create_Makefile_inc($self, $dir);
}

sub found {
   (undef, my ($name, $extension))=@_;
   my $ext_dir=$extension->dir;
   my $top_new;
   -d "$ext_dir/apps" or mkdir($top_new="$ext_dir/apps", 0755) or die "Can't create directory $ext_dir/apps: $!\n";
   my $dir="$ext_dir/apps/$name";
   $top_new ||= $dir;
   foreach ($dir, map { "$dir/$_" } qw(src include perllib rules scripts)) {
      mkdir($_,0755) or die "Can't create directory $_: $!\n";
   }
   if (-d "$ext_dir/.svn") {
      system("svn add $top_new")
         and warn_print("svn add $top_new failed!\nPlease investigate the reason and run it manually\n" );
   }
}

sub extension_dirs {
   my ($self)=@_;
   map { $_->app_dir($self) } @{$self->extensions}
}

#################################################################################
package Polymake::Core::Extension;
use Polymake::Struct (
   [ new => '$$;$' ],
   [ '$dir' => '#1' ],
   [ '$ord' => '#2' ],
   [ '$URI' => '#3' ],
);

my (%ext_by_dir, %ext_by_URI);

sub new {
   my $self=&_new;
   if (-f $self->dir."/URI") {
      open my $U, $self->dir."/URI";
      $self->URI=<$U>;
      chomp $self->URI;
   } else {
      $self->URI="file://".$self->dir;
      open my $U, ">", $self->dir."/URI"
      or die "can't create file '", $self->dir."/URI': $!\n";
      print $U $self->URI, "\n";
      warn_print( "Assigned a preliminary URI ", $self->URI, " to the new extension.\n",
		  "If you are going to share it with other people, please choose a really unique identifier\n",
		  "looking like http://your.domain/polymake/extensions/your_name\n",
		  "and store it in ", $self->dir."/URI" );
   }
   $self;
}

sub add {
   my ($pkg, $ext_dir, $maybe_new)=@_;
   $ext_by_dir{$ext_dir} ||= do {
      my $ord=0;
      foreach (@User::lookup_applications) {
	 $maybe_new=0, last if $_ eq $ext_dir;
	 ++$ord;
      }
      my $self=new($pkg,$ext_dir,$ord);
      if (exists $ext_by_URI{$self->URI}) {
	 die "Extension ", $self->URI, " already installed in ", $ext_by_URI{$self->URI}->dir, "\n";
      }
      if ($maybe_new) {
	 push @User::lookup_applications, $ext_dir;
	 $Prefs->custom->set('@lookup_applications');
      }
      $ext_by_URI{$self->URI}=$self
   }
}

sub lookup { $ext_by_dir{$_[1]} }

sub load {
   my ($pkg, $URI)=@_;
   $ext_by_URI{$URI} ||= do {
      if ($URI =~ m|^file://| and -d $') {
	 return load_contents(add($pkg,$'));
      } elsif (defined (my $ext_dir=locate_unknown($URI))) {
	 my $self=_new($pkg, $ext_dir, scalar(@User::lookup_applications), $URI);
	 $ext_by_dir{$ext_dir}=$self;
	 push @User::lookup_applications, $ext_dir;
	 $Prefs->custom->set('@lookup_applications');
	 load_contents($self);
      } else {
	 undef
      }
   }
}

sub load_contents {
   my $self=shift;
   foreach my $app_dir (glob($self->dir."/apps/*")) {
      $app_dir =~ $filename_re;
      if (defined (my $app=$repository{$1})) {
	 $app->load_extension($app_dir,$self);
      }
   }
   $self
}

sub locate_unknown { undef }

sub app_dir { $_[0]->dir."/apps/".$_[1]->name }

sub known { keys %ext_by_URI }

1
