102 lines
2.6 KiB
102 lines
2.6 KiB
use strict;
|
|
use warnings;
|
|
|
|
use Data::Dumper;
|
|
|
|
my $cdr_hash1 = {
|
|
field1 => "value1",
|
|
field2 => "value2",
|
|
field3 => "value3",
|
|
};
|
|
my $cdr_hash2 = {
|
|
field1 => "value4",
|
|
field2 => "value5",
|
|
field3 => "value6",
|
|
};
|
|
|
|
my $item1 = hash2obj(
|
|
hash => $cdr_hash1,
|
|
classname => "myCDRItem",
|
|
private => {},
|
|
accessors => {
|
|
source_user => sub {
|
|
my $self = shift;
|
|
return $self->{field1};
|
|
},
|
|
destination_user_in => sub {
|
|
my $self = shift;
|
|
return $self->{field2};
|
|
},
|
|
start_time => sub {
|
|
my $self = shift;
|
|
return $self->{field2};
|
|
},
|
|
}
|
|
);
|
|
my $item2 = hash2obj(
|
|
hash => $cdr_hash2,
|
|
#classname => "myCDRItem",
|
|
private => {},
|
|
accessors => {
|
|
source_user => sub {
|
|
my $self = shift;
|
|
return $self->{field1};
|
|
},
|
|
destination_user_in => sub {
|
|
my $self = shift;
|
|
return $self->{field2} . 'xx';
|
|
},
|
|
start_time => sub {
|
|
my $self = shift;
|
|
return $self->{field2};
|
|
},
|
|
}
|
|
);
|
|
|
|
print $item1->destination_user_in;
|
|
print $item2->destination_user_in;
|
|
print $item2->field1;
|
|
exit;
|
|
|
|
sub hash2obj {
|
|
#my $self = shift;
|
|
my %params = @_;
|
|
my ($hash,$classname,$accessors) = @params{qw/hash classname accessors/};
|
|
|
|
my $obj;
|
|
$obj = $hash if 'HASH' eq ref $hash;
|
|
$obj //= {};
|
|
unless (defined $classname and length($classname) > 0) {
|
|
my @chars = ('A'..'Z');
|
|
$classname //= '';
|
|
$classname .= $chars[rand scalar @chars] for 1..8;
|
|
}
|
|
$classname = __PACKAGE__ . '::' . $classname unless $classname =~ /::/;
|
|
bless($obj,$classname);
|
|
# for below and to register new methods in package
|
|
no strict "refs"; ## no critic (ProhibitNoStrict)
|
|
return $obj if scalar %{$classname . '::'};
|
|
use strict "refs";
|
|
print "registering class $classname\n";
|
|
$accessors //= {};
|
|
my %accessors = ( (map { $_ => undef; } keys %$obj), %$accessors); # create accessors for fields too
|
|
for my $accessor (keys %accessors) {
|
|
print "registering accessor $classname::$accessor\n";
|
|
# see http://search.cpan.org/~gsar/perl-5.6.1/pod/perltootc.pod
|
|
# accessor can be a coderef ...
|
|
no strict "refs"; ## no critic (ProhibitNoStrict)
|
|
*{$classname . '::' . $accessor} = sub {
|
|
my $self = shift;
|
|
&{$accessors{$accessor}}($self,shift) if scalar @_; #setter
|
|
return &{$accessors{$accessor}}($self); #getter
|
|
} if 'CODE' eq ref $accessors{$accessor};
|
|
# ... or hash field name:
|
|
*{$classname . '::' . $accessor} = sub {
|
|
my $self = shift;
|
|
$self->{$accessors{$accessor}} = shift if scalar @_; #setter
|
|
return $self->{$accessors{$accessor}}; #getter
|
|
} if '' eq ref $accessors{$accessor};
|
|
use strict "refs";
|
|
}
|
|
return $obj;
|
|
} |