cvsroot/Mozilla-Plugin/Plugin.pm

=head1 NAME

Browser::Plugin - embed perl into mozilla/netscape/ie/opera.

=head1 SYNOPSIS

 use Browser::Plugin;

=head1 DESCRIPTION

sorry...

=over 4

=cut

package Browser::Plugin;

use base Exporter;
use Storable;
#use XSLoader;

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

#XSLoader::load __PACKAGE__, $VERSION;

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

my $debug = 1;

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 {
   shift if ref $_[0];
   my $cmd = shift;
   my ($buf, $rcmd, $len);

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

      $data = substr $buf, 4;

      $rcmd = substr $buf, 3, 1;
      if ($rcmd =~ /^[a-z]$/) {
         die "rcv_cmd: sync error, expected '$cmd' but got '$rcmd'\n" if $cmd && $rcmd ne $cmd;
         return $rcmd;
      } else {
         &_handle_event($rcmd);
      }
   } while ($cmd);
}

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

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

# command from browser to plugin usually have capital letters while
# commands from perl to the browser always use lowercase letters
sub _handle_event($) {
   my $cmd = shift;

   warn "handle_event($cmd)\n" if $debug;
   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 Browser::Stream::Receive \%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";
   }
}

=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 { rcv_cmd }

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->{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->destroy;
   Storable::nfreeze $self->{save};
}

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

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

sub DESTROY     {}

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

=item ($error, $stream) = new_stream $mimetype, $target

Requests the creation of a new data stream produced by the plug-in and
consumed by the browser.

=cut

sub new_stream {
   my ($self, $type, $target) = @_;
   my ($error, $stream);

   snd_cmd 'n';
   snd_blk $mimetype;
   snd_blk $target;
   if (snd_snd) {
      rcv_cmd 'n';
      $error = rcv_u32;
      unless ($error) {
         $stream = new Browser::Stream::Send (
            instance     => $self,
            mimetype     => $type,
            id           => rcv_ptr,
            url          => $target,
         );
      }
   }
   ($error, $stream);
}

=item $error = $obj->get_url $url, $target

=cut

sub get_url {
   my ($self, $url, $target) = @_;
   my $error;

   snd_cmd 'u';
   snd_blk $url;
   snd_blk $target;
   if (snd_snd) {
      rcv_cmd 'u';
      $error = rcv_i32;
   }
   $error;
}

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

sub Browser::Stream::destroy {
   my $str   = shift;
   my $error = shift;
   unless ($str->{destroyed}) {
      $str->{destroyed}++;

      my $obj = $str->{instance};
      snd_cmd 'd';
      snd_ptr $obj->{id};
      snd_ptr $str->{id};
      snd_u32 $error || NPERR_NO_ERROR;
      snd_snd;
   }
}

*Browser::Stream::DESTROY = \&Browser::Stream::destroy;

BEGIN {
   @Browser::Stream::Receive::ISA = Browser::Stream;
}

sub Browser::Stream::Receive::write {
   # ...
}

BEGIN {
   @Browser::Stream::Send::ISA = Browser::Stream;
}

=item $bytes = $stream->write($data)

=cut

sub Browser::Stream::Send::write {
   my $str = shift;
   my $obj = $self->{instance};

   snd_cmd 'w';
   snd_ptr $obj->{id};
   snd_ptr $str->{id};
   snd_u32 length $_[0];
   if (snd_snd) {
      if (snd_dyn $_[0]) {
         rcv_cmd 'w';
         return rcv_i32 ();
      }
   }
   return 0;
}

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.12
Committed:	Sat Jul 21 00:41:47 2001 UTC (22 years, 11 months ago) by root
Branch:	MAIN
CVS Tags:	HEAD
Changes since 1.11:	+13 -13 lines
Log Message:	* empty log message *
#	User	Rev	Content
1	root	1.1	=head1 NAME
2
3	root	1.12	Browser::Plugin - embed perl into mozilla/netscape/ie/opera.
4	root	1.1
5			=head1 SYNOPSIS
6
7	root	1.12	use Browser::Plugin;
8	root	1.1
9			=head1 DESCRIPTION
10
11	root	1.2	sorry...
12
13	root	1.1	=over 4
14
15			=cut
16
17	root	1.12	package Browser::Plugin;
18	root	1.1
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.12	my $interface; # Browser::Plugin::xxx (design weakness)
29	root	1.6
30	root	1.11	my $debug = 1;
31
32	root	1.8	sub NP_VERSION_MAJOR (){ 0 }
33			sub NP_VERSION_MINOR (){ 9 }
34			sub NP_EMBED (){ 1 }
35			sub NP_FULL (){ 2 }
36			sub NP_NORMAL (){ 1 }
37			sub NP_SEEK (){ 2 }
38			sub NP_ASFILE (){ 3 }
39			sub NP_ASFILEONLY (){ 4 }
40			sub NP_MAXREADY (){ 2147483647 }
41			sub NPERR_NO_ERROR (){ 0 }
42			sub NPERR_GENERIC_ERROR (){ 1 }
43			sub NPERR_INVALID_INSTANCE_ERROR (){ 2 }
44			sub NPERR_INVALID_FUNCTABLE_ERROR (){ 3 }
45			sub NPERR_MODULE_LOAD_FAILED_ERROR (){ 4 }
46			sub NPERR_OUT_OF_MEMORY_ERROR (){ 5 }
47			sub NPERR_INVALID_PLUGIN_ERROR (){ 6 }
48			sub NPERR_INVALID_PLUGIN_DIR_ERROR (){ 7 }
49			sub NPERR_INCOMPATIBLE_VERSION_ERROR (){ 8 }
50			sub NPERR_INVALID_PARAM (){ 9 }
51			sub NPERR_INVALID_URL (){ 10 }
52			sub NPERR_FILE_NOT_FOUND (){ 11 }
53			sub NPERR_NO_DATA (){ 12 }
54			sub NPERR_STREAM_NOT_SEEKABLE (){ 13 }
55			sub NPVERS_HAS_STREAMOUTPUT (){ 8 }
56			sub NPVERS_HAS_NOTIFICATION (){ 9 }
57			sub NPVERS_HAS_LIVECONNECT (){ 9 }
58			sub NPVERS_WIN16_HAS_LIVECONNECT (){ 10 }
59
60	root	1.1	my $data;
61
62	root	1.8	sub BIAS() { -2147483647 } # ugliest hack ever seen
63	root	1.3
64	root	1.9	sub snd_cmd {
65			$data = pack "NN", 0, ord($_[-1]);
66	root	1.1	}
67
68	root	1.9	sub snd_ptr {
69			$data .= $_[-1];
70	root	1.3	}
71
72	root	1.9	sub snd_u32 {
73			$data .= pack "N", $_[-1];
74	root	1.3	}
75
76	root	1.9	sub snd_i32 {
77			$data .= pack "N", $_[-1] - BIAS;
78	root	1.1	}
79
80	root	1.9	sub snd_blk {
81			$data .= pack "NA*", length($_[-1]), $_[-1];
82	root	1.1	}
83
84	root	1.9	sub snd_snd {
85	root	1.1	substr ($data, 0, 4) = pack "N", length $data;
86	root	1.3	length ($data) == syswrite FD, $data;
87	root	1.2	}
88
89	root	1.9	sub snd_dyn {
90			length ($_[-1]) == syswrite FD, $_[-1];
91	root	1.1	}
92
93	root	1.9	sub rcv_cmd {
94	root	1.10	shift if ref $_[0];
95			my $cmd = shift;
96			my ($buf, $rcmd, $len);
97
98			do {
99			4 == sysread FD, $buf, 4 or exit;
100			$len = unpack "N", $buf;
101			$len -= 4;
102			$len == sysread FD, $buf, $len or die;
103
104			$data = substr $buf, 4;
105
106			$rcmd = substr $buf, 3, 1;
107			if ($rcmd =~ /^[a-z]$/) {
108			die "rcv_cmd: sync error, expected '$cmd' but got '$rcmd'\n" if $cmd && $rcmd ne $cmd;
109			return $rcmd;
110			} else {
111			&_handle_event($rcmd);
112			}
113			} while ($cmd);
114	root	1.1	}
115
116	root	1.9	sub rcv_ptr {
117	root	1.3	my $ptr = substr $data, 0, 8;
118			$data = substr $data, 8;
119			$ptr;
120			}
121
122	root	1.9	sub rcv_u32 {
123	root	1.3	my $u32 = unpack "N", $data;
124			$data = substr $data, 4;
125			$u32;
126			}
127
128	root	1.9	sub rcv_i32 {
129	root	1.3	my $i32 = BIAS + unpack "N", $data;
130	root	1.1	$data = substr $data, 4;
131			$i32;
132			}
133
134	root	1.9	sub rcv_blk {
135	root	1.1	my $len = unpack "N", $data;
136			my $str = substr $data, 4, $len;
137			$data = substr $data, 4 + $len;
138			$str;
139			}
140
141	root	1.9	sub rcv_dyn {
142			my $buf;
143			$_[-1] == sysread FD, $buf, $_[-1] or die "rcv_dyn: $!";
144			$buf;
145			}
146
147	root	1.11	# command from browser to plugin usually have capital letters while
148			# commands from perl to the browser always use lowercase letters
149	root	1.10	sub _handle_event($) {
150			my $cmd = shift;
151	root	1.1
152	root	1.11	warn "handle_event($cmd)\n" if $debug;
153			if ($cmd eq 'I') {
154	root	1.3	rcv_u32 == 1 or die "protocol version mismatch\n";
155	root	1.1	($IFACE, $OSNAME, $OSVERS) = (rcv_blk, rcv_blk, rcv_blk);
156	root	1.3
157	root	1.11	} elsif ($cmd eq '+') { # New
158	root	1.1	my ($objid, $type, $mode, $save, $argc)
159	root	1.3	= (rcv_ptr, rcv_blk, rcv_u32, rcv_blk, rcv_u32);
160	root	1.1	my %args;
161	root	1.2	while ($argc--) {
162			my ($argn, $argv) = (rcv_blk, rcv_blk);
163			$args{$argn} = $argv;
164			}
165	root	1.1
166	root	1.6	$_OBJ{$objid} = $interface->new(
167	root	1.9	instance => $objid,
168			type => $type,
169			mode => $mode,
170			save => $save,
171			args => \%args,
172	root	1.6	);
173	root	1.1
174	root	1.11	} elsif ($cmd eq '-') { # Destroy
175	root	1.3	my $objid = rcv_ptr;
176			my $save = (delete $_OBJ{$objid})->save;
177	root	1.2	snd_cmd "-";
178	root	1.3	snd_u32 length $save;
179			snd_snd and snd_dyn $save;
180
181	root	1.11	} elsif ($cmd eq 'X') { # SetWindow
182	root	1.3	my $objid = rcv_ptr;
183			my %args = (
184	root	1.9	id => rcv_ptr,
185			x => rcv_i32,
186			y => rcv_i32,
187			w => rcv_i32,
188			h => rcv_i32,
189	root	1.3	);
190			if ($IFACE eq "UNIX") {
191	root	1.9	$args{id} = unpack "xxxxN", $args{id};
192	root	1.3	$args{ws_type} = rcv_i32;
193			$args{ws_depth} = rcv_u32;
194			}
195
196	root	1.8	snd_cmd 'X';
197			snd_u32 $_OBJ{$objid}->set_window(\%args);
198			snd_snd;
199
200	root	1.11	} elsif ($cmd eq 'N') { # NewStream
201	root	1.8	my $obj = $_OBJ{+rcv_ptr};
202			my %args = (
203	root	1.9	instance => $obj,
204	root	1.8	mimetype => rcv_blk,
205			id => rcv_ptr,
206			url => rcv_blk,
207			end => rcv_u32,
208			lastmodified => rcv_u32,
209			notifydata => rcv_u32,
210			seekable => rcv_u32,
211	root	1.9	push_stream => 1,
212	root	1.8	);
213	root	1.12	my $str = $_OBJ{$args{id}} = new Browser::Stream::Receive \%args;
214	root	1.8
215			my ($stype, $err) = $obj->push_stream($str);
216
217	root	1.9	snd_cmd 'N';
218	root	1.8	snd_u32 $err;
219			snd_u32 $stype \|\| NP_NORMAL;
220			snd_snd;
221
222	root	1.11	} elsif ($cmd eq '/') { # StreamAsFile
223	root	1.8	my $obj = $_OBJ{+rcv_ptr};
224			my $str = $_OBJ{+rcv_ptr};
225			my $path = rcv_blk;
226
227			$obj->stream_as_file($obj, $stream, $path);
228
229	root	1.11	} elsif ($cmd eq 'R') { # WriteReady
230	root	1.8	my $obj = $_OBJ{+rcv_ptr};
231			my $str = $_OBJ{+rcv_ptr};
232
233			snd_cmd 'R';
234			snd_u32 $obj->write_ready($obj, $str);
235			snd_snd;
236
237	root	1.11	} elsif ($cmd eq 'W') { # Write
238	root	1.8	my $obj = $_OBJ{+rcv_ptr};
239			my $str = $_OBJ{+rcv_ptr};
240			my $ofs = rcv_i32;
241			my $len = rcv_i32;
242			my $dta = rcv_dyn $len;
243
244			snd_cmd 'W';
245			snd_i32 $obj->write($str, $ofs, $len, $dta);
246			snd_snd;
247
248	root	1.11	} elsif ($cmd eq 'D') { # DestroyStream
249	root	1.8	my $obj = $_OBJ{+rcv_ptr};
250			my $str = delete $_OBJ{+rcv_ptr};
251			my $why = rcv_u32;
252
253			$obj->destroy_stream($obj, $str, $why);
254	root	1.3
255	root	1.1	} else {
256			die "unknown command '$cmd' received";
257			}
258			}
259
260	root	1.10	=item my $fh = server_fh
261
262			The design of this module is event-based. When the plug-in starts (there
263			is always just one interpreter) it spawns one perl interpreter which
264			will immediately go into a even loop. If you want to use your own event
265			loop (e.g. using the Gtk or Event modules) you need to register a file
266			input handler on the filehandle returned by C<server_fh> that calls
267			C<server_event> whenever there is input pending on C<server_fh>. This will
268			ensure proper operation of the plug-in.
269
270			=item server_event
271
272			Call this function whenever there is data available on the C<server_fh>. This function
273			might not return.
274
275			Due to this design (flaw?), sharing of different toolkits using this
276			plug-in is difficult at best. Spawning a new perl interpreter for every
277			plug-in is also not very viable, so in the future one might be able to
278			specify a group on the embed statement (i.e. EMBED GROUP="gtk+").
279
280			=cut
281
282			sub server_fh { \*FD }
283
284			sub server_event { rcv_cmd }
285
286	root	1.1	sub mainloop {
287	root	1.2	server_event while 1;
288	root	1.1	}
289
290	root	1.3	sub init {
291	root	1.6	$interface = shift;
292	root	1.5
293	root	1.6	open FD, "+<&=$_[0]"; binmode FD;
294	root	1.1
295	root	1.6	$interface->mainloop;
296	root	1.1	}
297
298			sub new {
299	root	1.2	my $class = shift;
300	root	1.3	my $self = bless { @_ }, $class;
301			$self->{save} = $self->{save} ne ""
302			? Storable::thaw $self->{save}
303			: {};
304			$self;
305	root	1.1	}
306
307			sub set_window {
308	root	1.3	my $self = shift;
309			my $new = shift;
310	root	1.9
311			if ($self->{wininfo}) {
312			if ($self->{wininfo}{id} ne $new->{id}) {
313			$self->window_delete($self->{wininfo});
314			} elsif ($self->{wininfo}{w} != $new->{w}
315			or $self->{wininfo}{h} != $new->{h}) {
316	root	1.11	$self->window_resize($new->{w}, $new->{h});
317	root	1.3	}
318	root	1.9	$self->{wininfo} = $new;
319	root	1.6	}
320
321	root	1.9	unless ($self->{wininfo}) {
322			$self->{window} = $self->window_new($new) and $self->{wininfo} = $new;
323	root	1.3	}
324	root	1.8
325			();
326	root	1.1	}
327
328	root	1.10	sub window_new { () }
329	root	1.3	sub window_resize {}
330	root	1.6
331			sub window_delete {
332			my $self = shift;
333	root	1.9	delete $self->{wininfo};
334	root	1.6	delete $self->{window};
335			}
336	root	1.3
337	root	1.1	sub save {
338	root	1.6	my $self = shift;
339	root	1.10	$self->destroy;
340	root	1.6	Storable::nfreeze $self->{save};
341	root	1.1	}
342
343	root	1.11	sub destroy {
344			my $self = shift;
345			$self->set_window(undef);
346			}
347
348	root	1.8	sub write_ready { 0xfffff }
349			sub push_stream {}
350			sub stream_as_file {}
351			sub destroy_stream {}
352
353	root	1.11	sub DESTROY {}
354
355	root	1.8	sub write {
356			my ($self) = shift;
357			shift->write(@_);
358	root	1.9	}
359
360	root	1.10	=item ($error, $stream) = new_stream $mimetype, $target
361
362			Requests the creation of a new data stream produced by the plug-in and
363			consumed by the browser.
364
365			=cut
366
367			sub new_stream {
368			my ($self, $type, $target) = @_;
369			my ($error, $stream);
370
371			snd_cmd 'n';
372			snd_blk $mimetype;
373			snd_blk $target;
374			if (snd_snd) {
375			rcv_cmd 'n';
376			$error = rcv_u32;
377			unless ($error) {
378	root	1.12	$stream = new Browser::Stream::Send (
379	root	1.10	instance => $self,
380			mimetype => $type,
381			id => rcv_ptr,
382			url => $target,
383			);
384			}
385			}
386			($error, $stream);
387			}
388
389			=item $error = $obj->get_url $url, $target
390	root	1.9
391	root	1.10	=cut
392
393			sub get_url {
394			my ($self, $url, $target) = @_;
395	root	1.11	my $error;
396
397			snd_cmd 'u';
398			snd_blk $url;
399			snd_blk $target;
400			if (snd_snd) {
401			rcv_cmd 'u';
402			$error = rcv_i32;
403			}
404			$error;
405	root	1.10	}
406
407	root	1.12	sub Browser::Stream::new {
408	root	1.9	bless $_[1], $_[0];
409			}
410
411	root	1.12	sub Browser::Stream::destroy {
412	root	1.10	my $str = shift;
413			my $error = shift;
414			unless ($str->{destroyed}) {
415			$str->{destroyed}++;
416
417			my $obj = $str->{instance};
418			snd_cmd 'd';
419			snd_ptr $obj->{id};
420			snd_ptr $str->{id};
421			snd_u32 $error \|\| NPERR_NO_ERROR;
422			snd_snd;
423			}
424			}
425
426	root	1.12	*Browser::Stream::DESTROY = \&Browser::Stream::destroy;
427	root	1.10
428			BEGIN {
429	root	1.12	@Browser::Stream::Receive::ISA = Browser::Stream;
430	root	1.10	}
431
432	root	1.12	sub Browser::Stream::Receive::write {
433	root	1.9	# ...
434			}
435
436	root	1.10	BEGIN {
437	root	1.12	@Browser::Stream::Send::ISA = Browser::Stream;
438	root	1.10	}
439
440			=item $bytes = $stream->write($data)
441
442			=cut
443
444	root	1.12	sub Browser::Stream::Send::write {
445	root	1.10	my $str = shift;
446			my $obj = $self->{instance};
447
448			snd_cmd 'w';
449			snd_ptr $obj->{id};
450			snd_ptr $str->{id};
451			snd_u32 length $_[0];
452			if (snd_snd) {
453			if (snd_dyn $_[0]) {
454			rcv_cmd 'w';
455			return rcv_i32 ();
456			}
457			}
458			return 0;
459	root	1.1	}
460
461			1;
462
463			=back
464
465			=head1 BUGS
466
467			=head1 SEE ALSO
468
469			L<PApp>.
470
471			=head1 AUTHOR
472
473			Marc Lehmann <pcg@goof.com>
474			http://www.goof.com/pcg/marc/
475
476			=cut
477