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 XSLoader;

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

warn "in module [@ARGV]";#d#

#XSLoader::load __PACKAGE__, $VERSION;
use Data::Dumper;

my $data;

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

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

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

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

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

sub rcv_cmd {
   my $buf;
   4 == sysread $_[0], $buf, 4 or exit;
   my $len = unpack "N", $buf;
   $len -= 4;
   $len == sysread $_[0], $buf, $len or die;

   $data = substr $buf, 4;

   substr $buf, 3, 1;
}

sub rcv_i32() {
   my $i32 = 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() { $FD1 }

sub server_event() {
   my $cmd = rcv_cmd $FD1;

   if ($cmd eq "I") {
      rcv_i32 == 1 or die "protocol version mismatch\n";
      ($IFACE, $OSNAME, $OSVERS) = (rcv_blk, rcv_blk, rcv_blk);
   } elsif ($cmd eq "+") {
      my ($objid, $type, $mode, $save, $argc)
         = (rcv_i32, rcv_blk, rcv_i32, rcv_blk, rcv_i32);
      my %args;
      while ($argc--) {
         my ($argn, $argv) = (rcv_blk, rcv_blk);
         $args{$argn} = $argv;
      }

      $_OBJ{$objid} = new Mozilla::Plugin
         type => $type,
         mode => $mode,
         save => $save,
         args => \%args;

   } elsif ($cmd eq "-") {
      my $objid = rcv_i32;
      snd_cmd "-";
      my $save = (delete $_OBJ{$objid})->save;
      snd_i32 length $save;
      snd_dyn $FD1, $save;
   } else {
      die "unknown command '$cmd' received";
   }
}

sub mainloop {
   server_event while 1;
}

sub _main {
   $LIBDIR = shift @ARGV;
   $IN_MOZILLA = 1;
   (shift @ARGV) =~ /^(\d+),(\d+)$/ or die "init arg error";
   my ($fd1, $fd2) = ($1, $2);
   open $FD1, "+<&=$fd1"; binmode $FD1;
   open $FD2, "+<&=$fd2"; binmode $FD2;

   mainloop;
}

sub new {
   my $class = shift;
   bless { @_ }, $class;
}

sub set_window {
   warn "set_window: ".Dumper(\@_);
}

sub save {
   warn "save: ".Dumper(\@_);
   "[save]";
}

sub DESTROY {
   warn "DESTROY";
}

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.2
Committed:	Fri Feb 23 01:58:41 2001 UTC (23 years, 4 months ago) by root
Branch:	MAIN
Changes since 1.1:	+46 -14 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			#use XSLoader;
21
22			$VERSION = 0.12;
23			@EXPORT = qw();
24
25			warn "in module [@ARGV]";#d#
26
27			#XSLoader::load __PACKAGE__, $VERSION;
28			use Data::Dumper;
29
30			my $data;
31
32			sub snd_cmd($) {
33			$data = pack "NN", 0, ord($_[0]);
34			}
35
36			sub snd_i32($) {
37			$data .= pack "N", $_[0];
38			}
39
40			sub snd_blk($) {
41			$data .= pack "NA*", length($_[0]), $_[0];
42			}
43
44			sub snd_snd($) {
45			substr ($data, 0, 4) = pack "N", length $data;
46	root	1.2	length ($data) == syswrite $_[0], $data;
47			}
48
49			sub snd_dyn {
50			length ($_[1]) == syswrite $_[0], $_[1];
51	root	1.1	}
52
53			sub rcv_cmd {
54			my $buf;
55			4 == sysread $_[0], $buf, 4 or exit;
56			my $len = unpack "N", $buf;
57			$len -= 4;
58			$len == sysread $_[0], $buf, $len or die;
59
60			$data = substr $buf, 4;
61
62			substr $buf, 3, 1;
63			}
64
65			sub rcv_i32() {
66			my $i32 = unpack "N", $data;
67			$data = substr $data, 4;
68			$i32;
69			}
70
71			sub rcv_blk() {
72			my $len = unpack "N", $data;
73			my $str = substr $data, 4, $len;
74			$data = substr $data, 4 + $len;
75			$str;
76			}
77
78	root	1.2	=item my $fh = server_fh
79
80			The design of this module is event-based. When the plug-in starts (there
81			is always just one interpreter) it spawns one perl interpreter which
82			will immediately go into a even loop. If you want to use your own event
83			loop (e.g. using the Gtk or Event modules) you need to register a file
84			input handler on the filehandle returned by C<server_fh> that calls
85			C<server_event> whenever there is input pending on C<server_fh>. This will
86			ensure proper operation of the plug-in.
87
88			=item server_event
89
90			Call this function whenever there is data available on the C<server_fh>. This function
91			might not return.
92
93			Due to this design (flaw?), sharing of different toolkits using this
94			plug-in is difficult at best. Spawning a new perl interpreter for every
95			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+").
97
98			=cut
99
100			sub server_fh() { $FD1 }
101
102			sub server_event() {
103			my $cmd = rcv_cmd $FD1;
104	root	1.1
105			if ($cmd eq "I") {
106			rcv_i32 == 1 or die "protocol version mismatch\n";
107			($IFACE, $OSNAME, $OSVERS) = (rcv_blk, rcv_blk, rcv_blk);
108			} elsif ($cmd eq "+") {
109			my ($objid, $type, $mode, $save, $argc)
110			= (rcv_i32, rcv_blk, rcv_i32, rcv_blk, rcv_i32);
111			my %args;
112	root	1.2	while ($argc--) {
113			my ($argn, $argv) = (rcv_blk, rcv_blk);
114			$args{$argn} = $argv;
115			}
116	root	1.1
117			$_OBJ{$objid} = new Mozilla::Plugin
118			type => $type,
119			mode => $mode,
120			save => $save,
121			args => \%args;
122
123			} elsif ($cmd eq "-") {
124			my $objid = rcv_i32;
125	root	1.2	snd_cmd "-";
126			my $save = (delete $_OBJ{$objid})->save;
127			snd_i32 length $save;
128			snd_dyn $FD1, $save;
129	root	1.1	} else {
130			die "unknown command '$cmd' received";
131			}
132			}
133
134			sub mainloop {
135	root	1.2	server_event while 1;
136	root	1.1	}
137
138			sub _main {
139			$LIBDIR = shift @ARGV;
140			$IN_MOZILLA = 1;
141			(shift @ARGV) =~ /^(\d+),(\d+)$/ or die "init arg error";
142			my ($fd1, $fd2) = ($1, $2);
143	root	1.2	open $FD1, "+<&=$fd1"; binmode $FD1;
144			open $FD2, "+<&=$fd2"; binmode $FD2;
145	root	1.1
146			mainloop;
147			}
148
149			sub new {
150	root	1.2	my $class = shift;
151			bless { @_ }, $class;
152	root	1.1	}
153
154			sub set_window {
155			warn "set_window: ".Dumper(\@_);
156			}
157
158			sub save {
159			warn "save: ".Dumper(\@_);
160			"[save]";
161			}
162
163			sub DESTROY {
164			warn "DESTROY";
165			}
166
167			1;
168
169			=back
170
171			=head1 BUGS
172
173			=head1 SEE ALSO
174
175			L<PApp>.
176
177			=head1 AUTHOR
178
179			Marc Lehmann <pcg@goof.com>
180			http://www.goof.com/pcg/marc/
181
182			=cut
183