#!/usr/bin/perl
#
# Copyright (c) 1997-2007
# Ewgenij Gawrilow (TU Berlin), Michael Joswig (TU Darmstadt)
# 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 7586 2007-01-23 17:51:31Z gawrilow $
#
use v5.8.1;
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.3";
$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 reconfigure-rules list* ]
);
use Poly;
use Poly::Shell;
use Poly::Server;
use Poly::Sockets;
my $usage=<<'.';
usage: polymake [-dv] [-A <application>] [-f <rulefile>] [-I <ruledir>] [-T <timeout>]
[--reconfigure | --reconfigure-rules RULENAME ... ]
[--script] <script_file> [arg ...] | '<script>' |
<host:port> | <socket> | - |
[-n] [--verify] <file> <property|method> ... |
--touch <file> ... | --help | --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 is 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 all rule files
--reconfigure-rules RULENAME ...
rerun the autoconfiguration sections in the rule files matching RULENAME
--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;
}
sub release_date {
require POSIX;
my @date= '$Date: 2007-01-23 18:51:31 +0100 (Tue, 23 Jan 2007) $' =~ /(\d+)-(\d+)-(\d+)/;
return POSIX::strftime("%B %d, %Y",0,0,12,$date[2],$date[1]-1,$date[0]-1900);
}
if ($Switches::version) {
print STDERR "polymake version $Version, released on ", release_date, <<'.';
Copyright (c) 1997-2007
Ewgenij Gawrilow (TU Berlin), Michael Joswig (TU Darmstadt)
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;
$scope=new Poly::Scope;
if ($Switches::server ne "") {
open my $socket, "+>&=$Switches::server"
or die "cannot establish connection with client program: $!\n";
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) {
Poly::Shell::run_script($Switches::script);
$scope->perform_deferred unless $@;
} elsif (@ARGV<=1) {
my $pipe;
if (@ARGV==0) {
if (-t STDIN) {
### naked --reconfigure or interactive shell
if ($Switches::reconfigure || @Switches::reconfigure_rules) {
Poly::Shell::load_apps;
} else {
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::load_apps;
Poly::Shell::eval_expr($arg);
}
}
if ($pipe) {
Poly::Shell::run_pipe($pipe);
} else {
$scope->perform_deferred unless $@;
}
} else {
eval {
Poly::Shell::compat_mode(@ARGV);
$scope->perform_deferred;
}
}
if ($@) {
Poly::err_print($@);
exit 1;
}
END {
undef $scope;
%global=();
}
# Local Variables:
# mode: perl
# c-basic-offset:3
# End:
syntax highlighted by Code2HTML, v. 0.9.1