SGML::Parser::OpenSP::Tools - Tools to process OpenSP output

  Copyright (c) 2006-2008 Bjoern Hoehrmann <bjoern@hoehrmann.de>.
  This module is licensed under the same terms as Perl itself.

# Tools.pm -- SGML::Parser::OpenSP::Tools module
#
# $Id: Tools.pm,v 1.9 2006/08/30 14:50:35 hoehrmann Exp $

package SGML::Parser::OpenSP::Tools;
use 5.008; 
use strict;
use warnings;
use Carp;

# white-space as defined in XML 1.0
our $WHITESPACE = qr/[\x20\x09\x0d\x0a]/;

sub value_attribute
{
    my $attr = shift;
    
    # illegal input
    return 0 unless defined $attr;
    return 0 unless ref $attr eq "HASH";
    return 0 unless exists $attr->{Type};
    
    # these cannot have values
    return 0 if $attr->{Type} eq "implied";
    return 0 if $attr->{Type} eq "invalid";
    
    return 1;
}

sub specified_attribute
{
    my $attr = shift;

    return 0 unless value_attribute($attr);
    return 0 if $attr->{Defaulted} ne "specified";
    return 1;
}

sub defaulted_attribute
{
    my $attr = shift;
    return 0 unless value_attribute($attr);
    return 0 if $attr->{Defaulted} eq "specified";
    return 1;
}

sub attribute_value
{
    my $attr = shift;
    
    # ...
    return unless value_attribute($attr);

    # tokenized attributes
    return $attr->{Tokens}
      if $attr->{Type} eq "tokenized";

    my $value = "";
    
    # type is cdata
    foreach my $chunk (@{$attr->{CdataChunks}})
    {
        # todo: fix this for SDATA
        # todo: fix this for non-sgml chars

        $value .= $chunk->{Data};
    }
    
    return $value;
}

sub split_pi
{
    my $orig = shift;

    return unless defined $orig;
    return unless length $orig;
    
    my ($targ, $data) = split /$WHITESPACE/, $orig, 1;
    
    return $targ, $data;
}

sub split_message
{
    my $mess = shift; # message text
    my $name = shift; # file name
    my $oent = shift; # show_open_entities
    my $errn = shift; # show_error_numbers
    my $oelm = shift; # show_open_elements
    my $mess_debug = $mess;
    
    my %resu;
    
    if ($oent)
    {
        while($mess =~ s/^In entity (\S+) included from (.*?):(\d+):(\d+)\s+//)
        {
            push @{$resu{open_entities}}, { EntityName   => $1,
                                            FileName     => $2,
                                            LineNumber   => $3,
                                            ColumnNumber => $4 }
        }
    }
    
    # this splits the error message into its components. this is designed
    # to cope with most if not all delimiter problems inherent to the
    # message format which does not escape delimiters which can result in
    # ambiguous data. The following format is expected by this code
    # each error message component starts on a new line which is either
    # the first line or something that follows \n, then an optional formal
    # system identifier such as <LITERAL> or <OSFILE>, then the file name
    # as reported by $p->get_location->{FileName} then the line and finally
    # the column number -- for each message there should thus be three
    # individual components, line, column, "text" -- which can contain
    # additional components depending on the message, see below.
    
    my @comp = split(/(?:^|\n)(?:<[^>]+>)?\Q$name\E:(\d+):(\d+):\s*/, $mess);
    
    # check for proper format, the first component must be
    # empty and each entry must have line, column and text
    croak "Unexpected error message format ($mess_debug)"
      if length $comp[0] or (@comp - 1) % 3;
    
    # remove empty component
    shift @comp;
    
    # the first component is the primary message
    $resu{primary_message}->{LineNumber}   = shift @comp;
    $resu{primary_message}->{ColumnNumber} = shift @comp;
    
    if ($errn)
    {
        # with show_error_numbers the first component is
        # "<module>.<error number>", remove and store it
        $comp[0] =~ s/^(\d+)\.(\d+)://;
        
        # this can happen if it was incorrectly specified
        # that show_error_numbers was enabled or if OpenSP
        # has a bug that causes the number to be missing
        croak "message lacks error number information"
          unless defined $1 and defined $2;
        
        $resu{primary_message}->{Module} = $1;
        $resu{primary_message}->{Number} = $2;
    }
    
    # next component is a character indicating the severity
    $comp[0] =~ s/^(\w):\s+//;

    # this can happen if OpenSP has a bug in this regard
    croak "severity character missing from error message"
      unless defined $1;
      
    $resu{primary_message}->{Severity} = $1;

    # trim trailing white-space from the text
    $comp[0] =~ s/\s+$//;

    # the remainder of the message is the error message text
    $resu{primary_message}->{Text} = shift @comp;

    # optional auxiliary message
    if (@comp > 3 or (@comp == 3 and !$oelm))
    {
        # trim trailing white-space from the text
        $comp[2] =~ s/\s+$//;
        
        $resu{aux_message}->{LineNumber}   = shift @comp;
        $resu{aux_message}->{ColumnNumber} = shift @comp;
        $resu{aux_message}->{Text}         = shift @comp;
    }
    
    # open elements are optional in SGML declarations, etc.
    if ($oelm and @comp)
    {
        # this should only happen in case of OpenSP bugs
        croak "unexpected number of components in message"
          unless @comp == 3;

        croak "expected listing of open elements"
          unless pop(@comp) =~ /^open elements: (.*)/s;
          
        $resu{open_elements} = $1;
    }
    
    \%resu
}

1;

__END__