cvsroot/Mozilla-Plugin/Plugin.pm

=head1 NAME

Mozilla::Plugin - embed perl into mozilla/netscape.

=head1 SYNOPSIS

 use Mozilla::Plugin;

=head1 DESCRIPTION

sorry...

=over 4

=cut

package Mozilla::Plugin;

use base Exporter;
use Storable;
#use XSLoader;

$VERSION = 0.01;
@EXPORT = qw();

#XSLoader::load __PACKAGE__, $VERSION;

my $interface; # Mozilla::Plugin::xxx (design weakness)

sub NP_VERSION_MAJOR (){ 0 }
sub NP_VERSION_MINOR (){ 9 }
sub NP_EMBED (){ 1 }
sub NP_FULL (){ 2 }
sub NP_NORMAL (){ 1 }
sub NP_SEEK (){ 2 }
sub NP_ASFILE (){ 3 }
sub NP_ASFILEONLY (){ 4 }
sub NP_MAXREADY (){ 2147483647 }
sub NPERR_NO_ERROR (){ 0 }
sub NPERR_GENERIC_ERROR (){ 1 }
sub NPERR_INVALID_INSTANCE_ERROR (){ 2 }
sub NPERR_INVALID_FUNCTABLE_ERROR (){ 3 }
sub NPERR_MODULE_LOAD_FAILED_ERROR (){ 4 }
sub NPERR_OUT_OF_MEMORY_ERROR (){ 5 }
sub NPERR_INVALID_PLUGIN_ERROR (){ 6 }
sub NPERR_INVALID_PLUGIN_DIR_ERROR (){ 7 }
sub NPERR_INCOMPATIBLE_VERSION_ERROR (){ 8 }
sub NPERR_INVALID_PARAM (){ 9 }
sub NPERR_INVALID_URL (){ 10 }
sub NPERR_FILE_NOT_FOUND (){ 11 }
sub NPERR_NO_DATA (){ 12 }
sub NPERR_STREAM_NOT_SEEKABLE (){ 13 }
sub NPVERS_HAS_STREAMOUTPUT (){ 8 }
sub NPVERS_HAS_NOTIFICATION (){ 9 }
sub NPVERS_HAS_LIVECONNECT (){ 9 }
sub NPVERS_WIN16_HAS_LIVECONNECT (){ 10 }

my $data;

sub BIAS() { -2147483647 } # ugliest hack ever seen

sub snd_cmd {
   $data = pack "NN", 0, ord($_[-1]);
}

sub snd_ptr {
   $data .= $_[-1];
}

sub snd_u32 {
   $data .= pack "N", $_[-1];
}

sub snd_i32 {
   $data .= pack "N", $_[-1] - BIAS;
}

sub snd_blk {
   $data .= pack "NA*", length($_[-1]), $_[-1];
}

sub snd_snd {
   substr ($data, 0, 4) = pack "N", length $data;
   length ($data) == syswrite FD, $data;
}

sub snd_dyn {
   length ($_[-1]) == syswrite FD, $_[-1];
}

sub rcv_cmd {
   my $buf;
   4 == sysread FD, $buf, 4 or exit;
   my $len = unpack "N", $buf;
   $len -= 4;
   $len == sysread FD, $buf, $len or die;

   $data = substr $buf, 4;

   substr $buf, 3, 1;
}

sub rcv_ptr {
   my $ptr = substr $data, 0, 8;
   $data = substr $data, 8;
   printf "RCV_PTR(%s)\n", unpack "H*", $ptr;
   $ptr;
}

sub rcv_u32 {
   my $u32 = unpack "N", $data;
   $data = substr $data, 4;
   $u32;
}

sub rcv_i32 {
   my $i32 = BIAS + unpack "N", $data;
   $data = substr $data, 4;
   $i32;
}

sub rcv_blk {
   my $len = unpack "N", $data;
   my $str = substr $data, 4, $len;
   $data = substr $data, 4 + $len;
   $str;
}

sub rcv_dyn {
   my $buf;
   $_[-1] == sysread FD, $buf, $_[-1] or die "rcv_dyn: $!";
   $buf;
}

=item my $fh = server_fh

The design of this module is event-based. When the plug-in starts (there
is always just one interpreter) it spawns one perl interpreter which
will immediately go into a even loop. If you want to use your own event
loop (e.g. using the Gtk or Event modules) you need to register a file
input handler on the filehandle returned by C<server_fh> that calls
C<server_event> whenever there is input pending on C<server_fh>. This will
ensure proper operation of the plug-in.

=item server_event

Call this function whenever there is data available on the C<server_fh>. This function
might not return.

Due to this design (flaw?), sharing of different toolkits using this
plug-in is difficult at best. Spawning a new perl interpreter for every
plug-in is also not very viable, so in the future one might be able to
specify a group on the embed statement (i.e. EMBED GROUP="gtk+").

=cut

sub server_fh() { \*FD }

sub server_event() {
   my $cmd = rcv_cmd;

   warn "cmd<$cmd>\n";#d#

   if ($cmd eq "I") {
      rcv_u32 == 1 or die "protocol version mismatch\n";
      ($IFACE, $OSNAME, $OSVERS) = (rcv_blk, rcv_blk, rcv_blk);

   } elsif ($cmd eq "+") { # New
      my ($objid, $type, $mode, $save, $argc)
         = (rcv_ptr, rcv_blk, rcv_u32, rcv_blk, rcv_u32);
      my %args;
      while ($argc--) {
         my ($argn, $argv) = (rcv_blk, rcv_blk);
         $args{$argn} = $argv;
      }

      $_OBJ{$objid} = $interface->new(
         instance => $objid,
         type     => $type,
         mode     => $mode,
         save     => $save,
         args     => \%args,
      );

   } elsif ($cmd eq "-") { # Destroy
      my $objid = rcv_ptr;
      my $save = (delete $_OBJ{$objid})->save;
      snd_cmd "-";
      snd_u32 length $save;
      snd_snd and snd_dyn $save;

   } elsif ($cmd eq "X") { # SetWindow
      my $objid = rcv_ptr;
      my %args = (
            id => rcv_ptr,
            x  => rcv_i32,
            y  => rcv_i32,
            w  => rcv_i32,
            h  => rcv_i32,
      );
      if ($IFACE eq "UNIX") {
         $args{id} = unpack "xxxxN", $args{id};
         $args{ws_type}  = rcv_i32;
         $args{ws_depth} = rcv_u32;
      }

      snd_cmd 'X';
      snd_u32 $_OBJ{$objid}->set_window(\%args);
      snd_snd;

   } elsif ($cmd eq "N") { # NewStream
      my $obj = $_OBJ{+rcv_ptr};
      my %args = (
            instance     => $obj,
            mimetype     => rcv_blk,
            id           => rcv_ptr,
            url          => rcv_blk,
            end          => rcv_u32,
            lastmodified => rcv_u32,
            notifydata   => rcv_u32,
            seekable     => rcv_u32,
            push_stream  => 1,
      );
      my $str = $_OBJ{$args{id}} = new Mozilla::Stream \%args;

      my ($stype, $err) = $obj->push_stream($str);

      snd_cmd 'N';
      snd_u32 $err;
      snd_u32 $stype || NP_NORMAL;
      snd_snd;

   } elsif ($cmd eq "/") { # StreamAsFile
      my $obj = $_OBJ{+rcv_ptr};
      my $str = $_OBJ{+rcv_ptr};
      my $path = rcv_blk;

      $obj->stream_as_file($obj, $stream, $path);

   } elsif ($cmd eq "R") { # WriteReady
      my $obj = $_OBJ{+rcv_ptr};
      my $str = $_OBJ{+rcv_ptr};

      snd_cmd 'R';
      snd_u32 $obj->write_ready($obj, $str);
      snd_snd;

   } elsif ($cmd eq "W") { # Write
      my $obj = $_OBJ{+rcv_ptr};
      my $str = $_OBJ{+rcv_ptr};
      my $ofs = rcv_i32;
      my $len = rcv_i32;
      my $dta = rcv_dyn $len;

      snd_cmd 'W';
      snd_i32 $obj->write($str, $ofs, $len, $dta);
      snd_snd;

   } elsif ($cmd eq "D") { # DestroyStream
      my $obj = $_OBJ{+rcv_ptr};
      my $str = delete $_OBJ{+rcv_ptr};
      my $why = rcv_u32;

      $obj->destroy_stream($obj, $str, $why);

   } else {
      die "unknown command '$cmd' received";
   }
}

sub mainloop {
   server_event while 1;
}

sub init {
   $interface = shift;

   open FD, "+<&=$_[0]"; binmode FD;

   $interface->mainloop;
}

sub new {
   my $class = shift;
   my $self = bless { @_ }, $class;
   $self->{save} = $self->{save} ne ""
                   ? Storable::thaw $self->{save}
                   : {};
   $self;
}

sub set_window {
   my $self = shift;
   my $new = shift;

   if ($self->{wininfo}) {
      if ($self->{wininfo}{id} ne $new->{id}) {
         $self->window_delete($self->{wininfo});
      } elsif ($self->{wininfo}{w} != $new->{w}
               or $self->{wininfo}{h} != $new->{h}) {
         $self->window_resize($new->{id}, $new->{w}, $new->{h});
      }
      $self->{wininfo} = $new;
   }

   unless ($self->{wininfo}) {
      $self->{window} = $self->window_new($new) and $self->{wininfo} = $new;
   }

   ();
}

sub window_new    {}
sub window_resize {}

sub window_delete {
   my $self = shift;
   delete $self->{wininfo};
   delete $self->{window};
}

sub save {
   my $self = shift;
   $self->set_window(undef);
   $self->{destroy};
   Storable::nfreeze $self->{save};
}

sub destroy     {}
sub DESTROY     {}
sub write_ready { 0xfffff }
sub push_stream {}
sub stream_as_file {}
sub destroy_stream {}

sub write {
   my ($self) = shift;
   shift->write(@_);
}

package Mozilla::Stream;

sub new {
   bless $_[1], $_[0];
}

sub write {
   # ...
}

sub DESTROY {
   my $str = $_[0];
   warn "DESTROY stream";

   my $obj = $str->{instance};
   $obj->snd_cmd('d');
   $obj->snd_ptr($obj);
   $obj->snd_ptr($str);
   $obj->snd_snd;
}

1;

=back

=head1 BUGS

=head1 SEE ALSO

L<PApp>.

=head1 AUTHOR

 Marc Lehmann <pcg@goof.com>
 http://www.goof.com/pcg/marc/

=cut

Revision:	1.9
Committed:	Sun Mar 4 12:49:19 2001 UTC (23 years, 4 months ago) by root
Branch:	MAIN
Changes since 1.8:	+71 -44 lines
Log Message:	* empty log message *
#	User	Rev	Content
1	root	1.1	=head1 NAME
2
3			Mozilla::Plugin - embed perl into mozilla/netscape.
4
5			=head1 SYNOPSIS
6
7			use Mozilla::Plugin;
8
9			=head1 DESCRIPTION
10
11	root	1.2	sorry...
12
13	root	1.1	=over 4
14
15			=cut
16
17			package Mozilla::Plugin;
18
19			use base Exporter;
20	root	1.3	use Storable;
21	root	1.1	#use XSLoader;
22
23	root	1.3	$VERSION = 0.01;
24	root	1.1	@EXPORT = qw();
25
26			#XSLoader::load __PACKAGE__, $VERSION;
27
28	root	1.6	my $interface; # Mozilla::Plugin::xxx (design weakness)
29
30	root	1.8	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 }
57
58	root	1.1	my $data;
59
60	root	1.8	sub BIAS() { -2147483647 } # ugliest hack ever seen
61	root	1.3
62	root	1.9	sub snd_cmd {
63			$data = pack "NN", 0, ord($_[-1]);
64	root	1.1	}
65
66	root	1.9	sub snd_ptr {
67			$data .= $_[-1];
68	root	1.3	}
69
70	root	1.9	sub snd_u32 {
71			$data .= pack "N", $_[-1];
72	root	1.3	}
73
74	root	1.9	sub snd_i32 {
75			$data .= pack "N", $_[-1] - BIAS;
76	root	1.1	}
77
78	root	1.9	sub snd_blk {
79			$data .= pack "NA*", length($_[-1]), $_[-1];
80	root	1.1	}
81
82	root	1.9	sub snd_snd {
83	root	1.1	substr ($data, 0, 4) = pack "N", length $data;
84	root	1.3	length ($data) == syswrite FD, $data;
85	root	1.2	}
86
87	root	1.9	sub snd_dyn {
88			length ($_[-1]) == syswrite FD, $_[-1];
89	root	1.1	}
90
91	root	1.9	sub rcv_cmd {
92	root	1.1	my $buf;
93	root	1.3	4 == sysread FD, $buf, 4 or exit;
94	root	1.1	my $len = unpack "N", $buf;
95			$len -= 4;
96	root	1.3	$len == sysread FD, $buf, $len or die;
97	root	1.1
98			$data = substr $buf, 4;
99
100			substr $buf, 3, 1;
101			}
102
103	root	1.9	sub rcv_ptr {
104	root	1.3	my $ptr = substr $data, 0, 8;
105			$data = substr $data, 8;
106	root	1.9	printf "RCV_PTR(%s)\n", unpack "H*", $ptr;
107	root	1.3	$ptr;
108			}
109
110	root	1.9	sub rcv_u32 {
111	root	1.3	my $u32 = unpack "N", $data;
112			$data = substr $data, 4;
113			$u32;
114			}
115
116	root	1.9	sub rcv_i32 {
117	root	1.3	my $i32 = BIAS + unpack "N", $data;
118	root	1.1	$data = substr $data, 4;
119			$i32;
120			}
121
122	root	1.9	sub rcv_blk {
123	root	1.1	my $len = unpack "N", $data;
124			my $str = substr $data, 4, $len;
125			$data = substr $data, 4 + $len;
126			$str;
127			}
128
129	root	1.9	sub rcv_dyn {
130			my $buf;
131			$_[-1] == sysread FD, $buf, $_[-1] or die "rcv_dyn: $!";
132			$buf;
133			}
134
135	root	1.2	=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	root	1.6	sub server_fh() { \*FD }
158	root	1.2
159			sub server_event() {
160	root	1.3	my $cmd = rcv_cmd;
161
162			warn "cmd<$cmd>\n";#d#
163	root	1.1
164			if ($cmd eq "I") {
165	root	1.3	rcv_u32 == 1 or die "protocol version mismatch\n";
166	root	1.1	($IFACE, $OSNAME, $OSVERS) = (rcv_blk, rcv_blk, rcv_blk);
167	root	1.3
168	root	1.8	} elsif ($cmd eq "+") { # New
169	root	1.1	my ($objid, $type, $mode, $save, $argc)
170	root	1.3	= (rcv_ptr, rcv_blk, rcv_u32, rcv_blk, rcv_u32);
171	root	1.1	my %args;
172	root	1.2	while ($argc--) {
173			my ($argn, $argv) = (rcv_blk, rcv_blk);
174			$args{$argn} = $argv;
175			}
176	root	1.1
177	root	1.6	$_OBJ{$objid} = $interface->new(
178	root	1.9	instance => $objid,
179			type => $type,
180			mode => $mode,
181			save => $save,
182			args => \%args,
183	root	1.6	);
184	root	1.1
185	root	1.8	} elsif ($cmd eq "-") { # Destroy
186	root	1.3	my $objid = rcv_ptr;
187			my $save = (delete $_OBJ{$objid})->save;
188	root	1.2	snd_cmd "-";
189	root	1.3	snd_u32 length $save;
190			snd_snd and snd_dyn $save;
191
192	root	1.8	} elsif ($cmd eq "X") { # SetWindow
193	root	1.3	my $objid = rcv_ptr;
194			my %args = (
195	root	1.9	id => rcv_ptr,
196			x => rcv_i32,
197			y => rcv_i32,
198			w => rcv_i32,
199			h => rcv_i32,
200	root	1.3	);
201			if ($IFACE eq "UNIX") {
202	root	1.9	$args{id} = unpack "xxxxN", $args{id};
203	root	1.3	$args{ws_type} = rcv_i32;
204			$args{ws_depth} = rcv_u32;
205			}
206
207	root	1.8	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	root	1.9	instance => $obj,
215	root	1.8	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	root	1.9	push_stream => 1,
223	root	1.8	);
224			my $str = $_OBJ{$args{id}} = new Mozilla::Stream \%args;
225
226			my ($stype, $err) = $obj->push_stream($str);
227
228	root	1.9	snd_cmd 'N';
229	root	1.8	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	root	1.3
266	root	1.1	} else {
267			die "unknown command '$cmd' received";
268			}
269			}
270
271			sub mainloop {
272	root	1.2	server_event while 1;
273	root	1.1	}
274
275	root	1.3	sub init {
276	root	1.6	$interface = shift;
277	root	1.5
278	root	1.6	open FD, "+<&=$_[0]"; binmode FD;
279	root	1.1
280	root	1.6	$interface->mainloop;
281	root	1.1	}
282
283			sub new {
284	root	1.2	my $class = shift;
285	root	1.3	my $self = bless { @_ }, $class;
286			$self->{save} = $self->{save} ne ""
287			? Storable::thaw $self->{save}
288			: {};
289			$self;
290	root	1.1	}
291
292			sub set_window {
293	root	1.3	my $self = shift;
294			my $new = shift;
295	root	1.9
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	root	1.3	}
303	root	1.9	$self->{wininfo} = $new;
304	root	1.6	}
305
306	root	1.9	unless ($self->{wininfo}) {
307			$self->{window} = $self->window_new($new) and $self->{wininfo} = $new;
308	root	1.3	}
309	root	1.8
310			();
311	root	1.1	}
312
313	root	1.3	sub window_new {}
314			sub window_resize {}
315	root	1.6
316			sub window_delete {
317			my $self = shift;
318	root	1.9	delete $self->{wininfo};
319	root	1.6	delete $self->{window};
320			}
321	root	1.3
322	root	1.1	sub save {
323	root	1.6	my $self = shift;
324			$self->set_window(undef);
325	root	1.8	$self->{destroy};
326	root	1.6	Storable::nfreeze $self->{save};
327	root	1.1	}
328
329	root	1.8	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	root	1.9	}
340
341			package Mozilla::Stream;
342
343			sub new {
344			bless $_[1], $_[0];
345			}
346
347			sub write {
348			# ...
349			}
350
351			sub DESTROY {
352			my $str = $_[0];
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;
360	root	1.1	}
361
362			1;
363
364			=back
365
366			=head1 BUGS
367
368			=head1 SEE ALSO
369
370			L<PApp>.
371
372			=head1 AUTHOR
373
374			Marc Lehmann <pcg@goof.com>
375			http://www.goof.com/pcg/marc/
376
377			=cut
378