Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

Unblessing Perl objects and constructing the TO_JSON method for convert_blessed

Tags:

perl

moose

moo

In this answer I found a recommendation for a simple TO_JSON method, which is needed for serializing blessed objects to JSON.

sub TO_JSON { return { %{ shift() } }; }

Could anybody please explain in detail how it works?

I changed it to:

sub TO_JSON {
        my $self = shift;         # the object itself – blessed ref
        print STDERR Dumper $self;

        my %h = %{ $self };       # Somehow unblesses $self. WHY???
        print STDERR Dumper \%h;  # same as $self, only unblessed

        return { %h };    # Returns a hashref that contains a hash.
        #return \%h;      # Why not this? Works too…
}

Many questions… :( Simply, I’m unable to understand 3-liner Perl code. ;(

I need the TO_JSON but it will filter out:

  • unwanted attributes and
  • unset attributes too (e.g. for those the has_${attr} predicate returns false)

This is my code – it works but I really don't understand why the unblessing works…

use 5.010;
use warnings;
use Data::Dumper;

package Some;
use Moo;

has $_ => ( is => 'rw', predicate => 1,) for (qw(a1 a2 nn xx));

sub TO_JSON {
    my $self = shift;
    my $href;
    $href->{$_} = $self->$_ for( grep {!/xx/} keys %$self );
    # Same mysterious unblessing. The `keys` automagically filters out
    # “unset” attributes without the need of call of the has_${attr}
    # predicate… WHY?
    return $href;
}

package main;
use JSON;
use Data::Dumper;

my @objs = map { Some->new(a1 => "a1-$_", a2 => "a2-$_", xx=>"xx-$_") } (1..2);
my $data = {arr => \@objs};
#say Dumper $data;
say JSON->new->allow_blessed->convert_blessed->utf8->pretty->encode($data);

EDIT: To clarify the questions:

  • The %{ $hRef } derefences the $hRef (getting the hash pointed to by the reference), but why get a plain hash from a blessed object reference $self?
  • In other words, why the $self is a hashref?
  • I tried to make a hash slice like @{$self}{ grep {!/xx/} keys %$self} but it didn't work. Therefore I created that horrible TO_JSON.
  • If the $self is a hashref, why the keys %$self returns only attributes having a value, and not all declared attributes (e.g. the nn too – see the has)?
like image 935
novacik Avatar asked Aug 26 '14 14:08

novacik


2 Answers

sub TO_JSON { return { %{ shift() } }; }
                     | |  |
                     | |  L_ 1. pull first parameter from `@_`
                     | |        (hashref/blessed or not)
                     | |     
                     | L____ 2. dereference hash (returns key/value list)
                     |
                     L______ 3. return hashref assembled out of list

In your TO_JSON() function { %h } returns a shallow hash copy, while \%h returns a reference to %h (no copying).

like image 68
mpapec Avatar answered Sep 22 '22 15:09

mpapec


Perl implemented object orientation by simply making it possible for a reference to know which package it came from (with bless). Knowing that a reference came from the Foo package means that methods are really functions defined in that package.

Perl allows any kind of reference to get blessed; not just hash references. It's very common to bless hash references; a lot of documentation shows doing exactly that; and Moose does it; but, it's possible to bless an array reference, or a subroutine reference, or a filehandle, or a reference to a scalar. The syntax %{$self} only works on hash references (blessed or not). It takes the hash reference, and dereferences it as a hash. The fact that the original reference may have been blessed is lost.

I need the TO_JSON but what will filter out:

  • unwanted attributes
  • and unset attributes too (e.g. for those the has_${attr} predicate returns false.

Pre-5.20, hash slices only give you the values and not the keys from the original hash. You want both keys and values.

Assuming you have a hash, and want to filter out undef values and keys not on a whitelist, there are a few options. Here's what I have, using the JSON module:

use strict; # well, I used "use v5.18", but I don't know which version of Perl you're using
use warnings;
use JSON;

my $foo = { foo => undef, bar => 'baz', quux => 5 };
my %whitelist = map { $_, 1 } qw{foo bar};

my %bar = map { $_ => $foo->{$_} }
          grep { defined $foo->{$_} && exists $whitelist{$_} }
          keys %$foo;
print to_json(\%bar) . "\n";
# well, I used say() instead of print(), but I don't know which version of Perl you're using

The maps and greps aren't necessarily pretty, but it's the simplest way I could think of to filter out keys not on the whitelist and elements without an undef value.

You could use an array slice:

use strict;
use warnings;
use JSON;

my $foo = { foo => undef, bar => 'baz', quux => 5 };
my @whitelist = qw{foo bar};

my %filtered_on_keys;
@filtered_on_keys{@whitelist} = @$foo{@whitelist};

my %bar = map { $_ => $filtered_on_keys{$_} }
          grep { defined $filtered_on_keys{$_} }
          keys %filtered_on_keys;
print to_json(\%bar) . "\n";

Or if you like loops:

use strict;
use warnings;
use JSON;

my $foo = { foo => undef, bar => 'baz', quux => 5 };
my %whitelist = map { $_ => 1 } qw{foo bar};

my %bar;
while (my ($key, $value) = each %$foo) {
    if (defined $value && exists $whitelist{$key}) {
       $bar{$key} = $value;
    }
}

print to_json(\%bar) . "\n";

It seems like a good time to bring up Larry wall's quote, "Perl is designed to give you several ways to do anything, so consider picking the most readable one."

However, I made a big point that not all objects are hashes. The appropriate way to get data from an object is through its getter functions:

use strict;
use warnings;
use JSON;

my $foo = Foo->new({ foo => undef, bar => 'baz', quux => 5 }); # as an example

my %filtered_on_keys;
@filtered_on_keys{qw{foo bar}} = ($foo->get_foo(), $foo->get_bar());

my %bar = map { $_ => $filtered_on_keys{$_} }
          grep { defined $filtered_on_keys{$_} }
          keys %filtered_on_keys;
print to_json(\%bar) . "\n";
like image 29
Max Lybbert Avatar answered Sep 24 '22 15:09

Max Lybbert