#  Copyright (c) 1997-2007
#  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: Shell.pm 7550 2007-01-10 12:25:54Z gawrilow $

use strict;
use namespaces;

use Poly::Application;
use Poly::User;
use Poly::File;
use Poly::Object;
use Poly::Pipe;

package Poly::Shell;
use Poly::Ext;

### FIXME: to be filled with interactive stuff
sub new {
   bless [ ];
}

sub run {
   die "interactive mode not implemented yet\n";
   redefine Help("Poly::InteractiveHelp");
}

# the following three routines should access customizable variables from Poly::User package

sub load_apps {
   eval {
      package Poly::User;
      if ((my ($app_name)=@_)>0) {
	 if (!defined($_[0]) || $_[0] eq "none") {
	    $application=_new Application(shift);
	 } else {
	    application($app_name);
	 }
      } else {
	 foreach $app_name (@start_applications) {
	    add Application($app_name);
	 }
	 application($default_application);
      }
   };
   if ($@) {
      err_print($@);
      exit 1;
   }
}

sub run_script {
   my ($scriptfile)=@_;
   $scriptfile =~ s/^(\w+)::(?!$)//;
   load_apps($1);
   package Poly::User;
   local @INC=($application, @INC, new Poly::Shell::BadScriptHandler);
   local_unshift($application->myINC, ".", @lookup_scripts, $application->top."/scripts", "$main::InstallTop/scripts");
   local_array($application->compile_preamble, [ "use strict; use namespaces;\n" ]);
   local *default::=get_pkg(__PACKAGE__);
   do $scriptfile;
   beautify_error() if $@;
}

sub eval_expr {
   package Poly::User;
   local_unshift(\@INC, $application);
   local_unshift($application->myINC, ".", @lookup_scripts, $application->top."/scripts", "$main::InstallTop/scripts");
   local_array($application->compile_preamble, [ "use strict; use namespaces;\n" ]);
   eval shift;
   beautify_error() if $@;
}

# the line is considered as to be continued if it ends with:
# - an opening bracket whatever kind: { ( [
# - a binary operator: + - * / . cmp eq ...
# - a colon or a semicolon
sub is_continued {
   $_[0] =~ m'(?: [{([.,;*/<>=] | (?<!\+)\+ | (?<!-)- | \b (?: cmp | le | lt | ge | gt | eq | ne | x)) \s*$ 'x;
}

sub run_pipe {
   my ($pipe)=@_;
   my ($cmd, $line, $apps_loaded);
   while (length($cmd=<$pipe>)) {
      while (is_continued($cmd) && length($line=<$pipe>)) {
	 $cmd.=$line;
      }
      if (!$apps_loaded) {
	 if ($cmd !~ /^\s* application (?:\s+|\()['"]\w+/xs) {
	    load_apps;
	 }
	 $apps_loaded=1;
      }
      local $main::scope=new Scope();
      eval_expr($cmd);
      if ($@) {
	 err_print($@);
      } else {
	 $main::scope->perform_deferred;
      }
   }
   $@='';
}

###############################################################################################
my @request;

package Poly::Shell::Dummy;
my $dummy=bless [ ];

sub AUTOLOAD { $dummy }

package Poly::User::Prepare;

sub AUTOLOAD {
   $AUTOLOAD =~ /([^:]+)$/;
   if (@_) {
      die "unknown method or property: $1\n";
   }
   push @request, $1;
   $dummy;
}

sub the_rest {
   wantarray ? () : $dummy;
}

sub prepare {
   no strict 'refs';
   while (my ($func, $attr)=each %{$application->EXPORT}) {
      *$func= is_code($attr)
              ? \&the_rest :
	      $attr eq "prop"
              ? \&$func : \&the_rest;
   }
   @request=();
}

###############################################################################################
package Poly::Shell;

sub compat_mode {
   my $file=shift;

   if (-f $file) {
      # old style syntax: FILE PROPERTY ...
      Poly::User::load($file);

      if ($Switches::verify) {
	 $Poly::User::this->verify(@_);
	 return;
      }

      do {
	 package Poly::User::Prepare;
	 prepare();
	 my $i=1;
	 foreach (@_) {
	    if (/^ $id_only_re /ox and defined (my $label=$application->prefs->find_label($1))) {
	       if ($i<=$#_) {
		  if ($application->EXPORT->{$1} eq "user") {
		     warn_print( <<"." );
$1 is interpreted as  prefer_now "$1";
but this is probably not exactly the same as you have meant.

The recommended way to enforce using $1 is to call it explicitly:
$1($_[$i])
.
                  }
	          $label->set_temp_preferred($main::scope);
	       } else {
		  warn_print( <<"." );
$1 is a label controlling the choice of functions following it
on the command line.  Being put on the last position it does not
affect anything.
.
               }
	       undef $_;
	    } else {
	       eval $_;
	       if ($@) {
		  $@ =~ s/^Bareword "([^"]+)" not allowed .*$/Unknown method, property, or label: $1/mg unless $Switches::d;
		  die beautify_error();
	       }
	    }
            ++$i;
	 }
      };

      if ($Switches::n) {
	 if (defined (my $schedule=$Poly::User::this->give_schedule(@request))) {
	    print $schedule->report, "\n";
	 } else {
	    err_print( "no suitable rules found\n" );
	 }
	 return;
      }
      $Poly::User::this->give(@request);

      foreach my $expr (@_) {
	 next unless defined $expr;
	 my @pr=do {
	    package Poly::User;
	    no strict 'vars';
	    eval "printable($expr)"
	 };
	 die beautify_error() if $@;
	 if (@pr) {
	    enforce_nl($pr[-1]);
	    print "$expr\n", @pr, "\n";
	 }
      }

   } elsif ($file =~ /^ $id_only_re/xo) {
      # slight variation of the old style: FUNCTION FILE ...
      my $files_seen=0;
      foreach my $arg (@_) {
	 if (-f $arg) {
	    $arg=Poly::User::load($arg);
	    ++$files_seen;
	 }
      }
      load_apps if !$files_seen;

      if (my $function=Poly::User->can($file)) {
	 if ($Switches::n) {
	    die "can't call function $file in dry run mode\n";
	 }
	 if (my @pr=Poly::User::printable($function->(@_))) {
	    enforce_nl($pr[-1]);
	    print "$file\n", @pr, "\n";
	 }
      } else {
	 die "unknown function or file name: $file\n";
      }
   } else {
      die "file $file does not exist\n";
   }
}

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

# make this function visible for all modules and applications
sub Modules::returnObject {
   my $obj=shift;
   $obj->commit;
# try to guess the destination user variable
   if (defined (my $name=return_to_var())) {
      $obj->name ||= $name;
   }
   defined(wantarray) ? $obj : ($Poly::User::this=$obj);
}

package Poly::Shell::BadScriptHandler;
my $dummy=bless [ ];

sub new { $dummy; }

sub Poly::Shell::BadScriptHandler::INC {
   $@="script file '" . pop(@_) . "' not found\n";
   undef;
}

1