- From: Bjoern Hoehrmann <derhoermi@gmx.net>
- Date: Sun, 10 Oct 2004 05:37:45 +0200
- To: www-archive@w3.org
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 UTC