1package RPC::ExtDirect::Test::Util;
2
3use strict;
4use warnings;
5no  warnings 'uninitialized';
6
7use base 'Exporter';
8
9use Test::More;
10use JSON;
11
12our @EXPORT = qw/
13    ref_ok
14    is_deep
15    cmp_api
16    prepare_input
17/;
18
19our @EXPORT_OK = qw/
20    cmp_json
21/;
22
23### EXPORTED PUBLIC PACKAGE SUBROUTINE ###
24#
25# Replacement for isa_ok that actually checks that wanted value
26# is a blessed object and not a string with package name. :(
27#
28
29sub ref_ok {
30    my ($have, $want, $desc) = @_;
31
32    $desc = "Object isa $want" unless $desc;
33
34    ok( (ref $have eq $want) && $have->isa($want), $desc )
35        or diag explain "Expected '", $have, "' to be an object blessed into ",
36                        $want, " package";
37}
38
39### EXPORTED PUBLIC PACKAGE SUBROUTINE ###
40#
41# A wrapper around Test::More::is_deeply() that will print
42# the diagnostics if a test fails
43#
44
45sub is_deep {
46    is_deeply @_ or diag explain "Expected: ", $_[1], "Actual: ", $_[0];
47}
48
49### EXPORTED PUBLIC PACKAGE SUBROUTINE ###
50#
51# Compare two JavaScript API declarations
52#
53
54sub cmp_api {
55    # This can be called either as a class method, or a plain sub
56    shift if $_[0] eq __PACKAGE__;
57
58    my ($have, $want, $desc) = @_;
59
60    $have = deparse_api($have) unless ref $have;
61    $want = deparse_api($want) unless ref $want;
62
63    is_deep $have, $want, $desc;
64}
65
66### EXPORTED PUBLIC PACKAGE SUBROUTINE ###
67#
68# Compare two strings ignoring the whitespace
69#
70
71sub cmp_str {
72    # This can be called either as a class method, or a plain sub
73    shift if $_[0] eq __PACKAGE__;
74
75    my ($have, $want, $desc) = @_;
76
77    $_ =~ s/\s//g for ($have, $want);
78
79    is $have, $want, $desc;
80}
81
82### EXPORTED PUBLIC PACKAGE SUBROUTINE ###
83#
84# Compare two JSON structures, ignoring the whitespace
85#
86
87sub cmp_json {
88    # This can be called either as a class method, or a plain sub
89    shift if $_[0] eq __PACKAGE__;
90
91    my ($have_json, $want_json, $desc) = @_;
92
93    $_ =~ s/\s//g for ($have_json, $want_json);
94
95    my $have = JSON::from_json($have_json);
96    my $want = JSON::from_json($want_json);
97
98    is_deep $have, $want, $desc;
99}
100
101### NON EXPORTED PUBLIC PACKAGE SUBROUTINE ###
102#
103# Deparse and normalize a JavaScript string with Ext.Direct API
104# declaration into Perl data structures suitable for deep comparison
105#
106
107sub deparse_api {
108    my ($api_str) = @_;
109
110    $api_str =~ s/\s*//gms;
111
112    my @parts = split /;\s*/, $api_str;
113
114    for my $part ( @parts ) {
115        next unless $part =~ /=\{/;
116
117        my ($var, $json) = split /=/, $part;
118
119        my $api_def = JSON::from_json($json);
120
121        my $actions = sort_action_methods($api_def->{actions});
122
123        if ( defined $actions ) {
124            $api_def->{actions} = $actions;
125        }
126
127        $part = { $var => $api_def };
128    }
129
130    return [ @parts ];
131}
132
133### EXPORTED PUBLIC PACKAGE SUBROUTINE ###
134#
135# Convert a test input hashref into the actual object
136#
137
138sub prepare_input {
139    my ($mod, $input) = @_;
140
141    return $input unless ref $input;
142
143    # Package name should be in the RPC::ExtDirect::Test::Util namespace
144    my $pkg = __PACKAGE__.'::'.$mod;
145
146    # Convertor sub name goes first
147    my $conv = $input->{type};
148    my $arg  = $input->{arg};
149
150    # Calling the sub as a class method is easier
151    # than taking its ref, blah blah
152    my $result = $pkg->$conv(@$arg);
153
154    return $result;
155}
156
157### NON EXPORTED PUBLIC PACKAGE SUBROUTINE ###
158#
159# Sort the Method hashrefs on an Action object
160#
161
162sub sort_action_methods {
163    my ($api_href) = @_;
164
165    # %$api_href will auto-vivify if $api_href is undef
166    # This can bite your ass.
167    return unless $api_href;
168
169    my $new_href = {};
170
171    # map() looks too unwieldy here
172    for my $action_name ( keys %$api_href ) {
173        my @methods = @{ $api_href->{ $action_name } };
174
175        $new_href->{ $action_name }
176            = [ sort { $a->{name} cmp $b->{name} } @methods ];
177    }
178
179    return $new_href;
180}
181
1821;
183
184