File Coverage

blib/lib/MozRepl/RemoteObject/Methods.pm
Criterion Covered Total %
statement 9 82 10.9
branch 0 22 0.0
condition 0 30 0.0
subroutine 3 17 17.6
pod 10 13 76.9
total 22 164 13.4


line stmt bran cond sub pod time code
1             package MozRepl::RemoteObject::Methods;
2 27     27   104 use strict;
  27         31  
  27         844  
3 27     27   98 use Scalar::Util qw(blessed);
  27         30  
  27         1090  
4              
5 27     27   104 use vars qw[$VERSION];
  27         32  
  27         26226  
6             $VERSION = '0.38';
7              
8             =head1 NAME
9              
10             MozRepl::RemoteObject::Methods - Perl methods for mozrepl objects
11              
12             =head1 SYNOPSIS
13              
14             my @links = $obj->MozRepl::RemoteObject::Methods::xpath('//a');
15              
16             This module holds the routines that previously lived
17             as injected object methods on I Javascript objects.
18              
19             =head1 METHODS
20              
21             =head2 C<< $obj->MozRepl::RemoteObject::Methods::invoke(METHOD, ARGS) >>
22              
23             The C<< invoke() >> object method is an alternate way to
24             invoke Javascript methods. It is normally equivalent to
25             C<< $obj->$method(@ARGS) >>. This function must be used if the
26             METHOD name contains characters not valid in a Perl variable name
27             (like foreign language characters).
28             To invoke a Javascript objects native C<< __invoke >> method (if such a
29             thing exists), please use:
30              
31             $object->MozRepl::RemoteObject::Methods::invoke('__invoke', @args);
32              
33             This method can be used to call the Javascript functions with the
34             same name as other convenience methods implemented
35             in Perl:
36              
37             __attr
38             __setAttr
39             __xpath
40             __click
41             ...
42              
43             =cut
44              
45             sub invoke {
46 0     0 1   my ($self,$fn,@args) = @_;
47 0           my $id = $self->__id;
48 0 0         die unless $self->__id;
49            
50 0           ($fn) = $self->MozRepl::RemoteObject::Methods::transform_arguments($fn);
51 0           my $rn = bridge($self)->name;
52 0           @args = $self->MozRepl::RemoteObject::Methods::transform_arguments(@args);
53 0           local $" = ',';
54 0           my $js = <
55             $rn.callMethod($id,$fn,[@args])
56             JS
57 0           return bridge($self)->unjson($js);
58             }
59              
60             =head2 C<< $obj->MozRepl::RemoteObject::Methods::transform_arguments(@args) >>
61              
62             This method transforms the passed in arguments to their JSON string
63             representations.
64              
65             Things that match C< /^(?:[1-9][0-9]*|0+)$/ > get passed through.
66            
67             MozRepl::RemoteObject::Instance instances
68             are transformed into strings that resolve to their
69             Javascript global variables. Use the C<< ->expr >> method
70             to get an object representing these.
71            
72             It's also impossible to pass a negative or fractional number
73             as a number through to Javascript, or to pass digits as a Javascript string.
74              
75             =cut
76            
77             sub transform_arguments {
78 0     0 1   my $self = shift;
79 0           my $json = bridge($self)->json;
80             map {
81 0 0 0       if (! defined) {
  0 0 0        
    0 0        
    0 0        
    0 0        
    0          
82 0           'null'
83             } elsif (/^(?:[1-9][0-9]*|0+)$/) {
84 0           $_
85             #} elsif (ref and blessed $_ and $_->isa(__PACKAGE__)) {
86             } elsif (ref and blessed $_ and $_->isa('MozRepl::RemoteObject::Instance')) {
87 0           sprintf "%s.getLink(%d)", bridge($_)->name, id($_)
88             } elsif (ref and blessed $_ and $_->isa('MozRepl::RemoteObject')) {
89 0           $_->name
90             } elsif (ref and ref eq 'CODE') { # callback
91 0           my $cb = $self->bridge->make_callback($_);
92 0           sprintf "%s.getLink(%d)", bridge($self)->name,
93             id($cb)
94             } elsif (ref) {
95 0           $json->encode($_);
96             } else {
97 0           $json->encode($_)
98             }
99             } @_
100             };
101              
102             # Helper to centralize the reblessing
103             sub hash_get {
104 0     0 0   my $class = ref $_[0];
105 0           bless $_[0], "$class\::HashAccess";
106 0           my $res = $_[0]->{ $_[1] };
107 0           bless $_[0], $class;
108 0           $res
109             };
110              
111             sub hash_get_set {
112 0     0 0   my $class = ref $_[0];
113 0           bless $_[0], "$class\::HashAccess";
114 0           my $k = $_[-1];
115 0           my $res = $_[0]->{ $k };
116 0 0         if (@_ == 3) {
117 0           $_[0]->{$k} = $_[1];
118             };
119 0           bless $_[0], $class;
120 0           $res
121             };
122              
123             =head2 C<< $obj->MozRepl::RemoteObject::Methods::id >>
124              
125             Readonly accessor for the internal object id
126             that connects the Javascript object to the
127             Perl object.
128              
129             =cut
130              
131 0     0 1   sub id { hash_get( $_[0], 'id' ) };
132              
133             =head2 C<< $obj->MozRepl::RemoteObject::Methods::on_destroy >>
134              
135             Accessor for the callback
136             that gets invoked from C<< DESTROY >>.
137              
138             =cut
139              
140 0     0 1   sub on_destroy { hash_get_set( @_, 'on_destroy' )};
141              
142             =head2 C<< $obj->MozRepl::RemoteObject::Methods::bridge >>
143              
144             Readonly accessor for the bridge
145             that connects the Javascript object to the
146             Perl object.
147              
148             =cut
149              
150 0     0 1   sub bridge { hash_get( $_[0], 'bridge' )};
151              
152             =head2 C<< MozRepl::RemoteObject::Methods::as_hash($obj) >>
153              
154             =head2 C<< MozRepl::RemoteObject::Methods::as_array($obj) >>
155              
156             =head2 C<< MozRepl::RemoteObject::Methods::as_code($obj) >>
157              
158             Returns a reference to a hash/array/coderef. This is used
159             by L. Don't use these directly.
160              
161             =cut
162              
163              
164             sub as_hash {
165 0     0 1   my $self = shift;
166 0           tie my %h, 'MozRepl::RemoteObject::TiedHash', $self;
167 0           \%h;
168             };
169              
170             sub as_array {
171 0     0 1   my $self = shift;
172 0           tie my @a, 'MozRepl::RemoteObject::TiedArray', $self;
173 0           \@a;
174             };
175              
176             sub as_code {
177 0     0 1   my $self = shift;
178 0           my $class = ref $self;
179 0           my $id = id($self);
180 0           my $context = hash_get($self, 'return_context');
181             return sub {
182 0     0     my (@args) = @_;
183 0           my $bridge = bridge($self);
184            
185 0           my $rn = $bridge->name;
186 0           @args = transform_arguments($self,@args);
187 0           local $" = ',';
188 0           my $js = <
189             $rn.callThis($id,[@args])
190             JS
191 0           return $bridge->expr($js,$context);
192 0           };
193             };
194              
195             sub object_identity {
196 0     0 0   my ($self,$other) = @_;
197 0 0 0       return if ( ! $other
      0        
      0        
      0        
198             or ! ref $other
199             or ! blessed $other
200             or ! $other->isa('MozRepl::RemoteObject::Instance')
201             or ! $self->isa('MozRepl::RemoteObject::Instance'));
202 0 0         my $left = id($self)
203             or die "Internal inconsistency - no id found for $self";
204 0           my $right = id($other);
205 0           my $bridge = bridge($self);
206 0           my $rn = $bridge->name;
207 0           my $data = $bridge->expr(<
208             $rn.getLink($left)===$rn.getLink($right)
209             JS
210             }
211              
212             =head2 C<< $obj->MozRepl::RemoteObject::Methods::xpath( $query [, $ref, $cont ] ) >>
213              
214             Executes an XPath query and returns the node
215             snapshot result as a list.
216              
217             This is a convenience method that should only be called
218             on HTMLdocument nodes.
219              
220             The optional C<$ref> parameter can be a DOM node relative to which a
221             relative XPath expression will be evaluated. It defaults to C.
222              
223             The optional C<$cont> parameter can be a Javascript function that
224             will get applied to every result. This can be used to directly map
225             each DOM node in the XPath result to an attribute. For example
226             for efficiently fetching the text value of an XPath query resulting in
227             textnodes, the two snippets are equivalent, but the latter executes
228             less roundtrips between Perl and Javascript:
229              
230             my @text = map { $_->{nodeValue} }
231             $obj->MozRepl::RemoteObject::Methods::xpath( '//p/text()' )
232              
233              
234             my $fetch_nodeValue = $bridge->declare(<
235             function (e){ return e.nodeValue }
236             JS
237             my @text = map { $_->{nodeValue} }
238             $obj->MozRepl::RemoteObject::Methods::xpath( '//p/text()', undef, $fetch_nodeValue )
239              
240             Note that the result type is fetched with C< XPathResult.ORDERED_NODE_SNAPSHOT_TYPE >.
241             There is no support for retrieving results as C< XPathResult.ANY_TYPE > yet.
242              
243             =cut
244              
245             sub xpath {
246 0     0 1   my ($self,$query,$ref,$cont) = @_; # $self is a HTMLdocument
247 0   0       $ref ||= $self;
248 0           my $js = <<'JS';
249             function(doc,q,ref,cont) {
250             var xres = doc.evaluate(q,ref,null,XPathResult.ORDERED_NODE_SNAPSHOT_TYPE, null );
251             var map;
252             if( cont ) {
253             map = cont;
254             } else {
255             // Default is identity
256             map = function(e){ return e };
257             };
258             var res = [];
259             for ( var i=0 ; i < xres.snapshotLength; i++ )
260             {
261             res.push( map(xres.snapshotItem(i)));
262             };
263             return res
264             }
265             JS
266 0           my $snap = $self->bridge->declare($js,'list');
267 0           $snap->($self,$query,$ref,$cont);
268             }
269              
270              
271             =head2 C<< MozRepl::RemoteObject::Methods::dive($obj) >>
272              
273             Convenience method to quickly dive down a property chain.
274              
275             If any element on the path is missing, the method dies
276             with the error message which element was not found.
277              
278             This method is faster than descending through the object
279             forest with Perl, but otherwise identical.
280              
281             my $obj = $tab->{linkedBrowser}
282             ->{contentWindow}
283             ->{document}
284             ->{body}
285              
286             my $obj = $tab->MozRepl::RemoteObject::Methods::dive(
287             qw(linkedBrowser contentWindow document body)
288             );
289              
290             =cut
291              
292             sub dive {
293 0     0 1   my ($self,@path) = @_;
294 0           my $id = id($self);
295 0 0         die unless $id;
296 0           my $rn = bridge($self)->name;
297 0           (my $path) = transform_arguments($self,\@path);
298            
299 0           my $data = bridge($self)->unjson(<
300             $rn.dive($id,$path)
301             JS
302             }
303              
304             1;
305              
306             __END__