ngcp-panel/sandbox/hash2obj.pl

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;
}