# 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