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