#  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: User.pm,v 1.6.2.3 2004/12/17 16:19:03 gawrilow Exp $

use strict;
use namespaces;

use Poly::Help;

package Poly::UserSettings;

BEGIN {
   declare $dir="$ENV{HOME}/.polymake";

   if (!-d $dir) {
      mkdir $dir, 0755
      or die "can't per-user directory $dir: $!\n";
      warn_print( "directory $dir created for keeping individual user settings" );
   }
}
##################################################################################
package Poly::User;

declare $this;
declare $application;
BEGIN { declare @lookup_rules; }

my @imported;

my $top_help=new Poly::Help;
my $function_help=$top_help->add([ qw(functions Basic) ], <<'.');
These functions are part of the core user interface.  They are available in both scripting and interactive modes.
.
$function_help->category=1;
sub Poly::Shell::basic_help { $top_help }

package Poly::User::_secret;

sub unimport_app {
   unimport_function(\%Poly::User::, @imported);
}

sub import_app {
   @imported=();

   # import user functions, predeclare user methods so as to be caught up by AUTOLOAD
   while (my ($func, $attr)=each %{$application->EXPORT}) {
      next if $attr eq "func";
      no strict 'refs';
      if (!exists &{"Poly::User::$func"}) {
	 *{"Poly::User::$func"}= is_code($attr)
	                         ? $attr :
		                 $attr eq "user"
		                 ? namespaces::lookup_sub($application->pkg,$func)
		                 : \&{"Poly::User::$func"};
	 push @imported, $func;
      }
   }
}

package Poly::User;

##################################################################################
#
#  application
#
$function_help->add_function('application', <<'.');

args: [ "name" | object ]

Set the current application to the one given by @a name (loading its rules if necessary) or by an @a object of the type @c Poly::Application.

Called without arguments just returns the current @c Poly::Application object, which is also available in the variable @c $application.
Say @c{ print $application->name } to see its name.
.

sub application {
   if (@_>1) {
      die "usage: application [ \"name\" ]\n";
   } elsif (@_) {
      my $new_app=shift;
      $new_app=add Poly::Application($new_app) unless ref($new_app);
      if (defined($application)) {
	 return if $application == $new_app;
	 Poly::User::_secret::unimport_app;
	 readwrite($application);
      }
      $application=$new_app;
      readonly($application);
      Poly::User::_secret::import_app;
   } else {
      # tell the current application
      $application;
   }
}

####################################################################################
sub AUTOLOAD {
   my ($method_name)=$AUTOLOAD =~ /::([^:]+)$/;
   if ($application  and  my $attr=$application->EXPORT->{$method_name}) {
      if ($attr eq "func") {
	 # not explicitly exported, but allowed
	 my $sub=namespaces::lookup_sub($application->pkg, $method_name);
	 push @imported, $method_name;
	 no strict 'refs';
	 *$method_name=$sub;
	 goto &$sub;
      }
      if (defined($this)) {
	 if (defined (my $method=$this->can($method_name))) {
	    unshift @_, $this;
	    goto &$method;
	 } else {
	    die $attr eq "meth" ? "method" : "property",
	        " is not defined for an ", ref($this), " object\n";
	 }
      } else {
	 die "there is no default '\$this' object currently\n";
      }
   }
   die "undefined subroutine $AUTOLOAD\n";
}

####################################################################################
$function_help->add_function('include', <<'.');
args: "rulefile", ...

Read additional rule files, interpret them in the context of the current application.
If no paths are specified explicitly, the rulefiles are searched in the current directory as well
as in the directories stored in the preference variable @c @lookup_rules.
.

sub include {
   local @INC=($application, @INC);
   if (@lookup_rules) {
      @_=map {
	 my $path=$_;
	 if (! -f) {
	    foreach my $dir (@lookup_rules) {
	       if (-f "$dir/$_") {
		  $path="$dir/$_"; last;
	       }
	    }
	 }
	 $path;
      } @_;
   }
   $application->include_rules(@_);
}

#################################################################################
# my %file2var;

# sub Poly::Shell::file2var {
#    my ($name)=@_;
#    no strict 'refs';
#    my $varname;
#    if (defined ($varname=$file2var{$name})  &&  defined($$varname)) {
#       return $varname;
#    }
#    $file2var{$name}= do {
#       $varname=$name;
#       $varname =~ s/\.\w+$//;
#       $varname =~ s/[^\w]/_/g;
#       $varname =~ s/^(?=\d)/N/;
#       my $ph;
#       if (defined (my $obj=$$varname)
# 	  and  !UNIVERSAL::isa($obj, "Poly::Object") ||
# 	       !defined ($ph=$obj->persistent) ||
# 	       $ph->filename ne $name) {
# 	 for (my $i=1; 1; ++$i) {
# 	    if (!defined(${"$varname\_$i"})) {
# 	       $varname.="_$i";
# 	       last;
# 	    }
# 	 }
#       }
#       # declare the variable
#       declare *$varname=\( my $init="" );
#       $varname;
#    };
# }

$function_help->add_function('load', <<'.');
args: "filename"

Read the data file @a filename and create the object according to the type @see _type{stored there}.
If the data file does not contain a type declaration, the @see rules.default_type{default type}
of the current application is assumed.

When called in a void context (that is, the return value is neither explicitly stored in a variable,
nor passed to another function) the object is stored in the variable @c $this.  The application which has created
this data file is then made the current application.
.

sub load {
   my ($name)=@_;
   my $filename=$name;

   unless (-f $filename
	   or
	   defined($application)  &&  $filename !~ /\./  &&
	   -f ($filename .= "." . $application->file_suffix)) {

      if (my @files=glob "$name.*") {
	 warn_print( "wildcard $name.* matches more than one file" ) if @files>1;
	 $filename=$files[0];

      } else {
	 die "no such file: $name\n";
      }
   }
   my $obj=load Poly::Object($filename);
   if (defined wantarray) {
      application $obj->prototype->application if !defined $application;
      return $obj;
   }

#    no strict 'refs';
#    my $varname=Poly::Shell::file2var($name);
#    if (defined (my $old_obj=$$varname)) {
#       my $ph=$old_obj->persistent;
#       die "unsaved changes in \$$name would be lost\n" if !defined($ph) or $old_obj->changed;
#       return unless $ph->need_reload;
#    }

#    $$varname=$obj;
#    $user_objects{$varname}=0;
   $this=$obj;
   application $obj->prototype->application;
}

#################################################################################
#
#  save
#

$function_help->add_function('save', <<'.');
args: [ object [, "filename" [, overwrite ]]]

Store the given object, or @c $this if omitted, in a data file.

If @a filename is specified, create the file with this name and store the object there.
The boolean option @a overwrite allows to overwrite existing files.
If omitted or @c FALSE, and the given file already exists, emit a warning message and do nothing. 

If @a filename is omitted, write the object back to the file it was loaded from.
If the object was created with a @c new constructor, a new file is created, with the name consisting
of the object name (specified by the creation) and the application-specific @see rules.file_suffix{suffix}.
If the object name is empty, an artificial name of the form @c{ObjectType_NNN} is generated, where @c NNN is an ordinal number.

In any case all open transactions on the object are reverted with @see Poly::Object::rollback prior to writing to the file.
The save operation is not performed if the @see Poly::Object::changed attribute of the object reverts to @c FALSE after the rollback.
.

sub save {
   my ($obj, $filename, $force)=@_;
   $obj ||= $this  or  do {
      err_print( "no object specified" );
      return;
   };

   if (! $obj->persistent) {
      if (defined $filename) {
	 if ($filename !~ /\.\w+$/) {
	    $filename .= "." . $obj->prototype->application->file_suffix;
	 }
	 if (!$force && -f $filename) {
	    err_print( "File $filename already exists;\n",
		       "please choose another file name or delete the existing file (unlink \"$filename\")" );
	    return;
	 }

      } elsif (length($obj->name)) {
	 $filename=$obj->name.".".$obj->prototype->application->file_suffix;
	 if (!$force && -f $filename) {
	    if ($Poly::Object::suppress_save) {
	       # end cleanup phase - no chance more to speak with the user
	       unless (rename $filename, "$filename~") {
		  err_print( "can't create a backup copy $filename~: $!" );
		  return;
	       }
	       if ($Switches::v) {
		  warn_print( "previous object ".$obj->name." stored in a backup file $filename~" );
	       }

	    } else {
	       err_print( "File $filename already exists;\n",
			  "please specify a different name as the second argument or delete the existing file (unlink \"$filename\")" );
	       return;
	    }
	 }
      } else {
	 for (my $i=1;
		 -f ($filename=($obj->name=$obj->prototype->name."_$i".".".$obj->prototype->application->file_suffix));
		 ++$i) {
	 }
	 warn_print( "saving object as $filename" );
      }
      $obj->persistent=new Poly::File($filename);
      $obj->changed=1;

   } elsif (! $obj->changed) {
      if ($obj->persistent->need_reload) {
	 $obj->changed=1;

      } else {
	 warn_print( "no changes need to be saved" ) if !$Poly::Object::suppress_save;
	 return;
      }
   }

   $obj->save;
}

#################################################################################
#
#  prefer
#

$function_help->add_function('prefer', <<'.');
args: "label", ... | "reset"

Make the production rules, user functions, or methods labeled with given @a label
be preferred over competing rules (functions, methods).  The label syntax is the same
as in the @see rules.prefer directive in the rule files, except that the complex label names
and wildcards must be quoted in order to avoid perl complaints about bad syntax.

The new preference list is also saved in your personal file @c ~/.polymake/prefer.pl
so that it remains active in all forthcoming sessions until you revoke it with another
@c prefer command.

The special keyword @a reset reverts all preference settings to the initial state
as they had after loading the rule files.
.

sub prefer {
   if (@_==1 && $_[0] eq 'reset') {
      $application->prefs->reset;
   } else {
      $application->prefs->add_preference("@_");
   }
}
####################################################################################
# prepare for custom variables

package Poly::Module;
use Poly::Customize "$Poly::UserSettings::dir/customize.pl", "$main::InstallTop/configured.pl";
use Poly::Preference "$Poly::UserSettings::dir/prefer.pl";

1
