=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