# Copyright (c) 1997-2005
# 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 7370 2006-05-23 21:16:03Z gawrilow $
use strict;
use namespaces;
package Poly::PropertyValue;
use Struct (
[ new => '$;$$$' ],
[ '$property' => '#1' ], # Property
[ '$value' => '#2' ],
);
######################################################################
#
# Constructor
#
# new Poly::PropertyValue(Property, data, object) => (self, true_if_converted);
#
sub new {
my $self=&_new;
my ($prop, $orig_value, $object)=@_;
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)) {
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;
}
######################################################################
declare $UNDEF="==UNDEF==\n";
declare $UNDEF_re=qr/^\s*==UNDEF==\s*$/;
#
# 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 )
: ref($v) eq "ARRAY" ? @$v : 1;
}
1
syntax highlighted by Code2HTML, v. 0.9.1