W3C home > Mailing lists > Public > www-archive@w3.org > October 2004

PerlSAX 2.1 locator tests

From: Bjoern Hoehrmann <derhoermi@gmx.net>
Date: Sun, 10 Oct 2004 05:37:45 +0200
To: www-archive@w3.org
Message-ID: <4178ac63.840839443@smtp.bjoern.hoehrmann.de>

Hi,

  An experimental module to test PerlSAX 2.1 event location data. The
interface might benefit from some tweaks and I need to come up with a
good name. Specifically it might be good to offer object orientation
to specify entity_lines only once (or rather, whenever an entity is
opened) as well as the locator (as it is constant) and always provide
the diag() message so it can be used from test scripts more easily.

  use strict;
  use warnings;
  
  sub start_element_ok
  {
      my %opts = @_;
  
      return 1 if $opts{char} eq ">"; # literally included
      return 1 if $opts{char} eq ";"; # included through entity ref
      
      $opts{diag}->("'$opts{name}' must end in > or ;");
      return 0;
  }
  
  sub start_dtd_ok
  {
      my %opts = @_;
  
      return 1 if $opts{char} eq "["; # literally included
      return 1 if $opts{char} eq ">"; # included through entity ref
      
      $opts{diag}->("'$opts{name}' must end in [ or >");
      return 0;
  }
  
  sub end_dtd_ok
  {
      my %opts = @_;
  
      return 1 if $opts{char} eq ">"; # included through entity ref
      
      $opts{diag}->("'$opts{name}' must end in >");
      return 0;
  }
  
  sub start_cdata_ok
  {
      my %opts = @_;
  
      return 1 if $opts{char} eq "["; # literally included
      return 1 if $opts{char} eq ";"; # included through entity ref
      
      $opts{diag}->("'$opts{name}' must end in [ or ;");
      return 0;
  }
  
  sub start_entity_ok
  {
      my %opts = @_;
  
      return 1 if $opts{line} == 1 and $opts{colu} == 1;
  
      $opts{diag}->("'$opts{name}' must be at [1,1]");
      return 0;
  }
  
  sub end_entity_ok
  {
      my %opts = @_;
  
      warn "# todo: implement end_entity_ok\n";
  }
  
  sub warning_ok
  {
      my %opts = @_;
      my $exception = $opts{data}{Exception};
      my $l = $opts{loca};
  
      {
          no warnings 'uninitialized';
  
          return 1 if
            $l->{LineNumber}   == $exception->{LineNumber}   and
            $l->{ColumnNumber} == $exception->{ColumnNumber} and
            $l->{PublicId}     eq $exception->{PublicId}     and
            $l->{SystemId}     eq $exception->{SystemId};
      }
      
      $opts{diag}->("'$opts{name}' location must match exception");
      return 0;
  }
  
  sub characters_ok
  {
      my %opts = @_;
  
      my $etext = $opts{data}->{Data};
      return 1 if $opts{text} =~ /($etext|;)$/;
  
      $opts{diag}->("'$opts{name}' must end in '$etext'");
      return 0;
  }
  
  sub attribute_decl_ok
  {
      my %opts = @_;
  
      warn "# todo: implement end_entity_ok\n";
  }
  
  sub skipped_entity_ok
  {
      my %opts = @_;
  
      return 1 if $opts{char} eq ";";
      
      $opts{diag}->("'$opts{name}' must end in ;");
      return 0;
  }
  
  our %handler =
  (
      attribute_decl         => \&attribute_decl_ok,
      characters             => \&characters_ok,
      comment                => \&start_element_ok,
      element_decl           => \&start_element_ok,
      end_cdata              => \&start_element_ok,
      end_document           => \&end_entity_ok,
      end_dtd                => \&end_dtd_ok,
      end_element            => \&start_element_ok,
      end_entity             => \&end_entity_ok,
      end_prefix_mapping     => \&start_element_ok,
      error                  => \&warning_ok,
      external_entity_decl   => \&start_element_ok,
      fatal_error            => \&warning_ok,
      ignorable_whitespace   => \&characters_ok,
      internal_entitiy_decl  => \&start_element_ok,
      notation_decl          => \&start_element_ok,
      processing_instruction => \&start_element_ok,
      resolve_entity         => \&skipped_entity_ok,
      # set_document_locator => \&set_document_locator_ok,
      skipped_entity         => \&skipped_entity_ok,
      start_cdata            => \&start_cdata_ok,
      start_document         => \&start_entity_ok,
      start_dtd              => \&start_dtd_ok,
      start_element          => \&start_element_ok,
      start_entity           => \&start_entity_ok,
      start_prefix_mapping   => \&start_element_ok,
      unparsed_entity_decl   => \&start_element_ok,
      warning                => \&warning_ok,
  );
  
  sub sax_location_ok
  {
      my %opts = @_;
  
      my $docu = $opts{entity_lines};
      my $name = $opts{name};
      my $loca = $opts{locator};
      my $data = $opts{data} || {};
      my $diag = $opts{diag} || sub { };
      
      die "Missing entity_lines argument\n" unless defined $docu;
  
      # auto-magical behavior for undef event name
      ($name) = [caller(1)]->[3] =~ /::([^:]+)$/
        unless defined $name;
        
      if (not exists $handler{$name})
      {
          $diag->("Unknown event '$name'");
          return 0;
      }
      
      if (not defined $loca)
      {
          $diag->("Location must be defined");
          return 0;
      }
      
      # values for set_document_locator implementation defined
      return 1 if ($name eq 'set_document_locator');
  
      my $line = $loca->{LineNumber};
      my $colu = $loca->{ColumnNumber};
      
      if (not defined $line or $line <= 0)
      {
          $diag->("LineNumber must be an integer >= 1");
          return 0;
      }
      
      if (not defined $colu or $colu <= 0)
      {
          $diag->("ColumnNumber must be an integer >= 1");
          return 0;
      }
      
      if (@$docu < $line)
      {
          $diag->("LineNumber must be inside document");
          return 0;
      }
      
      if (length($docu->[$line - 1]) < $colu)
      {
          $diag->("ColumnNumber must be inside document");
          return 0;
      }
  
      my $char = substr($docu->[$line - 1], $colu - 1, 1);
      my $text = substr($docu->[$line - 1], 0, $colu);
  
      return $handler{$name}->
      (
        char => $char, line => $line, name => $name,
        text => $text, colu => $colu, loca => $loca,
        diag => $diag, data => $data, docu => $docu,
      );
  
  }
  
  # Example:
  
  print "ok" if sax_location_ok
  (
    entity_lines => ['<x/>'],
    name         => 'end_element',
    locator      => {LineNumber => 1, ColumnNumber => 3},
    diag         => sub { warn "@_\n" },
  )

regards.
Received on Sunday, 10 October 2004 03:38:34 GMT

This archive was generated by hypermail 2.2.0+W3C-0.50 : Wednesday, 7 November 2012 14:17:46 GMT