| … | |
… | |
| 6 | |
6 | |
| 7 | use Mozilla::Plugin; |
7 | use Mozilla::Plugin; |
| 8 | |
8 | |
| 9 | =head1 DESCRIPTION |
9 | =head1 DESCRIPTION |
| 10 | |
10 | |
|
|
11 | sorry... |
|
|
12 | |
| 11 | =over 4 |
13 | =over 4 |
| 12 | |
14 | |
| 13 | =cut |
15 | =cut |
| 14 | |
16 | |
| 15 | package Mozilla::Plugin; |
17 | package Mozilla::Plugin; |
| 16 | |
18 | |
| 17 | use base Exporter; |
19 | use base Exporter; |
|
|
20 | use Storable; |
| 18 | #use XSLoader; |
21 | #use XSLoader; |
| 19 | |
22 | |
| 20 | $VERSION = 0.12; |
23 | $VERSION = 0.01; |
| 21 | @EXPORT = qw(); |
24 | @EXPORT = qw(); |
| 22 | |
25 | |
| 23 | warn "in module [@ARGV]";#d# |
|
|
| 24 | |
|
|
| 25 | #XSLoader::load __PACKAGE__, $VERSION; |
26 | #XSLoader::load __PACKAGE__, $VERSION; |
| 26 | use Data::Dumper; |
27 | |
|
|
28 | my $interface; # Mozilla::Plugin::xxx (design weakness) |
|
|
29 | |
|
|
30 | sub NP_VERSION_MAJOR (){ 0 } |
|
|
31 | sub NP_VERSION_MINOR (){ 9 } |
|
|
32 | sub NP_EMBED (){ 1 } |
|
|
33 | sub NP_FULL (){ 2 } |
|
|
34 | sub NP_NORMAL (){ 1 } |
|
|
35 | sub NP_SEEK (){ 2 } |
|
|
36 | sub NP_ASFILE (){ 3 } |
|
|
37 | sub NP_ASFILEONLY (){ 4 } |
|
|
38 | sub NP_MAXREADY (){ 2147483647 } |
|
|
39 | sub NPERR_NO_ERROR (){ 0 } |
|
|
40 | sub NPERR_GENERIC_ERROR (){ 1 } |
|
|
41 | sub NPERR_INVALID_INSTANCE_ERROR (){ 2 } |
|
|
42 | sub NPERR_INVALID_FUNCTABLE_ERROR (){ 3 } |
|
|
43 | sub NPERR_MODULE_LOAD_FAILED_ERROR (){ 4 } |
|
|
44 | sub NPERR_OUT_OF_MEMORY_ERROR (){ 5 } |
|
|
45 | sub NPERR_INVALID_PLUGIN_ERROR (){ 6 } |
|
|
46 | sub NPERR_INVALID_PLUGIN_DIR_ERROR (){ 7 } |
|
|
47 | sub NPERR_INCOMPATIBLE_VERSION_ERROR (){ 8 } |
|
|
48 | sub NPERR_INVALID_PARAM (){ 9 } |
|
|
49 | sub NPERR_INVALID_URL (){ 10 } |
|
|
50 | sub NPERR_FILE_NOT_FOUND (){ 11 } |
|
|
51 | sub NPERR_NO_DATA (){ 12 } |
|
|
52 | sub NPERR_STREAM_NOT_SEEKABLE (){ 13 } |
|
|
53 | sub NPVERS_HAS_STREAMOUTPUT (){ 8 } |
|
|
54 | sub NPVERS_HAS_NOTIFICATION (){ 9 } |
|
|
55 | sub NPVERS_HAS_LIVECONNECT (){ 9 } |
|
|
56 | sub NPVERS_WIN16_HAS_LIVECONNECT (){ 10 } |
| 27 | |
57 | |
| 28 | my $data; |
58 | my $data; |
| 29 | |
59 | |
|
|
60 | sub BIAS() { -2147483647 } # ugliest hack ever seen |
|
|
61 | |
| 30 | sub snd_cmd($) { |
62 | sub snd_cmd { |
| 31 | $data = pack "NN", 0, ord($_[0]); |
63 | $data = pack "NN", 0, ord($_[-1]); |
| 32 | } |
64 | } |
| 33 | |
65 | |
|
|
66 | sub snd_ptr { |
|
|
67 | $data .= $_[-1]; |
|
|
68 | } |
|
|
69 | |
| 34 | sub snd_i32($) { |
70 | sub snd_u32 { |
| 35 | $data .= pack "N", $_[0]; |
71 | $data .= pack "N", $_[-1]; |
| 36 | } |
72 | } |
| 37 | |
73 | |
|
|
74 | sub snd_i32 { |
|
|
75 | $data .= pack "N", $_[-1] - BIAS; |
|
|
76 | } |
|
|
77 | |
| 38 | sub snd_blk($) { |
78 | sub snd_blk { |
| 39 | $data .= pack "NA*", length($_[0]), $_[0]; |
79 | $data .= pack "NA*", length($_[-1]), $_[-1]; |
| 40 | } |
80 | } |
| 41 | |
81 | |
| 42 | sub snd_snd($) { |
82 | sub snd_snd { |
| 43 | substr ($data, 0, 4) = pack "N", length $data; |
83 | substr ($data, 0, 4) = pack "N", length $data; |
| 44 | length($data) == syswrite $_[0], $data; |
84 | length ($data) == syswrite FD, $data; |
|
|
85 | } |
|
|
86 | |
|
|
87 | sub snd_dyn { |
|
|
88 | length ($_[-1]) == syswrite FD, $_[-1]; |
| 45 | } |
89 | } |
| 46 | |
90 | |
| 47 | sub rcv_cmd { |
91 | sub rcv_cmd { |
| 48 | my $buf; |
92 | my $buf; |
| 49 | 4 == sysread $_[0], $buf, 4 or exit; |
93 | 4 == sysread FD, $buf, 4 or exit; |
| 50 | my $len = unpack "N", $buf; |
94 | my $len = unpack "N", $buf; |
| 51 | $len -= 4; |
95 | $len -= 4; |
| 52 | $len == sysread $_[0], $buf, $len or die; |
96 | $len == sysread FD, $buf, $len or die; |
| 53 | |
97 | |
| 54 | $data = substr $buf, 4; |
98 | $data = substr $buf, 4; |
| 55 | |
99 | |
| 56 | substr $buf, 3, 1; |
100 | substr $buf, 3, 1; |
| 57 | } |
101 | } |
| 58 | |
102 | |
|
|
103 | sub rcv_ptr { |
|
|
104 | my $ptr = substr $data, 0, 8; |
|
|
105 | $data = substr $data, 8; |
|
|
106 | printf "RCV_PTR(%s)\n", unpack "H*", $ptr; |
|
|
107 | $ptr; |
|
|
108 | } |
|
|
109 | |
| 59 | sub rcv_i32() { |
110 | sub rcv_u32 { |
| 60 | my $i32 = unpack "N", $data; |
111 | my $u32 = unpack "N", $data; |
|
|
112 | $data = substr $data, 4; |
|
|
113 | $u32; |
|
|
114 | } |
|
|
115 | |
|
|
116 | sub rcv_i32 { |
|
|
117 | my $i32 = BIAS + unpack "N", $data; |
| 61 | $data = substr $data, 4; |
118 | $data = substr $data, 4; |
| 62 | $i32; |
119 | $i32; |
| 63 | } |
120 | } |
| 64 | |
121 | |
| 65 | sub rcv_blk() { |
122 | sub rcv_blk { |
| 66 | my $len = unpack "N", $data; |
123 | my $len = unpack "N", $data; |
| 67 | my $str = substr $data, 4, $len; |
124 | my $str = substr $data, 4, $len; |
| 68 | $data = substr $data, 4 + $len; |
125 | $data = substr $data, 4 + $len; |
| 69 | $str; |
126 | $str; |
| 70 | } |
127 | } |
| 71 | |
128 | |
| 72 | sub handle_cmd { |
129 | sub rcv_dyn { |
|
|
130 | my $buf; |
|
|
131 | $_[-1] == sysread FD, $buf, $_[-1] or die "rcv_dyn: $!"; |
|
|
132 | $buf; |
|
|
133 | } |
|
|
134 | |
|
|
135 | =item my $fh = server_fh |
|
|
136 | |
|
|
137 | The design of this module is event-based. When the plug-in starts (there |
|
|
138 | is always just one interpreter) it spawns one perl interpreter which |
|
|
139 | will immediately go into a even loop. If you want to use your own event |
|
|
140 | loop (e.g. using the Gtk or Event modules) you need to register a file |
|
|
141 | input handler on the filehandle returned by C<server_fh> that calls |
|
|
142 | C<server_event> whenever there is input pending on C<server_fh>. This will |
|
|
143 | ensure proper operation of the plug-in. |
|
|
144 | |
|
|
145 | =item server_event |
|
|
146 | |
|
|
147 | Call this function whenever there is data available on the C<server_fh>. This function |
|
|
148 | might not return. |
|
|
149 | |
|
|
150 | Due to this design (flaw?), sharing of different toolkits using this |
|
|
151 | plug-in is difficult at best. Spawning a new perl interpreter for every |
|
|
152 | plug-in is also not very viable, so in the future one might be able to |
|
|
153 | specify a group on the embed statement (i.e. EMBED GROUP="gtk+"). |
|
|
154 | |
|
|
155 | =cut |
|
|
156 | |
|
|
157 | sub server_fh() { \*FD } |
|
|
158 | |
|
|
159 | sub server_event() { |
| 73 | my $cmd = rcv_cmd *FD1; |
160 | my $cmd = rcv_cmd; |
|
|
161 | |
|
|
162 | warn "cmd<$cmd>\n";#d# |
| 74 | |
163 | |
| 75 | if ($cmd eq "I") { |
164 | if ($cmd eq "I") { |
| 76 | rcv_i32 == 1 or die "protocol version mismatch\n"; |
165 | rcv_u32 == 1 or die "protocol version mismatch\n"; |
| 77 | ($IFACE, $OSNAME, $OSVERS) = (rcv_blk, rcv_blk, rcv_blk); |
166 | ($IFACE, $OSNAME, $OSVERS) = (rcv_blk, rcv_blk, rcv_blk); |
| 78 | warn " ($IFACE, $OSNAME, $OSVERS) \n";#d# |
167 | |
| 79 | } elsif ($cmd eq "+") { |
168 | } elsif ($cmd eq "+") { # New |
| 80 | my ($objid, $type, $mode, $save, $argc) |
169 | my ($objid, $type, $mode, $save, $argc) |
| 81 | = (rcv_i32, rcv_blk, rcv_i32, rcv_blk, rcv_i32); |
170 | = (rcv_ptr, rcv_blk, rcv_u32, rcv_blk, rcv_u32); |
| 82 | my %args; |
171 | my %args; |
| 83 | $args{rcv_blk} = rcv_blk while $argc--; |
172 | while ($argc--) { |
|
|
173 | my ($argn, $argv) = (rcv_blk, rcv_blk); |
|
|
174 | $args{$argn} = $argv; |
|
|
175 | } |
| 84 | |
176 | |
| 85 | $_OBJ{$objid} = new Mozilla::Plugin |
177 | $_OBJ{$objid} = $interface->new( |
|
|
178 | instance => $objid, |
| 86 | type => $type, |
179 | type => $type, |
| 87 | mode => $mode, |
180 | mode => $mode, |
| 88 | save => $save, |
181 | save => $save, |
| 89 | args => \%args; |
182 | args => \%args, |
|
|
183 | ); |
| 90 | |
184 | |
| 91 | } elsif ($cmd eq "-") { |
185 | } elsif ($cmd eq "-") { # Destroy |
| 92 | my $objid = rcv_i32; |
186 | my $objid = rcv_ptr; |
| 93 | my $save = |
187 | my $save = (delete $_OBJ{$objid})->save; |
| 94 | $_OBJ{$objid}->save |
188 | snd_cmd "-"; |
|
|
189 | snd_u32 length $save; |
|
|
190 | snd_snd and snd_dyn $save; |
|
|
191 | |
|
|
192 | } elsif ($cmd eq "X") { # SetWindow |
|
|
193 | my $objid = rcv_ptr; |
|
|
194 | my %args = ( |
|
|
195 | id => rcv_ptr, |
|
|
196 | x => rcv_i32, |
|
|
197 | y => rcv_i32, |
|
|
198 | w => rcv_i32, |
|
|
199 | h => rcv_i32, |
|
|
200 | ); |
|
|
201 | if ($IFACE eq "UNIX") { |
|
|
202 | $args{id} = unpack "xxxxN", $args{id}; |
|
|
203 | $args{ws_type} = rcv_i32; |
|
|
204 | $args{ws_depth} = rcv_u32; |
|
|
205 | } |
|
|
206 | |
|
|
207 | snd_cmd 'X'; |
|
|
208 | snd_u32 $_OBJ{$objid}->set_window(\%args); |
|
|
209 | snd_snd; |
|
|
210 | |
|
|
211 | } elsif ($cmd eq "N") { # NewStream |
|
|
212 | my $obj = $_OBJ{+rcv_ptr}; |
|
|
213 | my %args = ( |
|
|
214 | instance => $obj, |
|
|
215 | mimetype => rcv_blk, |
|
|
216 | id => rcv_ptr, |
|
|
217 | url => rcv_blk, |
|
|
218 | end => rcv_u32, |
|
|
219 | lastmodified => rcv_u32, |
|
|
220 | notifydata => rcv_u32, |
|
|
221 | seekable => rcv_u32, |
|
|
222 | push_stream => 1, |
|
|
223 | ); |
|
|
224 | my $str = $_OBJ{$args{id}} = new Mozilla::Stream \%args; |
|
|
225 | |
|
|
226 | my ($stype, $err) = $obj->push_stream($str); |
|
|
227 | |
|
|
228 | snd_cmd 'N'; |
|
|
229 | snd_u32 $err; |
|
|
230 | snd_u32 $stype || NP_NORMAL; |
|
|
231 | snd_snd; |
|
|
232 | |
|
|
233 | } elsif ($cmd eq "/") { # StreamAsFile |
|
|
234 | my $obj = $_OBJ{+rcv_ptr}; |
|
|
235 | my $str = $_OBJ{+rcv_ptr}; |
|
|
236 | my $path = rcv_blk; |
|
|
237 | |
|
|
238 | $obj->stream_as_file($obj, $stream, $path); |
|
|
239 | |
|
|
240 | } elsif ($cmd eq "R") { # WriteReady |
|
|
241 | my $obj = $_OBJ{+rcv_ptr}; |
|
|
242 | my $str = $_OBJ{+rcv_ptr}; |
|
|
243 | |
|
|
244 | snd_cmd 'R'; |
|
|
245 | snd_u32 $obj->write_ready($obj, $str); |
|
|
246 | snd_snd; |
|
|
247 | |
|
|
248 | } elsif ($cmd eq "W") { # Write |
|
|
249 | my $obj = $_OBJ{+rcv_ptr}; |
|
|
250 | my $str = $_OBJ{+rcv_ptr}; |
|
|
251 | my $ofs = rcv_i32; |
|
|
252 | my $len = rcv_i32; |
|
|
253 | my $dta = rcv_dyn $len; |
|
|
254 | |
|
|
255 | snd_cmd 'W'; |
|
|
256 | snd_i32 $obj->write($str, $ofs, $len, $dta); |
|
|
257 | snd_snd; |
|
|
258 | |
|
|
259 | } elsif ($cmd eq "D") { # DestroyStream |
|
|
260 | my $obj = $_OBJ{+rcv_ptr}; |
|
|
261 | my $str = delete $_OBJ{+rcv_ptr}; |
|
|
262 | my $why = rcv_u32; |
|
|
263 | |
|
|
264 | $obj->destroy_stream($obj, $str, $why); |
|
|
265 | |
| 95 | } else { |
266 | } else { |
| 96 | die "unknown command '$cmd' received"; |
267 | die "unknown command '$cmd' received"; |
| 97 | } |
268 | } |
| 98 | } |
269 | } |
| 99 | |
270 | |
| 100 | sub mainloop { |
271 | sub mainloop { |
| 101 | handle_cmd while 1; |
272 | server_event while 1; |
| 102 | } |
273 | } |
| 103 | |
274 | |
| 104 | sub _main { |
275 | sub init { |
| 105 | $LIBDIR = shift @ARGV; |
276 | $interface = shift; |
| 106 | $IN_MOZILLA = 1; |
277 | |
| 107 | (shift @ARGV) =~ /^(\d+),(\d+)$/ or die "init arg error"; |
|
|
| 108 | my ($fd1, $fd2) = ($1, $2); |
|
|
| 109 | open FD1, "+<&=$fd1"; binmode FD1; |
278 | open FD, "+<&=$_[0]"; binmode FD; |
| 110 | open FD2, "+<&=$fd2"; binmode FD2; |
|
|
| 111 | |
279 | |
| 112 | mainloop; |
280 | $interface->mainloop; |
| 113 | |
|
|
| 114 | close FD2; |
|
|
| 115 | close FD1; |
|
|
| 116 | } |
281 | } |
| 117 | |
282 | |
| 118 | sub new { |
283 | sub new { |
| 119 | warn "new: ".Dumper(\@_); |
284 | my $class = shift; |
|
|
285 | my $self = bless { @_ }, $class; |
|
|
286 | $self->{save} = $self->{save} ne "" |
|
|
287 | ? Storable::thaw $self->{save} |
|
|
288 | : {}; |
|
|
289 | $self; |
| 120 | } |
290 | } |
| 121 | |
291 | |
| 122 | sub set_window { |
292 | sub set_window { |
| 123 | warn "set_window: ".Dumper(\@_); |
293 | my $self = shift; |
|
|
294 | my $new = shift; |
|
|
295 | |
|
|
296 | if ($self->{wininfo}) { |
|
|
297 | if ($self->{wininfo}{id} ne $new->{id}) { |
|
|
298 | $self->window_delete($self->{wininfo}); |
|
|
299 | } elsif ($self->{wininfo}{w} != $new->{w} |
|
|
300 | or $self->{wininfo}{h} != $new->{h}) { |
|
|
301 | $self->window_resize($new->{id}, $new->{w}, $new->{h}); |
|
|
302 | } |
|
|
303 | $self->{wininfo} = $new; |
|
|
304 | } |
|
|
305 | |
|
|
306 | unless ($self->{wininfo}) { |
|
|
307 | $self->{window} = $self->window_new($new) and $self->{wininfo} = $new; |
|
|
308 | } |
|
|
309 | |
|
|
310 | (); |
|
|
311 | } |
|
|
312 | |
|
|
313 | sub window_new {} |
|
|
314 | sub window_resize {} |
|
|
315 | |
|
|
316 | sub window_delete { |
|
|
317 | my $self = shift; |
|
|
318 | delete $self->{wininfo}; |
|
|
319 | delete $self->{window}; |
| 124 | } |
320 | } |
| 125 | |
321 | |
| 126 | sub save { |
322 | sub save { |
| 127 | warn "save: ".Dumper(\@_); |
323 | my $self = shift; |
| 128 | "[save]"; |
324 | $self->set_window(undef); |
|
|
325 | $self->{destroy}; |
|
|
326 | Storable::nfreeze $self->{save}; |
|
|
327 | } |
|
|
328 | |
|
|
329 | sub destroy {} |
|
|
330 | sub DESTROY {} |
|
|
331 | sub write_ready { 0xfffff } |
|
|
332 | sub push_stream {} |
|
|
333 | sub stream_as_file {} |
|
|
334 | sub destroy_stream {} |
|
|
335 | |
|
|
336 | sub write { |
|
|
337 | my ($self) = shift; |
|
|
338 | shift->write(@_); |
|
|
339 | } |
|
|
340 | |
|
|
341 | package Mozilla::Stream; |
|
|
342 | |
|
|
343 | sub new { |
|
|
344 | bless $_[1], $_[0]; |
|
|
345 | } |
|
|
346 | |
|
|
347 | sub write { |
|
|
348 | # ... |
| 129 | } |
349 | } |
| 130 | |
350 | |
| 131 | sub DESTROY { |
351 | sub DESTROY { |
|
|
352 | my $str = $_[0]; |
| 132 | warn "DESTROY"; |
353 | warn "DESTROY stream"; |
|
|
354 | |
|
|
355 | my $obj = $str->{instance}; |
|
|
356 | $obj->snd_cmd('d'); |
|
|
357 | $obj->snd_ptr($obj); |
|
|
358 | $obj->snd_ptr($str); |
|
|
359 | $obj->snd_snd; |
| 133 | } |
360 | } |
| 134 | |
361 | |
| 135 | 1; |
362 | 1; |
| 136 | |
363 | |
| 137 | =back |
364 | =back |
