Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP

Loading…

Add a JSON formatter #375

Merged
merged 9 commits into from

2 participants

@schwern
Owner

For #159

The formatter was easy.

I also thought about the deserialization process and added TB2::Event::Generic to act as a bucket for the deserialized events. This avoids the user needing a mapping of event types to classes which avoids having an event class registry.

This would be really neat as a replacement for TAP as the communication channel with the test harness.

schwern added some commits
@schwern schwern A formatter which dumps out JSON.
Potentially very handy for debugging or for IPC.  Could replace Test::Harness.
cf8b087
@schwern schwern Add TB2::Events->event_classes
Some tests want a list of all the event classes, so make it a public method
of TB2::Events.  Don't see the need to make it publicly documented.
9ef1086
@schwern schwern Ensure that events can round trip via as_hash. 5650b74
@schwern schwern Fix the docs for TB2::Event->keys_for_as_hash
Something I noticed.
2a3dacc
@schwern schwern Add TB2::Event::Generic.
A generic event bucket useful for reconstituting events from serialization.

It will accept anything and turn it into an attribute.

This isn't 100% for all events.  For example, subtest_end has a history
object and a result.  Might have to add in some special cases later.
0cdaa56
@schwern schwern Use TB2::Event::Generic to reconstitute JSON events. 118483f
@schwern
Owner

Ping @AndyA for a review. Then we can get to writing a new test harness!

@AndyA

Does it need to allow_blessed? That implies that it's not pure JSON on the wire.

Owner

A handful of events have objects in them, like TB2::Event::SubtestEnd has a TB2::History and TB2::Result object. Not sure how to deal with that more gracefully. That may be the only exception. Everything in TB2::Event::SubtestEnd->history and ->result can be derived from the event stream.

Owner

I'm going to make as_hash go recursive and add an as_hash method to TB2::History.

schwern added some commits
@schwern schwern Move as_hash out of TB2::Event and into a role.
We're going to need it in TB2::History and other objects to do proper
recursive dumping.
53021f9
@schwern schwern Make TB2::History->in_test and done_testing always return a boolean
This is important when as_hash is added to TB2::History so in_test
and done_testing are always defined and thus always dumped.
9e5ed1a
@schwern schwern Add TB2::History->as_hash and make as_hash recursive.
This makes dumping the event stream as_hash have the complete information.

I decided not to dump last_result or last_event because that seemed redundant
if you're looking at the whole event stream.  You're normally only looking
at the history object as part of a subtest_end event.

Decided not to dump the event storage, that would get large and recursive.

Decided not to dump store_events as that is not information about the
state of the test, but the state of the history object.  This is just data.
55f5314
@schwern
Owner

@AndyA What do you think of those revisions? I left allow_blessed in just in case somebody subclasses an event and shoves an object in which doesn't can("as_hash"). Better to dump it as null than blow up.

@AndyA

Is it not better to blow up if someone tries to serialise an object as JSON? It implies that the thing on the receiving end knows what to do with it. Other than that it looks great to me :)

@schwern
Owner

@AndyA allow_blessed turns objects into "null", so rogue objects will never make into the JSON stream.

My assumptions are...

  1. I don't want Event authors to be constantly worrying about serialization
  2. The party altering an Event may not be related to the party using the JSON formatter

The first may be a bad assumption, but I'm fairly convinced of the second. I don't want the JSON formatter spuriously blowing up because of what somebody unrelated did.

@schwern schwern merged commit a3137e6 into from
@schwern schwern deleted the branch
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Commits on Apr 23, 2013
  1. @schwern

    A formatter which dumps out JSON.

    schwern authored
    Potentially very handy for debugging or for IPC.  Could replace Test::Harness.
Commits on Apr 24, 2013
  1. @schwern

    Add TB2::Events->event_classes

    schwern authored
    Some tests want a list of all the event classes, so make it a public method
    of TB2::Events.  Don't see the need to make it publicly documented.
  2. @schwern
  3. @schwern

    Fix the docs for TB2::Event->keys_for_as_hash

    schwern authored
    Something I noticed.
  4. @schwern

    Add TB2::Event::Generic.

    schwern authored
    A generic event bucket useful for reconstituting events from serialization.
    
    It will accept anything and turn it into an attribute.
    
    This isn't 100% for all events.  For example, subtest_end has a history
    object and a result.  Might have to add in some special cases later.
  5. @schwern
  6. @schwern

    Move as_hash out of TB2::Event and into a role.

    schwern authored
    We're going to need it in TB2::History and other objects to do proper
    recursive dumping.
  7. @schwern

    Make TB2::History->in_test and done_testing always return a boolean

    schwern authored
    This is important when as_hash is added to TB2::History so in_test
    and done_testing are always defined and thus always dumped.
  8. @schwern

    Add TB2::History->as_hash and make as_hash recursive.

    schwern authored
    This makes dumping the event stream as_hash have the complete information.
    
    I decided not to dump last_result or last_event because that seemed redundant
    if you're looking at the whole event stream.  You're normally only looking
    at the history object as part of a subtest_end event.
    
    Decided not to dump the event storage, that would get large and recursive.
    
    Decided not to dump store_events as that is not information about the
    state of the test, but the state of the history object.  This is just data.
This page is out of date. Refresh to see the latest.
View
82 lib/TB2/CanAsHash.pm
@@ -0,0 +1,82 @@
+package TB2::CanAsHash;
+
+use TB2::Mouse ();
+use TB2::Mouse::Role;
+with 'TB2::CanTry';
+
+
+=head1 NAME
+
+TB2::CanAsHash - a role to dump an object as a hash
+
+=head1 SYNOPSIS
+
+ package Some::Object;
+
+ use TB2::Mouse;
+ with 'TB2::CanAsHash';
+
+
+=head2 Methods
+
+=head3 as_hash
+
+ my $data = $object->as_hash;
+
+Returns all the attributes and data associated with this C<$object> as
+a hash of attributes and values.
+
+Attributes with undefined values will not be dumped.
+
+It is recursive, objects encountered will have their as_hash method
+called, if they have one.
+
+The intent is to provide a way to dump all the information in an
+object without having to call methods which may or may not exist.
+
+Uses L</keys_for_as_hash> to determine which attributes to access.
+
+=cut
+
+sub as_hash {
+ my $self = shift;
+
+ my %hash;
+ for my $key (@{$self->keys_for_as_hash}) {
+ my $val = $self->$key();
+
+ next unless defined $val;
+
+ $val = $val->as_hash if eval { $self->try( sub { $val->can("as_hash") } ) };
+
+ $hash{$key} = $val if defined $val;
+ }
+
+ return \%hash;
+}
+
+
+=head3 keys_for_as_hash
+
+ my $keys = $object->keys_for_as_hash;
+
+Returns an array ref of keys for C<as_hash> to use as keys and methods
+to call on the $object for the key's value.
+
+By default it uses the $object's non-private attributes. That should
+be sufficient for most cases.
+
+=cut
+
+my %Attributes;
+sub keys_for_as_hash {
+ my $self = shift;
+ my $class = ref $self;
+ return $Attributes{$class} ||= [
+ grep !/^_/, map { $_->name } $class->meta->get_all_attributes
+ ];
+}
+
+no TB2::Mouse::Role;
+
+1;
View
46 lib/TB2/Event.pm
@@ -3,7 +3,7 @@ package TB2::Event;
use TB2::Mouse ();
use TB2::Mouse::Role;
use TB2::Types;
-with 'TB2::HasObjectID';
+with 'TB2::HasObjectID', 'TB2::CanAsHash';
requires qw( build_event_type );
@@ -118,52 +118,16 @@ underscores.
Used to build C<event_type>
+
=head2 Provided Methods
=head3 as_hash
- my $data = $event->as_hash;
-
-Returns all the attributes and data associated with this C<$event> as
-a hash of attributes and values.
-
-The intent is to provide a way to dump all the information in an Event
-without having to call methods which may or may not exist.
-
-=cut
-
-sub as_hash {
- my $self = shift;
- return {
- map {
- my $val = $self->$_();
- defined $val ? ( $_ => $val ) : ()
- } @{$self->keys_for_as_hash}
- };
-}
-
+See L<TB2::CanAsHash/as_hash> for details.
-=head3 keys_for_hash
-
- my $keys = $event->keys_for_hash;
-
-Returns an array ref of keys for C<as_hash> to use as keys and methods
-to call on the object for the key's value.
-
-By default it uses the object's non-private attributes. That should
-be sufficient for most events.
-
-=cut
-
-my %Attributes;
-sub keys_for_as_hash {
- my $self = shift;
- my $class = ref $self;
- return $Attributes{$class} ||= [
- grep !/^_/, map { $_->name } $class->meta->get_all_attributes
- ];
-}
+=head3 keys_for_as_hash
+See L<TB2::CanAshash/keys_for_as_hash> for details.
=head3 copy_context
View
62 lib/TB2/Event/Generic.pm
@@ -0,0 +1,62 @@
+package TB2::Event::Generic;
+
+use strict;
+use warnings;
+
+use Carp;
+use TB2::Mouse;
+with 'TB2::Event';
+
+
+=head1 NAME
+
+TB2::Event::Generic - A container for any type of event
+
+=head1 SYNOPSIS
+
+ use TB2::Event::Generic;
+
+ my $event = TB2::Event::Generic->new( $event->as_hash );
+
+=head1 DESCRIPTION
+
+This is a container for any type of event. Its primary purpose is to
+receive events serialized using C<< TB2::Event->as_hash >>.
+
+All attributes are read only.
+
+=head1 SEE ALSO
+
+See L<TB2::Formatter::JSON> for an example of use.
+
+=cut
+
+
+sub build_event_type {
+ croak("The event_type must be defined in the constructor");
+}
+
+# Ensure that all attributes are dumped via as_hash
+my @Attributes = grep !/^_/, map { $_->name } __PACKAGE__->meta->get_all_attributes;
+sub keys_for_as_hash {
+ my $self = shift;
+
+ return \@Attributes;
+}
+
+sub BUILDARGS {
+ my $class = shift;
+ my %args = @_;
+
+ # Generate attributes for whatever they pass in
+ for my $attribute (keys %args) {
+ next if $class->can($attribute);
+ has $attribute =>
+ is => 'ro';
+ push @Attributes, $attribute;
+ }
+
+ return \%args;
+}
+
+1;
View
31 lib/TB2/Events.pm
@@ -6,17 +6,26 @@ use warnings;
our $VERSION = '1.005000_006';
$VERSION = eval $VERSION; ## no critic (BuiltinFunctions::ProhibitStringyEval)
-
-use TB2::Event::TestStart;
-use TB2::Event::TestEnd;
-use TB2::Event::SubtestStart;
-use TB2::Event::SubtestEnd;
-use TB2::Event::SetPlan;
-use TB2::Event::TestMetadata;
-use TB2::Event::Log;
-use TB2::Event::Comment;
-use TB2::Event::Abort;
-use TB2::Result;
+sub event_classes {
+ return qw(
+ TB2::Event::TestStart
+ TB2::Event::TestEnd
+ TB2::Event::SubtestStart
+ TB2::Event::SubtestEnd
+ TB2::Event::SetPlan
+ TB2::Event::TestMetadata
+ TB2::Event::Log
+ TB2::Event::Comment
+ TB2::Event::Abort
+ TB2::Result
+ );
+}
+
+BEGIN {
+ for my $class (__PACKAGE__->event_classes) {
+ eval "require $class" or die $@;
+ }
+}
=head1 NAME
View
92 lib/TB2/Formatter/JSON.pm
@@ -0,0 +1,92 @@
+package TB2::Formatter::JSON;
+
+use TB2::Mouse;
+extends "TB2::Formatter";
+
+
+=head1 NAME
+
+TB2::Formatter::JSON - Output event objects as a JSON list
+
+=head1 DESCRIPTION
+
+This formatter outputs all events as a list of JSON items. The
+items are events dumped using C<< TB2::Event->as_hash >>. These
+events can be restored as L<TB2::Event::Generic> objects.
+
+ use TB2::Event::Generic;
+ use JSON;
+
+ my @$events_as_hash = decode_json( $events_as_json );
+ my @events = map { TB2::Event::Generic->new( $_ ) } @$events_as_hash;
+
+This is useful for debugging or as an interprocess communication
+mechanism. The reader of the JSON stream will have all the same
+information as an event handler does.
+
+Set the TB2_FORMATTER_CLASS environment variable to
+TB2::Formatter::JSON.
+
+=head1 NOTES
+
+Requires JSON::PP which is not a requirement of Test::More. This
+module will likely be split out of the Test-Simple distribution. If
+you use it, be sure to declare it.
+
+=cut
+
+{
+ my $json;
+ sub json {
+ require JSON::PP;
+ $json ||= JSON::PP->new
+ ->utf8
+ ->pretty
+ ->allow_unknown
+ ->allow_blessed;
+
+ return $json;
+ }
+}
+
+sub handle_test_start {
+ my $self = shift;
+ my($event, $ec) = @_;
+
+ $self->write(out => "[\n");
+ $self->_event2json($event);
+
+ return;
+}
+
+sub handle_test_end {
+ my $self = shift;
+ my($event, $ec) = @_;
+
+ $self->write(out => ",\n");
+ $self->_event2json($event);
+ $self->write(out => "]\n");
+
+ return;
+}
+
+sub handle_event {
+ my $self = shift;
+ my($event, $ec) = @_;
+
+ $self->write(out => ",\n");
+ $self->_event2json($event);
+
+ return;
+}
+
+sub _event2json {
+ my $self = shift;
+ my($event) = @_;
+
+ $self->write(out => $self->json->encode($event->as_hash) );
+
+ return;
+}
+
+1;
View
35 lib/TB2/History.pm
@@ -8,7 +8,8 @@ use TB2::threads::shared;
with 'TB2::EventHandler',
'TB2::CanTry',
- 'TB2::CanLoad';
+ 'TB2::CanLoad',
+ 'TB2::CanAsHash';
our $VERSION = '1.005000_006';
$VERSION = eval $VERSION; ## no critic (BuiltinFunctions::ProhibitStringyEval)
@@ -480,7 +481,8 @@ sub in_test {
my $self = shift;
return 0 if $self->abort;
- return $self->test_start && !$self->test_end;
+ return 1 if $self->test_start && !$self->test_end;
+ return 0;
}
@@ -497,7 +499,8 @@ sub done_testing {
my $self = shift;
return 0 if $self->abort;
- return $self->test_start && $self->test_end;
+ return 1 if $self->test_start && $self->test_end;
+ return 0;
}
@@ -687,7 +690,31 @@ sub consume {
$self->accept_event($_) for @{ $old_history->events };
return;
-};
+}
+
+
+my %Keys_To_Remove = map { $_ => 1 } qw(
+ event_storage
+ store_events
+ last_event
+ last_result
+);
+my @Keys_To_Add = qw(
+ subtest_depth
+ is_subtest
+ is_child_process
+ in_test
+ done_testing
+
+ can_succeed
+ test_was_successful
+);
+sub keys_for_as_hash {
+ my $self = shift;
+
+ my @keys = grep { !$Keys_To_Remove{$_} } @{ $self->TB2::CanAsHash::keys_for_as_hash };
+ return [ @keys, @Keys_To_Add ];
+}
no TB2::Mouse;
View
37 t/CanAsHash.t
@@ -0,0 +1,37 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+
+BEGIN { require "t/test.pl" }
+
+note "Setting up test class"; {
+ package Some::Object;
+ use TB2::Mouse;
+ with "TB2::CanAsHash";
+
+ has foo =>
+ is => 'rw';
+
+ has _private =>
+ is => 'rw';
+}
+
+
+note "empty object"; {
+ my $obj = Some::Object->new;
+
+ is_deeply $obj->as_hash, {}, "undefined attributes are ignored";
+}
+
+
+note "private accessors"; {
+ my $obj = Some::Object->new(
+ foo => 23,
+ _private => 42,
+ );
+
+ is_deeply $obj->as_hash, { foo => 23 };
+}
+
+done_testing;
View
13 t/Event/Events.t
@@ -6,18 +6,9 @@ use warnings;
BEGIN { require "t/test.pl"; }
use TB2::Events;
-my @events = map { "TB2::Event::".$_ }
- qw(TestStart TestEnd
- SetPlan
- TestMetadata
- Log
- Comment
- SubtestStart
- SubtestEnd
- Abort
- );
+my @events = TB2::Events->event_classes;
-for my $class (@events) {
+for my $class (grep !/TB2::Result/, @events) {
ok $class->can("event_type"), "$class loaded";
}
View
38 t/Event/Generic.t
@@ -0,0 +1,38 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+
+BEGIN { require "t/test.pl" }
+
+my $CLASS = 'TB2::Event::Generic';
+require_ok $CLASS;
+
+note "generic events"; {
+ my $line = __LINE__ + 1;
+ my $event = $CLASS->new(
+ foo => 23,
+ bar => 42,
+ event_type => "some_thing",
+ );
+
+ is $event->foo, 23;
+ is $event->bar, 42;
+ is $event->event_type, "some_thing";
+ ok $event->object_id;
+
+ is_deeply $event->as_hash, {
+ foo => 23,
+ bar => 42,
+ event_type => 'some_thing',
+ object_id => $event->object_id,
+ pid => $$
+ };
+}
+
+note "generic events must be given an event type"; {
+ ok !eval { $CLASS->new() };
+ like $@, qr{^The event_type must be defined in the constructor};
+}
+
+done_testing;
View
4 t/Event/SubtestEnd.t
@@ -25,8 +25,8 @@ note "defaults"; {
event_type => "subtest_end",
object_id => $event->object_id,
pid => $$,
- history => $history,
- result => $event->result,
+ history => $history->as_hash,
+ result => $event->result->as_hash,
};
is $event->result->name, "No tests run in subtest";
View
52 t/Event/as_hash.t
@@ -0,0 +1,52 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+
+BEGIN { require "t/test.pl" }
+
+use TB2::Events;
+use TB2::Event::Generic;
+use TB2::History;
+
+my %Special_Constructors = (
+ 'TB2::Event::SubtestEnd' => sub {
+ my $class = shift;
+ return $class->new(
+ history => TB2::History->new,
+ @_,
+ );
+ },
+ 'TB2::Result' => sub {
+ my $class = shift;
+ return TB2::Result->new_result(@_)
+ },
+ 'TB2::Event::Log' => sub {
+ my $class = shift;
+ return $class->new(
+ message => "This is a message",
+ @_
+ );
+ },
+ 'TB2::Event::Comment' => sub {
+ my $class = shift;
+ return $class->new(
+ comment => "This is a comment",
+ @_
+ );
+ }
+);
+
+note "as_hash / new round trip"; {
+ for my $class (TB2::Events->event_classes) {
+ my $constructor = $Special_Constructors{$class} || 'new';
+
+ note "Trying $class";
+ my $obj = $class->$constructor;
+
+ my $duplicate = TB2::Event::Generic->new( %{$obj->as_hash} );
+ is_deeply $obj->as_hash, $duplicate->as_hash, "$class round trip";
+ }
+}
+
+done_testing;
View
50 t/Formatter/JSON.t
@@ -0,0 +1,50 @@
+#!/usr/bin/perl -w
+
+use strict;
+use lib 't/lib';
+
+BEGIN {
+ require "t/test.pl";
+ plan(skip_all => "JSON::PP required") unless eval { require JSON::PP };
+}
+use MyEventCoordinator;
+use TB2::Events;
+use TB2::Event::Generic;
+
+use JSON::PP;
+
+use_ok 'TB2::Formatter::JSON';
+
+my $formatter = TB2::Formatter::JSON->new(
+ streamer_class => 'TB2::Streamer::Debug'
+);
+
+my $ec = MyEventCoordinator->new(
+ formatters => [$formatter]
+);
+
+{
+ my @events = (
+ TB2::Event::TestStart->new,
+ TB2::Event::SetPlan->new( asserts_expected => 2 ),
+ TB2::Result->new_result( pass => 1 ),
+ TB2::Result->new_result( pass => 0 ),
+ TB2::Event::TestEnd->new,
+ );
+
+ $ec->post_event($_) for @events;
+
+ my $json = $formatter->streamer->read;
+
+ my $events_as_hash = decode_json($json);
+ is_deeply $events_as_hash,
+ [map { $_->as_hash } @events],
+ "events restored as hashes";
+
+ my @restored_events = map { TB2::Event::Generic->new(%$_) } @$events_as_hash;
+ is_deeply [map { $_->as_hash } @restored_events],
+ [map { $_->as_hash } @events],
+ "events restored as generic events";
+}
+
+done_testing;
View
82 t/History/as_hash.t
@@ -0,0 +1,82 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+
+BEGIN { require "t/test.pl" }
+
+use TB2::History;
+use TB2::EventCoordinator;
+use TB2::Events;
+
+note "Empty history object as_hash"; {
+ my $history = TB2::History->new;
+
+ is_deeply $history->as_hash, {
+ counter => 0,
+ event_count => 0,
+ fail_count => 0,
+ literal_fail_count => 0,
+ literal_pass_count => 0,
+ pass_count => 0,
+ result_count => 0,
+ skip_count => 0,
+ todo_count => 0,
+
+ object_id => $history->object_id,
+
+ subtest_depth => 0,
+ is_subtest => 0,
+ is_child_process => 0,
+ in_test => 0,
+ done_testing => 0,
+
+ can_succeed => 1,
+ test_was_successful => 0,
+ };
+}
+
+
+note "Empty history object as_hash"; {
+ my $ec = TB2::EventCoordinator->new(
+ formatters => [],
+ );
+ my $history = $ec->history;
+
+ my $plan = TB2::Event::SetPlan->new( asserts_expected => 2 );
+ my @results = (TB2::Result->new_result( pass => 1 )) x 2;
+ my $test_end = TB2::Event::TestEnd->new;
+
+ $ec->post_event($_) for ($plan, @results, $test_end);
+
+ is_deeply $history->as_hash, {
+ counter => 2,
+ event_count => 5,
+ fail_count => 0,
+ literal_fail_count => 0,
+ literal_pass_count => 2,
+ pass_count => 2,
+ result_count => 2,
+ skip_count => 0,
+ todo_count => 0,
+
+ object_id => $history->object_id,
+
+ subtest_depth => 0,
+ is_subtest => 0,
+ is_child_process => 0,
+ in_test => 0,
+ done_testing => 1,
+
+ can_succeed => 1,
+ test_was_successful => 1,
+
+ pid_at_test_start => $$,
+
+ plan => $plan->as_hash,
+ test_end => $test_end->as_hash,
+ test_start => $history->test_start->as_hash
+ };
+}
+
+done_testing;
Something went wrong with that request. Please try again.