Doc::Perlish::Sender - a description of how to `send' parse events

  # get a sender from a sub-class constructor, like a Parser
  my $reader = Doc::Perlish::Reader->new( file => $filename );
  my $sender = Doc::Perlish::Parser->new( reader => $reader );
  my $receiver = Doc::Perlish::DOM->new();

  # either plumb it up first;
  $sender->receiver($receiver);
  $sender->send_all;

  $sender->restart;

  1 while $sender->send_one;

  # or specify the receiver immediately
  $sender->send_all_to($receiver);

  1 while $sender->send_one_to($receiver);

package Doc::Perlish::Sender;

use Doc::Perlish::Base -Base;
use Carp;

field 'receiver';

sub send_all {
    1 while $self->send_one(@_);
}

field 'sendstate';

field 'sendpadstack';
field 'sendstack';
our $DEBUG = 0;

use Maptastic;

sub _format {
    my @args = @_;
    return join (", ", map {
	(defined $_
	 ? (ref $_ eq "HASH"
	    ? ("{".(join(", ", map_each {
		$self->_format($_[0]) . " => " .
		    $self->_format($_[1])
		} $_ ))
	       ."}")
	    : (ref $_ eq "ARRAY"
	       ? ( "[".$self->_format(@$_)."]")
	       : (map {
		   s/\\/\\/g; s/\n/\\n/g; s/\r/\\r/g;
		   my $has_quotes = s/'/\'/g;
		   (m/^\d+$/ ? $_ : "'$_'")
	       } $_ )))
	 : "undef")
    } @args );
}


# this is the API that the sender sub-classes use
sub send {
    my $event = shift;

    print STDERR "$self: preparing to emit $event ".$self->_format(@_)." (ss=".($self->sendstate||"pu").")\n" if $DEBUG && $DEBUG > 1;

    $event and $event =~ m/^(?:(?:start|end)_(?:document|element)|characters|processing_instruction|ignorable_whitespace|comment)$/x
	or croak "$self sent bad event `$event'";

    return if $event eq "ignorable_whitespace" and $self->sendstate ne "body";

    if ( $event eq "start_document" and $self->sendstate ) {
	$self->send("end_document");
    }
    if ( $event eq "end_document" and !$self->sendstate ) {
	return undef;
    }

    # check to see if we need to start a document
    $self->send("start_document")
	if ( ! $self->sendstate and $event ne "start_document" );

    $self->send("start_element", "perldoc")
	if ( $self->sendstate and
	     $self->sendstate eq "start" and
	     $event ne "start_element" );

    # check to see if any dummy events are needed
    if ( $event eq "end_element" ) {
	my $stack = $self->sendstack;
	if ( defined(my $name = $_[0]) ) {
	    my $top;
	    croak "can't close unseen element `$name'"
		unless grep { $_ eq $name } @$stack;

	    $self->send("end_element", $top)
		while ( ($top = $stack->[$#$stack]) ne $name );
	} else {
	    shift;
	    unshift @_, $stack->[$#$stack];
	}
    }

    $self->send("end_element", $self->sendstack->[0])
	if ( $event eq "end_document" and
	     $self->sendstack and @{$self->sendstack});

    # ok, enough state sanity - send.
    my $receiver = $self->receiver or croak "no receiver!";
    if ( $event eq "start_element" ) {
	defined(my $name = $_[0])
	    or confess "start_element event with no name";
	push @{ $self->sendstack }, $name;
	push @{ $self->sendpadstack }, undef;
    }

    print STDERR "$self: emitting $event ".$self->_format(@_)."\n" if $DEBUG;
    if ( $receiver->can($event) ) {
	$receiver->$event(@_);
    }
    if ( $event eq "end_element" ) {
	pop @{ $self->sendstack };
	pop @{ $self->sendpadstack };
    }

    # fixme - add more checking...
    my $ss = $self->sendstate;
    if ( ! $ss ) {
	$self->sendstate("start");
	$self->sendstack([]);
	$self->sendpadstack([undef]);
    } elsif ( $ss eq "start" ) {
	$self->sendstate("body");
    } elsif ( $ss eq "body" and !@{ $self->sendstack } ) {
	$self->sendstate("end");
    } elsif ( $ss eq "end" ) {
	$self->restart;
    }

}

sub restart {
    $self->sendstate(undef);
    $self->sendstack(undef);
    $self->sendpadstack(undef);
}

sub sendpad {
    my $num = shift || 0;
    my $aref = $self->sendpadstack;
    my $idx = $#$aref - $num;
    return {} if $idx < 0;
    $aref->[$idx] ||= {};
}

sub final_receiver {
    if ( $self->receiver ) {
	if ( $self->receiver->can("final_target") ) {
	    $self->receiver->final_target;
	} else {
	    $self->receiver;
	}
    } else {
	$self;
    }
}

sub final_sender {
    if ( $self->receiver && $self->receiver->can("final_sender") ) {
	print STDERR "Self is $self, asking ".$self->receiver." for final sender\n";
	$self->receiver->final_sender;
    } else {
	print STDERR "Self is $self, returning ".$self." as final sender\n";
	$self;
    }
}

1;