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;
use Data::Dumper;#d#

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($_[0]);
}

sub snd_ptr($) {
   $data .= $_[0];
}

sub snd_u32($) {
   $data .= pack "N", $_[0];
}

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

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

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

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

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;
   $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;
}

=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(
         objid => $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 = (
            window => rcv_ptr,
            x      => rcv_i32,
            y      => rcv_i32,
            w      => rcv_i32,
            h      => rcv_i32,
      );
      if ($IFACE eq "UNIX") {
         $args{window}   = unpack "xxxxN", $args{window};
         $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 = (
            obj          => $obj,
            mimetype     => rcv_blk,
            id           => rcv_ptr,
            url          => rcv_blk,
            end          => rcv_u32,
            lastmodified => rcv_u32,
            notifydata   => rcv_u32,
            seekable     => rcv_u32,
      );
      my $str = $_OBJ{$args{id}} = new Mozilla::Stream \%args;

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

      snd_cmd 'W';
      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;
      print "window set calling with $new->{window}, $new->{w}, $new->{h} ($self->{window}\n";#d#
   if ($self->{window}) {
      if ($self->{window}{window} ne $new->{window}) {
         $self->window_delete($self->{window});
      } elsif ($self->{window}{w} != $new->{w}
               or $self->{window}{h} != $new->{h}) {
         $self->window_resize($new->{window}, $new->{w}, $new->{h});
      }
      $self->{window} = $new;
   }

   unless ($self->{window}) {
      $self->{window} = $new;
      print "window new calling with $new->{window}, $new->{w}, $new->{h}\n";#d#
      $self->window_new($new->{window}, $new->{w}, $new->{h});
   }

   ();
}

sub window_new    {}
sub window_resize {}

sub window_delete {
   my $self = shift;
   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(@_);
}

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.8
Committed:	Sun Feb 25 23:31:25 2001 UTC (25 years, 7 months ago) by root
Branch:	MAIN
Changes since 1.7:	+102 -7 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	root	1.3	use Data::Dumper;#d#
28	root	1.1
29	root	1.6	my $interface; # Mozilla::Plugin::xxx (design weakness)
30
31	root	1.8	sub NP_VERSION_MAJOR (){ 0 }
32			sub NP_VERSION_MINOR (){ 9 }
33			sub NP_EMBED (){ 1 }
34			sub NP_FULL (){ 2 }
35			sub NP_NORMAL (){ 1 }
36			sub NP_SEEK (){ 2 }
37			sub NP_ASFILE (){ 3 }
38			sub NP_ASFILEONLY (){ 4 }
39			sub NP_MAXREADY (){ 2147483647 }
40			sub NPERR_NO_ERROR (){ 0 }
41			sub NPERR_GENERIC_ERROR (){ 1 }
42			sub NPERR_INVALID_INSTANCE_ERROR (){ 2 }
43			sub NPERR_INVALID_FUNCTABLE_ERROR (){ 3 }
44			sub NPERR_MODULE_LOAD_FAILED_ERROR (){ 4 }
45			sub NPERR_OUT_OF_MEMORY_ERROR (){ 5 }
46			sub NPERR_INVALID_PLUGIN_ERROR (){ 6 }
47			sub NPERR_INVALID_PLUGIN_DIR_ERROR (){ 7 }
48			sub NPERR_INCOMPATIBLE_VERSION_ERROR (){ 8 }
49			sub NPERR_INVALID_PARAM (){ 9 }
50			sub NPERR_INVALID_URL (){ 10 }
51			sub NPERR_FILE_NOT_FOUND (){ 11 }
52			sub NPERR_NO_DATA (){ 12 }
53			sub NPERR_STREAM_NOT_SEEKABLE (){ 13 }
54			sub NPVERS_HAS_STREAMOUTPUT (){ 8 }
55			sub NPVERS_HAS_NOTIFICATION (){ 9 }
56			sub NPVERS_HAS_LIVECONNECT (){ 9 }
57			sub NPVERS_WIN16_HAS_LIVECONNECT (){ 10 }
58
59	root	1.1	my $data;
60
61	root	1.8	sub BIAS() { -2147483647 } # ugliest hack ever seen
62	root	1.3
63	root	1.1	sub snd_cmd($) {
64			$data = pack "NN", 0, ord($_[0]);
65			}
66
67	root	1.3	sub snd_ptr($) {
68			$data .= $_[0];
69			}
70
71			sub snd_u32($) {
72			$data .= pack "N", $_[0];
73			}
74
75	root	1.1	sub snd_i32($) {
76	root	1.3	$data .= pack "N", $_[0] - BIAS;
77	root	1.1	}
78
79			sub snd_blk($) {
80			$data .= pack "NA*", length($_[0]), $_[0];
81			}
82
83	root	1.3	sub snd_snd() {
84	root	1.1	substr ($data, 0, 4) = pack "N", length $data;
85	root	1.3	length ($data) == syswrite FD, $data;
86	root	1.2	}
87
88	root	1.3	sub snd_dyn($) {
89			length ($_[0]) == syswrite FD, $_[0];
90	root	1.1	}
91
92	root	1.3	sub rcv_cmd() {
93	root	1.1	my $buf;
94	root	1.3	4 == sysread FD, $buf, 4 or exit;
95	root	1.1	my $len = unpack "N", $buf;
96			$len -= 4;
97	root	1.3	$len == sysread FD, $buf, $len or die;
98	root	1.1
99			$data = substr $buf, 4;
100
101			substr $buf, 3, 1;
102			}
103
104	root	1.3	sub rcv_ptr() {
105			my $ptr = substr $data, 0, 8;
106			$data = substr $data, 8;
107			$ptr;
108			}
109
110			sub rcv_u32() {
111			my $u32 = unpack "N", $data;
112			$data = substr $data, 4;
113			$u32;
114			}
115
116	root	1.1	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			sub rcv_blk() {
123			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.2	=item my $fh = server_fh
130
131			The design of this module is event-based. When the plug-in starts (there
132			is always just one interpreter) it spawns one perl interpreter which
133			will immediately go into a even loop. If you want to use your own event
134			loop (e.g. using the Gtk or Event modules) you need to register a file
135			input handler on the filehandle returned by C<server_fh> that calls
136			C<server_event> whenever there is input pending on C<server_fh>. This will
137			ensure proper operation of the plug-in.
138
139			=item server_event
140
141			Call this function whenever there is data available on the C<server_fh>. This function
142			might not return.
143
144			Due to this design (flaw?), sharing of different toolkits using this
145			plug-in is difficult at best. Spawning a new perl interpreter for every
146			plug-in is also not very viable, so in the future one might be able to
147			specify a group on the embed statement (i.e. EMBED GROUP="gtk+").
148
149			=cut
150
151	root	1.6	sub server_fh() { \*FD }
152	root	1.2
153			sub server_event() {
154	root	1.3	my $cmd = rcv_cmd;
155
156			warn "cmd<$cmd>\n";#d#
157	root	1.1
158			if ($cmd eq "I") {
159	root	1.3	rcv_u32 == 1 or die "protocol version mismatch\n";
160	root	1.1	($IFACE, $OSNAME, $OSVERS) = (rcv_blk, rcv_blk, rcv_blk);
161	root	1.3
162	root	1.8	} elsif ($cmd eq "+") { # New
163	root	1.1	my ($objid, $type, $mode, $save, $argc)
164	root	1.3	= (rcv_ptr, rcv_blk, rcv_u32, rcv_blk, rcv_u32);
165	root	1.1	my %args;
166	root	1.2	while ($argc--) {
167			my ($argn, $argv) = (rcv_blk, rcv_blk);
168			$args{$argn} = $argv;
169			}
170	root	1.1
171	root	1.6	$_OBJ{$objid} = $interface->new(
172	root	1.3	objid => $objid,
173			type => $type,
174			mode => $mode,
175			save => $save,
176	root	1.6	args => \%args,
177			);
178	root	1.1
179	root	1.8	} elsif ($cmd eq "-") { # Destroy
180	root	1.3	my $objid = rcv_ptr;
181			my $save = (delete $_OBJ{$objid})->save;
182	root	1.2	snd_cmd "-";
183	root	1.3	snd_u32 length $save;
184			snd_snd and snd_dyn $save;
185
186	root	1.8	} elsif ($cmd eq "X") { # SetWindow
187	root	1.3	my $objid = rcv_ptr;
188			my %args = (
189			window => rcv_ptr,
190			x => rcv_i32,
191			y => rcv_i32,
192			w => rcv_i32,
193			h => rcv_i32,
194			);
195			if ($IFACE eq "UNIX") {
196			$args{window} = unpack "xxxxN", $args{window};
197			$args{ws_type} = rcv_i32;
198			$args{ws_depth} = rcv_u32;
199			}
200
201	root	1.8	snd_cmd 'X';
202			snd_u32 $_OBJ{$objid}->set_window(\%args);
203			snd_snd;
204
205			} elsif ($cmd eq "N") { # NewStream
206			my $obj = $_OBJ{+rcv_ptr};
207			my %args = (
208			obj => $obj,
209			mimetype => rcv_blk,
210			id => rcv_ptr,
211			url => rcv_blk,
212			end => rcv_u32,
213			lastmodified => rcv_u32,
214			notifydata => rcv_u32,
215			seekable => rcv_u32,
216			);
217			my $str = $_OBJ{$args{id}} = new Mozilla::Stream \%args;
218
219			my ($stype, $err) = $obj->push_stream($str);
220
221			snd_cmd 'W';
222			snd_u32 $err;
223			snd_u32 $stype \|\| NP_NORMAL;
224			snd_snd;
225
226			} elsif ($cmd eq "/") { # StreamAsFile
227			my $obj = $_OBJ{+rcv_ptr};
228			my $str = $_OBJ{+rcv_ptr};
229			my $path = rcv_blk;
230
231			$obj->stream_as_file($obj, $stream, $path);
232
233			} elsif ($cmd eq "R") { # WriteReady
234			my $obj = $_OBJ{+rcv_ptr};
235			my $str = $_OBJ{+rcv_ptr};
236
237			snd_cmd 'R';
238			snd_u32 $obj->write_ready($obj, $str);
239			snd_snd;
240
241			} elsif ($cmd eq "W") { # Write
242			my $obj = $_OBJ{+rcv_ptr};
243			my $str = $_OBJ{+rcv_ptr};
244			my $ofs = rcv_i32;
245			my $len = rcv_i32;
246			my $dta = rcv_dyn $len;
247
248			snd_cmd 'W';
249			snd_i32 $obj->write($str, $ofs, $len, $dta);
250			snd_snd;
251
252			} elsif ($cmd eq "D") { # DestroyStream
253			my $obj = $_OBJ{+rcv_ptr};
254			my $str = delete $_OBJ{+rcv_ptr};
255			my $why = rcv_u32;
256
257			$obj->destroy_stream($obj, $str, $why);
258	root	1.3
259	root	1.1	} else {
260			die "unknown command '$cmd' received";
261			}
262			}
263
264			sub mainloop {
265	root	1.2	server_event while 1;
266	root	1.1	}
267
268	root	1.3	sub init {
269	root	1.6	$interface = shift;
270	root	1.5
271	root	1.6	open FD, "+<&=$_[0]"; binmode FD;
272	root	1.1
273	root	1.6	$interface->mainloop;
274	root	1.1	}
275
276			sub new {
277	root	1.2	my $class = shift;
278	root	1.3	my $self = bless { @_ }, $class;
279			$self->{save} = $self->{save} ne ""
280			? Storable::thaw $self->{save}
281			: {};
282			$self;
283	root	1.1	}
284
285			sub set_window {
286	root	1.3	my $self = shift;
287			my $new = shift;
288	root	1.6	print "window set calling with $new->{window}, $new->{w}, $new->{h} ($self->{window}\n";#d#
289	root	1.3	if ($self->{window}) {
290			if ($self->{window}{window} ne $new->{window}) {
291			$self->window_delete($self->{window});
292	root	1.6	} elsif ($self->{window}{w} != $new->{w}
293			or $self->{window}{h} != $new->{h}) {
294	root	1.3	$self->window_resize($new->{window}, $new->{w}, $new->{h});
295			}
296			$self->{window} = $new;
297	root	1.6	}
298
299			unless ($self->{window}) {
300	root	1.3	$self->{window} = $new;
301	root	1.6	print "window new calling with $new->{window}, $new->{w}, $new->{h}\n";#d#
302	root	1.3	$self->window_new($new->{window}, $new->{w}, $new->{h});
303			}
304	root	1.8
305			();
306	root	1.1	}
307
308	root	1.3	sub window_new {}
309			sub window_resize {}
310	root	1.6
311			sub window_delete {
312			my $self = shift;
313			delete $self->{window};
314			}
315	root	1.3
316	root	1.1	sub save {
317	root	1.6	my $self = shift;
318			$self->set_window(undef);
319	root	1.8	$self->{destroy};
320	root	1.6	Storable::nfreeze $self->{save};
321	root	1.1	}
322
323	root	1.8	sub destroy {}
324			sub DESTROY {}
325			sub write_ready { 0xfffff }
326			sub push_stream {}
327			sub stream_as_file {}
328			sub destroy_stream {}
329
330			sub write {
331			my ($self) = shift;
332			shift->write(@_);
333	root	1.1	}
334
335			1;
336
337			=back
338
339			=head1 BUGS
340
341			=head1 SEE ALSO
342
343			L<PApp>.
344
345			=head1 AUTHOR
346
347			Marc Lehmann <pcg@goof.com>
348			http://www.goof.com/pcg/marc/
349
350			=cut
351