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
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
|
#!/usr/local/bin/perl
package Y;
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};
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
$self->{value} = $value ;
return $value;
}
sub FETCH
{
my $self = shift ;
return defined $self->{value} ? $self->{value} : $self->{default} ;
}
package X ;
use ExtUtils::testlib;
use Class::MakeMethods::Emulator::MethodMaker
tie_scalar =>
[
a => ['Y',
enum => [qw/A B C/],
default => 'B' ],
],
new => 'new';
package main;
use ExtUtils::testlib;
use lib qw ( ./t );
use Test;
my $o = new X;
TEST { 1 };
TEST {$o->a eq 'B'} ;
TEST {$o->a('A') eq 'A'} ;
TEST {$o->a eq 'A'} ;
exit 0;
|
