=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 $data;

sub BIAS() { -2000000000 } # 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 "+") {
      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;
      }

      warn "new obj $objid\n";#d#
      $_OBJ{$objid} = new Mozilla::Plugin
         objid => $objid,
         type  => $type,
         mode  => $mode,
         save  => $save,
         args  => \%args;

   } elsif ($cmd eq "-") {
      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 "W") {
      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;
      }

      $_OBJ{$objid}->set_window(\%args);

   } else {
      die "unknown command '$cmd' received";
   }
}

sub mainloop {
   server_event while 1;
}

sub init {
   my $self = shift;

   $IN_MOZILLA = 1;

   open FD, "+<&=$_[0]"; binmode $FD;

   warn "init: ".Dumper(@_);

   $self->mainloop;
}

sub new {
   my $class = shift;
   my $self = bless { @_ }, $class;
   $self->{save} = $self->{save} ne ""
                   ? Storable::thaw $self->{save}
                   : {};
   warn "new: ".Dumper($self);
   $self;
}

sub set_window {
   my $self = shift;
   my $new = shift;
   if ($self->{window}) {
      if ($self->{window}{window} ne $new->{window}) {
         $self->window_delete($self->{window});
      } else {
         $self->window_resize($new->{window}, $new->{w}, $new->{h});
      }
      $self->{window} = $new;
   } else {
      $self->{window} = $new;
      $self->window_new($new->{window}, $new->{w}, $new->{h});
   }
   warn "set_window: ".Dumper($self);
}

sub window_new    {}
sub window_resize {}
sub window_delete {}

sub save {
   $_[0]->{save}{test} = ['t1',5,7];
   Storable::nfreeze $_[0]->{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