#  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: User.pm 9991 2010-12-12 23:36:28Z gawrilow $

use strict;
use namespaces;

package Polymake::User;

declare $application;

sub application {
   if (@_>1) {
      die "usage: application [ \"name\" ]\n";
   } elsif (@_) {
      my $new_app=shift;
      if (defined wantarray) {
         if (ref($new_app)) {
            warn_print( "application() call without effect as the application ", $new_app->name, " already loaded" );
            $new_app;
         } else {
            add Core::Application($new_app);
         }
      } else {
         $new_app=add Core::Application($new_app) unless ref($new_app);
         if (defined($application)) {
            return if $application == $new_app;
            readwrite($application);
         }
         $application=$new_app;
         readonly($application);
         namespaces::import_subs_from($_->eval_expr) for ($application, values %{$application->used});
      }
   } else {
      # tell the current application
      $application;
   }
}

#################################################################################
sub include {
   my $rc=$application->include_rules(@_);
   if ($rc != @_) {
      foreach (@_) {
         my ($app, $rulefile)= /^($id_re)::/o ? ($application->used->{$1}, $') : ($application, $_);
         if (my ($filename, $pos)=$app->lookup_rule($rulefile)) {
            $filename=$rulefile if $pos==0;
            unless ($application->rulefiles->{$filename}) {
               warn_print( "rulefile $_ is disabled by auto-configuration\n",
                           "Try  reconfigure \"$_\";  if you really want it." );
            }
         }
      }
   }
}
#################################################################################
sub load {
   my ($name)=@_;
   my $filename=$name;
   replace_special_paths($filename);
   unless (-f $filename
           or
           defined($application->default_file_suffix)  &&  $filename !~ /\.\w+$/  &&
           -f ($filename .= "." . $application->default_file_suffix)) {
      croak( "no such file: $name" );
   }
   my $obj=load Core::Object($filename);
   $obj;
}
#################################################################################
sub save {
   my ($obj, $filename)=@_;
   if (!is_object($obj) || !instanceof Core::Object($obj)) {
      croak( "only polymake Objects can be stored with the function save()" );
   }
   if (defined($obj->parent)) {
      croak( "A sub-object can't be saved without its parent" );
   }
   if (!$obj->persistent || defined($filename)) {
      if (defined $filename) {
         replace_special_paths($filename);
         if ($filename !~ /\.\w+$/) {
            $filename .= "." . $obj->default_file_suffix;
         }

      } else {
         if (!length($obj->name)) {
            $obj->name=Core::name_of_arg_var(0);
         }
         if (length($obj->name)) {
            $filename=$obj->name.".".$obj->default_file_suffix;
            if (-f $filename) {
               if ($Shell->interactive) {
                  print "The file $filename already exists.\n",
                        "Please specify another file name or confirm it to be overwritten:\n";
                  $filename=$Shell->enter_filename($filename, { prompt => "data file" }) or return;
               } else {
                  croak( "Can't save an object '", $obj->name, "' since the file $filename already exists.\n",
                         "Please specify the explicit file name as the second argument to save() or delete the existing file (unlink \"$filename\")" );
               }
            }
         } else {
            if ($Shell->interactive) {
               print "Please specify the file name for the anonymous ", $obj->type->full_name, " object:\n";
               $filename=$Shell->enter_filename("", { prompt => "data file" }) or return;
            } else {
               my $i=1;
               while (-f ($filename=($obj->name=$obj->type->name."_$i".".".$obj->default_file_suffix))) { ++$i }
               warn_print( "saving object as $filename" );
            }
         }
      }
      $obj->persistent=new Core::XMLfile($filename);
      $obj->changed=1;

   } elsif (! $obj->changed) {
      warn_print( "no changes need to be saved" );
      return;
   }

   $obj->save;
}

#################################################################################
sub load_data {
   my $filename=shift;
   replace_special_paths($filename);
   my $xf=new Core::XMLfile($filename);
   scalar($xf->load_data);
}

sub save_data {
   my ($data, $filename, $description)=@_;
   if (!is_object($data)) {
      croak( "only complex data types can be saved in separate files" );
   }
   if (instanceof Core::Object($data)) {
      croak( "an object of type ", $data->type->full_name, " can't be saved with save_data: please use save() instead" );
   }
   if (defined (my $type=UNIVERSAL::can($data,"type"))) {
      $type=$type->();
      if (instanceof Core::PropertyType($type)) {
         replace_special_paths($filename);
         my $xf=new Core::XMLfile($filename);
         $xf->save_data($data, $description);
         return;
      }
   }
   croak( "can't save ", ref($data), ": it does not belong to any declared property type" );
}
#################################################################################
use subs qw(rename unlink mkdir chdir rmdir);

sub rename { my ($from,$to)=@_; replace_special_paths($from,$to); CORE::rename($from,$to) or die "rename failed: $!\n"; }
sub unlink { my @list=@_; replace_special_paths(@list); CORE::unlink(@list) or die "unlink failed: $!\n"; }
sub mkdir { my ($path,$mask)=@_; replace_special_paths($path); CORE::mkdir($path,$mask || 0755) or die "mkdir failed: $!\n"; }
sub rmdir { my ($path)=@_; replace_special_paths($path); CORE::rmdir($path) or die "rmdir failed: $!\n"; }

sub chdir {
   my $path;
   if (my ($path)=@_) {
      replace_special_paths($path) if is_string($path);
      CORE::chdir($path) or die "chdir failed: $!\n";
   } else {
      CORE::chdir;
   }
}

sub pwd { print Cwd::cwd }

#################################################################################
sub prefer {
   $application->prefer(@_);
}

sub prefer_now {
   $application->prefer_now(@_);
}

# an alias, for the sake of symmetry
*set_preference=\&prefer;

sub reset_preference {
   $application->reset_preference(@_);
}

sub set_custom {
   $application->_set_custom(Core::name_of_custom_var(1), $Prefs->custom);
}

sub reset_custom {
   $application->_reset_custom(Core::name_of_custom_var(0), $Prefs->custom);
}

###############################################################################################
sub script {
   my $name=shift;
   replace_special_paths($name);
   my ($code, $full_path, $in_app)=find Core::StoredScript($name);
   if (defined $code) {
      local *ARGV=\@_;
      &$code;
   } else {
      local @ARGV=@_;
      defined($in_app) ? $in_app != $User::application && (local $User::application=$in_app,  local $INC[0]=$in_app)
                       : local_save_scalar($User::application);
      $name="script" . (defined($in_app) ? ":" : "=") . $full_path;
      if (wantarray) {
         my @ret=do $name;
         die $@ if $@;
         @ret
      } elsif (defined wantarray) {
         my $ret=do $name;
         die $@ if $@;
         $ret
      } else {
         do $name;
         die $@ if $@;
      }
   }
}
####################################################################################
# prepare for custom variables and preferences

package Polymake::User::Verbose;
*Polymake::Verbose::=get_pkg(__PACKAGE__);

push @Core::UserSettings::add_custom_vars,
sub {
   my $ch=$Prefs->create_custom("Polymake::User");

   $ch->pkg_help->{__PACKAGE__}=<<'.';
# The following variables control the display of various informational message classes.
.
   declare $credits=1;
   $ch->add('$credits', <<'.');
# Display the copyright notices and URLs of third-party software:
# 0 - never, 1 - at the first use in the current session, 2 - always
.
   declare $rules=1;
   $ch->add('$rules', <<'.');
# Display the information about the rules:
# 0 - nothing, 1 - significant failures, 2 - summary and all failed preconditions, 3 - each executed rule
.
   declare $scheduler=0;
   $ch->add('$scheduler', <<'.');
# Reveal the internals of the rule scheduler:
# 0 - nothing, 1 - summary and statistics, 2 - initial rule selection,
# 3 - shortest path search (overwhelming amount of data)
.
   declare $cpp=0;
   $ch->add('$cpp', <<'.');
# Tell about the actions of the perl/C++ interface generator:
# 0 - nothing, 1 - compiler calls and source file updates, 2 - generated source code
.
   declare $files=1;
   $ch->add('$files', <<'.');
# Notify about nontrivial actions during data file processing
.
   declare $external=0;
$ch->add('$external', <<'.');
# Notify about external programs starting in the background
# (not to be mixed up with credits!)
.

   package Polymake::User;

   declare @start_applications;
   $ch->add('@start_applications', <<'.');
# Applications to be loaded at the beginning of each interactive or batch session
.
   declare $default_application="polytope";
   $ch->add('$default_application', <<'.');
# Application to start with as the current one
.
   declare @lookup_applications=($InstallTop);
   $ch->add('@lookup_applications', <<'.', $Core::Customize::state_accumulating);
# A list of directories where to look for applications and extensions
.
   declare @lookup_scripts;
   $ch->add('@lookup_scripts', <<'.', $Core::Customize::state_accumulating);
# A list of directories where to look for scripts
.
   declare %renamed_extensions;
   $ch->add('%renamed_extensions', <<'.');
# Matching old extensions' URI to their current location
.
   declare $history_size=200;
   $ch->add('$history_size', <<'.');
# Maximal number of commands stored in the interactive shell's history.
# If set to undef, history list grows unlimited.
.
   declare $history_editor=$ENV{VISUAL} || $ENV{EDITOR} || "vi";
   $ch->add('$history_editor', <<'.');
# Editor for the ''history'' command.
# Must be a complete shell command. If the temporary file name is expected somewhere in the middle
# of the arguments, please use the placeholder %f.
.

   $ch->cleanup;

   # treat relative paths as starting at $HOME
   s{^(?:~/|(?!/))}{$ENV{HOME}/} for @lookup_applications, @lookup_scripts;

   if (!@start_applications) {
      if ($DeveloperMode) {
         ### FIXME: remove this when all applications migrated
         $ch->set('@start_applications', grep { /^(?:polytope|topaz|matroid|tropical|fan)$/ } map { m{apps/([^/]+)/rules} } glob("$InstallTop/apps/*/rules/main.rules"));
      } else {
         $ch->set('@start_applications', map { m{apps/([^/]+)/rules} } glob("$InstallTop/apps/*/rules/main.rules"));
      }
   }
};

1

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