package AMP::ParseWiki; ###### ParseWiki class
### 	$Id: ParseWiki.pm,v 1.3 2002/11/25 15:50:22 steve Exp $
###
###	This class parses and processes "WikiWiki" text and related markup.
###
###	The 

use XML::Node;
use XML::TrivialParser;
use AMP::ParseXH;

use Exporter();
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);

BEGIN {
    $VERSION=1.00;
    @ISA = qw(Exporter AMP::ParseXH);
    @EXPORT = qw(
		 );
}


#############################################################################
###
### Constructors:
###


sub new {
    my ($class, $context, $entities) = @_;

    #my $self = $class->XML::TrivialParser::new;
    my $self = bless { '_buf' => '', '_stack' => [], '_depth' => 0 }, $class;
    $self->{"_context"} = $context;
    $self->{"_entities"} = $entities;

    $self;
}


#############################################################################
###
### Parser:
###

##* parse ($text)
#	Append $text to the buffer (which contains whatever couldn't 
#	be parsed from the previous chunk) and scan off as many tokens
#	as possible.  An appropriate token handler method (see below) is 
#	called for each token.
#
#	This being a Wiki parser, the simplest thing is to chunk the file into
#	nonblank text delimited by whitespace.  Then we look at the front
#	and back of each chunk for markup.  Crosslinking is done elsewhere.
#	Entity expansion is also done elsewhere, _after_ markup is inserted.
#
sub parse {
    my $self = shift;

    my $buf = \ $self->{'_buf'};
    unless (defined $_[0]) {
	# signals EOF (assume rest is plain text)
	$self->text($$buf) if length $$buf;
	$$buf = '';
	return $self;
    }
    $$buf .= $_[0];

    # Parse html text in $$buf.  The strategy is to remove complete
    # tokens from the beginning of $$buf until we can't decide whether
    # it is a token or not, or the $$buf is empty.
    while (1) {  # the loop will end by returning when text is parsed
	# First we try to pull off any plain text (anything before a "<" char)
	if ($$buf =~ s|^([^<]+)||) {
	    unless (length $$buf) {
		my $text = $1;
		# At the end of the buffer, we should not parse white space
		# but leave it for parsing on the next round.
		if ($text =~ s|(\s+)$||) {
		    $$buf = $1;
                # Same treatment for chopped up entites.
		} elsif ($text =~ s/(&(?:(?:\#\d*)?|[-.\w]*))$//) {
		    $$buf = $1;
		};
		$self -> text($text);
		return $self;
	    } else {
		$self -> text($1);
	    }
        # Look for 'CDATA sections' <![CDATA[ ... ]]> (steve)
	} elsif ($$buf =~ s|^(<!\[CDATA\[)||) {
	    my $eaten = $1;
	    my $text = '';
	    while ($$buf =~ s|^(([^\]]*)\])||) {
		$eaten .= $1;
		$text .= $2;
		if ($$buf =~ s|^(\]>)||s) { 
		    $eaten .= $1;
		    $self->cdata($text);
		} else {
		    $text .= ']';
		}
	    }
	    $$buf = $eaten . $$buf;  # must start with it all next time
	    return $self;
	# Then, markup declarations (usually either <!DOCTYPE...> or a comment)
	# === this is badly broken for XML. ===
	} elsif ($$buf =~ s|^(<!)||) {
	    my $eaten = $1;
	    my $text = '';
	    # Eat text and beginning of comment
	    while ($$buf =~ s|^(([^>]*?)--)||) {
		$eaten .= $1;
		$text .= $2;
		# Look for end of comment
		if ($$buf =~ s|^((.*?)--)||s) {
		    $eaten .= $1;
		    $self->comment($2);
		} else {
		    # Need more data to get all comment text.  This might
		    # result in the comment callback being called more than
		    # once for the several comment data.
		    $$buf = $eaten . $$buf;
		    return $self;
		}
	    }
	    # Can we finish the tag
	    if ($$buf =~ s|^([^>]*)>||) {
		$text .= $1;
		$self->declaration($text) if $text =~ /\S/;
		if ($$buf =~ s|^((.*?)\]\])||s) {
		    $eaten .= $1;
		    $self->comment($2);
		}
	    } else {
		$$buf = $eaten . $$buf;  # must start with it all next time
		return $self;
	    }
        # Look for 'processing instructions' <? ...?> (steve)
	} elsif ($$buf =~ s|(<\?)||) {
	    my $eaten = $1;
	    if ($$buf =~ s|^([^>]*)>||) {
		my $text = $1;
		$text =~ s|\?$||; # Remove the trailing ? if any.
		$self->pi($text);
	    } else {
		$$buf = $eaten . $$buf;  # must start with it all next time
		return $self;
	    }
	# Then, look for a end tag
	} elsif ($$buf =~ s|^</||) {
	    # end tag
	    if ($$buf =~ s|^\s*([a-z][a-z0-9\:\_\.\-]*)\s*>||i) {
		$self->end_tag(lc($1));
	    } elsif ($$buf =~ s|^\s*>||i) {
		$self->end_tag('', 1);	# Empty end tag
	    } elsif ($$buf =~ m|^\s*[a-z]*[a-z0-9\:\_\.\-]*\s*$|i) {
		$$buf = "</" . $$buf;  # need more data to be sure
		return $self;
	    } else {
		# it is plain text after all
		$self -> text($$buf);
		$$buf = "";
	    }
	# Then, finally we look for a start tag
	} elsif ($$buf =~ s|^<||) {
	    # start tag
	    my $eaten = '<';

	    # This first thing we must find is a tag name.  RFC1866 says:
	    #   A name consists of a letter followed by letters,
	    #   digits, periods, or hyphens. The length of a name is
	    #   limited to 72 characters by the `NAMELEN' parameter in
	    #   the SGML declaration for HTML, 9.5, "SGML Declaration
	    #   for HTML".  In a start-tag, the element name must
	    #   immediately follow the tag open delimiter `<'.
	    if ($$buf =~ s|^(([a-zA-Z][a-zA-Z0-9\:\_\.\-]*)\s*)||) {
		$eaten .= $1;
		my $tag = $2;
		my @attr;

		# Then we would like to find some attributes
		while ($$buf =~ s|^(([a-zA-Z][a-zA-Z0-9\:\_\.\-]*)\s*)||) {
		    $eaten .= $1;
		    my $attr = $2;
		    my $val;
		    # The attribute might take an optional value (first we
		    # check for an unquoted value)
		    if ($$buf =~ s|(^=\s*([^\"\'>\s][^>\s]*)\s*)||) { #"
			$eaten .= $1;
			$val = $2;
		    # or quoted by " "or ' '
		    } elsif ($$buf =~ s|(^=\s*([\"\'])(.*?)\2\s*)||s) { #"
			$eaten .= $1;
			$val = $3;
                    # truncated just after the '=' or inside the attribute
		    } elsif ($$buf =~ m|^(=\s*)$| or
			     $$buf =~ m|^(=\s*[\"\'].*)|s) { #"
			$$buf = "$eaten$1";
			return $self;
		    } else {
			# assume attribute with implicit value
			$val = $attr;
		    }
		    push(@attr, $attr, $val);
		    #$attr{$attr}=$val
		}
		
		# At the end there should be a closing ">"
		# XML: optional closing /> treated as empty end tag
		#      could be treated as attr with a funny name and an
		#      implicit value, but that would be cheating.
		#
		if ($$buf =~ s|^>||) {
		    $self->start_tag($tag, \@attr);
		} elsif ($$buf =~ s|^\/>||) {
		    push(@attr, '_empty'=>'/');
		    $self->start_tag($tag, \@attr);
		} elsif (length $$buf) {
		    # Not a conforming start tag, regard it as normal text
		    $self -> text($eaten);
		} else {
		    $$buf = $eaten;  # need more data to know
		    return $self;
		}
	    } elsif (length $$buf) {
		$self -> text($eaten);
	    } else {
		$$buf = $eaten . $$buf;  # need more data to parse
		return $self;
	    }

	} elsif (length $$buf) {
	    die; # This should never happen
	} else {
	    # The buffer is empty now
	    return $self;
	}
    }
    $self;
}


### parseFile($file)
#	Completely parse a file.
#
sub parseFile
{
    my($self, $file) = @_;
    no strict 'refs';  # so that a symbol ref as $file works
    local(*F);
    unless (ref($file) || $file =~ /^\*[\w:]+$/) {
	# Assume $file is a filename
	open(F, $file) || die "Can't open $file: $!";
	$file = \*F;
    }
    my $chunk = '';
    while(read($file, $chunk, 2048)) {
	$self->parse($chunk);
    }
    close($file);
    $self->parse(undef); #EOF
}


1;
