… | |
… | |
15 | =cut |
15 | =cut |
16 | |
16 | |
17 | package Mozilla::Plugin; |
17 | package Mozilla::Plugin; |
18 | |
18 | |
19 | use base Exporter; |
19 | use base Exporter; |
|
|
20 | use Storable; |
20 | #use XSLoader; |
21 | #use XSLoader; |
21 | |
22 | |
22 | $VERSION = 0.12; |
23 | $VERSION = 0.01; |
23 | @EXPORT = qw(); |
24 | @EXPORT = qw(); |
24 | |
25 | |
25 | warn "in module [@ARGV]";#d# |
|
|
26 | |
|
|
27 | #XSLoader::load __PACKAGE__, $VERSION; |
26 | #XSLoader::load __PACKAGE__, $VERSION; |
28 | use Data::Dumper; |
27 | use Data::Dumper;#d# |
29 | |
28 | |
30 | my $data; |
29 | my $data; |
|
|
30 | |
|
|
31 | sub BIAS() { -2000000000 } # ugliest hack ever seen |
31 | |
32 | |
32 | sub snd_cmd($) { |
33 | sub snd_cmd($) { |
33 | $data = pack "NN", 0, ord($_[0]); |
34 | $data = pack "NN", 0, ord($_[0]); |
34 | } |
35 | } |
35 | |
36 | |
|
|
37 | sub snd_ptr($) { |
|
|
38 | $data .= $_[0]; |
|
|
39 | } |
|
|
40 | |
|
|
41 | sub snd_u32($) { |
|
|
42 | $data .= pack "N", $_[0]; |
|
|
43 | } |
|
|
44 | |
36 | sub snd_i32($) { |
45 | sub snd_i32($) { |
37 | $data .= pack "N", $_[0]; |
46 | $data .= pack "N", $_[0] - BIAS; |
38 | } |
47 | } |
39 | |
48 | |
40 | sub snd_blk($) { |
49 | sub snd_blk($) { |
41 | $data .= pack "NA*", length($_[0]), $_[0]; |
50 | $data .= pack "NA*", length($_[0]), $_[0]; |
42 | } |
51 | } |
43 | |
52 | |
44 | sub snd_snd($) { |
53 | sub snd_snd() { |
45 | substr ($data, 0, 4) = pack "N", length $data; |
54 | substr ($data, 0, 4) = pack "N", length $data; |
46 | length ($data) == syswrite $_[0], $data; |
55 | length ($data) == syswrite FD, $data; |
47 | } |
56 | } |
48 | |
57 | |
49 | sub snd_dyn { |
58 | sub snd_dyn($) { |
50 | length ($_[1]) == syswrite $_[0], $_[1]; |
59 | length ($_[0]) == syswrite FD, $_[0]; |
51 | } |
60 | } |
52 | |
61 | |
53 | sub rcv_cmd { |
62 | sub rcv_cmd() { |
54 | my $buf; |
63 | my $buf; |
55 | 4 == sysread $_[0], $buf, 4 or exit; |
64 | 4 == sysread FD, $buf, 4 or exit; |
56 | my $len = unpack "N", $buf; |
65 | my $len = unpack "N", $buf; |
57 | $len -= 4; |
66 | $len -= 4; |
58 | $len == sysread $_[0], $buf, $len or die; |
67 | $len == sysread FD, $buf, $len or die; |
59 | |
68 | |
60 | $data = substr $buf, 4; |
69 | $data = substr $buf, 4; |
61 | |
70 | |
62 | substr $buf, 3, 1; |
71 | substr $buf, 3, 1; |
63 | } |
72 | } |
64 | |
73 | |
|
|
74 | sub rcv_ptr() { |
|
|
75 | my $ptr = substr $data, 0, 8; |
|
|
76 | $data = substr $data, 8; |
|
|
77 | $ptr; |
|
|
78 | } |
|
|
79 | |
|
|
80 | sub rcv_u32() { |
|
|
81 | my $u32 = unpack "N", $data; |
|
|
82 | $data = substr $data, 4; |
|
|
83 | $u32; |
|
|
84 | } |
|
|
85 | |
65 | sub rcv_i32() { |
86 | sub rcv_i32() { |
66 | my $i32 = unpack "N", $data; |
87 | my $i32 = BIAS + unpack "N", $data; |
67 | $data = substr $data, 4; |
88 | $data = substr $data, 4; |
68 | $i32; |
89 | $i32; |
69 | } |
90 | } |
70 | |
91 | |
71 | sub rcv_blk() { |
92 | sub rcv_blk() { |
… | |
… | |
95 | plug-in is also not very viable, so in the future one might be able to |
116 | plug-in is also not very viable, so in the future one might be able to |
96 | specify a group on the embed statement (i.e. EMBED GROUP="gtk+"). |
117 | specify a group on the embed statement (i.e. EMBED GROUP="gtk+"). |
97 | |
118 | |
98 | =cut |
119 | =cut |
99 | |
120 | |
100 | sub server_fh() { $FD1 } |
121 | sub server_fh() { *FD } |
101 | |
122 | |
102 | sub server_event() { |
123 | sub server_event() { |
103 | my $cmd = rcv_cmd $FD1; |
124 | my $cmd = rcv_cmd; |
|
|
125 | |
|
|
126 | warn "cmd<$cmd>\n";#d# |
104 | |
127 | |
105 | if ($cmd eq "I") { |
128 | if ($cmd eq "I") { |
106 | rcv_i32 == 1 or die "protocol version mismatch\n"; |
129 | rcv_u32 == 1 or die "protocol version mismatch\n"; |
107 | ($IFACE, $OSNAME, $OSVERS) = (rcv_blk, rcv_blk, rcv_blk); |
130 | ($IFACE, $OSNAME, $OSVERS) = (rcv_blk, rcv_blk, rcv_blk); |
|
|
131 | |
108 | } elsif ($cmd eq "+") { |
132 | } elsif ($cmd eq "+") { |
109 | my ($objid, $type, $mode, $save, $argc) |
133 | my ($objid, $type, $mode, $save, $argc) |
110 | = (rcv_i32, rcv_blk, rcv_i32, rcv_blk, rcv_i32); |
134 | = (rcv_ptr, rcv_blk, rcv_u32, rcv_blk, rcv_u32); |
111 | my %args; |
135 | my %args; |
112 | while ($argc--) { |
136 | while ($argc--) { |
113 | my ($argn, $argv) = (rcv_blk, rcv_blk); |
137 | my ($argn, $argv) = (rcv_blk, rcv_blk); |
114 | $args{$argn} = $argv; |
138 | $args{$argn} = $argv; |
115 | } |
139 | } |
116 | |
140 | |
|
|
141 | warn "new obj $objid\n";#d# |
117 | $_OBJ{$objid} = new Mozilla::Plugin |
142 | $_OBJ{$objid} = new Mozilla::Plugin |
|
|
143 | objid => $objid, |
118 | type => $type, |
144 | type => $type, |
119 | mode => $mode, |
145 | mode => $mode, |
120 | save => $save, |
146 | save => $save, |
121 | args => \%args; |
147 | args => \%args; |
122 | |
148 | |
123 | } elsif ($cmd eq "-") { |
149 | } elsif ($cmd eq "-") { |
124 | my $objid = rcv_i32; |
150 | my $objid = rcv_ptr; |
|
|
151 | my $save = (delete $_OBJ{$objid})->save; |
125 | snd_cmd "-"; |
152 | snd_cmd "-"; |
126 | my $save = (delete $_OBJ{$objid})->save; |
|
|
127 | snd_i32 length $save; |
153 | snd_u32 length $save; |
128 | snd_dyn $FD1, $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 | warn Dumper([$objid,\%args]); |
|
|
171 | |
|
|
172 | $_OBJ{$objid}->set_window(\%args); |
|
|
173 | |
129 | } else { |
174 | } else { |
130 | die "unknown command '$cmd' received"; |
175 | die "unknown command '$cmd' received"; |
131 | } |
176 | } |
132 | } |
177 | } |
133 | |
178 | |
134 | sub mainloop { |
179 | sub mainloop { |
135 | server_event while 1; |
180 | server_event while 1; |
136 | } |
181 | } |
137 | |
182 | |
138 | sub _main { |
183 | sub init { |
139 | $LIBDIR = shift @ARGV; |
|
|
140 | $IN_MOZILLA = 1; |
184 | $IN_MOZILLA = 1; |
141 | (shift @ARGV) =~ /^(\d+),(\d+)$/ or die "init arg error"; |
185 | |
142 | my ($fd1, $fd2) = ($1, $2); |
|
|
143 | open $FD1, "+<&=$fd1"; binmode $FD1; |
186 | open FD, "+<&=$_[1]"; binmode $FD; |
144 | open $FD2, "+<&=$fd2"; binmode $FD2; |
|
|
145 | |
187 | |
|
|
188 | warn "init: ".Dumper(@_); |
146 | mainloop; |
189 | mainloop; |
147 | } |
190 | } |
148 | |
191 | |
149 | sub new { |
192 | sub new { |
150 | my $class = shift; |
193 | my $class = shift; |
151 | bless { @_ }, $class; |
194 | my $self = bless { @_ }, $class; |
|
|
195 | $self->{save} = $self->{save} ne "" |
|
|
196 | ? Storable::thaw $self->{save} |
|
|
197 | : {}; |
|
|
198 | warn "new: ".Dumper($self); |
|
|
199 | $self; |
152 | } |
200 | } |
153 | |
201 | |
154 | sub set_window { |
202 | sub set_window { |
|
|
203 | my $self = shift; |
|
|
204 | my $new = shift; |
|
|
205 | if ($self->{window}) { |
|
|
206 | if ($self->{window}{window} ne $new->{window}) { |
|
|
207 | $self->window_delete($self->{window}); |
|
|
208 | } else { |
|
|
209 | $self->window_resize($new->{window}, $new->{w}, $new->{h}); |
|
|
210 | } |
|
|
211 | $self->{window} = $new; |
|
|
212 | } else { |
|
|
213 | $self->{window} = $new; |
|
|
214 | $self->window_new($new->{window}, $new->{w}, $new->{h}); |
|
|
215 | } |
155 | warn "set_window: ".Dumper(\@_); |
216 | warn "set_window: ".Dumper($self); |
156 | } |
217 | } |
|
|
218 | |
|
|
219 | sub window_new {} |
|
|
220 | sub window_resize {} |
|
|
221 | sub window_delete {} |
157 | |
222 | |
158 | sub save { |
223 | sub save { |
159 | warn "save: ".Dumper(\@_); |
224 | $_[0]->{save}{test} = ['t1',5,7]; |
160 | "[save]"; |
225 | Storable::nfreeze $_[0]->{save}; |
161 | } |
226 | } |
162 | |
227 | |
163 | sub DESTROY { |
228 | sub DESTROY { |
164 | warn "DESTROY"; |
229 | warn "DESTROY"; |
165 | } |
230 | } |