… | |
… | |
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 | use Data::Dumper;#d# |
|
|
28 | |
|
|
29 | my $interface; # Mozilla::Plugin::xxx (design weakness) |
27 | |
30 | |
28 | my $data; |
31 | my $data; |
|
|
32 | |
|
|
33 | sub BIAS() { -2000000000 } # ugliest hack ever seen |
29 | |
34 | |
30 | sub snd_cmd($) { |
35 | sub snd_cmd($) { |
31 | $data = pack "NN", 0, ord($_[0]); |
36 | $data = pack "NN", 0, ord($_[0]); |
32 | } |
37 | } |
33 | |
38 | |
|
|
39 | sub snd_ptr($) { |
|
|
40 | $data .= $_[0]; |
|
|
41 | } |
|
|
42 | |
|
|
43 | sub snd_u32($) { |
|
|
44 | $data .= pack "N", $_[0]; |
|
|
45 | } |
|
|
46 | |
34 | sub snd_i32($) { |
47 | sub snd_i32($) { |
35 | $data .= pack "N", $_[0]; |
48 | $data .= pack "N", $_[0] - BIAS; |
36 | } |
49 | } |
37 | |
50 | |
38 | sub snd_blk($) { |
51 | sub snd_blk($) { |
39 | $data .= pack "NA*", length($_[0]), $_[0]; |
52 | $data .= pack "NA*", length($_[0]), $_[0]; |
40 | } |
53 | } |
41 | |
54 | |
42 | sub snd_snd($) { |
55 | sub 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 | |
|
|
60 | sub snd_dyn($) { |
|
|
61 | length ($_[0]) == syswrite FD, $_[0]; |
|
|
62 | } |
|
|
63 | |
47 | sub rcv_cmd { |
64 | sub 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 | |
|
|
76 | sub rcv_ptr() { |
|
|
77 | my $ptr = substr $data, 0, 8; |
|
|
78 | $data = substr $data, 8; |
|
|
79 | $ptr; |
|
|
80 | } |
|
|
81 | |
|
|
82 | sub rcv_u32() { |
|
|
83 | my $u32 = unpack "N", $data; |
|
|
84 | $data = substr $data, 4; |
|
|
85 | $u32; |
|
|
86 | } |
|
|
87 | |
59 | sub rcv_i32() { |
88 | sub 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 | |
65 | sub rcv_blk() { |
94 | sub 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 | |
72 | sub handle_cmd { |
101 | =item my $fh = server_fh |
|
|
102 | |
|
|
103 | The design of this module is event-based. When the plug-in starts (there |
|
|
104 | is always just one interpreter) it spawns one perl interpreter which |
|
|
105 | will immediately go into a even loop. If you want to use your own event |
|
|
106 | loop (e.g. using the Gtk or Event modules) you need to register a file |
|
|
107 | input handler on the filehandle returned by C<server_fh> that calls |
|
|
108 | C<server_event> whenever there is input pending on C<server_fh>. This will |
|
|
109 | ensure proper operation of the plug-in. |
|
|
110 | |
|
|
111 | =item server_event |
|
|
112 | |
|
|
113 | Call this function whenever there is data available on the C<server_fh>. This function |
|
|
114 | might not return. |
|
|
115 | |
|
|
116 | Due to this design (flaw?), sharing of different toolkits using this |
|
|
117 | plug-in is difficult at best. Spawning a new perl interpreter for every |
|
|
118 | plug-in is also not very viable, so in the future one might be able to |
|
|
119 | specify a group on the embed statement (i.e. EMBED GROUP="gtk+"). |
|
|
120 | |
|
|
121 | =cut |
|
|
122 | |
|
|
123 | sub server_fh() { \*FD } |
|
|
124 | |
|
|
125 | sub 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 | |
100 | sub mainloop { |
181 | sub mainloop { |
101 | handle_cmd while 1; |
182 | server_event while 1; |
102 | } |
183 | } |
103 | |
184 | |
104 | sub _main { |
185 | sub 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 | |
118 | sub new { |
193 | sub 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 | |
122 | sub set_window { |
203 | sub 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 | |
|
|
225 | sub window_new {} |
|
|
226 | sub window_resize {} |
|
|
227 | |
|
|
228 | sub window_delete { |
|
|
229 | my $self = shift; |
|
|
230 | delete $self->{window}; |
124 | } |
231 | } |
125 | |
232 | |
126 | sub save { |
233 | sub 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 | |
131 | sub DESTROY { |
239 | sub DESTROY { |
132 | warn "DESTROY"; |
240 | warn "DESTROY"; |
133 | } |
241 | } |