1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
|
#!/usr/local/bin/perl
package TieScalarTest ;
# use warnings FATAL => qw(all);
use Carp;
use strict;
require Tie::Scalar ;
sub TIESCALAR {
my $type = shift;
my %args = @_ ;
my $self={} ;
if (defined $args{enum}) {
# store all enum values in a hash. This way, checking
# whether a value is present in the enum set is easier
map {$self->{enum}{$_} = 1;} @{$args{enum}} ;
} else {
croak ref($self)," error: no enum values defined when calling init";
}
$self->{default} = $args{default};
$self->{name} = $args{name};
bless $self,$type;
}
sub STORE {
my ($self,$value) = @_ ;
croak "cannot set ",ref($self)," item to $value. Expected ",
join(' ',keys %{$self->{enum}})
unless defined $self->{enum}{$value} ;
# we may want to check other rules here ... TBD
# warn "Tie: Setting\n";
$self->{value} = $value ;
return $value;
}
sub FETCH {
my $self = shift ;
# warn "Tie: Fetching\n";
return defined $self->{value} ? $self->{value} : $self->{default} ;
}
1;
|
