#  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: InteractiveCommands.pm 10028 2011-01-28 23:11:25Z gawrilow $

#  Application methods and user commands available in interactive mode

use strict;
use namespaces;

package Polymake::Core::Application;

sub reconfigure {
   my ($self, $rulefile)=@_;
   defined($self->configured->{$rulefile})
     or die "there are no configuration actions associated with rulefile $rulefile\n";
   my $success;
   if (defined (my $code=$self->rule_code->{$rulefile})) {
      if ($self->config_clock->{$rulefile} < $reconfigure) {
         $self->configured->{$rulefile}=0;
         if (defined $self->compile_scope) {
            &$code;
         } else {
            require 'Polymake/config_utils.pl';
            my $reconf=new Reconf($self);
            local_unshift(\@INC, $self);
            local_sub(get_pkg($self->pkg)->{self}, sub { $reconf });
            local_scalar($self->compile_scope, new Scope());
            local_array($self->custom->tied_vars, [ ]);
            $self->compile_scope->cleanup->{$self->custom}=undef;
            &$code;
            $_->finalize for @{$self->rules_to_finalize};
            @{$self->rules_to_finalize}=();
         }
      }
      $self->configured->{$rulefile}
   } else {
      delete $self->rulefiles->{$rulefile};
      include_rules($self, $rulefile);
   }
}
###############################################################################################
sub unconfigure {
   my ($self, $rulefile)=@_;
   unless (my $was_config=$self->configured->{$rulefile}) {
      if (defined $was_config) {
         die "rulefile $rulefile is already unconfigured\n";
      } else {
         die "there are no configuration actions associated with rulefile $rulefile\n";
      }
   }
   if (defined (my $code=$self->rule_code->{$rulefile})) {
      my $unconf=new Unconf($self);
      local_sub(get_pkg($self->pkg)->{self}, sub { $unconf });
      &$code;
   } else {
      $self->custom->handler->need_save=1;
      $self->configured->{$rulefile}=0;
   }
}
###############################################################################################
sub list_unconfigured {
   my $self=shift;
   grep { !$self->rulefiles->{$_} || $self->configured->{$_}<0 } keys %{$self->configured}
}
###############################################################################################
sub credit_of_rulefile {
   my ($self, $rulefile)=@_;
   LoadPreamble::include_rule($self, $rulefile, 1);
   if (defined (my $credit=$self->credits_by_rulefile->{$rulefile})) {
      if (is_object($credit)) {
         $credit
      } else {
         $self->credits_by_rulefile->{$rulefile}=lookup_credit($self, $credit)
      }
   } else {
      undef
   }
}
###############################################################################################
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 $dir=$extension->app_dir($self);
   File::Path::mkpath([ map { "$dir/$_" } qw(src include perllib rules scripts) ], 0, 0755);
   if (-d "$ext_dir/.svn") {
      my $top_new="$ext_dir/apps";
      $top_new=$dir if -d "$top_new/.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_include_links($self, $ext_dir);
}
###############################################################################################
sub found {
   (undef, my ($name, $extension))=@_;
   my $core= $DeveloperMode && !is_object($extension) && $extension eq "core";
   my $ext_dir= $core ? $InstallTop : $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), $core ? qw(testsuite) : ()) {
      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" );
      if ($core) {
         system("svn propset noexport test $dir/testsuite")
            and warn_print("svn propset noexport test $dir/testsuite failed!\nPlease investigate the reason and run it manually\n");
      }
   }
   my $app=_new(@_[0,1]);
   $app->installTop=$ext_dir;
   $app->top=$dir;
   CPlusPlus::found_application($app,$core);
}
###############################################################################################

package Polymake::Core::Application::LoadPreamble;
use Polymake::Struct (
   [ '@ISA' => 'Application' ],
);

# pretend the last configuration step in the preamble to fail
sub configure {
   my ($self, $code, $filename, $line)=@_;
   $line < $self->preamble_end->{$filename};
}
*configure_build=\&configure;

sub add_credit {
   my $self=shift;
   my $credit=$self->SUPER::add_credit(@_, 1);
   $credit->shown=$Rule::Credit::hide;
   $credit
}

sub include_rule {
   my ($self, $rulefile, $other)=@_;
   if (my $code=$self->rule_code->{$rulefile}) {
      my $credit=$self->credits_by_rulefile->{$rulefile};
      if (defined($credit) && !is_object($credit)) {
         local_bless($self, __PACKAGE__) if $other;
         my $reread=new Reconf($self, 1);
         local_unshift(\@INC, $self);
         local_sub(get_pkg($self->pkg)->{self}, sub { $reread });
         &$code;
      }
   } else {
      my $conf=$self->configured->{$rulefile};
      if ($conf || !defined($conf)) {
         local_bless($self, "Polymake::Core::Application") unless $other;
         local $Shell=new NoShell();
         include_rules($self, $rulefile);
      } else {
         delete $self->rulefiles->{$rulefile};
         delete $self->configured->{$rulefile};
         local_bless($self, __PACKAGE__) if $other;
         include_rules($self, $rulefile);
         $self->configured->{$rulefile}=0;
         $self->rulefiles->{$rulefile}=0;
      }
   }
}

sub include_required {
   my ($self, $block, $filename, $line)=@_;
   foreach my $rulefile (parse_rule_block($block)) {
      unless (is_ARRAY($rulefile)) {
         if ($rulefile =~ /^($id_re)::/o) {
            include_rule($self->used->{$1}, $', 1);
         } else {
            include_rule($self, $rulefile);
         }
      }
   }
   $line < $self->preamble_end->{$filename};
}
###############################################################################################

package Polymake::Core::Application::Reconf;
use Polymake::Struct (
   [ new => '$;$' ],
   [ '$application' => '#1' ],
   [ '$simulate_failure' => '#2' ],
);

sub start_preamble { shift }
sub preamble_end { $_[0]->application->preamble_end }

sub add_credit {
   my $self=shift;
   my $credit=$self->application->add_credit(@_, 1);
   if ($self->simulate_failure && $_[1] =~ /\S/) {
      $credit->shown=$Rule::Credit::hide;
   }
   $credit
}

sub add_custom {
   my $self=shift;
   if (!$self->simulate_failure  and  my $var=$self->application->custom->re_tie(@_)) {
      $var->extension=$extension;
   }
}

sub close_preamble {
   my ($app, $success, $filename, $line, $optional)=@_;
   if ($success) {
      return 1 if $line < $app->preamble_end->{$filename};   # further CONFIGURE blocks follow
   }

   my ($rulefile)= $extension ? $filename : $filename =~ $filename_re;
   $app->config_clock->{$rulefile}=$reconfigure;
   $app->custom->handler->need_save=1;
   if ($success) {
      $app->configured->{$rulefile} ||= 1;
   } elsif ($optional) {
      $app->configured->{$rulefile}=-1;
      return 1 if $line < $app->preamble_end->{$filename};
   } else {
      $app->configured->{$rulefile}=0;
      return 0;
   }

   ($app->rulefiles->{$rulefile} &&= return 0)=1;   # avoid repeated loading; the configured status should be true already
   if (is_object (my $credit=$app->credits_by_rulefile->{$rulefile})) {
      $credit->shown &= ~$Rule::Credit::hide;
   }
   1
}

sub configure {
   my ($self, $code, $filename, $line, $optional)=@_;
   if ($self->simulate_failure) {
      $line < $self->preamble_end->{$filename};
   } else {
      my $success=eval { $code->() };
      if ($@) {
         warn_print( "$filename - autoconfiguration failed:\n", $@ );
         $@="";
      }
      close_preamble($self->application, $success, $filename, $line, $optional);
   }
}

sub configure_build {
   my ($self, $code, $filename, $line)=@_;
   if ($self->simulate_failure) {
      $line < $self->preamble_end->{$filename};
   } elsif ($self->application->cpp->needs_build($extension)) {
      my @vars=eval { $code->() };
      if ($@) {
         warn_print( "$filename - autoconfiguration failed:\n", $@ );
         $@="";
      }
      if (@vars) {
         $self->application->cpp->store_in_conf_makefile($extension->dir, @vars);
      }
      close_preamble($self->application, @vars ? 1 : 0, $filename, $line);
   } else {
      close_preamble($self, 1, $filename, $line);
   }
}

sub include_required {
   my ($self, $block, $filename, $line)=@_;
   if ($self->simulate_failure) {
      LoadPreamble::include_required($self->application, $block, $filename, $line);
   } else {
      my $success=1;
      foreach (parse_rule_block($block)) {
         if (is_ARRAY($_)) {
            my $rc;
            foreach my $rulefile (@$_) {
               if ($rc) {
                  exclude_rule($self->application, $rulefile);
               } else {
                  $rc=reconfigure($self, $rulefile);
               }
            }
            $success=0, last unless $rc;
         } else {
            $success=0, last unless reconfigure($self, $_);
         }
      }
      close_preamble($self->application, $success, $filename, $line);
   }
}

sub reconfigure {
   my ($self, $rulefile)=@_;
   if ($rulefile =~ /^($id_re)::/o) {
      $self->application->used->{$1}->reconfigure($');
   } else {
      $self->application->reconfigure($rulefile);
   }
}

sub AUTOLOAD {
   my $self=shift;
   my ($method)= $AUTOLOAD =~ /::(\w+)$/;
   $self->application->$method(@_);
}

sub DESTROY { }

###############################################################################################

package Polymake::Core::Application::Unconf;
use Polymake::Struct (
   [ new => '$' ],
   [ '$application' => '#1' ],
);

sub start_preamble { shift }
sub preamble_end { $_[0]->application->preamble_end }

sub add_credit {
   my ($self, $product, $text)=@_;
   my $credit=$self->application->lookup_credit($product);
   if ($text =~ /\S/) {
      $credit->shown=$Rule::Credit::hide;
   }
   $credit;
}

sub add_custom {
   my ($self, $varname, $help_text, $state, $pkg)=@_;
   $self->application->custom->unset($varname, $pkg) if $state;
}

# pretend the last configuration step in the preamble to fail
sub configure {
   my ($self, $code, $filename, $line)=@_;
   $line < $self->application->preamble_end->{$filename} or do {
      my ($rulefile)= $extension ? $filename : $filename =~ $filename_re;
      $self->application->config_clock->{$rulefile}=$reconfigure;
      $self->application->custom->handler->need_save=1;
      $self->application->configured->{$rulefile}=0;
   }
}
*configure_build=\&configure;
*include_required=\&configure;

###############################################################################################

package Polymake::Core::Extension;

sub locate_unknown {
   my $URI=shift;

   my $ignore=InteractiveHelp::underline("ignore");
   my $skip  =InteractiveHelp::underline("skip");
   my $stop  =InteractiveHelp::underline("stop");

   print <<".";
In order to proceed, you should import a polymake extension with identifier
  $URI
Please download and unpack it somewhere, or check it out if it is kept in some
repository, then enter the top directory (one above "apps/") here.

In the case this is an old identifier of an extension you already have,
please specify its current top directory; the mapping between identifiers
will be stored for future sessions and applied automatically.

If you know that this extension is obsolete and has been integrated into the
standard distribution or other extensions, please enter $ignore.

Finally, if you don't know where to get the extension or don't want to bother
importing it, please enter $stop to stop loading the data file
or $skip to load the data without components defined in this extension.
.
   for (;;) {
      my $dir=$Shell->enter_filename("", { prompt => "extension dir" });
      if ($dir =~ /^(?:ignore|stop|skip)$/i) {
         $refused{$URI}=lc($dir);
         return;
      } elsif (-d $dir && -x _) {
         return Cwd::abs_path($dir);
      } else {
         print $dir && "The directory $dir does not exist or is unaccessible.\n",
               "Please enter a correct location, `ignore', `stop', or `skip'.\n";
      }
   }
}
######################################################################################
sub forget {
   my $self=shift;
   my @drop_apps;
   foreach my $app (list Application) {
      if ($app->installTop eq $self->dir) {
         $Prefs->forget_application($app->prefs);
         $Custom->forget_application($app->custom);
         $app->cpp->forget_extension($self, 1);
         delete $repository{$app->name};
         push @drop_apps, $app;
      } elsif (delete_from_list($app->extensions, $self)) {
         $app->custom->forget_extension($self);
         $app->cpp->forget_extension($self);
         my $had_configured;
         while (my ($rulefile)=each %{$app->configured}) {
            if (index($rulefile, $self->dir)==0) {
               delete $app->configured->{$rulefile};
               $had_configured=1;
            }
         }
         if ($had_configured) {
            $app->custom->set('%configured');
         }
      }
   }
   $Prefs->forget_extension($self);
   delete $by_dir{$self->dir};
   delete $by_URI{$self->URI};
   @drop_apps;
}
###############################################################################################

package Polymake::User;

sub apropos {
   my $expr=shift;
   $expr=qr/$expr/i;
   if (my @list=map { $_->help->list_matching_leaves(sub { length($_[0]->text) && $_[0]->name =~ $expr }) } $application, values %{$application->used}) {
      print map { $_->full_path."\n" } @list;
   } else {
      print "No matching help items found\n";
   }
}
###############################################################################################
sub show_preferences {
   my $default_seen;
   foreach ($application->prefs->list_active) {
      print "$_\n";
      $default_seen ||= m/\(\#\)$/;
   }
   if ($default_seen) {
      print "Preferences marked with (#) are in effect by default, as specified in the rule files\n";
   }
}
###############################################################################################
sub show_credits {
   my $brief=shift;
   my ($shown, $hidden);
   foreach my $credit (num_sorted_uniq(sort { $a->product cmp $b->product }
                                       map { values %{$_->credits} } $application, values %{$application->used} )) {
      if ($credit->shown == $Core::Rule::Credit::hide) {
         $hidden=1;
      } else {
         if (!$shown) {
            print "\nApplication ", $application->name, " currently uses following third-party software packages:\n";
         }
         if ($brief) {
            print $shown && ", ", $credit->product;
         } else {
            my $text=$credit->text;
            Core::InteractiveHelp::clean_text($text);
            print "\n", $credit->product, "\n", $text;
         }
         $shown=1;
      }
   }
   if ($brief) {
      if ($shown) {
         print "\nFor more details:  show_credits;\n";
      }
   } elsif (!$shown) {
      if ($hidden) {
         print "\nApplication ", $application->name, " currently does not use any third-party software packages;\n",
               "For more details:  show_unconfigured;\n";
      } else {
         print "\nApplication ", $application->name, " does not offer any interfaces to third-party software.\n";
      }
   } elsif ($hidden || grep { !$_ } map { values %{$_->configured} } $application, values %{$application->used}) {
      print "\n", Core::InteractiveHelp::bold("Note:"), " there are also some other interfaces which are currently disabled;\n",
            "For more details:  show_unconfigured;\n";
   }
}
###############################################################################################
sub choose_extension_tree {
   my ($ext_dir)=@_;
   if (defined $ext_dir) {
      replace_special_paths($ext_dir);
      -d $ext_dir or die "directory $ext_dir does not exist\n";
      -w _ && -x _ or die "you don't have enough permissions to use directory $ext_dir\n";
      $ext_dir=Cwd::abs_path($ext_dir);
      if ($ext_dir =~ m{^(?:$InstallTop|$InstallArch)(?:/|$)}) {
         die "An extension may not reside within the polymake core tree.\n",
             "Please choose a different location.\n";
      }
      ($ext_dir, 1);
   } else {
      foreach (@lookup_applications[1..$#lookup_applications]) {
         if (-w $_ && -x _) {
            warn_print( "using extension base directory $_\n" );
            return ($_, 0);
         }
      }
      die "please specify the extension base directory\n";
   }
}

sub found_extension {
   $application->found_extension(add Core::Extension(&choose_extension_tree));
}

sub found_application {
   my $app_name=shift;
   defined(lookup Core::Application($app_name)) and die "application $app_name already loaded\n";
   foreach (@lookup_applications) {
      -d "$_/apps/$app_name" and die "application $app_name seems to be already created: look at $_/apps\n";
   }
   found Core::Application($app_name, $DeveloperMode && $_[0] eq "core" ? $_[0] : add Core::Extension(&choose_extension_tree));
}

sub import_extension {
   my $ext_dir=shift;
   replace_special_paths($ext_dir);
   $ext_dir=Cwd::abs_path($ext_dir);
   if (lookup Core::Extension($ext_dir)) {
      die "extension $ext_dir already imported\n";
   }
   -d $ext_dir or die "directory $ext_dir does not exist\n";
   my $ext=add Core::Extension($ext_dir,1);
   $ext->load_contents;
}

sub forget_extension {
   my $ext_dir=shift;
   replace_special_paths($ext_dir);
   my $ext= -d $ext_dir ? lookup Core::Extension($ext_dir) : lookup_by_URI Core::Extension($ext_dir)
      or die "no known extension associated with ", -d _ ? "directory " : "URI ", $ext_dir, "\n";

   for (my ($pos,$end)=(1, $#lookup_applications); $pos<=$end; ++$pos) {
      if ($lookup_applications[$pos] eq $ext->dir) {
         $Prefs->custom->delete_from_private_list('@lookup_applications', $pos)
           or die "Extension $ext_dir can't be forgotten: it is included by global configuration\n";
      }
   }
   foreach my $app ($ext->forget) {
      if ($app==$default_application) {
         $Prefs->custom->reset('$default_application');
      }
      if ($app==$application) {
         application($default_application);
      }
      delete_string_from_list(\@start_applications, $app->name);
   }
   $Prefs->custom->set('@start_applications');
}
###############################################################################################
sub x_configure {
   my ($rulefile, $method, $piece_proc)=@_;
   ++$Core::Application::reconfigure;

   if ($rulefile =~ m{^($id_re)::(.*)}o) {
      if (defined (my $app=$application->used->{$1})) {
         $app->$method($2);
      } elsif (lookup Application($1)) {
         die "application $1 is not in the current active scope\n";
      } else {
         die "unknown application $1\n";
      }
   } elsif ($rulefile =~ m{^/}) {
      foreach my $app ($application, values %{$application->used}) {
         foreach my $ext (@{$app->extensions}) {
            if (index($rulefile, $ext->app_dir($app))==0) {
               local $Core::Application::extension=$ext;
               $app->$method($rulefile);
               return;
            }
         }
      }
      die "$rulefile does not belong to any loaded extension\n";
   } else {
      $application->$method($rulefile);
      # to avoid further user's confusion, we should process the rulefiles with equal name in all known applications as well
      my %known;
      foreach my $app (list Core::Application) {
         if ($method eq "reconfigure" ? exists $app->configured->{$rulefile} : $app->configured->{$rulefile}) {
            $app->$method($rulefile);
         }
         $known{$app->pkg}=1;
      }
      $application->custom->handler->transform_pieces($piece_proc, \%known);
   }
}

sub reconfigure {
   my $rulefile=shift;
   x_configure($rulefile, "reconfigure",
               # remove the configuration status of the rulefile in applications not loaded now
               sub {
                  $_[0] =~ s/(^\s* %rulefiles \s*=\s* \( [^()]*?) ^\s* (['"])\Q$rulefile\E\2 \s*=>.*? \n/$1/mx;
               })
}
sub unconfigure {
   my $rulefile=shift;
   x_configure($rulefile, "unconfigure",
               # change the configuration status of the rulefile in applications not loaded now to 'false'
               sub {
                  $_[0] =~ s/(^\s* %rulefiles \s*=\s* \( [^()]*? ^\s* (['"])\Q$rulefile\E\2 \s*=>\s*) \d+/${1}0/mx;
               })
}
###############################################################################################
sub show_unconfigured {
   my (%shown_credits, $credit, $shown);
   local $Core::Application::reconfigure=0;
   foreach my $rulefile ($application->list_unconfigured) {
      print "$rulefile\n";
      if ($credit=$application->credit_of_rulefile($rulefile)) {
         $shown_credits{$credit->product}++;
         print $credit->text, "\n";
      }
      $shown=1;
   }
   while (my ($name, $app)=each %{$application->used}) {
      foreach my $rulefile ($app->list_unconfigured) {
         next if $credit=$app->credit_of_rulefile($rulefile) and $shown_credits{$credit->product}++;
         print (($rulefile !~ m{^/} && "$name\::")."$rulefile\n",
                $credit ? ($credit->text, "\n") : ());
         $shown=1;
      }
   }
   if ($shown) {
      print "To enable an interface:  reconfigure(\"", Core::InteractiveHelp::underline("RULEFILE"), "\");\n";
   }
}
###############################################################################################
sub export_configured {
   my ($filename, $merge_with_global)=@_;
   replace_special_paths($filename);
   $Custom->export($filename, $merge_with_global, $Prefs->custom);
}

1

# Local Variables:
# cperl-indent-level:3
# indent-tabs-mode:nil
# End:
