#  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: Shell.pm,v 1.18.2.4 2004/12/17 17:00:54 gawrilow Exp $

use strict;
use namespaces;

use Poly::User;
use Poly::Application;
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";
}

# 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 eval_expr {
   no strict 'vars', 'subs';
   package Poly::User;
   eval shift;
}

sub beautify_error {
   my $f=__FILE__;
   $@ =~ s/ at \(eval \d+\)(\[$f:\d+\])? line 1(\.)?/$1/g;
   $@ =~ s/^Bareword "([^"]+)" not allowed .*$/Unknown method, property, or label: $1/mg;
   $@;
}

sub run_pipe {
   my ($pipe)=@_;
   my ($cmd, $line);
   while (length($cmd=<$pipe>)) {
      while (is_continued($cmd) && length($line=<$pipe>)) {
	 $cmd.=$line;
      }
      local $main::scope=new Poly::Scope;
      eval_expr($cmd);
      err_print(beautify_error()) if $@;
      $main::scope->end;
   }
   $@='';
}

declare @request;

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

sub AUTOLOAD { $dummy }

package Poly::Shell::Compat;
my $repeat;

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

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

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

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

sub printable {
   my $thing=shift;
   if (is_object($thing)) {
      if (my $array=overload::Method($thing, '@{}')) {
	 return &$array($thing);
      } else {
	 return ref($thing);
      }
   }
   if (is_ARRAY($thing)) {
      @$thing;
   } elsif (defined($thing)) {
      $thing.(substr($thing,-1) ne "\n" && "\n")
   } else {
      "== UNDEF ==\n";
   }
}

sub compat_mode {
   local $main::scope=new Poly::Scope;
   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::Shell::Compat;
	 prepare();
	 foreach (@_) {
	    no strict 'subs';
	    $repeat=0;
	    eval $_;
	    die beautify_error() if $@;
	    undef $_ unless $repeat;
	 }
      };

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

      foreach my $expr (@_) {
	 next unless defined $expr;
	 my @res=eval_expr($expr);
	 die beautify_error() if $@;
	 if (@res==1) {
	    if (UNIVERSAL::isa($res[0], "Visual::Object")) {
	       Visual::show(undef, $res[0]);
	    } else {
	       print "$expr\n", printable($res[0]), "\n";
	    }
	 } elsif (@res) {
	    print "$expr\n", @res, "\n";
	 }
      }

   } elsif ($file =~ /^(?!\d)\w+$/) {
      # 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;
	 }
      }
      &main::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 @results=&$function(@_)) {
	    print "$file\n", printable($results[0]), "\n";
	 }
      } else {
	 die "unknown function or file name: $file\n";
      }
   } else {
      die "file $file does not exist\n";
   }
   $main::scope->end;
}
#################################################################################
#
#  Persistency handling
#
my %user_objects=(\$Poly::User::this => 0);

sub save_user_objects {
   foreach my $var (keys %user_objects) {
      if (defined (my $obj=$$var)) {
	 if (UNIVERSAL::isa($obj, "Poly::Object")) {
	    Poly::User::save($obj);
	 }
      }
   }
}

END {
   $Poly::Object::suppress_save=1;
   save_user_objects;
}

# 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;
      no strict 'refs';
      $user_objects{\${"Poly::User::name"}}=0;
   }
   defined(wantarray) ? $obj : ($Poly::User::this=$obj);
}

1
