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 (25 years, 3 months ago) by root
Branch:	MAIN
CVS Tags:	HEAD
Changes since 1.11:	+13 -13 lines
Log Message:	* empty log message *
#	Content
1	=head1 NAME
2
3	Browser::Plugin - embed perl into mozilla/netscape/ie/opera.
4
5	=head1 SYNOPSIS
6
7	use Browser::Plugin;
8
9	=head1 DESCRIPTION
10
11	sorry...
12
13	=over 4
14
15	=cut
16
17	package Browser::Plugin;
18
19	use base Exporter;
20	use Storable;
21	#use XSLoader;
22
23	$VERSION = 0.01;
24	@EXPORT = qw();
25
26	#XSLoader::load __PACKAGE__, $VERSION;
27
28	my $interface; # Browser::Plugin::xxx (design weakness)
29
30	my $debug = 1;
31
32	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	my $data;
61
62	sub BIAS() { -2147483647 } # ugliest hack ever seen
63
64	sub snd_cmd {
65	$data = pack "NN", 0, ord($_[-1]);
66	}
67
68	sub snd_ptr {
69	$data .= $_[-1];
70	}
71
72	sub snd_u32 {
73	$data .= pack "N", $_[-1];
74	}
75
76	sub snd_i32 {
77	$data .= pack "N", $_[-1] - BIAS;
78	}
79
80	sub snd_blk {
81	$data .= pack "NA*", length($_[-1]), $_[-1];
82	}
83
84	sub snd_snd {
85	substr ($data, 0, 4) = pack "N", length $data;
86	length ($data) == syswrite FD, $data;
87	}
88
89	sub snd_dyn {
90	length ($_[-1]) == syswrite FD, $_[-1];
91	}
92
93	sub rcv_cmd {
94	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	}
115
116	sub rcv_ptr {
117	my $ptr = substr $data, 0, 8;
118	$data = substr $data, 8;
119	$ptr;
120	}
121
122	sub rcv_u32 {
123	my $u32 = unpack "N", $data;
124	$data = substr $data, 4;
125	$u32;
126	}
127
128	sub rcv_i32 {
129	my $i32 = BIAS + unpack "N", $data;
130	$data = substr $data, 4;
131	$i32;
132	}
133
134	sub rcv_blk {
135	my $len = unpack "N", $data;
136	my $str = substr $data, 4, $len;
137	$data = substr $data, 4 + $len;
138	$str;
139	}
140
141	sub rcv_dyn {
142	my $buf;
143	$_[-1] == sysread FD, $buf, $_[-1] or die "rcv_dyn: $!";
144	$buf;
145	}
146
147	# command from browser to plugin usually have capital letters while
148	# commands from perl to the browser always use lowercase letters
149	sub _handle_event($) {
150	my $cmd = shift;
151
152	warn "handle_event($cmd)\n" if $debug;
153	if ($cmd eq 'I') {
154	rcv_u32 == 1 or die "protocol version mismatch\n";
155	($IFACE, $OSNAME, $OSVERS) = (rcv_blk, rcv_blk, rcv_blk);
156
157	} elsif ($cmd eq '+') { # New
158	my ($objid, $type, $mode, $save, $argc)
159	= (rcv_ptr, rcv_blk, rcv_u32, rcv_blk, rcv_u32);
160	my %args;
161	while ($argc--) {
162	my ($argn, $argv) = (rcv_blk, rcv_blk);
163	$args{$argn} = $argv;
164	}
165
166	$_OBJ{$objid} = $interface->new(
167	instance => $objid,
168	type => $type,
169	mode => $mode,
170	save => $save,
171	args => \%args,
172	);
173
174	} elsif ($cmd eq '-') { # Destroy
175	my $objid = rcv_ptr;
176	my $save = (delete $_OBJ{$objid})->save;
177	snd_cmd "-";
178	snd_u32 length $save;
179	snd_snd and snd_dyn $save;
180
181	} elsif ($cmd eq 'X') { # SetWindow
182	my $objid = rcv_ptr;
183	my %args = (
184	id => rcv_ptr,
185	x => rcv_i32,
186	y => rcv_i32,
187	w => rcv_i32,
188	h => rcv_i32,
189	);
190	if ($IFACE eq "UNIX") {
191	$args{id} = unpack "xxxxN", $args{id};
192	$args{ws_type} = rcv_i32;
193	$args{ws_depth} = rcv_u32;
194	}
195
196	snd_cmd 'X';
197	snd_u32 $_OBJ{$objid}->set_window(\%args);
198	snd_snd;
199
200	} elsif ($cmd eq 'N') { # NewStream
201	my $obj = $_OBJ{+rcv_ptr};
202	my %args = (
203	instance => $obj,
204	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	push_stream => 1,
212	);
213	my $str = $_OBJ{$args{id}} = new Browser::Stream::Receive \%args;
214
215	my ($stype, $err) = $obj->push_stream($str);
216
217	snd_cmd 'N';
218	snd_u32 $err;
219	snd_u32 $stype \|\| NP_NORMAL;
220	snd_snd;
221
222	} elsif ($cmd eq '/') { # StreamAsFile
223	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	} elsif ($cmd eq 'R') { # WriteReady
230	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	} elsif ($cmd eq 'W') { # Write
238	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	} elsif ($cmd eq 'D') { # DestroyStream
249	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
255	} else {
256	die "unknown command '$cmd' received";
257	}
258	}
259
260	=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	sub mainloop {
287	server_event while 1;
288	}
289
290	sub init {
291	$interface = shift;
292
293	open FD, "+<&=$_[0]"; binmode FD;
294
295	$interface->mainloop;
296	}
297
298	sub new {
299	my $class = shift;
300	my $self = bless { @_ }, $class;
301	$self->{save} = $self->{save} ne ""
302	? Storable::thaw $self->{save}
303	: {};
304	$self;
305	}
306
307	sub set_window {
308	my $self = shift;
309	my $new = shift;
310
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	$self->window_resize($new->{w}, $new->{h});
317	}
318	$self->{wininfo} = $new;
319	}
320
321	unless ($self->{wininfo}) {
322	$self->{window} = $self->window_new($new) and $self->{wininfo} = $new;
323	}
324
325	();
326	}
327
328	sub window_new { () }
329	sub window_resize {}
330
331	sub window_delete {
332	my $self = shift;
333	delete $self->{wininfo};
334	delete $self->{window};
335	}
336
337	sub save {
338	my $self = shift;
339	$self->destroy;
340	Storable::nfreeze $self->{save};
341	}
342
343	sub destroy {
344	my $self = shift;
345	$self->set_window(undef);
346	}
347
348	sub write_ready { 0xfffff }
349	sub push_stream {}
350	sub stream_as_file {}
351	sub destroy_stream {}
352
353	sub DESTROY {}
354
355	sub write {
356	my ($self) = shift;
357	shift->write(@_);
358	}
359
360	=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	$stream = new Browser::Stream::Send (
379	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
391	=cut
392
393	sub get_url {
394	my ($self, $url, $target) = @_;
395	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	}
406
407	sub Browser::Stream::new {
408	bless $_[1], $_[0];
409	}
410
411	sub Browser::Stream::destroy {
412	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	*Browser::Stream::DESTROY = \&Browser::Stream::destroy;
427
428	BEGIN {
429	@Browser::Stream::Receive::ISA = Browser::Stream;
430	}
431
432	sub Browser::Stream::Receive::write {
433	# ...
434	}
435
436	BEGIN {
437	@Browser::Stream::Send::ISA = Browser::Stream;
438	}
439
440	=item $bytes = $stream->write($data)
441
442	=cut
443
444	sub Browser::Stream::Send::write {
445	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	}
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