#  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: File.pm 7370 2006-05-23 21:16:03Z gawrilow $

use strict;
use namespaces;

require Poly::Application;
require Poly::Tempfile;

package Poly::File;
declare $strict;

#################################################################################
#
#  Constructor: new Poly::File('filename');
#
use Struct (
   [ new => '$' ],
   [ '$filename' => '#1' ],
   '$timestamp',
   '$line',
   '@errors',
);

#################################################################################
sub need_reload {
   my ($self)=@_;
   return (stat $self->filename)[9] > $self->timestamp;
}
#################################################################################
sub load {
   my ($self, $object, $file_version)=@_;
   # FIXME: in XML era it will be recognized from the file contents
   my $app_name ||= $Poly::User::default_application;

   $self->timestamp=(stat $self->filename)[9];

   open P, $self->filename  or  die "error reading file '", $self->filename, "': $!\n";

   my ($proto);
   @{$self->errors}=();

   # determine the application
   # first, try at the file begin (since v2.0)
   while (<P>) {
      s/^\s+//;
      if (/^ _application \s+ ($id_re) \s*$/xo) {
	 $app_name=$1;
	 last;
      }
      if (/^ _version \s+ (\S+) \s*$/x) {
	 # it is probably v1.4
	 $file_version=eval "v$1";
	 last;
      }
      if (substr($_,0,1) eq '#') {
	 next;
      }
      if (/\S/) {
	 # try at the file end (v1.5)
	 seek P, -40, 2;
	 local $/;
	 $_=<P>;
	 if (/^\s* _application \s+ ($id_re) \s*$/xmo) {
	    $app_name=$1;
	 }
	 if (/^\s* _version \s+ (\S+) \s*$/xm) {
	    $file_version=eval "v$1";
	 }
	 seek P, 0, 0;
	 $.=1;
	 last;
      }
   }

   if (defined($file_version) && $file_version lt v1.5) {
      $app_name="polytope";
   }
   my $app=add Application($app_name)
   or return undef;

   if (!defined $object->name) {
      my ($object_name)= $self->filename =~ $filename_re;
      if (defined (my $suffix=$app->file_suffix)) {
	 $object_name =~ s/\.$suffix$//;
      }
      $object->name=$object_name;
   }

 INPUT:
   while (<P>) {
      s/^\s+//;
      next if $_ eq "";
      if (substr($_,0,1) eq '#') {
	 next;
      }

      if (/^(_?dependenci?es)\s*$/i) {
	 while (<P>) {	# skip the DEPENDENCES from old versions
	    last unless /\S/;
	 }
      } elsif (/^ _version \s+ (\S+) \s*$/x) {
	 $file_version=eval "v$1";
      } elsif (/^ _application \s+ ($id_re) \s*$/xo) {
	 next;
      } elsif (/^ _type \s+ ($type_re) \s*$/xo) {
	 $self->line=$.;

	 unless ($proto=$app->types->{$1}) {
	    $proto=$app->default_type;
	    $self->report_warning("unknown type '$1', default type '", $proto->name, "' assumed");
	 }
	 bless $object, $proto->object_type;
	 next;

      } elsif (my ($negated, $prop_name, $attr)=/^(!)? ($id_re) (?(1) | (\([\w+]*\))?) \s*$/xo) {
	 $self->line=$.;

	 if (! $proto) {
	    $proto=$app->default_type;
	    bless $object, $proto->object_type;
	 }

	 my $data=[ ];
	 while (<P>) {
	    next if /^\s*\#/;
	    if (/\S/) {
	       push @$data, $_;
	    } else {
	       last;
	    }
	 }
	 enforce_nl($data->[-1]) if $#$data>=0;

	 my ($prop, $unknown)=$proto->property($prop_name);
	 if ($unknown && $strict) {
	    report_error($self, "unknown property '$prop_name' not allowed in strict mode");
	 } elsif ($prop->temporary) {
	    report_warning($self, "discarding temporary property '$prop_name'");
	 } else {
	    if ($negated) {
	       if ($file_version le v2.0) {
		  if (@$data) {
		     $self->report_warning("ignoring data in a negated property '!$prop_name'");
		  }
		  $data= $prop->type eq "boolean" ? [ 0 ] : undef;
	       } else {
		  report_error($self, "obsolete syntax for an undefined property: '!$prop_name'");
		  undef $data;
	       }
	    } elsif (!@$data) {
	       if ($file_version le v2.0  and  $prop->type eq "boolean") {
		  # In v1.3 booleans were encoded as attributes (true) and (false),
		  # while in v1.4 .. v2.0 as empty or negated sections.
		  $data->[0]= $attr ne "(false)";
	       }
	    } elsif ($file_version gt v2.0  and  @$data==1  and  $data->[0] =~ $Poly::PropertyValue::UNDEF_re) {
	       undef $data;
	    }

	    if (my $upgrade=$prop->upgrade  and  $file_version lt $main::VersionNumber) {
	       for (my $i=0; $i<$#$upgrade; $i+=2) {
		  if ($file_version le $upgrade->[$i]) {
		     my @upgraded=eval { select_method($upgrade->[$i+1], $object)->($data) };
		     if ($@) {
			report_parse_error($self, "error upgrading property '$prop_name'");
			next INPUT;
		     }

		     if (@upgraded==1) {
			# the property stays the same
			$data=shift @upgraded; last;

		     } else {
			# replaced with new properties
			my $orig_prop_name=$prop_name;
			while (($prop_name, $data)=splice @upgraded, 0, 2) {
			   ($prop, $unknown)=$proto->property($prop_name);
			   if ($unknown) {
			      if ($strict) {
				 report_error($self, "old property '$orig_prop_name' upgraded to unknown '$prop_name' not allowed in strict mode");
				 last;
			      } else {
				 report_warning($self, "old property '$orig_prop_name' upgraded to unknown '$prop_name'");
			      }
			   }
			   eval { $object->add($prop, $data) };
			   if ($@) {
			      report_parse_error($self, "error upgrading property '$orig_prop_name' to '$prop_name'");
			      last;
			   }
			}
			next INPUT;
		     }
		  }
	       }
	    }

	    eval { $object->add($prop, $data) };
	    if ($@) {
	       report_parse_error($self, "error reading property '$prop_name'");
	    }
	 }
	 report_warning($self, "unknown property '$prop_name'") if $unknown and $Switches::v;

      } else {
         $self->line=$.;  chomp;
	 report_error($self, "ill-formed section header '$_'");
	 while (<P>) {		# skip the rest of the malformed sektion
	    last unless /\S/;
	 }
      }
   }
   close P;

   die @{$self->errors} if @{$self->errors};
}
#################################################################################
sub report_warning {
   my $self=shift;
   warn_print( "\"", $self->filename, "\", line ", $self->line, ": ", @_ );
}
#################################################################################
sub report_error {
   my ($self, $text)=@_;
   push @{$self->errors}, "\"".$self->filename."\", line ".$self->line.": $text\n";
}
#################################################################################
sub report_parse_error {
   my ($self, $my_text)=@_;
   my ($where, $text)= $@ =~ /^(?: (.*?) \t)? (.*)/x;
   $where ||= 0;
   $where+=$self->line;
   push @{$self->errors}, "\"".$self->filename."\", line $where: $my_text: $text\n";
}
#################################################################################
sub save {
   my ($self, $object)=@_;
   my $tempfile=new OverwriteFile($self->filename);
   open my $tmp, ">", $tempfile
      or die "can't create temporary file \"$tempfile\" for object ", $object->name, ": $!\n";

   my $proto=$object->prototype;
   print $tmp "_application ", $proto->application->name, "\n",
              "_version $main::Version\n",
	      "_type ", $proto->name, "\n\n";

   foreach my $pv (@{$object->contents}) {
      next if !defined $pv;
      print $tmp $pv->property->name, "\n", $pv->toStringArray, "\n"
      or die "error writing to temporary file '$tempfile': $!\n";
   }
   close $tmp
   or die "error writing to temporary file '$tempfile': $!\n";

   $object->changed=0;
}
#################################################################################

package Poly::File::Discard;

sub new { my $dummy; bless \$dummy, shift }
sub load { }
sub save { }

1