#  Copyright (c) 1997-2007
#  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 7560 2007-01-15 14:04:09Z gawrilow $

use strict;
use namespaces;

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 @start_applications;   declare $default_application;
   declare @lookup_applications;
   declare @lookup_rules;         declare @lookup_scripts;
}

my @imported;

package Poly::User::_secret;

sub unimport_app {
   if (@imported) {
      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";
      package Poly::User;  no strict 'refs';
      if (!exists &$func) {
	 *$func= is_code($attr)
	         ? $attr :
		 $attr eq "user" || $attr eq "pref"
		 ? namespaces::lookup_sub($application->pkg,$func)
		 : \&$func;
	 push @imported, $func;
      }
   }
}

package Poly::User;

##################################################################################
#
#  application
#
sub application {
   if (@_>1) {
      die "usage: application [ \"name\" ]\n";
   } elsif (@_) {
      my $new_app=shift;
      $new_app=add 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;
	 &$sub;
      }
      if ($attr eq "prop" || $attr eq "meth") {
	 if (defined($this)) {
	    $this->$method_name(@_);
	 } else {
	    die "there is no default '\$this' object currently\n";
	 }
      } else {
	 croak( "$attr function $method_name is not available" );
      }
   } else {
      croak( "undefined subroutine $method_name" );
   }
}

####################################################################################
sub include {
   is_object($INC[0])
   ? $INC[0]==$application || (local $INC[0]=$application)
   : local_unshift(@INC, $application);

   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;
#    };
# }

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 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;

   $this=$obj;
   application $obj->prototype->application;
}

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

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 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
#

sub prefer {
   $application->prefs->add_preference("@_");
}

sub prefer_now {
   $application->prefs->set_temp_preference($main::scope, @_);
}

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

sub reset_preference {
   if ($_[0] eq "all" || $_[0] eq "*") {
      $application->prefs->handler->reset_all;
   } else {
      $application->prefs->reset(@_);
   }
}

####################################################################################
# prepare for custom variables and preferences

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

package Poly::User;

foreach (@lookup_applications, @lookup_rules, @lookup_scripts) {
   # treate relative paths as starting at $HOME
   s{^(?!/)}{$ENV{HOME}/};
}

if ((my $ph=Poly::Module::prefs_handler)->need_save) {
   unless (@start_applications) {
      @start_applications=map { m{ ([^/]+) $ }x } grep { -d "$_/rules" } glob("$main::InstallTop/apps/*");
   }
   $default_application ||= $main::DefaultAppName;

   my $l_app_c= !@lookup_applications && "# ";
   my $l_rul_c= !@lookup_rules        && "# ";
   my $l_scr_c= !@lookup_scripts      && "# ";

   $ph->orphans->{BEGIN}=<<".";
#
#  Settings common for all applications

# start with these applications:
\@start_applications=qw( @start_applications );

# assume this application for scripts and objects created from scratch:
\$default_application="$default_application";

# look for applications in the following directories:
$l_app_c\@lookup_applications=qw( @lookup_applications );

# look for additional rules in the following directories:
$l_rul_c\@lookup_rules=qw( @lookup_rules );

# look for scripts in the following directories:
$l_scr_c\@lookup_scripts=qw( @lookup_scripts );
.
}

1