#!/usr/bin/perl
#
#  Copyright (c) 1997-2006
#  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: polymake,v 1.123 2006/03/10 12:13:21 gawrilow Exp $
#

use v5.8;
use strict;
use integer;
use Config;

use vars qw( $Version $VersionNumber $InstallTop $InstallArch $Arch $DeveloperMode
	     $DefaultAppName $scope %global
	   );

sub find_build_dir {
   my ($builddir)=glob "$InstallTop/build";
   if (!defined $builddir || ! -d $builddir) {
      foreach my $arch (exists $ENV{Arch} ? ($ENV{Arch}) : (), map { $_ eq lc($_) ? $_ : ($_, lc($_)) } split /\s+/, `uname -msp`) {
	 if (-d ($builddir="$InstallTop/build.$arch")) {
	    $Arch=$arch;
	    goto FOUND;
	 }
      }
      die "build directory not found: probably need to set 'Arch' environment variable?\n";
   }
 FOUND:
   require Cwd;
   Cwd::abs_path($builddir);
}

BEGIN {
   $InstallTop= $0=~m%(?:^|/)[^/]+/[^/]+$% ? ($` || ".") : "..";
   $InstallArch=find_build_dir;
   $DefaultAppName="polytope";	# the historically oldest application
   $DeveloperMode=1;

   # Customize will need them right now, during the compilation
   $Version="2.2";
   $VersionNumber=eval "v$Version";

   # load this before namespaces are activated, as some perl versions crash when it is accessed later
   my $dummy=$Config::Config{use64bitint};
}
use lib "$InstallTop/perl", "$InstallArch/perlx";     # default locations for polymake modules

use Switches qw( POLYMAKE_SWITCHES env
                 d cnt   n bool  v cnt
                 script string-  f list  A string  I list
                 T number
	         [  verify bool  touch bool  help bool  version bool  server string  ]
		 keep-temporary bool  reconfigure bool
	       );

use Poly;
use Poly::Shell;
use Poly::Server;
use Poly::Sockets;

my $usage=<<'.';
usage: polymake [-dv] [-A <application>] [-f <rulefile>] [-I <ruledir>] [-T <timeout>]
                [--script] <script_file> [arg ...] | '<script>' |
                <host:port> | <socket> | - |
                [--reconfigure] [-n] [--verify] <file> <property|method> ... |
                --touch <file> ... | --help [<topic>] | --version
.

my $long_usage=<<'.';
usage: polymake [options] [arguments]
   called without arguments:
      starts an interactive shell with command line editing (unimplemented yet)

   arguments may be one of the following:
      --help
         print this text and exit
      --version
         print the version number, copyright notice, and exit
      [--script] [application::]script_file
         execute the perl script in the file
         if application prefix ist specified, the file is looked up
         in the application-specific script directory
      --script [application::]script_file arguments ...
         execute the perl script in the file, passing the arguments in @ARGV
      'script text'
         interpret the string as a perl expression
      -
         read and execute the commands from the standard input

      socket_file | host:port
         connect to the named/TCP socket, read and execute the commands;
         the standard output is redirected to the socket

      file PROPERTY | METHOD [ ... ]
         the compatibility mode with polymake <= 2.0:
         read the object from the data file, print the properties or
         run the user methods

      function ARG ...
         simplified syntax for a user function call; arguments can be data files
         and numerical or string constants

      --verify file [ LABEL ... ] PROPERTY ...
         read the object from the data file, recompute the properties (using
         the labeled rules if any labels are specified), and compare with
         the original values

      --touch file [ file ... ]
         read the files and write them out; useful for converting from
         earlier polymake versions

   options are:
      -d  produce some debug output; can be repeated to increase the debug level
      -v  tell what's going on; can be repeated to increase the verbosity level

      -n  `dry run' mode: show the production rules that would be applied to the
          object, but don't run any; available only in compatibility and
          verification modes

      --reconfigure
          rerun the autoconfiguration sections in the rule files
      --keep-temporary
          save the temporary properties in the data file (for test purposes)
      -T sec
          set a time limit for the execution of production rules

   deprecated options, kept for the sake of compatibility with earlier releases:
      -A application_name
          start with this application, ignoring the @start_applications
      -I directory
          look for applications and rule files in this directory first;
          may be repeated
      -f rule_file
          load this file in addition to main.rules; may be repeated
.

if ($Switches::ERROR  or
    ($Switches::n || $Switches::verify) && ($Switches::help || $Switches::touch)
   ) {
   $!=1;
   die $usage;
}

if ($Switches::version) {
   print STDERR <<".", <<'..';
polymake version $Version
.
Copyright (c) 1997-2006
Ewgenij Gawrilow, Michael Joswig (Technische Universitaet Berlin, Germany)
http://www.math.tu-berlin.de/polymake,  mailto:polymake@math.tu-berlin.de

This is free software; see the source for copying conditions.  There is NO
warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
..
   exit;
}

if ($Switches::v || $Switches::d) {
   print STDERR "polymake version $Version\n";
}

if ($Switches::help) {
   print STDERR $long_usage;
   exit;
}

# fill in the options
$Poly::Property::allow_temporary=0 if $Switches::keep_temporary;

if (@Switches::f) {
   Poly::warn_print( "the option -f is obsolete; put 'include' commands in ~/.polymake/prefer.pl instead\n" );
   my $ph=Poly::Module::prefs_handler();
   while (my ($modname, $text)=each %{$ph->orphans}) {
      if ($modname ne "BEGIN") {
	 $text .= "include qw(@Switches::f);\n";
      }
   }
}

@Poly::Module::lookup=(@Poly::User::lookup_applications, $InstallTop);

if (@Switches::I) {
   Poly::warn_print( "the option -I is obsolete; store the paths in ~/.polymake/prefer.pl instead\n" );
   @Poly::User::lookup_rules=@Switches::I;
}

if ($Switches::A) {
   ### not yet ...
   ### Poly::warn_print( "the option -A is obsolete; put the settings in ~/.polymake/prefer.pl instead\n" );
   $Poly::User::default_application=$Switches::A;
   @Poly::User::start_applications=();
}

$Switches::v=2 if $Switches::d and $Switches::v<2;

sub load_apps {
   eval { defined($_[0]) ? Poly::User::application(shift) : Poly::Shell::load_apps() };
   if ($@) {
      Poly::err_print($@);
      exit 1;
   }
}

if ($Switches::server ne "") {
   open my $socket, "+>&=$Switches::server"
      or die "cannot establish connection with client program: $!\n";
   local $scope=new Poly::Scope;
   Poly::Server::serve(new Poly::Pipe($socket));
   $!=1, die $@ if $@;

} elsif ($Switches::touch) {
   foreach (@ARGV) {
      my $obj=load Poly::Object($_);
      $obj->changed=1;
      $obj->save;
   }

} elsif ($Switches::script) {
   $Switches::script =~ s/^(\w+)::(?!$)//;
   load_apps($1);
   local $scope=new Poly::Scope;
   Poly::Shell::run_script($Switches::script);
   $scope->perform_deferred unless $@;

} elsif (@ARGV<=1) {
   load_apps;
   my $pipe;
   local $scope=new Poly::Scope;
   if (@ARGV==0) {
      if (-t STDIN) {
	 ### naked --reconfigure or interactive shell
	 if (!$Switches::reconfigure) {
	    Poly::Shell::run;
	 }
      } else {
	 $pipe=new Poly::Pipe(\*STDIN);
      }

   } else {
      my $arg=shift;
      if ($arg =~ /^([\w.]+):(\d+)$/) {
	 ### TCP address
	 $pipe=new Poly::ClientSocket($1,$2);
	 select $pipe; $|=1;

      } elsif ($arg eq "-") {
	 $pipe=new Poly::Pipe(\*STDIN);

      } elsif ($arg !~ /[\s'"]/) {
	 if (-S _) {
	    ### UNIX-domain socket
	    open my $socket, "+>$arg"
	       or die "error opening socket $arg: $!\n";
	    $pipe=new Poly::Pipe($socket);
	    select $pipe; $|=1;
	 } else {
	    ### script file
	    Poly::Shell::run_script($arg);
	 }

      } else {
	 Poly::Shell::eval_expr($arg);
      }
   }
   if ($pipe) {
      Poly::Shell::run_pipe($pipe);
   } else {
      $scope->perform_deferred unless $@;
   }
} else {
   eval {
      Poly::Shell::compat_mode(@ARGV);
   }
}
if ($@) {
   Poly::err_print($@);
   exit 1;
}

END {
   %global=();
}


# Local Variables:
# mode: perl
# c-basic-offset:3
# End:
