#  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: PropertyValue.pm,v 1.6 2004/10/14 16:12:35 gawrilow Exp $

use strict;
use namespaces;

package Poly::PropertyValue;

use Struct (
   [ new => '$;$$$' ],
   [ '$property' => '#1' ],		# Property
   [ '$value' => '#2' ],
   '$comment',
);
######################################################################
#
#  Constructor
#
#  new Poly::PropertyValue(Property, data, comment, object) => (self, true_if_converted);
#
sub new {
   my $self=&_new;
   my ($prop, $orig_value, $_comment, $object)=@_;
   if (defined($_comment) && @$_comment) {
      $self->comment=$_comment;
   }
   my $conv=0;
   if (defined($self->value)) {
      ### FIXME: need generic type-depedent constructor/verifier
      my $bad;
      if ($prop->dimension <= 1) {
	 if ($prop->type eq "object") {
	    $bad= !is_object($self->value);
	 } else {
	    if (is_array($self->value)) {
	       if (!@{$self->value}) {
		  if ($prop->allow_empty) {
		     $self->value="";
		  } elsif ($prop->type eq "boolean") {
		     $self->value="1";	# convert from the old (<= v2.0) representation
		  } else {
		     $bad=1;
		  }
	       } elsif (@{$self->value}>1) {
		  $bad=1;
	       } elsif ($prop->dimension==0) {
		  $bad= (($self->value) = $self->value->[0] =~ /\S+/g) != 1;
	       } else {
		  ($self->value) = $self->value->[0] =~ /^\s*(.*?)\s*$/;
		  $bad= !$prop->allow_empty && !length($self->value);
	       }
	    }
	    if ($prop->type eq "boolean" && !$bad) {
	       if ($self->value eq "") {
		  $self->value=0;
		  $conv=1;
	       } elsif ($self->value !~ /^[01]$/) {
		  if ($self->value =~ /^(?: (true) | false )$/xi) {
		     $self->value = defined($1) + 0;
		     $conv=1;
		  } else {
		     $bad=1;
		  }
	       }
	    }
	 }
	 if ($bad) {
	    die "invalid '", $prop->type, "' value: '", @{$self->value}, "'\n";
	 }

      } elsif (is_array($self->value)) {
	 if (!defined($_comment)) {
	    ### comment is not defined when called directly from Object::new
	    ### FIXME: is a terrible hack!
	    foreach my $line (@{$self->value}) {
	       $line .= "\n" if substr($line,-1) ne "\n";
	    }
	 }
      } else {
	 $self->value .= "\n" if substr($self->value,-1) ne "\n";
	 $self->value=[ $self->value ];
      }

      if (defined (my $accept=$prop->accept)) {
	 my $orig_value=$self->value;
	 $self->value= is_method($accept) ? $object->$accept($orig_value) : &$accept($orig_value);
	 $conv= $self->value != $orig_value;
      }
      readonly($self->value) if $prop->type ne "object";
   }
   if (wantarray) { ($self, $conv) } else { $self }
}
######################################################################
sub DESTROY {
   my ($self)=@_;
   readwrite($self->value);
}
######################################################################
sub set_value {
   my ($self, $new_value)=@_;
   my $old_value=$self->value; undef $self->value;
   readwrite($old_value);
   $self->value=$new_value;
   readonly($self->value);
   return $old_value if defined wantarray;
}
######################################################################
#
#  Get the canonical printable representation.
#  (currently the same as the internal one)
#
sub toStringArray($) {
   my $v=shift->value;
   wantarray
   ? ( defined($v) ? ref($v) eq "ARRAY" ? @$v : "$v\n" : "==UNDEF==\n" )
   : ref($v) eq "ARRAY" ? @$v : 1;
}

1
