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.1 by root, Thu Feb 22 23:18:48 2001 UTC vs.
Revision 1.6 by root, Sun Feb 25 12:04:43 2001 UTC

6 6
7 use Mozilla::Plugin; 7 use Mozilla::Plugin;
8 8
9=head1 DESCRIPTION 9=head1 DESCRIPTION
10 10
11sorry...
12
11=over 4 13=over 4
12 14
13=cut 15=cut
14 16
15package Mozilla::Plugin; 17package Mozilla::Plugin;
16 18
17use base Exporter; 19use base Exporter;
20use 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
23warn "in module [@ARGV]";#d#
24
25#XSLoader::load __PACKAGE__, $VERSION; 26#XSLoader::load __PACKAGE__, $VERSION;
26use Data::Dumper; 27use Data::Dumper;#d#
28
29my $interface; # Mozilla::Plugin::xxx (design weakness)
27 30
28my $data; 31my $data;
32
33sub BIAS() { -2000000000 } # ugliest hack ever seen
29 34
30sub snd_cmd($) { 35sub snd_cmd($) {
31 $data = pack "NN", 0, ord($_[0]); 36 $data = pack "NN", 0, ord($_[0]);
32} 37}
33 38
39sub snd_ptr($) {
40 $data .= $_[0];
41}
42
43sub snd_u32($) {
44 $data .= pack "N", $_[0];
45}
46
34sub snd_i32($) { 47sub snd_i32($) {
35 $data .= pack "N", $_[0]; 48 $data .= pack "N", $_[0] - BIAS;
36} 49}
37 50
38sub snd_blk($) { 51sub snd_blk($) {
39 $data .= pack "NA*", length($_[0]), $_[0]; 52 $data .= pack "NA*", length($_[0]), $_[0];
40} 53}
41 54
42sub snd_snd($) { 55sub snd_snd() {
43 substr ($data, 0, 4) = pack "N", length $data; 56 substr ($data, 0, 4) = pack "N", length $data;
44 length($data) == syswrite $_[0], $data; 57 length ($data) == syswrite FD, $data;
45} 58}
46 59
60sub snd_dyn($) {
61 length ($_[0]) == syswrite FD, $_[0];
62}
63
47sub rcv_cmd { 64sub rcv_cmd() {
48 my $buf; 65 my $buf;
49 4 == sysread $_[0], $buf, 4 or exit; 66 4 == sysread FD, $buf, 4 or exit;
50 my $len = unpack "N", $buf; 67 my $len = unpack "N", $buf;
51 $len -= 4; 68 $len -= 4;
52 $len == sysread $_[0], $buf, $len or die; 69 $len == sysread FD, $buf, $len or die;
53 70
54 $data = substr $buf, 4; 71 $data = substr $buf, 4;
55 72
56 substr $buf, 3, 1; 73 substr $buf, 3, 1;
57} 74}
58 75
76sub rcv_ptr() {
77 my $ptr = substr $data, 0, 8;
78 $data = substr $data, 8;
79 $ptr;
80}
81
82sub rcv_u32() {
83 my $u32 = unpack "N", $data;
84 $data = substr $data, 4;
85 $u32;
86}
87
59sub rcv_i32() { 88sub rcv_i32() {
60 my $i32 = unpack "N", $data; 89 my $i32 = BIAS + unpack "N", $data;
61 $data = substr $data, 4; 90 $data = substr $data, 4;
62 $i32; 91 $i32;
63} 92}
64 93
65sub rcv_blk() { 94sub rcv_blk() {
67 my $str = substr $data, 4, $len; 96 my $str = substr $data, 4, $len;
68 $data = substr $data, 4 + $len; 97 $data = substr $data, 4 + $len;
69 $str; 98 $str;
70} 99}
71 100
72sub handle_cmd { 101=item my $fh = server_fh
102
103The design of this module is event-based. When the plug-in starts (there
104is always just one interpreter) it spawns one perl interpreter which
105will immediately go into a even loop. If you want to use your own event
106loop (e.g. using the Gtk or Event modules) you need to register a file
107input handler on the filehandle returned by C<server_fh> that calls
108C<server_event> whenever there is input pending on C<server_fh>. This will
109ensure proper operation of the plug-in.
110
111=item server_event
112
113Call this function whenever there is data available on the C<server_fh>. This function
114might not return.
115
116Due to this design (flaw?), sharing of different toolkits using this
117plug-in is difficult at best. Spawning a new perl interpreter for every
118plug-in is also not very viable, so in the future one might be able to
119specify a group on the embed statement (i.e. EMBED GROUP="gtk+").
120
121=cut
122
123sub server_fh() { \*FD }
124
125sub server_event() {
73 my $cmd = rcv_cmd *FD1; 126 my $cmd = rcv_cmd;
127
128 warn "cmd<$cmd>\n";#d#
74 129
75 if ($cmd eq "I") { 130 if ($cmd eq "I") {
76 rcv_i32 == 1 or die "protocol version mismatch\n"; 131 rcv_u32 == 1 or die "protocol version mismatch\n";
77 ($IFACE, $OSNAME, $OSVERS) = (rcv_blk, rcv_blk, rcv_blk); 132 ($IFACE, $OSNAME, $OSVERS) = (rcv_blk, rcv_blk, rcv_blk);
78 warn " ($IFACE, $OSNAME, $OSVERS) \n";#d# 133
79 } elsif ($cmd eq "+") { 134 } elsif ($cmd eq "+") {
80 my ($objid, $type, $mode, $save, $argc) 135 my ($objid, $type, $mode, $save, $argc)
81 = (rcv_i32, rcv_blk, rcv_i32, rcv_blk, rcv_i32); 136 = (rcv_ptr, rcv_blk, rcv_u32, rcv_blk, rcv_u32);
82 my %args; 137 my %args;
83 $args{rcv_blk} = rcv_blk while $argc--; 138 while ($argc--) {
139 my ($argn, $argv) = (rcv_blk, rcv_blk);
140 $args{$argn} = $argv;
141 }
84 142
85 $_OBJ{$objid} = new Mozilla::Plugin 143 warn "new obj $objid\n";#d#
144 $_OBJ{$objid} = $interface->new(
145 objid => $objid,
86 type => $type, 146 type => $type,
87 mode => $mode, 147 mode => $mode,
88 save => $save, 148 save => $save,
89 args => \%args; 149 args => \%args,
150 );
90 151
91 } elsif ($cmd eq "-") { 152 } elsif ($cmd eq "-") {
92 my $objid = rcv_i32; 153 my $objid = rcv_ptr;
93 my $save = 154 my $save = (delete $_OBJ{$objid})->save;
94 $_OBJ{$objid}->save 155 snd_cmd "-";
156 snd_u32 length $save;
157 snd_snd and snd_dyn $save;
158
159 } elsif ($cmd eq "W") {
160 my $objid = rcv_ptr;
161 my %args = (
162 window => rcv_ptr,
163 x => rcv_i32,
164 y => rcv_i32,
165 w => rcv_i32,
166 h => rcv_i32,
167 );
168 if ($IFACE eq "UNIX") {
169 $args{window} = unpack "xxxxN", $args{window};
170 $args{ws_type} = rcv_i32;
171 $args{ws_depth} = rcv_u32;
172 }
173
174 $_OBJ{$objid}->set_window(\%args);
175
95 } else { 176 } else {
96 die "unknown command '$cmd' received"; 177 die "unknown command '$cmd' received";
97 } 178 }
98} 179}
99 180
100sub mainloop { 181sub mainloop {
101 handle_cmd while 1; 182 server_event while 1;
102} 183}
103 184
104sub _main { 185sub init {
105 $LIBDIR = shift @ARGV; 186 $interface = shift;
106 $IN_MOZILLA = 1; 187
107 (shift @ARGV) =~ /^(\d+),(\d+)$/ or die "init arg error";
108 my ($fd1, $fd2) = ($1, $2);
109 open FD1, "+<&=$fd1"; binmode FD1; 188 open FD, "+<&=$_[0]"; binmode FD;
110 open FD2, "+<&=$fd2"; binmode FD2;
111 189
112 mainloop; 190 $interface->mainloop;
113
114 close FD2;
115 close FD1;
116} 191}
117 192
118sub new { 193sub new {
194 my $class = shift;
195 my $self = bless { @_ }, $class;
196 $self->{save} = $self->{save} ne ""
197 ? Storable::thaw $self->{save}
198 : {};
119 warn "new: ".Dumper(\@_); 199 warn "new: ".Dumper($self);
200 $self;
120} 201}
121 202
122sub set_window { 203sub set_window {
204 my $self = shift;
205 my $new = shift;
206 print "window set calling with $new->{window}, $new->{w}, $new->{h} ($self->{window}\n";#d#
207 if ($self->{window}) {
208 if ($self->{window}{window} ne $new->{window}) {
209 $self->window_delete($self->{window});
210 } elsif ($self->{window}{w} != $new->{w}
211 or $self->{window}{h} != $new->{h}) {
212 $self->window_resize($new->{window}, $new->{w}, $new->{h});
213 }
214 $self->{window} = $new;
215 }
216
217 unless ($self->{window}) {
218 $self->{window} = $new;
219 print "window new calling with $new->{window}, $new->{w}, $new->{h}\n";#d#
220 $self->window_new($new->{window}, $new->{w}, $new->{h});
221 }
123 warn "set_window: ".Dumper(\@_); 222 warn "set_window: ".Dumper($self);
223}
224
225sub window_new {}
226sub window_resize {}
227
228sub window_delete {
229 my $self = shift;
230 delete $self->{window};
124} 231}
125 232
126sub save { 233sub save {
127 warn "save: ".Dumper(\@_); 234 my $self = shift;
128 "[save]"; 235 $self->set_window(undef);
236 Storable::nfreeze $self->{save};
129} 237}
130 238
131sub DESTROY { 239sub DESTROY {
132 warn "DESTROY"; 240 warn "DESTROY";
133} 241}

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines