blob: 20df78a3b9bb4d1becafb30f37f98a14a359f491 (
plain)
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
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
|
package NDB::Util::Base;
use strict;
use Carp;
# constructors
my $log;
sub initmodule {
$log = NDB::Util::Log->instance;
}
sub new {
my $class = shift;
my $this = bless {}, $class;
return $this;
}
sub getlog {
my $this = shift;
return NDB::Util::Log->instance;
}
# clone an object
# extra attributes override or delete (if value is undef)
sub clone {
my $this = shift;
@_ % 2 == 0 or confess 0+@_;
my(%attr) = @_;
my $that = bless {}, ref($this);
for my $attr (sort keys %$this) {
if (! exists($attr{$attr})) {
my $get = "get$attr";
$attr{$attr} = $this->$get();
}
}
for my $attr (sort keys %attr) {
if (defined($attr{$attr})) {
my $set = "set$attr";
$that->$set($attr{$attr});
}
}
return $that;
}
# methods for member variables:
# - set returns 1 on success and undef on undefined or invalid value
# - get aborts unless value exists or a default (maybe undef) is given
# - has tests existence of value
# - del deletes the value and returns it (maybe undef)
sub attributes {
@_ % 2 == 1 or confess 0+@_;
my $class = shift;
my @attr = @_;
while (@attr) {
my $attr = shift @attr;
my $filter = shift @attr;
$attr =~ /^\w+$/ or confess $attr;
ref($filter) eq 'CODE' or confess $attr;
my $set = sub {
@_ == 2 or confess "set$attr: arg count: @_";
my $this = shift;
my $value = shift;
if (! defined($value)) {
$log->put("set$attr: undefined value")->push($this);
return undef;
}
local $_ = $value;
if (! &$filter($this)) {
$log->put("set$attr: invalid value: $value")->push($this);
return undef;
}
$value = $_;
if (! defined($value)) {
confess "set$attr: changed to undef";
}
$this->{$attr} = $value;
return 1;
};
my $get = sub {
@_ == 1 || @_ == 2 or confess "get$attr: arg count: @_";
my $this = shift;
my $value = $this->{$attr};
if (! defined($value)) {
@_ == 0 and confess "get$attr: no value";
$value = shift;
}
return $value;
};
my $has = sub {
@_ == 1 or confess "has$attr: arg count: @_";
my $this = shift;
my $value = $this->{$attr};
return defined($value);
};
my $del = sub {
@_ == 1 or confess "del$attr: arg count: @_";
my $this = shift;
my $value = delete $this->{$attr};
return $value;
};
no strict 'refs';
*{"${class}::set$attr"} = $set;
*{"${class}::get$attr"} = $get;
*{"${class}::has$attr"} = $has;
*{"${class}::del$attr"} = $del;
}
}
1;
# vim:set sw=4:
|
