ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/Mozilla-Plugin/Plugin.pm
(Generate patch)

Comparing Mozilla-Plugin/Plugin.pm (file contents):
Revision 1.4 by root, Fri Feb 23 20:01:27 2001 UTC vs.
Revision 1.12 by root, Sat Jul 21 00:41:47 2001 UTC

1=head1 NAME 1=head1 NAME
2 2
3Mozilla::Plugin - embed perl into mozilla/netscape. 3Browser::Plugin - embed perl into mozilla/netscape/ie/opera.
4 4
5=head1 SYNOPSIS 5=head1 SYNOPSIS
6 6
7 use Mozilla::Plugin; 7 use Browser::Plugin;
8 8
9=head1 DESCRIPTION 9=head1 DESCRIPTION
10 10
11sorry... 11sorry...
12 12
13=over 4 13=over 4
14 14
15=cut 15=cut
16 16
17package Mozilla::Plugin; 17package Browser::Plugin;
18 18
19use base Exporter; 19use base Exporter;
20use Storable; 20use Storable;
21#use XSLoader; 21#use XSLoader;
22 22
23$VERSION = 0.01; 23$VERSION = 0.01;
24@EXPORT = qw(); 24@EXPORT = qw();
25 25
26#XSLoader::load __PACKAGE__, $VERSION; 26#XSLoader::load __PACKAGE__, $VERSION;
27use Data::Dumper;#d# 27
28my $interface; # Browser::Plugin::xxx (design weakness)
29
30my $debug = 1;
31
32sub NP_VERSION_MAJOR (){ 0 }
33sub NP_VERSION_MINOR (){ 9 }
34sub NP_EMBED (){ 1 }
35sub NP_FULL (){ 2 }
36sub NP_NORMAL (){ 1 }
37sub NP_SEEK (){ 2 }
38sub NP_ASFILE (){ 3 }
39sub NP_ASFILEONLY (){ 4 }
40sub NP_MAXREADY (){ 2147483647 }
41sub NPERR_NO_ERROR (){ 0 }
42sub NPERR_GENERIC_ERROR (){ 1 }
43sub NPERR_INVALID_INSTANCE_ERROR (){ 2 }
44sub NPERR_INVALID_FUNCTABLE_ERROR (){ 3 }
45sub NPERR_MODULE_LOAD_FAILED_ERROR (){ 4 }
46sub NPERR_OUT_OF_MEMORY_ERROR (){ 5 }
47sub NPERR_INVALID_PLUGIN_ERROR (){ 6 }
48sub NPERR_INVALID_PLUGIN_DIR_ERROR (){ 7 }
49sub NPERR_INCOMPATIBLE_VERSION_ERROR (){ 8 }
50sub NPERR_INVALID_PARAM (){ 9 }
51sub NPERR_INVALID_URL (){ 10 }
52sub NPERR_FILE_NOT_FOUND (){ 11 }
53sub NPERR_NO_DATA (){ 12 }
54sub NPERR_STREAM_NOT_SEEKABLE (){ 13 }
55sub NPVERS_HAS_STREAMOUTPUT (){ 8 }
56sub NPVERS_HAS_NOTIFICATION (){ 9 }
57sub NPVERS_HAS_LIVECONNECT (){ 9 }
58sub NPVERS_WIN16_HAS_LIVECONNECT (){ 10 }
28 59
29my $data; 60my $data;
30 61
31sub BIAS() { -2000000000 } # ugliest hack ever seen 62sub BIAS() { -2147483647 } # ugliest hack ever seen
32 63
33sub snd_cmd($) { 64sub snd_cmd {
34 $data = pack "NN", 0, ord($_[0]); 65 $data = pack "NN", 0, ord($_[-1]);
35} 66}
36 67
37sub snd_ptr($) { 68sub snd_ptr {
38 $data .= $_[0]; 69 $data .= $_[-1];
39} 70}
40 71
41sub snd_u32($) { 72sub snd_u32 {
42 $data .= pack "N", $_[0]; 73 $data .= pack "N", $_[-1];
43} 74}
44 75
45sub snd_i32($) { 76sub snd_i32 {
46 $data .= pack "N", $_[0] - BIAS; 77 $data .= pack "N", $_[-1] - BIAS;
47} 78}
48 79
49sub snd_blk($) { 80sub snd_blk {
50 $data .= pack "NA*", length($_[0]), $_[0]; 81 $data .= pack "NA*", length($_[-1]), $_[-1];
51} 82}
52 83
53sub snd_snd() { 84sub snd_snd {
54 substr ($data, 0, 4) = pack "N", length $data; 85 substr ($data, 0, 4) = pack "N", length $data;
55 length ($data) == syswrite FD, $data; 86 length ($data) == syswrite FD, $data;
56} 87}
57 88
58sub snd_dyn($) { 89sub snd_dyn {
59 length ($_[0]) == syswrite FD, $_[0]; 90 length ($_[-1]) == syswrite FD, $_[-1];
60} 91}
61 92
62sub rcv_cmd() { 93sub rcv_cmd {
63 my $buf; 94 shift if ref $_[0];
95 my $cmd = shift;
96 my ($buf, $rcmd, $len);
97
98 do {
64 4 == sysread FD, $buf, 4 or exit; 99 4 == sysread FD, $buf, 4 or exit;
65 my $len = unpack "N", $buf; 100 $len = unpack "N", $buf;
66 $len -= 4; 101 $len -= 4;
67 $len == sysread FD, $buf, $len or die; 102 $len == sysread FD, $buf, $len or die;
68 103
69 $data = substr $buf, 4; 104 $data = substr $buf, 4;
70 105
71 substr $buf, 3, 1; 106 $rcmd = substr $buf, 3, 1;
107 if ($rcmd =~ /^[a-z]$/) {
108 die "rcv_cmd: sync error, expected '$cmd' but got '$rcmd'\n" if $cmd && $rcmd ne $cmd;
109 return $rcmd;
110 } else {
111 &_handle_event($rcmd);
112 }
113 } while ($cmd);
72} 114}
73 115
74sub rcv_ptr() { 116sub rcv_ptr {
75 my $ptr = substr $data, 0, 8; 117 my $ptr = substr $data, 0, 8;
76 $data = substr $data, 8; 118 $data = substr $data, 8;
77 $ptr; 119 $ptr;
78} 120}
79 121
80sub rcv_u32() { 122sub rcv_u32 {
81 my $u32 = unpack "N", $data; 123 my $u32 = unpack "N", $data;
82 $data = substr $data, 4; 124 $data = substr $data, 4;
83 $u32; 125 $u32;
84} 126}
85 127
86sub rcv_i32() { 128sub rcv_i32 {
87 my $i32 = BIAS + unpack "N", $data; 129 my $i32 = BIAS + unpack "N", $data;
88 $data = substr $data, 4; 130 $data = substr $data, 4;
89 $i32; 131 $i32;
90} 132}
91 133
92sub rcv_blk() { 134sub rcv_blk {
93 my $len = unpack "N", $data; 135 my $len = unpack "N", $data;
94 my $str = substr $data, 4, $len; 136 my $str = substr $data, 4, $len;
95 $data = substr $data, 4 + $len; 137 $data = substr $data, 4 + $len;
96 $str; 138 $str;
139}
140
141sub rcv_dyn {
142 my $buf;
143 $_[-1] == sysread FD, $buf, $_[-1] or die "rcv_dyn: $!";
144 $buf;
145}
146
147# command from browser to plugin usually have capital letters while
148# commands from perl to the browser always use lowercase letters
149sub _handle_event($) {
150 my $cmd = shift;
151
152 warn "handle_event($cmd)\n" if $debug;
153 if ($cmd eq 'I') {
154 rcv_u32 == 1 or die "protocol version mismatch\n";
155 ($IFACE, $OSNAME, $OSVERS) = (rcv_blk, rcv_blk, rcv_blk);
156
157 } elsif ($cmd eq '+') { # New
158 my ($objid, $type, $mode, $save, $argc)
159 = (rcv_ptr, rcv_blk, rcv_u32, rcv_blk, rcv_u32);
160 my %args;
161 while ($argc--) {
162 my ($argn, $argv) = (rcv_blk, rcv_blk);
163 $args{$argn} = $argv;
164 }
165
166 $_OBJ{$objid} = $interface->new(
167 instance => $objid,
168 type => $type,
169 mode => $mode,
170 save => $save,
171 args => \%args,
172 );
173
174 } elsif ($cmd eq '-') { # Destroy
175 my $objid = rcv_ptr;
176 my $save = (delete $_OBJ{$objid})->save;
177 snd_cmd "-";
178 snd_u32 length $save;
179 snd_snd and snd_dyn $save;
180
181 } elsif ($cmd eq 'X') { # SetWindow
182 my $objid = rcv_ptr;
183 my %args = (
184 id => rcv_ptr,
185 x => rcv_i32,
186 y => rcv_i32,
187 w => rcv_i32,
188 h => rcv_i32,
189 );
190 if ($IFACE eq "UNIX") {
191 $args{id} = unpack "xxxxN", $args{id};
192 $args{ws_type} = rcv_i32;
193 $args{ws_depth} = rcv_u32;
194 }
195
196 snd_cmd 'X';
197 snd_u32 $_OBJ{$objid}->set_window(\%args);
198 snd_snd;
199
200 } elsif ($cmd eq 'N') { # NewStream
201 my $obj = $_OBJ{+rcv_ptr};
202 my %args = (
203 instance => $obj,
204 mimetype => rcv_blk,
205 id => rcv_ptr,
206 url => rcv_blk,
207 end => rcv_u32,
208 lastmodified => rcv_u32,
209 notifydata => rcv_u32,
210 seekable => rcv_u32,
211 push_stream => 1,
212 );
213 my $str = $_OBJ{$args{id}} = new Browser::Stream::Receive \%args;
214
215 my ($stype, $err) = $obj->push_stream($str);
216
217 snd_cmd 'N';
218 snd_u32 $err;
219 snd_u32 $stype || NP_NORMAL;
220 snd_snd;
221
222 } elsif ($cmd eq '/') { # StreamAsFile
223 my $obj = $_OBJ{+rcv_ptr};
224 my $str = $_OBJ{+rcv_ptr};
225 my $path = rcv_blk;
226
227 $obj->stream_as_file($obj, $stream, $path);
228
229 } elsif ($cmd eq 'R') { # WriteReady
230 my $obj = $_OBJ{+rcv_ptr};
231 my $str = $_OBJ{+rcv_ptr};
232
233 snd_cmd 'R';
234 snd_u32 $obj->write_ready($obj, $str);
235 snd_snd;
236
237 } elsif ($cmd eq 'W') { # Write
238 my $obj = $_OBJ{+rcv_ptr};
239 my $str = $_OBJ{+rcv_ptr};
240 my $ofs = rcv_i32;
241 my $len = rcv_i32;
242 my $dta = rcv_dyn $len;
243
244 snd_cmd 'W';
245 snd_i32 $obj->write($str, $ofs, $len, $dta);
246 snd_snd;
247
248 } elsif ($cmd eq 'D') { # DestroyStream
249 my $obj = $_OBJ{+rcv_ptr};
250 my $str = delete $_OBJ{+rcv_ptr};
251 my $why = rcv_u32;
252
253 $obj->destroy_stream($obj, $str, $why);
254
255 } else {
256 die "unknown command '$cmd' received";
257 }
97} 258}
98 259
99=item my $fh = server_fh 260=item my $fh = server_fh
100 261
101The design of this module is event-based. When the plug-in starts (there 262The design of this module is event-based. When the plug-in starts (there
… …
116plug-in is also not very viable, so in the future one might be able to 277plug-in is also not very viable, so in the future one might be able to
117specify a group on the embed statement (i.e. EMBED GROUP="gtk+"). 278specify a group on the embed statement (i.e. EMBED GROUP="gtk+").
118 279
119=cut 280=cut
120 281
121sub server_fh() { *FD } 282sub server_fh { \*FD }
122 283
123sub server_event() { 284sub server_event { rcv_cmd }
124 my $cmd = rcv_cmd;
125
126 warn "cmd<$cmd>\n";#d#
127
128 if ($cmd eq "I") {
129 rcv_u32 == 1 or die "protocol version mismatch\n";
130 ($IFACE, $OSNAME, $OSVERS) = (rcv_blk, rcv_blk, rcv_blk);
131
132 } elsif ($cmd eq "+") {
133 my ($objid, $type, $mode, $save, $argc)
134 = (rcv_ptr, rcv_blk, rcv_u32, rcv_blk, rcv_u32);
135 my %args;
136 while ($argc--) {
137 my ($argn, $argv) = (rcv_blk, rcv_blk);
138 $args{$argn} = $argv;
139 }
140
141 warn "new obj $objid\n";#d#
142 $_OBJ{$objid} = new Mozilla::Plugin
143 objid => $objid,
144 type => $type,
145 mode => $mode,
146 save => $save,
147 args => \%args;
148
149 } elsif ($cmd eq "-") {
150 my $objid = rcv_ptr;
151 my $save = (delete $_OBJ{$objid})->save;
152 snd_cmd "-";
153 snd_u32 length $save;
154 snd_snd and snd_dyn $save;
155
156 } elsif ($cmd eq "W") {
157 my $objid = rcv_ptr;
158 my %args = (
159 window => rcv_ptr,
160 x => rcv_i32,
161 y => rcv_i32,
162 w => rcv_i32,
163 h => rcv_i32,
164 );
165 if ($IFACE eq "UNIX") {
166 $args{window} = unpack "xxxxN", $args{window};
167 $args{ws_type} = rcv_i32;
168 $args{ws_depth} = rcv_u32;
169 }
170
171 $_OBJ{$objid}->set_window(\%args);
172
173 } else {
174 die "unknown command '$cmd' received";
175 }
176}
177 285
178sub mainloop { 286sub mainloop {
179 server_event while 1; 287 server_event while 1;
180} 288}
181 289
182sub init { 290sub init {
183 $IN_MOZILLA = 1; 291 $interface = shift;
184 292
185 open FD, "+<&=$_[1]"; binmode $FD; 293 open FD, "+<&=$_[0]"; binmode FD;
186 294
187 warn "init: ".Dumper(@_); 295 $interface->mainloop;
188 mainloop;
189} 296}
190 297
191sub new { 298sub new {
192 my $class = shift; 299 my $class = shift;
193 my $self = bless { @_ }, $class; 300 my $self = bless { @_ }, $class;
194 $self->{save} = $self->{save} ne "" 301 $self->{save} = $self->{save} ne ""
195 ? Storable::thaw $self->{save} 302 ? Storable::thaw $self->{save}
196 : {}; 303 : {};
197 warn "new: ".Dumper($self);
198 $self; 304 $self;
199} 305}
200 306
201sub set_window { 307sub set_window {
202 my $self = shift; 308 my $self = shift;
203 my $new = shift; 309 my $new = shift;
310
204 if ($self->{window}) { 311 if ($self->{wininfo}) {
205 if ($self->{window}{window} ne $new->{window}) { 312 if ($self->{wininfo}{id} ne $new->{id}) {
206 $self->window_delete($self->{window}); 313 $self->window_delete($self->{wininfo});
207 } else { 314 } elsif ($self->{wininfo}{w} != $new->{w}
315 or $self->{wininfo}{h} != $new->{h}) {
208 $self->window_resize($new->{window}, $new->{w}, $new->{h}); 316 $self->window_resize($new->{w}, $new->{h});
209 } 317 }
210 $self->{window} = $new; 318 $self->{wininfo} = $new;
211 } else {
212 $self->{window} = $new;
213 $self->window_new($new->{window}, $new->{w}, $new->{h});
214 } 319 }
215 warn "set_window: ".Dumper($self);
216}
217 320
321 unless ($self->{wininfo}) {
322 $self->{window} = $self->window_new($new) and $self->{wininfo} = $new;
323 }
324
325 ();
326}
327
218sub window_new {} 328sub window_new { () }
219sub window_resize {} 329sub window_resize {}
330
220sub window_delete {} 331sub window_delete {
332 my $self = shift;
333 delete $self->{wininfo};
334 delete $self->{window};
335}
221 336
222sub save { 337sub save {
223 $_[0]->{save}{test} = ['t1',5,7]; 338 my $self = shift;
339 $self->destroy;
224 Storable::nfreeze $_[0]->{save}; 340 Storable::nfreeze $self->{save};
225} 341}
226 342
343sub destroy {
344 my $self = shift;
345 $self->set_window(undef);
346}
347
348sub write_ready { 0xfffff }
349sub push_stream {}
350sub stream_as_file {}
351sub destroy_stream {}
352
227sub DESTROY { 353sub DESTROY {}
228 warn "DESTROY"; 354
355sub write {
356 my ($self) = shift;
357 shift->write(@_);
358}
359
360=item ($error, $stream) = new_stream $mimetype, $target
361
362Requests the creation of a new data stream produced by the plug-in and
363consumed by the browser.
364
365=cut
366
367sub new_stream {
368 my ($self, $type, $target) = @_;
369 my ($error, $stream);
370
371 snd_cmd 'n';
372 snd_blk $mimetype;
373 snd_blk $target;
374 if (snd_snd) {
375 rcv_cmd 'n';
376 $error = rcv_u32;
377 unless ($error) {
378 $stream = new Browser::Stream::Send (
379 instance => $self,
380 mimetype => $type,
381 id => rcv_ptr,
382 url => $target,
383 );
384 }
385 }
386 ($error, $stream);
387}
388
389=item $error = $obj->get_url $url, $target
390
391=cut
392
393sub get_url {
394 my ($self, $url, $target) = @_;
395 my $error;
396
397 snd_cmd 'u';
398 snd_blk $url;
399 snd_blk $target;
400 if (snd_snd) {
401 rcv_cmd 'u';
402 $error = rcv_i32;
403 }
404 $error;
405}
406
407sub Browser::Stream::new {
408 bless $_[1], $_[0];
409}
410
411sub Browser::Stream::destroy {
412 my $str = shift;
413 my $error = shift;
414 unless ($str->{destroyed}) {
415 $str->{destroyed}++;
416
417 my $obj = $str->{instance};
418 snd_cmd 'd';
419 snd_ptr $obj->{id};
420 snd_ptr $str->{id};
421 snd_u32 $error || NPERR_NO_ERROR;
422 snd_snd;
423 }
424}
425
426*Browser::Stream::DESTROY = \&Browser::Stream::destroy;
427
428BEGIN {
429 @Browser::Stream::Receive::ISA = Browser::Stream;
430}
431
432sub Browser::Stream::Receive::write {
433 # ...
434}
435
436BEGIN {
437 @Browser::Stream::Send::ISA = Browser::Stream;
438}
439
440=item $bytes = $stream->write($data)
441
442=cut
443
444sub Browser::Stream::Send::write {
445 my $str = shift;
446 my $obj = $self->{instance};
447
448 snd_cmd 'w';
449 snd_ptr $obj->{id};
450 snd_ptr $str->{id};
451 snd_u32 length $_[0];
452 if (snd_snd) {
453 if (snd_dyn $_[0]) {
454 rcv_cmd 'w';
455 return rcv_i32 ();
456 }
457 }
458 return 0;
229} 459}
230 460
2311; 4611;
232 462
233=back 463=back

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines