view release on metacpan or  search on metacpan

lib/Alvis/Canonical.pm  view on Meta::CPAN

		if ($context eq 'list')
		{
		    $txt.="\n  \<item\>";
		    push(@{$self->{stack}},$context);
		    push(@{$self->{stack}},'item');
		    
		}
		elsif ($context eq 'item')
		{
		    # close the previous item
		    $txt.="\</item\>\n  \<item\>";
		    push(@{$self->{stack}},'item');
		}
		elsif ($context eq 'section')
		{
		    # List start tag missing or converted to a section.
		    # Several alternatives would make sense, but for now,
		    # close the preceding section and start a new one.
		    # Avoids unnecessary structural depth.
		    $txt.="\</section\>\n  \<section\>";
		    push(@{$self->{stack}},$context);
		}
	    }
	    # Otherwise it's a loose item-type start tag => remove
	}
	else
	{
	    die("Should be impossible: a list tag that is neither of " .
		"<list> or <item> type ($tag).");
	}
    }

    return $txt;
}

sub _handle_links
{
    my $self=shift;
    my $can_doc=shift;
    my $header=shift;

    #
    # Fix links which contain already defined Alvis structures or other 
    # links (links cannot nest in Alvis)
    #
    if ($DEBUG)
    {
	my $can_doc2=$self->_to_alvis($can_doc);
	$can_doc2=$self->_pretty_print($can_doc2);
	open(F,">candoc.before");
	print F $can_doc2;
	close(F);
    }

    $self->{stack}=();
    $can_doc=~s/(\&lt;(\/)?((?:(?i)A|FRAME|IFRAME)|section|list|item)(?:\s.*?)?\&gt;)/$self->_fix_links($1,$2,$3)/sgoe;
    # close all tags left open 
#    warn "STACK:", join("|",@{$self->{stack}});
    while (defined(my $open_alvis_tag=pop(@{$self->{stack}})))
    {
	if ($open_alvis_tag=~/^(a|frame|iframe)$/o)
	{
	    $can_doc.="\&lt;/$open_alvis_tag\&gt;";
	}
	else
	{
	    die("Should be impossible: non-link opening tag " .
		"($open_alvis_tag) left on stack.");
	}
    }

    if ($DEBUG)
    {
	$can_doc=$self->_to_alvis($can_doc);
	$can_doc=$self->_pretty_print($can_doc);
	open(F,">candoc.after");
	print F $can_doc;
    }

    $self->{stack}=();
    $can_doc=~s/\&lt;(A|FRAME|IFRAME)(\s.*?)?\&gt;(.*?)\&lt;\/\1\&gt;/$self->_link($1,$2,$3,$header)/isgoe;

    if ($DEBUG)
    {
	my $can_doc2=$self->_to_alvis($can_doc);
	$can_doc2=$self->_pretty_print($can_doc2);
	open(F,">candoc.after_link");
	print F $can_doc2;
    }

    return $can_doc;
}

#
# Fixes links so they do not interleave with each other or ANY kind of element
#
sub _fix_links
{
    my $self=shift;
    my $all=shift;
    my $end=shift;
    my $tag=shift;

    if ($DEBUG)
    {
	warn "ALL:$all";
	warn "STACK NOW:",join("|",@{$self->{stack}}) if defined($self->{stack});
    }

    my $txt="";
    # If it's an end tag
    if ($end)
    {
	if ($tag=~/^(a|frame|iframe)$/io)
	{
	    # Close an immediate matching link tag in the context, if any 
	    if (defined(my $context=pop(@{$self->{stack}})))
	    {
		if ($context eq lc($tag))
		{
		    $txt.="\&lt;/$context\&gt;";
		}
		else
		{
		    # ignore this closing tag, it's misplaced/overruled
		    push(@{$self->{stack}},$context);
		}
	    }
	    # ignore this closing tag, it's misplaced/overruled
	}
	elsif ($tag=~/^(section|list|item)$/o) 
	{
	    # Close an immediate link tag in the context, if any 
	    if (defined(my $context=pop(@{$self->{stack}})))
	    {
		if ($context=~/^(a|frame|iframe)$/)
		{
		    $txt.="\&lt;/$context\&gt;";
		    # close the surrounding structure
		    if (defined(my $context=pop(@{$self->{stack}})))
		    {
			if ($tag ne $context)
			{
			    die("Should be impossible: mismatch of already " .
				"fixed immediate Alvis opening tag ($context) " .
				"and closing tag ($tag).");
			}
			
		    }
		    else
		    {
			die("Should be impossible: no already fixed " .
			    "immediate Alvis $tag tag to close surrounding " .
			    "a link tag.");
		    }
		}
		else # non-link context
		{
		    if ($tag ne $context)
		    {
			die("Should be impossible: mismatch of already " .
			    "fixed immediate Alvis opening tag ($context) " .
			    "and closing tag ($tag).");
		    }
		}
	    }
	    else # no context to close...wtf?
	    {
		die("Should be impossible: no already fixed immediate Alvis " .
		    "$tag tag to close");
	    }
	    $txt.=$all;
	}
	else
	{
	    die("Should be impossible: unrecognized closing tag type ($tag).");
	}
    }
    else # a start tag
    {
	# Whatever the tag is,
	# close an immediate matching link tag in the context, if any 
	if (defined(my $context=pop(@{$self->{stack}})))
	{
	    if ($context=~/^(a|frame|iframe)$/)
	    {
		$txt.="\&lt;/$context\&gt;";
	    }
	    else
	    {
		push(@{$self->{stack}},$context);
	    }
	}

	push(@{$self->{stack}},lc($tag)); # remember to normalize

	$txt.=$all;
    }

    return $txt;
}

sub _link
{
    my $self=shift;
    my $tag=shift;
    my $params=shift;
    my $text=shift;
    my $header=shift;

    my $txt="";
    my $url;

    my %link=();
    $link{type}=lc($tag);
    if ($link{type} eq 'a')
    {
	if (defined($params) && $params=~/href\s*=\s*([\"\'])(.*?)\1/isgo)
	{
	    $url=$self->_handle_url($2,$header->{baseURL});
	}
    }
    elsif ($link{type}=~/^(frame|iframe)$/o)
    {
	if (defined($params) && $params=~/src\s*=\s*([\'\"])(.*?)\1/isgo)
	{
	    $url=$self->_handle_url($2,$header->{baseURL});
	}
    }
    else
    {
	die("Should be impossible: Unrecognized link type ($tag).");
    }

    $text=~s/^\s+//isgo;
    $text=~s/\s+$//isgo;

    # If the URL is ok, proceed
    if (defined($url))
    {
	$url=$self->_make_attr_XML_safe($url);

	$link{url}=$url;

	if (defined($text))
	{
	    $link{text}=$text;
	}
	
	push(@{$header->{links}},\%link);

	if (defined($text))
	{
	    $txt="\&lt;ulink url=\"$link{url}\"\&gt;$text\&lt;/ulink\&gt;";
	}
	else
	{
	    $txt="\&lt;ulink url=\"$link{url}\"\&gt;\&lt;/ulink\&gt;";
	}
    }
    else # remove this non-interesting link (but retain the anchor text)
    {
	if (defined($text))
	{
	    $txt="$text";
	}
	else
	{
	    $txt="";
	}
    }

    return $txt;
}

sub _handle_url
{
    my $self=shift;
    my $url=shift;
    my $base=shift;

    if ($url=~/^\#/)
    {