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
|
#!/usr/local/bin/perl
package myHash;
use Tie::Hash ;
@ISA=qw/Tie::StdHash/ ;
use vars qw/$log/ ;
$log = 'log: ';
sub TIEHASH {
my $class = shift;
my $p = shift || '';
#print "log $p ($log))\n";
$log .= "tie $p,";
return bless {}, $class ;
}
sub STORE { my ($self, $idx, $value) = @_ ;
#print "storing $idx, $value ...\n";
$log .= "store $idx,";
$self->{$idx}=$value;
return $value;}
package myObj ;
use ExtUtils::testlib;
use Class::MakeMethods::Emulator::MethodMaker
get_set => [qw/a b c/] ;
sub new
{
my $class = shift;
bless { @_ }, $class;
}
sub all { my $self = shift; return join (' ', values %{$self}) ;}
package X ;
use ExtUtils::testlib;
use Class::MakeMethods::Emulator::MethodMaker
object_tie_hash =>
[
{
slot => 'a',
tie_hash => ['myHash', "log a"],
class => ['myObj', 'a' => 'foo']
},
{
slot =>['b','c'],
tie_hash => ['myHash', "log bc"],
class => ['myObj', 'b' => 'bar']
}
],
new => 'new';
package main;
use ExtUtils::testlib;
BEGIN { unshift @INC, ( $0 =~ /\A(.*?)[\w\.]+\z/ )[0] }
use Test;
use Data::Dumper ;
my $o = new X;
TEST { 1 };
# create a hash of 2 object with default constructor arguments
TEST {$o->a(foo=> [], bar => [])} ;
#print Dumper $o ;
TEST {$o->a->{foo}->a eq 'foo'} ;
TEST {$o->a->{bar}->a eq 'foo'} ;
TEST {$o->a(foo2=> [a=> 'toto'])} ;
#print Dumper $o ;
TEST {$o->a->{foo2}->a eq 'toto'} ;
TEST {$o->b(foo2=> [a=> 'toto'])} ;
#print Dumper $o ;
TEST {$o->b->{foo2}->a eq 'toto'} ;
exit 0 ;
|
