# HG changeset patch # User Dario Sestito # Date 1267635086 0 # Node ID 6d3c3db11e72b177e746529a0b4134106c33fb65 # Parent 266a7e9b9237b6ffbde43b77ca0727a210188172 Add Raptor uh parser diff -r 266a7e9b9237 -r 6d3c3db11e72 uh_parser/RaptorCommon.pm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/uh_parser/RaptorCommon.pm Wed Mar 03 16:51:26 2010 +0000 @@ -0,0 +1,41 @@ +# Copyright (c) 2009 Symbian Foundation Ltd +# This component and the accompanying materials are made available +# under the terms of the License "Eclipse Public License v1.0" +# which accompanies this distribution, and is available +# at the URL "http://www.eclipse.org/legal/epl-v10.html". +# +# Initial Contributors: +# Symbian Foundation Ltd - initial contribution. +# +# Contributors: +# +# Description: +# Common constants for the raptor parser suite + +package RaptorCommon; + +our $SEVERITY_CRITICAL = 'critical'; +our $SEVERITY_MAJOR = 'major'; +our $SEVERITY_MINOR = 'minor'; + +sub init +{ + my $filename = "$::raptorbitsdir/summary.csv"; + if (!-f$filename) + { + print "Writing summary file $filename\n"; + open(SUMMARY, ">$filename"); + close(SUMMARY); + } +} + +sub dump_fault +{ + my ($category, $subcategory, $severity, $location, $component, $mmp, $phase, $recipe, $file, $line) = @_; + + open(SUMMARY, ">>$::raptorbitsdir/summary.csv"); + print SUMMARY "$category,$subcategory,$severity,$location,$component,$mmp,$phase,$recipe,$file,$line\n"; + close(SUMMARY); +} + +1; diff -r 266a7e9b9237 -r 6d3c3db11e72 uh_parser/RaptorError.pm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/uh_parser/RaptorError.pm Wed Mar 03 16:51:26 2010 +0000 @@ -0,0 +1,170 @@ +# Copyright (c) 2009 Symbian Foundation Ltd +# This component and the accompanying materials are made available +# under the terms of the License "Eclipse Public License v1.0" +# which accompanies this distribution, and is available +# at the URL "http://www.eclipse.org/legal/epl-v10.html". +# +# Initial Contributors: +# Symbian Foundation Ltd - initial contribution. +# +# Contributors: +# +# Description: +# Raptor parser module. +# Extract, analyzes and dumps raptor errors i.e. content of tags from a raptor log file + +package RaptorError; + +use strict; +use RaptorCommon; + +our $reset_status = {}; +my $buildlog_status = {}; +my $buildlog_error_status = {}; + +$reset_status->{name} = 'reset_status'; +$reset_status->{next_status} = {buildlog=>$buildlog_status}; + +$buildlog_status->{name} = 'buildlog_status'; +$buildlog_status->{next_status} = {error=>$buildlog_error_status}; +$buildlog_status->{on_start} = 'RaptorError::on_start_buildlog'; + +$buildlog_error_status->{name} = 'buildlog_error_status'; +$buildlog_error_status->{next_status} = {}; +$buildlog_error_status->{on_start} = 'RaptorError::on_start_buildlog_error'; +$buildlog_error_status->{on_end} = 'RaptorError::on_end_buildlog_error'; +$buildlog_error_status->{on_chars} = 'RaptorError::on_chars_buildlog_error'; + +my $filename = ''; +my $failure_item = 0; + +my $characters = ''; + +my $CATEGORY_RAPTORERROR = 'raptor_error'; +my $CATEGORY_RAPTORERROR_CANNOTPROCESSSCHEMAVERSION = 'cannot_process_schema_version'; +my $CATEGORY_RAPTORERROR_NOBLDINFFOUND = 'no_bld_inf_found'; +my $CATEGORY_RAPTORERROR_CANTFINDMMPFILE = 'cant_find_mmp_file'; +my $CATEGORY_RAPTORERROR_MAKEEXITEDWITHERRORS = 'make_exited_with_errors'; +my $CATEGORY_RAPTORERROR_TOOLDIDNOTRETURNVERSION = 'tool_didnot_return_version'; +my $CATEGORY_RAPTORERROR_UNKNOWNBUILDCONFIG = 'unknown_build_config'; +my $CATEGORY_RAPTORERROR_NOBUILDCONFIGSGIVEN = 'no_build_configs_given'; + +sub process +{ + my ($text, $logfile, $component, $mmp, $phase, $recipe, $file, $line) = @_; + + my $category = $CATEGORY_RAPTORERROR; + my $severity = ''; + my $subcategory = ''; + + if ($text =~ m,Cannot process schema version .* of file,) + { + $severity = $RaptorCommon::SEVERITY_CRITICAL; + $subcategory = $CATEGORY_RAPTORERROR_CANNOTPROCESSSCHEMAVERSION; + RaptorCommon::dump_fault($category, $subcategory, $severity, $logfile, $component, $mmp, $phase, $recipe, $file, $line); + } + elsif ($text =~ m,No bld\.inf found at,) + { + $severity = $RaptorCommon::SEVERITY_MAJOR; + $subcategory = $CATEGORY_RAPTORERROR_NOBLDINFFOUND; + RaptorCommon::dump_fault($category, $subcategory, $severity, $logfile, $component, $mmp, $phase, $recipe, $file, $line); + } + elsif ($text =~ m,Can't find mmp file,) + { + $severity = $RaptorCommon::SEVERITY_MINOR; + $subcategory = $CATEGORY_RAPTORERROR_CANTFINDMMPFILE; + RaptorCommon::dump_fault($category, $subcategory, $severity, $logfile, $component, $mmp, $phase, $recipe, $file, $line); + } + elsif ($text =~ m,The make-engine exited with errors,) + { + $severity = $RaptorCommon::SEVERITY_CRITICAL; + $subcategory = $CATEGORY_RAPTORERROR_MAKEEXITEDWITHERRORS; + RaptorCommon::dump_fault($category, $subcategory, $severity, $logfile, $component, $mmp, $phase, $recipe, $file, $line); + } + elsif ($text =~ m,tool .* from config .* did not return version .* as required,) + { + $severity = $RaptorCommon::SEVERITY_CRITICAL; + $subcategory = $CATEGORY_RAPTORERROR_TOOLDIDNOTRETURNVERSION; + RaptorCommon::dump_fault($category, $subcategory, $severity, $logfile, $component, $mmp, $phase, $recipe, $file, $line); + } + elsif ($text =~ m,Unknown build configuration '.*',) + { + $severity = $RaptorCommon::SEVERITY_CRITICAL; + $subcategory = $CATEGORY_RAPTORERROR_UNKNOWNBUILDCONFIG; + RaptorCommon::dump_fault($category, $subcategory, $severity, $logfile, $component, $mmp, $phase, $recipe, $file, $line); + } + elsif ($text =~ m,No build configurations given,) + { + $severity = $RaptorCommon::SEVERITY_CRITICAL; + $subcategory = $CATEGORY_RAPTORERROR_NOBUILDCONFIGSGIVEN; + RaptorCommon::dump_fault($category, $subcategory, $severity, $logfile, $component, $mmp, $phase, $recipe, $file, $line); + } + else # log everything by default + { + RaptorCommon::dump_fault($category, $subcategory, $severity, $logfile, $component, $mmp, $phase, $recipe, $file, $line); + } +} + +sub on_start_buildlog +{ + RaptorCommon::init(); + + $filename = "$::raptorbitsdir/raptor_error.txt"; + if (!-f$filename) + { + print "Writing errors file $filename\n"; + open(FILE, ">$filename"); + close(FILE); + } +} + +sub on_start_buildlog_error +{ +} + +sub on_chars_buildlog_error +{ + my ($ch) = @_; + + #print "on_chars_buildlog_error\n"; + + $characters .= $ch->{Data}; + + #print "characters is now -->$characters<--\n"; +} + +sub on_end_buildlog_error +{ + #print "on_end_buildlog_error\n"; + + $characters =~ s,^[\r\n]*,,; + $characters =~ s,[\r\n]*$,,; + + if ($characters =~ m,[^\s^\r^\n],) + { + if ($failure_item == 0 and -f "$filename") + { + open(FILE, "$filename"); + { + local $/ = undef; + my $filecontent = ; + $failure_item = $1 if ($filecontent =~ m/.*---failure_item_(\d+)/s); + } + close(FILE); + } + + $failure_item++; + + open(FILE, ">>$filename"); + print FILE "---failure_item_$failure_item\---\n"; + print FILE "$characters\n\n"; + close(FILE); + + process($characters, $::current_log_file, '', '', '', '', "raptor_error.txt", $failure_item); + } + + $characters = ''; +} + + +1; \ No newline at end of file diff -r 266a7e9b9237 -r 6d3c3db11e72 uh_parser/RaptorInfo.pm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/uh_parser/RaptorInfo.pm Wed Mar 03 16:51:26 2010 +0000 @@ -0,0 +1,89 @@ +# Copyright (c) 2009 Symbian Foundation Ltd +# This component and the accompanying materials are made available +# under the terms of the License "Eclipse Public License v1.0" +# which accompanies this distribution, and is available +# at the URL "http://www.eclipse.org/legal/epl-v10.html". +# +# Initial Contributors: +# Symbian Foundation Ltd - initial contribution. +# +# Contributors: +# +# Description: +# Raptor parser module. +# Extract, analyzes and dumps raptor info text i.e. content of tags from a raptor log file + +package RaptorInfo; + +use strict; +use RaptorCommon; + +our $reset_status = {}; +my $buildlog_status = {}; +my $buildlog_info_status = {}; + +$reset_status->{name} = 'reset_status'; +$reset_status->{next_status} = {buildlog=>$buildlog_status}; + +$buildlog_status->{name} = 'buildlog_status'; +$buildlog_status->{next_status} = {info=>$buildlog_info_status}; + +$buildlog_info_status->{name} = 'buildlog_info_status'; +$buildlog_info_status->{next_status} = {}; +$buildlog_info_status->{on_start} = 'RaptorInfo::on_start_buildlog_info'; +$buildlog_info_status->{on_end} = 'RaptorInfo::on_end_buildlog_info'; +$buildlog_info_status->{on_chars} = 'RaptorInfo::on_chars_buildlog_info'; + +my $characters = ''; + +my $category = $RaptorCommon::CATEGORY_RAPTORINFO; + +sub process +{ + my ($text) = @_; + + my $severity = ''; + + if ($text =~ m,unmatchable,) + { + $severity = $RaptorCommon::SEVERITY_CRITICAL; + + #dump_error($category, $severity, $text); + print "$category, $severity, $text\n"; + } +} + +sub on_start_buildlog_info +{ + my $filename = "$::raptorbitsdir/info.txt"; + print "Writing info file $filename\n" if (!-f$filename); + open(FILE, ">>$filename"); +} + +sub on_chars_buildlog_info +{ + my ($ch) = @_; + + #print "on_chars_buildlog_info\n"; + + $characters .= $ch->{Data}; + + #print "characters is now -->$characters<--\n"; +} + +sub on_end_buildlog_info +{ + #print "on_end_buildlog_info\n"; + + process($characters); + + print FILE $characters if ($characters =~ m,[^\s^\r^\n],); + print FILE "\n" if ($characters !~ m,[\r\n]$, ); + + $characters = ''; + + close(FILE); +} + + +1; \ No newline at end of file diff -r 266a7e9b9237 -r 6d3c3db11e72 uh_parser/RaptorRecipe.pm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/uh_parser/RaptorRecipe.pm Wed Mar 03 16:51:26 2010 +0000 @@ -0,0 +1,279 @@ +# Copyright (c) 2009 Symbian Foundation Ltd +# This component and the accompanying materials are made available +# under the terms of the License "Eclipse Public License v1.0" +# which accompanies this distribution, and is available +# at the URL "http://www.eclipse.org/legal/epl-v10.html". +# +# Initial Contributors: +# Symbian Foundation Ltd - initial contribution. +# +# Contributors: +# +# Description: +# Raptor parser module. +# Extract, analyzes and dumps raptor recipes i.e. content of tags from a raptor log file + +package RaptorRecipe; + +use strict; +use RaptorCommon; + +our $reset_status = {}; +my $buildlog_status = {}; +my $buildlog_recipe_status = {}; +my $buildlog_recipe_status_status = {}; + +$reset_status->{name} = 'reset_status'; +$reset_status->{next_status} = {buildlog=>$buildlog_status}; + +$buildlog_status->{name} = 'buildlog_status'; +$buildlog_status->{next_status} = {recipe=>$buildlog_recipe_status}; +$buildlog_status->{on_start} = 'RaptorRecipe::on_start_buildlog'; +$buildlog_status->{on_end} = 'RaptorRecipe::on_end_buildlog'; + +$buildlog_recipe_status->{name} = 'buildlog_recipe_status'; +$buildlog_recipe_status->{next_status} = {status=>$buildlog_recipe_status_status}; +$buildlog_recipe_status->{on_start} = 'RaptorRecipe::on_start_buildlog_recipe'; +$buildlog_recipe_status->{on_end} = 'RaptorRecipe::on_end_buildlog_recipe'; +$buildlog_recipe_status->{on_chars} = 'RaptorRecipe::on_chars_buildlog_recipe'; + +$buildlog_recipe_status_status->{name} = 'buildlog_recipe_status_status'; +$buildlog_recipe_status_status->{next_status} = {}; +$buildlog_recipe_status_status->{on_start} = 'RaptorRecipe::on_start_buildlog_recipe_status'; + + +my $filename = ''; +my $failure_item = 0; + +my $recipe_info = {}; + +my $characters = ''; + +my $CATEGORY_RECIPEFAILURE = 'recipe_failure'; +my $CATEGORY_RECIPEFAILURE_ARMCC_CANNOTOPENSOURCEINPUTFILE = 'armcc_cannot_open_source_input_file'; +my $CATEGORY_RECIPEFAILURE_ARMLINK_COULDNOTOPENFILE = 'armlink_could_not_open_file'; +my $CATEGORY_RECIPEFAILURE_ELF2E32_COULDNOTOPENFILE = 'elf2e32_could_not_open_file'; +my $CATEGORY_RECIPEFAILURE_ARMAR_FILEDOESNOTEXIST = 'armar_file_does_not_exist'; +my $CATEGORY_RECIPEFAILURE_ARMCC_CONTROLLINGEXPRESSIONISCONSTANT = 'armcc_controlling_expression_is_constant'; +my $CATEGORY_RECIPEFAILURE_ARMCC_INTERNALFAULT = 'armcc_internal_fault'; +my $CATEGORY_RECIPEFAILURE_ARMCC_MODIFIERNOTALLOWED = 'armcc_modifier_not_allowed'; +my $CATEGORY_RECIPEFAILURE_ARMCC_GENERICWARNINGSERRORS = 'armcc_generic_warnings_errors'; +my $CATEGORY_RECIPEFAILURE_ELF2E32_SYMBOLMISSINGFROMELFFILE = 'elf2e32_symbol_missing_from_elf_file'; +my $CATEGORY_RECIPEFAILURE_MWCCSYM2_FILECANNOTBEOPENED = 'mwccsym2_file_cannot_be_opened'; + +my $mmp_with_issues = {}; + + +sub process +{ + my ($text, $config, $component, $mmp, $phase, $recipe, $file, $line) = @_; + + my $category = $CATEGORY_RECIPEFAILURE; + my $severity = ''; + my $subcategory = ''; + + # if mmp is defined assign severity=MAJOR for the first failure + # then severity=MINOR to all other (for each logfile) + if ($mmp and defined $mmp_with_issues->{$::current_log_file}->{$mmp}) + { + $severity = $RaptorCommon::SEVERITY_MINOR; + } + elsif ($mmp) + { + $mmp_with_issues->{$::current_log_file} = {} if (!defined $mmp_with_issues->{$::current_log_file}); + $mmp_with_issues->{$::current_log_file}->{$mmp} = 1; + $severity = $RaptorCommon::SEVERITY_MAJOR; + } + else + { + $severity = $RaptorCommon::SEVERITY_MAJOR; + } + + + if ($text =~ m,Error: #5: cannot open source input file .*: No such file or directory,) + { + my $subcategory = $CATEGORY_RECIPEFAILURE_ARMCC_CANNOTOPENSOURCEINPUTFILE; + RaptorCommon::dump_fault($category, $subcategory, $severity, $config, $component, $mmp, $phase, $recipe, $file, $line); + } + elsif ($text =~ m,Fatal error: L6002U: Could not open file .*: No such file or directory,) + { + my $subcategory = $CATEGORY_RECIPEFAILURE_ARMLINK_COULDNOTOPENFILE; + RaptorCommon::dump_fault($category, $subcategory, $severity, $config, $component, $mmp, $phase, $recipe, $file, $line); + } + elsif ($text =~ m,elf2e32 : Error: E1001: Could not open file : .*.,) + { + my $subcategory = $CATEGORY_RECIPEFAILURE_ELF2E32_COULDNOTOPENFILE; + RaptorCommon::dump_fault($category, $subcategory, $severity, $config, $component, $mmp, $phase, $recipe, $file, $line); + } + elsif ($text =~ m,elf2e32 : Error: E1036: Symbol .* Missing from ELF File,) + { + my $subcategory = $CATEGORY_RECIPEFAILURE_ELF2E32_SYMBOLMISSINGFROMELFFILE; + RaptorCommon::dump_fault($category, $subcategory, $severity, $config, $component, $mmp, $phase, $recipe, $file, $line); + } + elsif ($text =~ m,Error: L6833E: File '.*' does not exist,) + { + my $subcategory = $CATEGORY_RECIPEFAILURE_ARMAR_FILEDOESNOTEXIST; + RaptorCommon::dump_fault($category, $subcategory, $severity, $config, $component, $mmp, $phase, $recipe, $file, $line); + } + elsif ($text =~ m,: Warning: #236-D: controlling expression is constant,) + { + my $subcategory = $CATEGORY_RECIPEFAILURE_ARMCC_CONTROLLINGEXPRESSIONISCONSTANT; + RaptorCommon::dump_fault($category, $subcategory, $severity, $config, $component, $mmp, $phase, $recipe, $file, $line); + } + elsif ($text =~ m,/armcc.exe , and $text =~ m,Internal fault: ,) + { + my $subcategory = $CATEGORY_RECIPEFAILURE_ARMCC_INTERNALFAULT; + RaptorCommon::dump_fault($category, $subcategory, $severity, $config, $component, $mmp, $phase, $recipe, $file, $line); + } + elsif ($text =~ m,/armcc.exe , and $text =~ m,Error: #655-D: the modifier ".*" is not allowed on this declaration,) + { + my $subcategory = $CATEGORY_RECIPEFAILURE_ARMCC_MODIFIERNOTALLOWED; + RaptorCommon::dump_fault($category, $subcategory, $severity, $config, $component, $mmp, $phase, $recipe, $file, $line); + } + # the following captures generic armcc error/warnings, not captured by regexps above + elsif ($text =~ m,/armcc.exe , and $text =~ m,: \d+ warnings\, \d+ errors$,) + { + my $subcategory = $CATEGORY_RECIPEFAILURE_ARMCC_GENERICWARNINGSERRORS; + RaptorCommon::dump_fault($category, $subcategory, $severity, $config, $component, $mmp, $phase, $recipe, $file, $line); + } + elsif ($text =~ m,mwccsym2.exe , and $text =~ m,: the file '.*' cannot be opened,) + { + my $subcategory = $CATEGORY_RECIPEFAILURE_MWCCSYM2_FILECANNOTBEOPENED; + RaptorCommon::dump_fault($category, $subcategory, $severity, $config, $component, $mmp, $phase, $recipe, $file, $line); + } + else # log everything by default + { + RaptorCommon::dump_fault($category, $subcategory, $severity, $config, $component, $mmp, $phase, $recipe, $file, $line); + } +} + +sub on_start_buildlog +{ + #print FILE "line,layer,component,name,armlicence,platform,phase,code,bldinf,mmp,target,source,\n"; + + RaptorCommon::init(); +} + +sub on_start_buildlog_recipe +{ + my ($el) = @_; + + #print "on_start_buildlog_recipe\n"; + + $recipe_info = {}; + + my $attributes = $el->{Attributes}; + for (keys %{$attributes}) + { + $recipe_info->{$attributes->{$_}->{'LocalName'}} = $attributes->{$_}->{'Value'}; + #print "$_ -> $attributes->{$_}->{'Value'}\n"; + } +} + +sub on_chars_buildlog_recipe +{ + my ($ch) = @_; + + #print "on_chars_buildlog_recipe\n"; + + $characters .= $ch->{Data}; + + #print "characters is now -->$characters<--\n"; +} + +sub on_start_buildlog_recipe_status +{ + my ($el) = @_; + + my $attributes = $el->{Attributes}; + for (keys %{$attributes}) + { + if ($attributes->{$_}->{'LocalName'} eq 'code') + { + $recipe_info->{$attributes->{$_}->{'LocalName'}} = $attributes->{$_}->{'Value'}; + } + elsif ($attributes->{$_}->{'LocalName'} eq 'exit') + { + $recipe_info->{$attributes->{$_}->{'LocalName'}} = $attributes->{$_}->{'Value'}; + } + elsif ($attributes->{$_}->{'LocalName'} eq 'attempt') + { + $recipe_info->{$attributes->{$_}->{'LocalName'}} = $attributes->{$_}->{'Value'}; + } + } +} + +sub on_end_buildlog_recipe +{ + $::allbldinfs->{$recipe_info->{bldinf}} = 1; + + if ($recipe_info->{exit} =~ /failed/) + { + # normalize bldinf path + $recipe_info->{bldinf} = lc($recipe_info->{bldinf}); + $recipe_info->{bldinf} =~ s,^[A-Za-z]:,,; + $recipe_info->{bldinf} =~ s,[\\],/,g; + + my $package = ''; + if ($recipe_info->{bldinf} =~ m,/((os|mw|app|tools|ostools|adaptation)/[^/]*),) + { + $package = $1; + $package =~ s,/,_,; + } + else + { + print "WARNING: can't understand bldinf attribute of recipe: $recipe_info->{bldinf}. Won't dump to failed recipes file.\n"; + } + + # also normalize mmp path if this exists + if ($recipe_info->{mmp}) + { + $recipe_info->{mmp} = lc($recipe_info->{mmp}); + $recipe_info->{mmp} =~ s,^[A-Za-z]:,,; + $recipe_info->{mmp} =~ s,[\\],/,g; + } + + $characters =~ s,^[\r\n]*,,; + $characters =~ s,[\r\n]*$,,; + + if ($package) + { + $filename = "$::raptorbitsdir/$package.txt"; + if (!-f$filename) + { + print "Writing recipe file $filename\n"; + open(FILE, ">$filename"); + close(FILE); + } + + if ($failure_item == 0 and -f "$filename") + { + open(FILE, "$filename"); + { + local $/ = undef; + my $filecontent = ; + $failure_item = $1 if ($filecontent =~ m/.*---failure_item_(\d+)/s); + } + close(FILE); + } + + $failure_item++; + + open(FILE, ">>$filename"); + print FILE "---failure_item_$failure_item\---\n"; + print FILE "$characters\n\n"; + close(FILE); + } + + process($characters, $recipe_info->{config}, $recipe_info->{bldinf}, $recipe_info->{mmp}, $recipe_info->{phase}, $recipe_info->{name}, "$package.txt", $failure_item); + } + + $characters = ''; +} + +sub on_end_buildlog +{ +} + + +1; \ No newline at end of file diff -r 266a7e9b9237 -r 6d3c3db11e72 uh_parser/RaptorSAXHandler.pm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/uh_parser/RaptorSAXHandler.pm Wed Mar 03 16:51:26 2010 +0000 @@ -0,0 +1,108 @@ +# Copyright (c) 2009 Symbian Foundation Ltd +# This component and the accompanying materials are made available +# under the terms of the License "Eclipse Public License v1.0" +# which accompanies this distribution, and is available +# at the URL "http://www.eclipse.org/legal/epl-v10.html". +# +# Initial Contributors: +# Symbian Foundation Ltd - initial contribution. +# +# Contributors: +# +# Description: +# SAX Handler for the Raptor log + +package RaptorSAXHandler; +use base qw(XML::SAX::Base); + +sub new +{ + my ($type) = @_; + + return bless {}, $type; +} + +sub add_observer +{ + my ($self, $name, $initialstatus) = @_; + + $self->{observers} = {} if (!defined $self->{observers}); + + $self->{observers}->{$name} = $initialstatus; +} + +sub start_document +{ + my ($self, $doc) = @_; + # process document start event + + #print "start_document\n"; +} + +sub start_element +{ + my ($self, $el) = @_; + # process element start event + + my $tagname = $el->{LocalName}; + + #print "start_element($tagname)\n"; + + for my $observer (keys %{$self->{observers}}) + { + #print "processing observer $observer: $self->{observers}->{$observer} $self->{observers}->{$observer}->{name}\n"; + #for (keys %{$self->{observers}->{$observer}->{next_status}}) {print "$_\n";} + + if (defined $self->{observers}->{$observer}->{next_status}->{$tagname}) + { + #print "processing observer $observer\n"; + my $oldstatus = $self->{observers}->{$observer}; + $self->{observers}->{$observer} = $self->{observers}->{$observer}->{next_status}->{$tagname}; + #print "$observer: status is now $self->{observers}->{$observer}->{name}\n"; + $self->{observers}->{$observer}->{next_status}->{$tagname} = $oldstatus; + &{$self->{observers}->{$observer}->{on_start}}($el) if (defined $self->{observers}->{$observer}->{on_start}); + } + elsif (defined $self->{observers}->{$observer}->{next_status}->{'?default?'}) + { + #print "processing observer $observer\n"; + #print "changing to default status\n"; + my $oldstatus = $self->{observers}->{$observer}; + $self->{observers}->{$observer} = $self->{observers}->{$observer}->{next_status}->{'?default?'}; + #print "status is now ?default?\n"; + $self->{observers}->{$observer}->{next_status}->{$tagname} = $oldstatus; + &{$self->{observers}->{$observer}->{on_start}}($el) if (defined $self->{observers}->{$observer}->{on_start}); + } + } +} + +sub end_element +{ + my ($self, $el) = @_; + # process element start event + + my $tagname = $el->{LocalName}; + + #print "end_element($tagname)\n"; + + for my $observer (keys %{$self->{observers}}) + { + if (defined $self->{observers}->{$observer}->{next_status}->{$tagname}) + { + &{$self->{observers}->{$observer}->{on_end}}($el) if (defined $self->{observers}->{$observer}->{on_end}); + $self->{observers}->{$observer} = $self->{observers}->{$observer}->{next_status}->{$tagname}; + #print "status is now $self->{observers}->{$observer}->{name}\n"; + } + } +} + +sub characters +{ + my ($self, $ch) = @_; + + for my $observer (keys %{$self->{observers}}) + { + &{$self->{observers}->{$observer}->{on_chars}}($ch) if (defined $self->{observers}->{$observer}->{on_chars}); + } +} + +1; diff -r 266a7e9b9237 -r 6d3c3db11e72 uh_parser/RaptorUnreciped.pm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/uh_parser/RaptorUnreciped.pm Wed Mar 03 16:51:26 2010 +0000 @@ -0,0 +1,184 @@ +# Copyright (c) 2009 Symbian Foundation Ltd +# This component and the accompanying materials are made available +# under the terms of the License "Eclipse Public License v1.0" +# which accompanies this distribution, and is available +# at the URL "http://www.eclipse.org/legal/epl-v10.html". +# +# Initial Contributors: +# Symbian Foundation Ltd - initial contribution. +# +# Contributors: +# +# Description: +# Raptor parser module. +# Extract, analyzes and dumps text in context which doesn't belong to any tags + +package RaptorUnreciped; + +use strict; +use RaptorCommon; + +our $reset_status = {}; +my $buildlog_status = {}; +my $buildlog_subtag_status = {}; + +$reset_status->{name} = 'reset_status'; +$reset_status->{next_status} = {buildlog=>$buildlog_status}; + +$buildlog_status->{name} = 'buildlog_status'; +$buildlog_status->{next_status} = {'?default?'=>$buildlog_subtag_status}; +$buildlog_status->{on_start} = 'RaptorUnreciped::on_start_buildlog'; +$buildlog_status->{on_end} = 'RaptorUnreciped::on_end_buildlog'; +$buildlog_status->{on_chars} = 'RaptorUnreciped::on_chars_buildlog'; + +$buildlog_subtag_status->{name} = 'buildlog_subtag_status'; +$buildlog_subtag_status->{next_status} = {}; +$buildlog_subtag_status->{on_start} = 'RaptorUnreciped::on_start_buildlog_subtag'; +$buildlog_subtag_status->{on_end} = 'RaptorUnreciped::on_end_buildlog_subtag'; + +my $filename = ''; +my $failure_item = 0; + +my $characters = ''; +my $store_chars = 1; + +my $CATEGORY_RAPTORUNRECIPED = 'raptor_unreciped'; +my $CATEGORY_RAPTORUNRECIPED_NORULETOMAKETARGET = 'no_rule_to_make_target'; +my $CATEGORY_RAPTORUNRECIPED_TARGETNOTREMADEFORERRORS = 'target_not_remade_for_errors'; +my $CATEGORY_RAPTORUNRECIPED_IGNORINGOLDCOMMANDSFORTARGET = 'ignoring_old_commands_for_target'; +my $CATEGORY_RAPTORUNRECIPED_OVERRIDINGCOMMANDSFORTARGET = 'overriding_commands_for_target'; + +sub process +{ + my ($text, $logfile, $component, $mmp, $phase, $recipe, $file, $line) = @_; + + my $category = $CATEGORY_RAPTORUNRECIPED; + my $severity = ''; + my $subcategory = ''; + + if ($text =~ m,make\.exe: \*\*\* No rule to make target,) + { + $severity = $RaptorCommon::SEVERITY_MAJOR; + my $subcategory = $CATEGORY_RAPTORUNRECIPED_NORULETOMAKETARGET; + RaptorCommon::dump_fault($category, $subcategory, $severity, $logfile, $component, $mmp, $phase, $recipe, $file, $line); + } + elsif ($text =~ m,make\.exe: Target .* not remade because of errors,) + { + $severity = $RaptorCommon::SEVERITY_MINOR; + my $subcategory = $CATEGORY_RAPTORUNRECIPED_TARGETNOTREMADEFORERRORS; + RaptorCommon::dump_fault($category, $subcategory, $severity, $logfile, $component, $mmp, $phase, $recipe, $file, $line); + } + elsif ($text =~ m,: warning: ignoring old commands for target,) + { + $severity = $RaptorCommon::SEVERITY_MINOR; + my $subcategory = $CATEGORY_RAPTORUNRECIPED_IGNORINGOLDCOMMANDSFORTARGET; + RaptorCommon::dump_fault($category, $subcategory, $severity, $logfile, $component, $mmp, $phase, $recipe, $file, $line); + } + elsif ($text =~ m,: warning: overriding commands for target,) + { + $severity = $RaptorCommon::SEVERITY_MINOR; + my $subcategory = $CATEGORY_RAPTORUNRECIPED_OVERRIDINGCOMMANDSFORTARGET; + RaptorCommon::dump_fault($category, $subcategory, $severity, $logfile, $component, $mmp, $phase, $recipe, $file, $line); + } + elsif ($text =~ m,make\.exe: Nothing to be done for .*,) + { + # don't dump + } + elsif ($text =~ m,^(true|false)$,) + { + # don't dump + } + else # log everything by default + { + RaptorCommon::dump_fault($category, $subcategory, $severity, $logfile, $component, $mmp, $phase, $recipe, $file, $line); + } +} + +sub on_start_buildlog +{ + RaptorCommon::init(); + + $filename = "$::raptorbitsdir/raptor_unreciped.txt"; + if (!-f$filename) + { + print "Writing unreciped file $filename\n"; + open(FILE, ">$filename"); + close(FILE); + } +} + +sub on_chars_buildlog +{ + my ($ch) = @_; + + #print "on_chars_buildlog\n"; + + if ($store_chars) + { + $characters .= $ch->{Data}; + + #print "characters is now -->$characters<--\n"; + } +} + +sub on_end_buildlog_subtag +{ + $store_chars = 1; +} + +sub process_characters +{ + #print "process_characters\n"; + + $characters =~ s,^[\r\n]*,,; + $characters =~ s,[\r\n]*$,,; + + #print "characters is -->$characters<--\n"; + + my @lines = split(/[\r\n]/, $characters); + for my $line (@lines) + { + if ($line =~ m,[^\s^\r^\n],) + { + #print "dumping chars\n"; + + if ($failure_item == 0 and -f "$filename") + { + open(FILE, "$filename"); + { + local $/ = undef; + my $filecontent = ; + $failure_item = $1 if ($filecontent =~ m/.*---failure_item_(\d+)/s); + } + close(FILE); + } + + $failure_item++; + + open(FILE, ">>$filename"); + print FILE "---failure_item_$failure_item\---\n"; + print FILE "$line\n\n"; + close(FILE); + + process($line, $::current_log_file, '', '', '', '', "raptor_unreciped.txt", $failure_item); + } + } + + $characters = ''; + $store_chars = 0; +} + +sub on_start_buildlog_subtag +{ + #print "on_start_buildlog_subtag\n"; + + process_characters(); +} + +sub on_end_buildlog +{ + process_characters(); +} + + +1; diff -r 266a7e9b9237 -r 6d3c3db11e72 uh_parser/RaptorWarning.pm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/uh_parser/RaptorWarning.pm Wed Mar 03 16:51:26 2010 +0000 @@ -0,0 +1,128 @@ +# Copyright (c) 2009 Symbian Foundation Ltd +# This component and the accompanying materials are made available +# under the terms of the License "Eclipse Public License v1.0" +# which accompanies this distribution, and is available +# at the URL "http://www.eclipse.org/legal/epl-v10.html". +# +# Initial Contributors: +# Symbian Foundation Ltd - initial contribution. +# +# Contributors: +# +# Description: +# Raptor parser module. +# Extract, analyzes and dumps raptor warnings i.e. content of tags from a raptor log file + +package RaptorWarning; + +use strict; +use RaptorCommon; + +our $reset_status = {}; +my $buildlog_status = {}; +my $buildlog_warning_status = {}; + +$reset_status->{name} = 'reset_status'; +$reset_status->{next_status} = {buildlog=>$buildlog_status}; + +$buildlog_status->{name} = 'buildlog_status'; +$buildlog_status->{next_status} = {warning=>$buildlog_warning_status}; +$buildlog_status->{on_start} = 'RaptorWarning::on_start_buildlog'; + +$buildlog_warning_status->{name} = 'buildlog_warning_status'; +$buildlog_warning_status->{next_status} = {}; +$buildlog_warning_status->{on_start} = 'RaptorWarning::on_start_buildlog_warning'; +$buildlog_warning_status->{on_end} = 'RaptorWarning::on_end_buildlog_warning'; +$buildlog_warning_status->{on_chars} = 'RaptorWarning::on_chars_buildlog_warning'; + +my $filename = ''; +my $failure_item = 0; + +my $characters = ''; + +my $CATEGORY_RAPTORWARNING = 'raptor_warning'; +my $CATEGORY_RAPTORWARNING_MISSINGFLAGABIV2 = 'missing_enable_abiv2_mode'; + +sub process +{ + my ($text, $logfile, $component, $mmp, $phase, $recipe, $file, $line) = @_; + + my $category = $CATEGORY_RAPTORWARNING; + my $severity = ''; + my $subcategory = ''; + + if ($text =~ m,missing flag ENABLE_ABIV2_MODE,) + { + $severity = $RaptorCommon::SEVERITY_MINOR; + my $subcategory = $CATEGORY_RAPTORWARNING_MISSINGFLAGABIV2; + RaptorCommon::dump_fault($category, $subcategory, $severity, $logfile, $component, $mmp, $phase, $recipe, $file, $line); + } + else # log everything by default + { + RaptorCommon::dump_fault($category, $subcategory, $severity, $logfile, $component, $mmp, $phase, $recipe, $file, $line); + } +} + +sub on_start_buildlog +{ + RaptorCommon::init(); + + $filename = "$::raptorbitsdir/raptor_warning.txt"; + if (!-f$filename) + { + print "Writing warnings file $filename\n"; + open(FILE, ">$filename"); + close(FILE); + } +} +sub on_start_buildlog_warning +{ + open(FILE, ">>$filename"); +} + +sub on_chars_buildlog_warning +{ + my ($ch) = @_; + + #print "on_chars_buildlog_warning\n"; + + $characters .= $ch->{Data}; + + #print "characters is now -->$characters<--\n"; +} + +sub on_end_buildlog_warning +{ + #print "on_end_buildlog_warning\n"; + + $characters =~ s,^[\r\n]*,,; + $characters =~ s,[\r\n]*$,,; + + if ($characters =~ m,[^\s^\r^\n],) + { + if ($failure_item == 0 and -f "$filename") + { + open(FILE, "$filename"); + { + local $/ = undef; + my $filecontent = ; + $failure_item = $1 if ($filecontent =~ m/.*---failure_item_(\d+)/s); + } + close(FILE); + } + + $failure_item++; + + open(FILE, ">>$filename"); + print FILE "---failure_item_$failure_item\---\n"; + print FILE "$characters\n\n"; + close(FILE); + + process($characters, $::current_log_file, '', '', '', '', "raptor_warning.txt", $failure_item); + } + + $characters = ''; +} + + +1; \ No newline at end of file diff -r 266a7e9b9237 -r 6d3c3db11e72 uh_parser/XML/NamespaceSupport.pm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/uh_parser/XML/NamespaceSupport.pm Wed Mar 03 16:51:26 2010 +0000 @@ -0,0 +1,565 @@ + +### +# XML::NamespaceSupport - a simple generic namespace processor +# Robin Berjon +### + +package XML::NamespaceSupport; +use strict; +use constant FATALS => 0; # root object +use constant NSMAP => 1; +use constant UNKNOWN_PREF => 2; +use constant AUTO_PREFIX => 3; +use constant DEFAULT => 0; # maps +use constant PREFIX_MAP => 1; +use constant DECLARATIONS => 2; + +use vars qw($VERSION $NS_XMLNS $NS_XML); +$VERSION = '1.07'; +$NS_XMLNS = 'http://www.w3.org/2000/xmlns/'; +$NS_XML = 'http://www.w3.org/XML/1998/namespace'; + + +# add the ns stuff that baud wants based on Java's xml-writer + + +#-------------------------------------------------------------------# +# constructor +#-------------------------------------------------------------------# +sub new { + my $class = ref($_[0]) ? ref(shift) : shift; + my $options = shift; + my $self = [ + 1, # FATALS + [[ # NSMAP + undef, # DEFAULT + { xml => $NS_XML }, # PREFIX_MAP + undef, # DECLARATIONS + ]], + 'aaa', # UNKNOWN_PREF + 0, # AUTO_PREFIX + ]; + $self->[NSMAP]->[0]->[PREFIX_MAP]->{xmlns} = $NS_XMLNS if $options->{xmlns}; + $self->[FATALS] = $options->{fatal_errors} if defined $options->{fatal_errors}; + $self->[AUTO_PREFIX] = $options->{auto_prefix} if defined $options->{auto_prefix}; + return bless $self, $class; +} +#-------------------------------------------------------------------# + +#-------------------------------------------------------------------# +# reset() - return to the original state (for reuse) +#-------------------------------------------------------------------# +sub reset { + my $self = shift; + $#{$self->[NSMAP]} = 0; +} +#-------------------------------------------------------------------# + +#-------------------------------------------------------------------# +# push_context() - add a new empty context to the stack +#-------------------------------------------------------------------# +sub push_context { + my $self = shift; + push @{$self->[NSMAP]}, [ + $self->[NSMAP]->[-1]->[DEFAULT], + { %{$self->[NSMAP]->[-1]->[PREFIX_MAP]} }, + [], + ]; +} +#-------------------------------------------------------------------# + +#-------------------------------------------------------------------# +# pop_context() - remove the topmost context fromt the stack +#-------------------------------------------------------------------# +sub pop_context { + my $self = shift; + die 'Trying to pop context without push context' unless @{$self->[NSMAP]} > 1; + pop @{$self->[NSMAP]}; +} +#-------------------------------------------------------------------# + +#-------------------------------------------------------------------# +# declare_prefix() - declare a prefix in the current scope +#-------------------------------------------------------------------# +sub declare_prefix { + my $self = shift; + my $prefix = shift; + my $value = shift; + + warn <<' EOWARN' unless defined $prefix or $self->[AUTO_PREFIX]; + Prefix was undefined. + If you wish to set the default namespace, use the empty string ''. + If you wish to autogenerate prefixes, set the auto_prefix option + to a true value. + EOWARN + + return 0 if index(lc($prefix), 'xml') == 0; + + if (defined $prefix and $prefix eq '') { + $self->[NSMAP]->[-1]->[DEFAULT] = $value; + } + else { + die "Cannot undeclare prefix $prefix" if $value eq ''; + if (not defined $prefix and $self->[AUTO_PREFIX]) { + while (1) { + $prefix = $self->[UNKNOWN_PREF]++; + last if not exists $self->[NSMAP]->[-1]->[PREFIX_MAP]->{$prefix}; + } + } + elsif (not defined $prefix and not $self->[AUTO_PREFIX]) { + return 0; + } + $self->[NSMAP]->[-1]->[PREFIX_MAP]->{$prefix} = $value; + } + push @{$self->[NSMAP]->[-1]->[DECLARATIONS]}, $prefix; + return 1; +} +#-------------------------------------------------------------------# + +#-------------------------------------------------------------------# +# declare_prefixes() - declare several prefixes in the current scope +#-------------------------------------------------------------------# +sub declare_prefixes { + my $self = shift; + my %prefixes = @_; + while (my ($k,$v) = each %prefixes) { + $self->declare_prefix($k,$v); + } +} +#-------------------------------------------------------------------# + +#-------------------------------------------------------------------# +# undeclare_prefix +#-------------------------------------------------------------------# +sub undeclare_prefix { + my $self = shift; + my $prefix = shift; + return unless not defined $prefix or $prefix eq ''; + return unless exists $self->[NSMAP]->[-1]->[PREFIX_MAP]->{$prefix}; + + my ( $tfix ) = grep { $_ eq $prefix } @{$self->[NSMAP]->[-1]->[DECLARATIONS]}; + if ( not defined $tfix ) { + die "prefix $prefix not declared in this context\n"; + } + + @{$self->[NSMAP]->[-1]->[DECLARATIONS]} = grep { $_ ne $prefix } @{$self->[NSMAP]->[-1]->[DECLARATIONS]}; + delete $self->[NSMAP]->[-1]->[PREFIX_MAP]->{$prefix}; +} +#-------------------------------------------------------------------# + +#-------------------------------------------------------------------# +# get_prefix() - get a (random) prefix for a given URI +#-------------------------------------------------------------------# +sub get_prefix { + my $self = shift; + my $uri = shift; + + # we have to iterate over the whole hash here because if we don't + # the iterator isn't reset and the next pass will fail + my $pref; + while (my ($k, $v) = each %{$self->[NSMAP]->[-1]->[PREFIX_MAP]}) { + $pref = $k if $v eq $uri; + } + return $pref; +} +#-------------------------------------------------------------------# + +#-------------------------------------------------------------------# +# get_prefixes() - get all the prefixes for a given URI +#-------------------------------------------------------------------# +sub get_prefixes { + my $self = shift; + my $uri = shift; + + return keys %{$self->[NSMAP]->[-1]->[PREFIX_MAP]} unless defined $uri; + return grep { $self->[NSMAP]->[-1]->[PREFIX_MAP]->{$_} eq $uri } keys %{$self->[NSMAP]->[-1]->[PREFIX_MAP]}; +} +#-------------------------------------------------------------------# + +#-------------------------------------------------------------------# +# get_declared_prefixes() - get all prefixes declared in the last context +#-------------------------------------------------------------------# +sub get_declared_prefixes { + return @{$_[0]->[NSMAP]->[-1]->[DECLARATIONS]}; +} +#-------------------------------------------------------------------# + +#-------------------------------------------------------------------# +# get_uri() - get an URI given a prefix +#-------------------------------------------------------------------# +sub get_uri { + my $self = shift; + my $prefix = shift; + + warn "Prefix must not be undef in get_uri(). The emtpy prefix must be ''" unless defined $prefix; + + return $self->[NSMAP]->[-1]->[DEFAULT] if $prefix eq ''; + return $self->[NSMAP]->[-1]->[PREFIX_MAP]->{$prefix} if exists $self->[NSMAP]->[-1]->[PREFIX_MAP]->{$prefix}; + return undef; +} +#-------------------------------------------------------------------# + +#-------------------------------------------------------------------# +# process_name() - provide details on a name +#-------------------------------------------------------------------# +sub process_name { + my $self = shift; + my $qname = shift; + my $aflag = shift; + + if ($self->[FATALS]) { + return( ($self->_get_ns_details($qname, $aflag))[0,2], $qname ); + } + else { + eval { return( ($self->_get_ns_details($qname, $aflag))[0,2], $qname ); } + } +} +#-------------------------------------------------------------------# + +#-------------------------------------------------------------------# +# process_element_name() - provide details on a element's name +#-------------------------------------------------------------------# +sub process_element_name { + my $self = shift; + my $qname = shift; + + if ($self->[FATALS]) { + return $self->_get_ns_details($qname, 0); + } + else { + eval { return $self->_get_ns_details($qname, 0); } + } +} +#-------------------------------------------------------------------# + + +#-------------------------------------------------------------------# +# process_attribute_name() - provide details on a attribute's name +#-------------------------------------------------------------------# +sub process_attribute_name { + my $self = shift; + my $qname = shift; + + if ($self->[FATALS]) { + return $self->_get_ns_details($qname, 1); + } + else { + eval { return $self->_get_ns_details($qname, 1); } + } +} +#-------------------------------------------------------------------# + + +#-------------------------------------------------------------------# +# ($ns, $prefix, $lname) = $self->_get_ns_details($qname, $f_attr) +# returns ns, prefix, and lname for a given attribute name +# >> the $f_attr flag, if set to one, will work for an attribute +#-------------------------------------------------------------------# +sub _get_ns_details { + my $self = shift; + my $qname = shift; + my $aflag = shift; + + my ($ns, $prefix, $lname); + (my ($tmp_prefix, $tmp_lname) = split /:/, $qname, 3) + < 3 or die "Invalid QName: $qname"; + + # no prefix + my $cur_map = $self->[NSMAP]->[-1]; + if (not defined($tmp_lname)) { + $prefix = undef; + $lname = $qname; + # attr don't have a default namespace + $ns = ($aflag) ? undef : $cur_map->[DEFAULT]; + } + + # prefix + else { + if (exists $cur_map->[PREFIX_MAP]->{$tmp_prefix}) { + $prefix = $tmp_prefix; + $lname = $tmp_lname; + $ns = $cur_map->[PREFIX_MAP]->{$prefix} + } + else { # no ns -> lname == name, all rest undef + die "Undeclared prefix: $tmp_prefix"; + } + } + + return ($ns, $prefix, $lname); +} +#-------------------------------------------------------------------# + +#-------------------------------------------------------------------# +# parse_jclark_notation() - parse the Clarkian notation +#-------------------------------------------------------------------# +sub parse_jclark_notation { + shift; + my $jc = shift; + $jc =~ m/^\{(.*)\}([^}]+)$/; + return $1, $2; +} +#-------------------------------------------------------------------# + + +#-------------------------------------------------------------------# +# Java names mapping +#-------------------------------------------------------------------# +*XML::NamespaceSupport::pushContext = \&push_context; +*XML::NamespaceSupport::popContext = \&pop_context; +*XML::NamespaceSupport::declarePrefix = \&declare_prefix; +*XML::NamespaceSupport::declarePrefixes = \&declare_prefixes; +*XML::NamespaceSupport::getPrefix = \&get_prefix; +*XML::NamespaceSupport::getPrefixes = \&get_prefixes; +*XML::NamespaceSupport::getDeclaredPrefixes = \&get_declared_prefixes; +*XML::NamespaceSupport::getURI = \&get_uri; +*XML::NamespaceSupport::processName = \&process_name; +*XML::NamespaceSupport::processElementName = \&process_element_name; +*XML::NamespaceSupport::processAttributeName = \&process_attribute_name; +*XML::NamespaceSupport::parseJClarkNotation = \&parse_jclark_notation; +*XML::NamespaceSupport::undeclarePrefix = \&undeclare_prefix; +#-------------------------------------------------------------------# + + +1; +#,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,# +#`,`, Documentation `,`,`,`,`,`,`,`,`,`,`,`,`,`,`,`,`,`,`,`,`,`,`,`,# +#```````````````````````````````````````````````````````````````````# + +=pod + +=head1 NAME + +XML::NamespaceSupport - a simple generic namespace support class + +=head1 SYNOPSIS + + use XML::NamespaceSupport; + my $nsup = XML::NamespaceSupport->new; + + # add a new empty context + $nsup->push_context; + # declare a few prefixes + $nsup->declare_prefix($prefix1, $uri1); + $nsup->declare_prefix($prefix2, $uri2); + # the same shorter + $nsup->declare_prefixes($prefix1 => $uri1, $prefix2 => $uri2); + + # get a single prefix for a URI (randomly) + $prefix = $nsup->get_prefix($uri); + # get all prefixes for a URI (probably better) + @prefixes = $nsup->get_prefixes($uri); + # get all prefixes in scope + @prefixes = $nsup->get_prefixes(); + # get all prefixes that were declared for the current scope + @prefixes = $nsup->get_declared_prefixes; + # get a URI for a given prefix + $uri = $nsup->get_uri($prefix); + + # get info on a qname (java-ish way, it's a bit weird) + ($ns_uri, $local_name, $qname) = $nsup->process_name($qname, $is_attr); + # the same, more perlish + ($ns_uri, $prefix, $local_name) = $nsup->process_element_name($qname); + ($ns_uri, $prefix, $local_name) = $nsup->process_attribute_name($qname); + + # remove the current context + $nsup->pop_context; + + # reset the object for reuse in another document + $nsup->reset; + + # a simple helper to process Clarkian Notation + my ($ns, $lname) = $nsup->parse_jclark_notation('{http://foo}bar'); + # or (given that it doesn't care about the object + my ($ns, $lname) = XML::NamespaceSupport->parse_jclark_notation('{http://foo}bar'); + + +=head1 DESCRIPTION + +This module offers a simple to process namespaced XML names (unames) +from within any application that may need them. It also helps maintain +a prefix to namespace URI map, and provides a number of basic checks. + +The model for this module is SAX2's NamespaceSupport class, readable at +http://www.megginson.com/SAX/Java/javadoc/org/xml/sax/helpers/NamespaceSupport.html. +It adds a few perlisations where we thought it appropriate. + +=head1 METHODS + +=over 4 + +=item * XML::NamespaceSupport->new(\%options) + +A simple constructor. + +The options are C, C, and C + +If C is turned on (it is off by default) the mapping from the +xmlns prefix to the URI defined for it in DOM level 2 is added to the +list of predefined mappings (which normally only contains the xml +prefix mapping). + +If C is turned off (it is on by default) a number of +validity errors will simply be flagged as failures, instead of +die()ing. + +If C is turned on (it is off by default) when one +provides a prefix of C to C it will generate a +random prefix mapped to that namespace. Otherwise an undef prefix will +trigger a warning (you should probably know what you're doing if you +turn this option on). + +=item * $nsup->push_context + +Adds a new empty context to the stack. You can then populate it with +new prefixes defined at this level. + +=item * $nsup->pop_context + +Removes the topmost context in the stack and reverts to the previous +one. It will die() if you try to pop more than you have pushed. + +=item * $nsup->declare_prefix($prefix, $uri) + +Declares a mapping of $prefix to $uri, at the current level. + +Note that with C turned on, if you declare a prefix +mapping in which $prefix is undef(), you will get an automatic prefix +selected for you. If it is off you will get a warning. + +This is useful when you deal with code that hasn't kept prefixes around +and need to reserialize the nodes. It also means that if you want to +set the default namespace (ie with an empty prefix) you must use the +empty string instead of undef. This behaviour is consistent with the +SAX 2.0 specification. + +=item * $nsup->declare_prefixes(%prefixes2uris) + +Declares a mapping of several prefixes to URIs, at the current level. + +=item * $nsup->get_prefix($uri) + +Returns a prefix given an URI. Note that as several prefixes may be +mapped to the same URI, it returns an arbitrary one. It'll return +undef on failure. + +=item * $nsup->get_prefixes($uri) + +Returns an array of prefixes given an URI. It'll return all the +prefixes if the uri is undef. + +=item * $nsup->get_declared_prefixes + +Returns an array of all the prefixes that have been declared within +this context, ie those that were declared on the last element, not +those that were declared above and are simply in scope. + +=item * $nsup->get_uri($prefix) + +Returns a URI for a given prefix. Returns undef on failure. + +=item * $nsup->process_name($qname, $is_attr) + +Given a qualified name and a boolean indicating whether this is an +attribute or another type of name (those are differently affected by +default namespaces), it returns a namespace URI, local name, qualified +name tuple. I know that that is a rather abnormal list to return, but +it is so for compatibility with the Java spec. See below for more +Perlish alternatives. + +If the prefix is not declared, or if the name is not valid, it'll +either die or return undef depending on the current setting of +C. + +=item * $nsup->undeclare_prefix($prefix); + +Removes a namespace prefix from the current context. This function may +be used in SAX's end_prefix_mapping when there is fear that a namespace +declaration might be available outside their scope (which shouldn't +normally happen, but you never know ;). This may be needed in order to +properly support Namespace 1.1. + +=item * $nsup->process_element_name($qname) + +Given a qualified name, it returns a namespace URI, prefix, and local +name tuple. This method applies to element names. + +If the prefix is not declared, or if the name is not valid, it'll +either die or return undef depending on the current setting of +C. + +=item * $nsup->process_attribute_name($qname) + +Given a qualified name, it returns a namespace URI, prefix, and local +name tuple. This method applies to attribute names. + +If the prefix is not declared, or if the name is not valid, it'll +either die or return undef depending on the current setting of +C. + +=item * $nsup->reset + +Resets the object so that it can be reused on another document. + +=back + +All methods of the interface have an alias that is the name used in +the original Java specification. You can use either name +interchangeably. Here is the mapping: + + Java name Perl name + --------------------------------------------------- + pushContext push_context + popContext pop_context + declarePrefix declare_prefix + declarePrefixes declare_prefixes + getPrefix get_prefix + getPrefixes get_prefixes + getDeclaredPrefixes get_declared_prefixes + getURI get_uri + processName process_name + processElementName process_element_name + processAttributeName process_attribute_name + parseJClarkNotation parse_jclark_notation + undeclarePrefix undeclare_prefix + +=head1 VARIABLES + +Two global variables are made available to you. They used to be constants but +simple scalars are easier to use in a number of contexts. They are not +exported but can easily be accessed from any package, or copied into it. + +=over 4 + +=item * C<$NS_XMLNS> + +The namespace for xmlns prefixes, http://www.w3.org/2000/xmlns/. + +=item * C<$NS_XML> + +The namespace for xml prefixes, http://www.w3.org/XML/1998/namespace. + +=back + +=head1 TODO + + - add more tests + - optimise here and there + +=head1 AUTHOR + +Robin Berjon, robin@knowscape.com, with lots of it having been done +by Duncan Cameron, and a number of suggestions from the perl-xml +list. + +=head1 COPYRIGHT + +Copyright (c) 2001 Robin Berjon. All rights reserved. This program is +free software; you can redistribute it and/or modify it under the same +terms as Perl itself. + +=head1 SEE ALSO + +XML::Parser::PerlSAX + +=cut + diff -r 266a7e9b9237 -r 6d3c3db11e72 uh_parser/XML/SAX.pm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/uh_parser/XML/SAX.pm Wed Mar 03 16:51:26 2010 +0000 @@ -0,0 +1,379 @@ +# $Id: SAX.pm,v 1.27 2007/02/07 09:33:50 grant Exp $ + +package XML::SAX; + +use strict; +use vars qw($VERSION @ISA @EXPORT_OK); + +$VERSION = '0.15'; + +use Exporter (); +@ISA = ('Exporter'); + +@EXPORT_OK = qw(Namespaces Validation); + +use File::Basename qw(dirname); +use File::Spec (); +use Symbol qw(gensym); +use XML::SAX::ParserFactory (); # loaded for simplicity + +use constant PARSER_DETAILS => "ParserDetails.ini"; + +use constant Namespaces => "http://xml.org/sax/features/namespaces"; +use constant Validation => "http://xml.org/sax/features/validation"; + +my $known_parsers = undef; + +# load_parsers takes the ParserDetails.ini file out of the same directory +# that XML::SAX is in, and looks at it. Format in POD below + +=begin EXAMPLE + +[XML::SAX::PurePerl] +http://xml.org/sax/features/namespaces = 1 +http://xml.org/sax/features/validation = 0 +# a comment + +# blank lines ignored + +[XML::SAX::AnotherParser] +http://xml.org/sax/features/namespaces = 0 +http://xml.org/sax/features/validation = 1 + +=end EXAMPLE + +=cut + +sub load_parsers { + my $class = shift; + my $dir = shift; + + # reset parsers + $known_parsers = []; + + # get directory from wherever XML::SAX is installed + if (!$dir) { + $dir = $INC{'XML/SAX.pm'}; + $dir = dirname($dir); + } + + my $fh = gensym(); + if (!open($fh, File::Spec->catfile($dir, "SAX", PARSER_DETAILS))) { + XML::SAX->do_warn("could not find " . PARSER_DETAILS . " in $dir/SAX\n"); + return $class; + } + + $known_parsers = $class->_parse_ini_file($fh); + + return $class; +} + +sub _parse_ini_file { + my $class = shift; + my ($fh) = @_; + + my @config; + + my $lineno = 0; + while (defined(my $line = <$fh>)) { + $lineno++; + my $original = $line; + # strip whitespace + $line =~ s/\s*$//m; + $line =~ s/^\s*//m; + # strip comments + $line =~ s/[#;].*$//m; + # ignore blanks + next if $line =~ /^$/m; + + # heading + if ($line =~ /^\[\s*(.*)\s*\]$/m) { + push @config, { Name => $1 }; + next; + } + + # instruction + elsif ($line =~ /^(.*?)\s*?=\s*(.*)$/) { + unless(@config) { + push @config, { Name => '' }; + } + $config[-1]{Features}{$1} = $2; + } + + # not whitespace, comment, or instruction + else { + die "Invalid line in ini: $lineno\n>>> $original\n"; + } + } + + return \@config; +} + +sub parsers { + my $class = shift; + if (!$known_parsers) { + $class->load_parsers(); + } + return $known_parsers; +} + +sub remove_parser { + my $class = shift; + my ($parser_module) = @_; + + if (!$known_parsers) { + $class->load_parsers(); + } + + @$known_parsers = grep { $_->{Name} ne $parser_module } @$known_parsers; + + return $class; +} + +sub add_parser { + my $class = shift; + my ($parser_module) = @_; + + if (!$known_parsers) { + $class->load_parsers(); + } + + # first load module, then query features, then push onto known_parsers, + + my $parser_file = $parser_module; + $parser_file =~ s/::/\//g; + $parser_file .= ".pm"; + + require $parser_file; + + my @features = $parser_module->supported_features(); + + my $new = { Name => $parser_module }; + foreach my $feature (@features) { + $new->{Features}{$feature} = 1; + } + + # If exists in list already, move to end. + my $done = 0; + my $pos = undef; + for (my $i = 0; $i < @$known_parsers; $i++) { + my $p = $known_parsers->[$i]; + if ($p->{Name} eq $parser_module) { + $pos = $i; + } + } + if (defined $pos) { + splice(@$known_parsers, $pos, 1); + push @$known_parsers, $new; + $done++; + } + + # Otherwise (not in list), add at end of list. + if (!$done) { + push @$known_parsers, $new; + } + + return $class; +} + +sub save_parsers { + my $class = shift; + + # get directory from wherever XML::SAX is installed + my $dir = $INC{'XML/SAX.pm'}; + $dir = dirname($dir); + + my $file = File::Spec->catfile($dir, "SAX", PARSER_DETAILS); + chmod 0644, $file; + unlink($file); + + my $fh = gensym(); + open($fh, ">$file") || + die "Cannot write to $file: $!"; + + foreach my $p (@$known_parsers) { + print $fh "[$p->{Name}]\n"; + foreach my $key (keys %{$p->{Features}}) { + print $fh "$key = $p->{Features}{$key}\n"; + } + print $fh "\n"; + } + + print $fh "\n"; + + close $fh; + + return $class; +} + +sub do_warn { + my $class = shift; + # Don't output warnings if running under Test::Harness + warn(@_) unless $ENV{HARNESS_ACTIVE}; +} + +1; +__END__ + +=head1 NAME + +XML::SAX - Simple API for XML + +=head1 SYNOPSIS + + use XML::SAX; + + # get a list of known parsers + my $parsers = XML::SAX->parsers(); + + # add/update a parser + XML::SAX->add_parser(q(XML::SAX::PurePerl)); + + # remove parser + XML::SAX->remove_parser(q(XML::SAX::Foodelberry)); + + # save parsers + XML::SAX->save_parsers(); + +=head1 DESCRIPTION + +XML::SAX is a SAX parser access API for Perl. It includes classes +and APIs required for implementing SAX drivers, along with a factory +class for returning any SAX parser installed on the user's system. + +=head1 USING A SAX2 PARSER + +The factory class is XML::SAX::ParserFactory. Please see the +documentation of that module for how to instantiate a SAX parser: +L. However if you don't want to load up +another manual page, here's a short synopsis: + + use XML::SAX::ParserFactory; + use XML::SAX::XYZHandler; + my $handler = XML::SAX::XYZHandler->new(); + my $p = XML::SAX::ParserFactory->parser(Handler => $handler); + $p->parse_uri("foo.xml"); + # or $p->parse_string("") or $p->parse_file($fh); + +This will automatically load a SAX2 parser (defaulting to +XML::SAX::PurePerl if no others are found) and return it to you. + +In order to learn how to use SAX to parse XML, you will need to read +L and for reference, L. + +=head1 WRITING A SAX2 PARSER + +The first thing to remember in writing a SAX2 parser is to subclass +XML::SAX::Base. This will make your life infinitely easier, by providing +a number of methods automagically for you. See L for more +details. + +When writing a SAX2 parser that is compatible with XML::SAX, you need +to inform XML::SAX of the presence of that driver when you install it. +In order to do that, XML::SAX contains methods for saving the fact that +the parser exists on your system to a "INI" file, which is then loaded +to determine which parsers are installed. + +The best way to do this is to follow these rules: + +=over 4 + +=item * Add XML::SAX as a prerequisite in Makefile.PL: + + WriteMakefile( + ... + PREREQ_PM => { 'XML::SAX' => 0 }, + ... + ); + +Alternatively you may wish to check for it in other ways that will +cause more than just a warning. + +=item * Add the following code snippet to your Makefile.PL: + + sub MY::install { + package MY; + my $script = shift->SUPER::install(@_); + if (ExtUtils::MakeMaker::prompt( + "Do you want to modify ParserDetails.ini?", 'Y') + =~ /^y/i) { + $script =~ s/install :: (.*)$/install :: $1 install_sax_driver/m; + $script .= <<"INSTALL"; + + install_sax_driver : + \t\@\$(PERL) -MXML::SAX -e "XML::SAX->add_parser(q(\$(NAME)))->save_parsers()" + + INSTALL + } + return $script; + } + +Note that you should check the output of this - \$(NAME) will use the name of +your distribution, which may not be exactly what you want. For example XML::LibXML +has a driver called XML::LibXML::SAX::Generator, which is used in place of +\$(NAME) in the above. + +=item * Add an XML::SAX test: + +A test file should be added to your t/ directory containing something like the +following: + + use Test; + BEGIN { plan tests => 3 } + use XML::SAX; + use XML::SAX::PurePerl::DebugHandler; + XML::SAX->add_parser(q(XML::SAX::MyDriver)); + local $XML::SAX::ParserPackage = 'XML::SAX::MyDriver'; + eval { + my $handler = XML::SAX::PurePerl::DebugHandler->new(); + ok($handler); + my $parser = XML::SAX::ParserFactory->parser(Handler => $handler); + ok($parser); + ok($parser->isa('XML::SAX::MyDriver'); + $parser->parse_string(""); + ok($handler->{seen}{start_element}); + }; + +=back + +=head1 EXPORTS + +By default, XML::SAX exports nothing into the caller's namespace. However you +can request the symbols C and C which are the +URIs for those features, allowing an easier way to request those features +via ParserFactory: + + use XML::SAX qw(Namespaces Validation); + my $factory = XML::SAX::ParserFactory->new(); + $factory->require_feature(Namespaces); + $factory->require_feature(Validation); + my $parser = $factory->parser(); + +=head1 AUTHOR + +Current maintainer: Grant McLean, grantm@cpan.org + +Originally written by: + +Matt Sergeant, matt@sergeant.org + +Kip Hampton, khampton@totalcinema.com + +Robin Berjon, robin@knowscape.com + +=head1 LICENSE + +This is free software, you may use it and distribute it under +the same terms as Perl itself. + +=head1 SEE ALSO + +L for writing SAX Filters and Parsers + +L for an XML parser written in 100% +pure perl. + +L for details on exception handling + +=cut + diff -r 266a7e9b9237 -r 6d3c3db11e72 uh_parser/XML/SAX/Base.pm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/uh_parser/XML/SAX/Base.pm Wed Mar 03 16:51:26 2010 +0000 @@ -0,0 +1,3164 @@ +package XML::SAX::Base; + +# version 0.10 - Kip Hampton +# version 0.13 - Robin Berjon +# version 0.15 - Kip Hampton +# version 0.17 - Kip Hampton +# version 0.19 - Kip Hampton +# version 0.21 - Kip Hampton +# version 0.22 - Robin Berjon +# version 0.23 - Matt Sergeant +# version 0.24 - Robin Berjon +# version 0.25 - Kip Hampton +# version 1.00 - Kip Hampton +# version 1.01 - Kip Hampton +# version 1.02 - Robin Berjon +# version 1.03 - Matt Sergeant +# version 1.04 - Kip Hampton + +#-----------------------------------------------------# +# STOP!!!!! +# +# This file is generated by the 'Makefile.PL' file +# that ships with the XML::SAX distribution. +# If you need to make changes, patch that file NOT +# this one. +#-----------------------------------------------------# + +use strict; +use vars qw($VERSION); +use XML::SAX::Exception qw(); + +$VERSION = '1.04'; + +sub notation_decl { + my $self = shift; + if (defined $self->{Methods}->{'notation_decl'}) { + $self->{Methods}->{'notation_decl'}->(@_); + } + else { + my $method; + my $callbacks; + if (exists $self->{ParseOptions}) { + $callbacks = $self->{ParseOptions}; + } + else { + $callbacks = $self; + } + if (0) { # dummy to make elsif's below compile + } + elsif (defined $callbacks->{'DTDHandler'} and $method = $callbacks->{'DTDHandler'}->can('notation_decl') ) { + my $handler = $callbacks->{'DTDHandler'}; + $self->{Methods}->{'notation_decl'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'Handler'} and $method = $callbacks->{'Handler'}->can('notation_decl') ) { + my $handler = $callbacks->{'Handler'}; + $self->{Methods}->{'notation_decl'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'DTDHandler'} + and $callbacks->{'DTDHandler'}->can('AUTOLOAD') + and $callbacks->{'DTDHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'DTDHandler'}->notation_decl(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'DTDHandler'}; + $self->{Methods}->{'notation_decl'} = sub { $handler->notation_decl(@_) }; + } + return $res; + } + elsif (defined $callbacks->{'Handler'} + and $callbacks->{'Handler'}->can('AUTOLOAD') + and $callbacks->{'Handler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'Handler'}->notation_decl(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'Handler'}; + $self->{Methods}->{'notation_decl'} = sub { $handler->notation_decl(@_) }; + } + return $res; + } + else { + $self->{Methods}->{'notation_decl'} = sub { }; + } + } + +} + +sub resolve_entity { + my $self = shift; + if (defined $self->{Methods}->{'resolve_entity'}) { + $self->{Methods}->{'resolve_entity'}->(@_); + } + else { + my $method; + my $callbacks; + if (exists $self->{ParseOptions}) { + $callbacks = $self->{ParseOptions}; + } + else { + $callbacks = $self; + } + if (0) { # dummy to make elsif's below compile + } + elsif (defined $callbacks->{'EntityResolver'} and $method = $callbacks->{'EntityResolver'}->can('resolve_entity') ) { + my $handler = $callbacks->{'EntityResolver'}; + $self->{Methods}->{'resolve_entity'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'Handler'} and $method = $callbacks->{'Handler'}->can('resolve_entity') ) { + my $handler = $callbacks->{'Handler'}; + $self->{Methods}->{'resolve_entity'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'EntityResolver'} + and $callbacks->{'EntityResolver'}->can('AUTOLOAD') + and $callbacks->{'EntityResolver'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'EntityResolver'}->resolve_entity(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'EntityResolver'}; + $self->{Methods}->{'resolve_entity'} = sub { $handler->resolve_entity(@_) }; + } + return $res; + } + elsif (defined $callbacks->{'Handler'} + and $callbacks->{'Handler'}->can('AUTOLOAD') + and $callbacks->{'Handler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'Handler'}->resolve_entity(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'Handler'}; + $self->{Methods}->{'resolve_entity'} = sub { $handler->resolve_entity(@_) }; + } + return $res; + } + else { + $self->{Methods}->{'resolve_entity'} = sub { }; + } + } + +} + +sub start_cdata { + my $self = shift; + if (defined $self->{Methods}->{'start_cdata'}) { + $self->{Methods}->{'start_cdata'}->(@_); + } + else { + my $method; + my $callbacks; + if (exists $self->{ParseOptions}) { + $callbacks = $self->{ParseOptions}; + } + else { + $callbacks = $self; + } + if (0) { # dummy to make elsif's below compile + } + elsif (defined $callbacks->{'DocumentHandler'} and $method = $callbacks->{'DocumentHandler'}->can('start_cdata') ) { + my $handler = $callbacks->{'DocumentHandler'}; + $self->{Methods}->{'start_cdata'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'LexicalHandler'} and $method = $callbacks->{'LexicalHandler'}->can('start_cdata') ) { + my $handler = $callbacks->{'LexicalHandler'}; + $self->{Methods}->{'start_cdata'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'Handler'} and $method = $callbacks->{'Handler'}->can('start_cdata') ) { + my $handler = $callbacks->{'Handler'}; + $self->{Methods}->{'start_cdata'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'DocumentHandler'} + and $callbacks->{'DocumentHandler'}->can('AUTOLOAD') + and $callbacks->{'DocumentHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'DocumentHandler'}->start_cdata(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'DocumentHandler'}; + $self->{Methods}->{'start_cdata'} = sub { $handler->start_cdata(@_) }; + } + return $res; + } + elsif (defined $callbacks->{'LexicalHandler'} + and $callbacks->{'LexicalHandler'}->can('AUTOLOAD') + and $callbacks->{'LexicalHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'LexicalHandler'}->start_cdata(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'LexicalHandler'}; + $self->{Methods}->{'start_cdata'} = sub { $handler->start_cdata(@_) }; + } + return $res; + } + elsif (defined $callbacks->{'Handler'} + and $callbacks->{'Handler'}->can('AUTOLOAD') + and $callbacks->{'Handler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'Handler'}->start_cdata(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'Handler'}; + $self->{Methods}->{'start_cdata'} = sub { $handler->start_cdata(@_) }; + } + return $res; + } + else { + $self->{Methods}->{'start_cdata'} = sub { }; + } + } + +} + +sub set_document_locator { + my $self = shift; + if (defined $self->{Methods}->{'set_document_locator'}) { + $self->{Methods}->{'set_document_locator'}->(@_); + } + else { + my $method; + my $callbacks; + if (exists $self->{ParseOptions}) { + $callbacks = $self->{ParseOptions}; + } + else { + $callbacks = $self; + } + if (0) { # dummy to make elsif's below compile + } + elsif (defined $callbacks->{'ContentHandler'} and $method = $callbacks->{'ContentHandler'}->can('set_document_locator') ) { + my $handler = $callbacks->{'ContentHandler'}; + $self->{Methods}->{'set_document_locator'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'DocumentHandler'} and $method = $callbacks->{'DocumentHandler'}->can('set_document_locator') ) { + my $handler = $callbacks->{'DocumentHandler'}; + $self->{Methods}->{'set_document_locator'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'Handler'} and $method = $callbacks->{'Handler'}->can('set_document_locator') ) { + my $handler = $callbacks->{'Handler'}; + $self->{Methods}->{'set_document_locator'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'ContentHandler'} + and $callbacks->{'ContentHandler'}->can('AUTOLOAD') + and $callbacks->{'ContentHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'ContentHandler'}->set_document_locator(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'ContentHandler'}; + $self->{Methods}->{'set_document_locator'} = sub { $handler->set_document_locator(@_) }; + } + return $res; + } + elsif (defined $callbacks->{'DocumentHandler'} + and $callbacks->{'DocumentHandler'}->can('AUTOLOAD') + and $callbacks->{'DocumentHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'DocumentHandler'}->set_document_locator(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'DocumentHandler'}; + $self->{Methods}->{'set_document_locator'} = sub { $handler->set_document_locator(@_) }; + } + return $res; + } + elsif (defined $callbacks->{'Handler'} + and $callbacks->{'Handler'}->can('AUTOLOAD') + and $callbacks->{'Handler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'Handler'}->set_document_locator(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'Handler'}; + $self->{Methods}->{'set_document_locator'} = sub { $handler->set_document_locator(@_) }; + } + return $res; + } + else { + $self->{Methods}->{'set_document_locator'} = sub { }; + } + } + +} + +sub xml_decl { + my $self = shift; + if (defined $self->{Methods}->{'xml_decl'}) { + $self->{Methods}->{'xml_decl'}->(@_); + } + else { + my $method; + my $callbacks; + if (exists $self->{ParseOptions}) { + $callbacks = $self->{ParseOptions}; + } + else { + $callbacks = $self; + } + if (0) { # dummy to make elsif's below compile + } + elsif (defined $callbacks->{'DTDHandler'} and $method = $callbacks->{'DTDHandler'}->can('xml_decl') ) { + my $handler = $callbacks->{'DTDHandler'}; + $self->{Methods}->{'xml_decl'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'Handler'} and $method = $callbacks->{'Handler'}->can('xml_decl') ) { + my $handler = $callbacks->{'Handler'}; + $self->{Methods}->{'xml_decl'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'DTDHandler'} + and $callbacks->{'DTDHandler'}->can('AUTOLOAD') + and $callbacks->{'DTDHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'DTDHandler'}->xml_decl(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'DTDHandler'}; + $self->{Methods}->{'xml_decl'} = sub { $handler->xml_decl(@_) }; + } + return $res; + } + elsif (defined $callbacks->{'Handler'} + and $callbacks->{'Handler'}->can('AUTOLOAD') + and $callbacks->{'Handler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'Handler'}->xml_decl(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'Handler'}; + $self->{Methods}->{'xml_decl'} = sub { $handler->xml_decl(@_) }; + } + return $res; + } + else { + $self->{Methods}->{'xml_decl'} = sub { }; + } + } + +} + +sub processing_instruction { + my $self = shift; + if (defined $self->{Methods}->{'processing_instruction'}) { + $self->{Methods}->{'processing_instruction'}->(@_); + } + else { + my $method; + my $callbacks; + if (exists $self->{ParseOptions}) { + $callbacks = $self->{ParseOptions}; + } + else { + $callbacks = $self; + } + if (0) { # dummy to make elsif's below compile + } + elsif (defined $callbacks->{'ContentHandler'} and $method = $callbacks->{'ContentHandler'}->can('processing_instruction') ) { + my $handler = $callbacks->{'ContentHandler'}; + $self->{Methods}->{'processing_instruction'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'DocumentHandler'} and $method = $callbacks->{'DocumentHandler'}->can('processing_instruction') ) { + my $handler = $callbacks->{'DocumentHandler'}; + $self->{Methods}->{'processing_instruction'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'Handler'} and $method = $callbacks->{'Handler'}->can('processing_instruction') ) { + my $handler = $callbacks->{'Handler'}; + $self->{Methods}->{'processing_instruction'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'ContentHandler'} + and $callbacks->{'ContentHandler'}->can('AUTOLOAD') + and $callbacks->{'ContentHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'ContentHandler'}->processing_instruction(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'ContentHandler'}; + $self->{Methods}->{'processing_instruction'} = sub { $handler->processing_instruction(@_) }; + } + return $res; + } + elsif (defined $callbacks->{'DocumentHandler'} + and $callbacks->{'DocumentHandler'}->can('AUTOLOAD') + and $callbacks->{'DocumentHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'DocumentHandler'}->processing_instruction(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'DocumentHandler'}; + $self->{Methods}->{'processing_instruction'} = sub { $handler->processing_instruction(@_) }; + } + return $res; + } + elsif (defined $callbacks->{'Handler'} + and $callbacks->{'Handler'}->can('AUTOLOAD') + and $callbacks->{'Handler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'Handler'}->processing_instruction(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'Handler'}; + $self->{Methods}->{'processing_instruction'} = sub { $handler->processing_instruction(@_) }; + } + return $res; + } + else { + $self->{Methods}->{'processing_instruction'} = sub { }; + } + } + +} + +sub start_prefix_mapping { + my $self = shift; + if (defined $self->{Methods}->{'start_prefix_mapping'}) { + $self->{Methods}->{'start_prefix_mapping'}->(@_); + } + else { + my $method; + my $callbacks; + if (exists $self->{ParseOptions}) { + $callbacks = $self->{ParseOptions}; + } + else { + $callbacks = $self; + } + if (0) { # dummy to make elsif's below compile + } + elsif (defined $callbacks->{'ContentHandler'} and $method = $callbacks->{'ContentHandler'}->can('start_prefix_mapping') ) { + my $handler = $callbacks->{'ContentHandler'}; + $self->{Methods}->{'start_prefix_mapping'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'Handler'} and $method = $callbacks->{'Handler'}->can('start_prefix_mapping') ) { + my $handler = $callbacks->{'Handler'}; + $self->{Methods}->{'start_prefix_mapping'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'ContentHandler'} + and $callbacks->{'ContentHandler'}->can('AUTOLOAD') + and $callbacks->{'ContentHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'ContentHandler'}->start_prefix_mapping(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'ContentHandler'}; + $self->{Methods}->{'start_prefix_mapping'} = sub { $handler->start_prefix_mapping(@_) }; + } + return $res; + } + elsif (defined $callbacks->{'Handler'} + and $callbacks->{'Handler'}->can('AUTOLOAD') + and $callbacks->{'Handler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'Handler'}->start_prefix_mapping(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'Handler'}; + $self->{Methods}->{'start_prefix_mapping'} = sub { $handler->start_prefix_mapping(@_) }; + } + return $res; + } + else { + $self->{Methods}->{'start_prefix_mapping'} = sub { }; + } + } + +} + +sub entity_reference { + my $self = shift; + if (defined $self->{Methods}->{'entity_reference'}) { + $self->{Methods}->{'entity_reference'}->(@_); + } + else { + my $method; + my $callbacks; + if (exists $self->{ParseOptions}) { + $callbacks = $self->{ParseOptions}; + } + else { + $callbacks = $self; + } + if (0) { # dummy to make elsif's below compile + } + elsif (defined $callbacks->{'DocumentHandler'} and $method = $callbacks->{'DocumentHandler'}->can('entity_reference') ) { + my $handler = $callbacks->{'DocumentHandler'}; + $self->{Methods}->{'entity_reference'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'Handler'} and $method = $callbacks->{'Handler'}->can('entity_reference') ) { + my $handler = $callbacks->{'Handler'}; + $self->{Methods}->{'entity_reference'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'DocumentHandler'} + and $callbacks->{'DocumentHandler'}->can('AUTOLOAD') + and $callbacks->{'DocumentHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'DocumentHandler'}->entity_reference(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'DocumentHandler'}; + $self->{Methods}->{'entity_reference'} = sub { $handler->entity_reference(@_) }; + } + return $res; + } + elsif (defined $callbacks->{'Handler'} + and $callbacks->{'Handler'}->can('AUTOLOAD') + and $callbacks->{'Handler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'Handler'}->entity_reference(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'Handler'}; + $self->{Methods}->{'entity_reference'} = sub { $handler->entity_reference(@_) }; + } + return $res; + } + else { + $self->{Methods}->{'entity_reference'} = sub { }; + } + } + +} + +sub attlist_decl { + my $self = shift; + if (defined $self->{Methods}->{'attlist_decl'}) { + $self->{Methods}->{'attlist_decl'}->(@_); + } + else { + my $method; + my $callbacks; + if (exists $self->{ParseOptions}) { + $callbacks = $self->{ParseOptions}; + } + else { + $callbacks = $self; + } + if (0) { # dummy to make elsif's below compile + } + elsif (defined $callbacks->{'DTDHandler'} and $method = $callbacks->{'DTDHandler'}->can('attlist_decl') ) { + my $handler = $callbacks->{'DTDHandler'}; + $self->{Methods}->{'attlist_decl'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'Handler'} and $method = $callbacks->{'Handler'}->can('attlist_decl') ) { + my $handler = $callbacks->{'Handler'}; + $self->{Methods}->{'attlist_decl'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'DTDHandler'} + and $callbacks->{'DTDHandler'}->can('AUTOLOAD') + and $callbacks->{'DTDHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'DTDHandler'}->attlist_decl(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'DTDHandler'}; + $self->{Methods}->{'attlist_decl'} = sub { $handler->attlist_decl(@_) }; + } + return $res; + } + elsif (defined $callbacks->{'Handler'} + and $callbacks->{'Handler'}->can('AUTOLOAD') + and $callbacks->{'Handler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'Handler'}->attlist_decl(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'Handler'}; + $self->{Methods}->{'attlist_decl'} = sub { $handler->attlist_decl(@_) }; + } + return $res; + } + else { + $self->{Methods}->{'attlist_decl'} = sub { }; + } + } + +} + +sub error { + my $self = shift; + if (defined $self->{Methods}->{'error'}) { + $self->{Methods}->{'error'}->(@_); + } + else { + my $method; + my $callbacks; + if (exists $self->{ParseOptions}) { + $callbacks = $self->{ParseOptions}; + } + else { + $callbacks = $self; + } + if (0) { # dummy to make elsif's below compile + } + elsif (defined $callbacks->{'ErrorHandler'} and $method = $callbacks->{'ErrorHandler'}->can('error') ) { + my $handler = $callbacks->{'ErrorHandler'}; + $self->{Methods}->{'error'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'Handler'} and $method = $callbacks->{'Handler'}->can('error') ) { + my $handler = $callbacks->{'Handler'}; + $self->{Methods}->{'error'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'ErrorHandler'} + and $callbacks->{'ErrorHandler'}->can('AUTOLOAD') + and $callbacks->{'ErrorHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'ErrorHandler'}->error(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'ErrorHandler'}; + $self->{Methods}->{'error'} = sub { $handler->error(@_) }; + } + return $res; + } + elsif (defined $callbacks->{'Handler'} + and $callbacks->{'Handler'}->can('AUTOLOAD') + and $callbacks->{'Handler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'Handler'}->error(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'Handler'}; + $self->{Methods}->{'error'} = sub { $handler->error(@_) }; + } + return $res; + } + else { + $self->{Methods}->{'error'} = sub { }; + } + } + +} + +sub unparsed_entity_decl { + my $self = shift; + if (defined $self->{Methods}->{'unparsed_entity_decl'}) { + $self->{Methods}->{'unparsed_entity_decl'}->(@_); + } + else { + my $method; + my $callbacks; + if (exists $self->{ParseOptions}) { + $callbacks = $self->{ParseOptions}; + } + else { + $callbacks = $self; + } + if (0) { # dummy to make elsif's below compile + } + elsif (defined $callbacks->{'DTDHandler'} and $method = $callbacks->{'DTDHandler'}->can('unparsed_entity_decl') ) { + my $handler = $callbacks->{'DTDHandler'}; + $self->{Methods}->{'unparsed_entity_decl'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'Handler'} and $method = $callbacks->{'Handler'}->can('unparsed_entity_decl') ) { + my $handler = $callbacks->{'Handler'}; + $self->{Methods}->{'unparsed_entity_decl'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'DTDHandler'} + and $callbacks->{'DTDHandler'}->can('AUTOLOAD') + and $callbacks->{'DTDHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'DTDHandler'}->unparsed_entity_decl(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'DTDHandler'}; + $self->{Methods}->{'unparsed_entity_decl'} = sub { $handler->unparsed_entity_decl(@_) }; + } + return $res; + } + elsif (defined $callbacks->{'Handler'} + and $callbacks->{'Handler'}->can('AUTOLOAD') + and $callbacks->{'Handler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'Handler'}->unparsed_entity_decl(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'Handler'}; + $self->{Methods}->{'unparsed_entity_decl'} = sub { $handler->unparsed_entity_decl(@_) }; + } + return $res; + } + else { + $self->{Methods}->{'unparsed_entity_decl'} = sub { }; + } + } + +} + +sub end_entity { + my $self = shift; + if (defined $self->{Methods}->{'end_entity'}) { + $self->{Methods}->{'end_entity'}->(@_); + } + else { + my $method; + my $callbacks; + if (exists $self->{ParseOptions}) { + $callbacks = $self->{ParseOptions}; + } + else { + $callbacks = $self; + } + if (0) { # dummy to make elsif's below compile + } + elsif (defined $callbacks->{'LexicalHandler'} and $method = $callbacks->{'LexicalHandler'}->can('end_entity') ) { + my $handler = $callbacks->{'LexicalHandler'}; + $self->{Methods}->{'end_entity'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'Handler'} and $method = $callbacks->{'Handler'}->can('end_entity') ) { + my $handler = $callbacks->{'Handler'}; + $self->{Methods}->{'end_entity'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'LexicalHandler'} + and $callbacks->{'LexicalHandler'}->can('AUTOLOAD') + and $callbacks->{'LexicalHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'LexicalHandler'}->end_entity(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'LexicalHandler'}; + $self->{Methods}->{'end_entity'} = sub { $handler->end_entity(@_) }; + } + return $res; + } + elsif (defined $callbacks->{'Handler'} + and $callbacks->{'Handler'}->can('AUTOLOAD') + and $callbacks->{'Handler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'Handler'}->end_entity(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'Handler'}; + $self->{Methods}->{'end_entity'} = sub { $handler->end_entity(@_) }; + } + return $res; + } + else { + $self->{Methods}->{'end_entity'} = sub { }; + } + } + +} + +sub end_element { + my $self = shift; + if (defined $self->{Methods}->{'end_element'}) { + $self->{Methods}->{'end_element'}->(@_); + } + else { + my $method; + my $callbacks; + if (exists $self->{ParseOptions}) { + $callbacks = $self->{ParseOptions}; + } + else { + $callbacks = $self; + } + if (0) { # dummy to make elsif's below compile + } + elsif (defined $callbacks->{'ContentHandler'} and $method = $callbacks->{'ContentHandler'}->can('end_element') ) { + my $handler = $callbacks->{'ContentHandler'}; + $self->{Methods}->{'end_element'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'DocumentHandler'} and $method = $callbacks->{'DocumentHandler'}->can('end_element') ) { + my $handler = $callbacks->{'DocumentHandler'}; + $self->{Methods}->{'end_element'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'Handler'} and $method = $callbacks->{'Handler'}->can('end_element') ) { + my $handler = $callbacks->{'Handler'}; + $self->{Methods}->{'end_element'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'ContentHandler'} + and $callbacks->{'ContentHandler'}->can('AUTOLOAD') + and $callbacks->{'ContentHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'ContentHandler'}->end_element(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'ContentHandler'}; + $self->{Methods}->{'end_element'} = sub { $handler->end_element(@_) }; + } + return $res; + } + elsif (defined $callbacks->{'DocumentHandler'} + and $callbacks->{'DocumentHandler'}->can('AUTOLOAD') + and $callbacks->{'DocumentHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'DocumentHandler'}->end_element(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'DocumentHandler'}; + $self->{Methods}->{'end_element'} = sub { $handler->end_element(@_) }; + } + return $res; + } + elsif (defined $callbacks->{'Handler'} + and $callbacks->{'Handler'}->can('AUTOLOAD') + and $callbacks->{'Handler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'Handler'}->end_element(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'Handler'}; + $self->{Methods}->{'end_element'} = sub { $handler->end_element(@_) }; + } + return $res; + } + else { + $self->{Methods}->{'end_element'} = sub { }; + } + } + +} + +sub comment { + my $self = shift; + if (defined $self->{Methods}->{'comment'}) { + $self->{Methods}->{'comment'}->(@_); + } + else { + my $method; + my $callbacks; + if (exists $self->{ParseOptions}) { + $callbacks = $self->{ParseOptions}; + } + else { + $callbacks = $self; + } + if (0) { # dummy to make elsif's below compile + } + elsif (defined $callbacks->{'DocumentHandler'} and $method = $callbacks->{'DocumentHandler'}->can('comment') ) { + my $handler = $callbacks->{'DocumentHandler'}; + $self->{Methods}->{'comment'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'LexicalHandler'} and $method = $callbacks->{'LexicalHandler'}->can('comment') ) { + my $handler = $callbacks->{'LexicalHandler'}; + $self->{Methods}->{'comment'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'Handler'} and $method = $callbacks->{'Handler'}->can('comment') ) { + my $handler = $callbacks->{'Handler'}; + $self->{Methods}->{'comment'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'DocumentHandler'} + and $callbacks->{'DocumentHandler'}->can('AUTOLOAD') + and $callbacks->{'DocumentHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'DocumentHandler'}->comment(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'DocumentHandler'}; + $self->{Methods}->{'comment'} = sub { $handler->comment(@_) }; + } + return $res; + } + elsif (defined $callbacks->{'LexicalHandler'} + and $callbacks->{'LexicalHandler'}->can('AUTOLOAD') + and $callbacks->{'LexicalHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'LexicalHandler'}->comment(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'LexicalHandler'}; + $self->{Methods}->{'comment'} = sub { $handler->comment(@_) }; + } + return $res; + } + elsif (defined $callbacks->{'Handler'} + and $callbacks->{'Handler'}->can('AUTOLOAD') + and $callbacks->{'Handler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'Handler'}->comment(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'Handler'}; + $self->{Methods}->{'comment'} = sub { $handler->comment(@_) }; + } + return $res; + } + else { + $self->{Methods}->{'comment'} = sub { }; + } + } + +} + +sub element_decl { + my $self = shift; + if (defined $self->{Methods}->{'element_decl'}) { + $self->{Methods}->{'element_decl'}->(@_); + } + else { + my $method; + my $callbacks; + if (exists $self->{ParseOptions}) { + $callbacks = $self->{ParseOptions}; + } + else { + $callbacks = $self; + } + if (0) { # dummy to make elsif's below compile + } + elsif (defined $callbacks->{'DeclHandler'} and $method = $callbacks->{'DeclHandler'}->can('element_decl') ) { + my $handler = $callbacks->{'DeclHandler'}; + $self->{Methods}->{'element_decl'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'Handler'} and $method = $callbacks->{'Handler'}->can('element_decl') ) { + my $handler = $callbacks->{'Handler'}; + $self->{Methods}->{'element_decl'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'DeclHandler'} + and $callbacks->{'DeclHandler'}->can('AUTOLOAD') + and $callbacks->{'DeclHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'DeclHandler'}->element_decl(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'DeclHandler'}; + $self->{Methods}->{'element_decl'} = sub { $handler->element_decl(@_) }; + } + return $res; + } + elsif (defined $callbacks->{'Handler'} + and $callbacks->{'Handler'}->can('AUTOLOAD') + and $callbacks->{'Handler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'Handler'}->element_decl(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'Handler'}; + $self->{Methods}->{'element_decl'} = sub { $handler->element_decl(@_) }; + } + return $res; + } + else { + $self->{Methods}->{'element_decl'} = sub { }; + } + } + +} + +sub attribute_decl { + my $self = shift; + if (defined $self->{Methods}->{'attribute_decl'}) { + $self->{Methods}->{'attribute_decl'}->(@_); + } + else { + my $method; + my $callbacks; + if (exists $self->{ParseOptions}) { + $callbacks = $self->{ParseOptions}; + } + else { + $callbacks = $self; + } + if (0) { # dummy to make elsif's below compile + } + elsif (defined $callbacks->{'DeclHandler'} and $method = $callbacks->{'DeclHandler'}->can('attribute_decl') ) { + my $handler = $callbacks->{'DeclHandler'}; + $self->{Methods}->{'attribute_decl'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'Handler'} and $method = $callbacks->{'Handler'}->can('attribute_decl') ) { + my $handler = $callbacks->{'Handler'}; + $self->{Methods}->{'attribute_decl'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'DeclHandler'} + and $callbacks->{'DeclHandler'}->can('AUTOLOAD') + and $callbacks->{'DeclHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'DeclHandler'}->attribute_decl(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'DeclHandler'}; + $self->{Methods}->{'attribute_decl'} = sub { $handler->attribute_decl(@_) }; + } + return $res; + } + elsif (defined $callbacks->{'Handler'} + and $callbacks->{'Handler'}->can('AUTOLOAD') + and $callbacks->{'Handler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'Handler'}->attribute_decl(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'Handler'}; + $self->{Methods}->{'attribute_decl'} = sub { $handler->attribute_decl(@_) }; + } + return $res; + } + else { + $self->{Methods}->{'attribute_decl'} = sub { }; + } + } + +} + +sub fatal_error { + my $self = shift; + if (defined $self->{Methods}->{'fatal_error'}) { + $self->{Methods}->{'fatal_error'}->(@_); + } + else { + my $method; + my $callbacks; + if (exists $self->{ParseOptions}) { + $callbacks = $self->{ParseOptions}; + } + else { + $callbacks = $self; + } + if (0) { # dummy to make elsif's below compile + } + elsif (defined $callbacks->{'ErrorHandler'} and $method = $callbacks->{'ErrorHandler'}->can('fatal_error') ) { + my $handler = $callbacks->{'ErrorHandler'}; + $self->{Methods}->{'fatal_error'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'Handler'} and $method = $callbacks->{'Handler'}->can('fatal_error') ) { + my $handler = $callbacks->{'Handler'}; + $self->{Methods}->{'fatal_error'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'ErrorHandler'} + and $callbacks->{'ErrorHandler'}->can('AUTOLOAD') + and $callbacks->{'ErrorHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'ErrorHandler'}->fatal_error(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'ErrorHandler'}; + $self->{Methods}->{'fatal_error'} = sub { $handler->fatal_error(@_) }; + } + return $res; + } + elsif (defined $callbacks->{'Handler'} + and $callbacks->{'Handler'}->can('AUTOLOAD') + and $callbacks->{'Handler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'Handler'}->fatal_error(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'Handler'}; + $self->{Methods}->{'fatal_error'} = sub { $handler->fatal_error(@_) }; + } + return $res; + } + else { + $self->{Methods}->{'fatal_error'} = sub { }; + } + } + +} + +sub start_document { + my $self = shift; + if (defined $self->{Methods}->{'start_document'}) { + $self->{Methods}->{'start_document'}->(@_); + } + else { + my $method; + my $callbacks; + if (exists $self->{ParseOptions}) { + $callbacks = $self->{ParseOptions}; + } + else { + $callbacks = $self; + } + if (0) { # dummy to make elsif's below compile + } + elsif (defined $callbacks->{'ContentHandler'} and $method = $callbacks->{'ContentHandler'}->can('start_document') ) { + my $handler = $callbacks->{'ContentHandler'}; + $self->{Methods}->{'start_document'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'DocumentHandler'} and $method = $callbacks->{'DocumentHandler'}->can('start_document') ) { + my $handler = $callbacks->{'DocumentHandler'}; + $self->{Methods}->{'start_document'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'Handler'} and $method = $callbacks->{'Handler'}->can('start_document') ) { + my $handler = $callbacks->{'Handler'}; + $self->{Methods}->{'start_document'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'ContentHandler'} + and $callbacks->{'ContentHandler'}->can('AUTOLOAD') + and $callbacks->{'ContentHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'ContentHandler'}->start_document(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'ContentHandler'}; + $self->{Methods}->{'start_document'} = sub { $handler->start_document(@_) }; + } + return $res; + } + elsif (defined $callbacks->{'DocumentHandler'} + and $callbacks->{'DocumentHandler'}->can('AUTOLOAD') + and $callbacks->{'DocumentHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'DocumentHandler'}->start_document(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'DocumentHandler'}; + $self->{Methods}->{'start_document'} = sub { $handler->start_document(@_) }; + } + return $res; + } + elsif (defined $callbacks->{'Handler'} + and $callbacks->{'Handler'}->can('AUTOLOAD') + and $callbacks->{'Handler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'Handler'}->start_document(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'Handler'}; + $self->{Methods}->{'start_document'} = sub { $handler->start_document(@_) }; + } + return $res; + } + else { + $self->{Methods}->{'start_document'} = sub { }; + } + } + +} + +sub external_entity_decl { + my $self = shift; + if (defined $self->{Methods}->{'external_entity_decl'}) { + $self->{Methods}->{'external_entity_decl'}->(@_); + } + else { + my $method; + my $callbacks; + if (exists $self->{ParseOptions}) { + $callbacks = $self->{ParseOptions}; + } + else { + $callbacks = $self; + } + if (0) { # dummy to make elsif's below compile + } + elsif (defined $callbacks->{'DeclHandler'} and $method = $callbacks->{'DeclHandler'}->can('external_entity_decl') ) { + my $handler = $callbacks->{'DeclHandler'}; + $self->{Methods}->{'external_entity_decl'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'Handler'} and $method = $callbacks->{'Handler'}->can('external_entity_decl') ) { + my $handler = $callbacks->{'Handler'}; + $self->{Methods}->{'external_entity_decl'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'DeclHandler'} + and $callbacks->{'DeclHandler'}->can('AUTOLOAD') + and $callbacks->{'DeclHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'DeclHandler'}->external_entity_decl(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'DeclHandler'}; + $self->{Methods}->{'external_entity_decl'} = sub { $handler->external_entity_decl(@_) }; + } + return $res; + } + elsif (defined $callbacks->{'Handler'} + and $callbacks->{'Handler'}->can('AUTOLOAD') + and $callbacks->{'Handler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'Handler'}->external_entity_decl(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'Handler'}; + $self->{Methods}->{'external_entity_decl'} = sub { $handler->external_entity_decl(@_) }; + } + return $res; + } + else { + $self->{Methods}->{'external_entity_decl'} = sub { }; + } + } + +} + +sub warning { + my $self = shift; + if (defined $self->{Methods}->{'warning'}) { + $self->{Methods}->{'warning'}->(@_); + } + else { + my $method; + my $callbacks; + if (exists $self->{ParseOptions}) { + $callbacks = $self->{ParseOptions}; + } + else { + $callbacks = $self; + } + if (0) { # dummy to make elsif's below compile + } + elsif (defined $callbacks->{'ErrorHandler'} and $method = $callbacks->{'ErrorHandler'}->can('warning') ) { + my $handler = $callbacks->{'ErrorHandler'}; + $self->{Methods}->{'warning'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'Handler'} and $method = $callbacks->{'Handler'}->can('warning') ) { + my $handler = $callbacks->{'Handler'}; + $self->{Methods}->{'warning'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'ErrorHandler'} + and $callbacks->{'ErrorHandler'}->can('AUTOLOAD') + and $callbacks->{'ErrorHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'ErrorHandler'}->warning(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'ErrorHandler'}; + $self->{Methods}->{'warning'} = sub { $handler->warning(@_) }; + } + return $res; + } + elsif (defined $callbacks->{'Handler'} + and $callbacks->{'Handler'}->can('AUTOLOAD') + and $callbacks->{'Handler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'Handler'}->warning(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'Handler'}; + $self->{Methods}->{'warning'} = sub { $handler->warning(@_) }; + } + return $res; + } + else { + $self->{Methods}->{'warning'} = sub { }; + } + } + +} + +sub doctype_decl { + my $self = shift; + if (defined $self->{Methods}->{'doctype_decl'}) { + $self->{Methods}->{'doctype_decl'}->(@_); + } + else { + my $method; + my $callbacks; + if (exists $self->{ParseOptions}) { + $callbacks = $self->{ParseOptions}; + } + else { + $callbacks = $self; + } + if (0) { # dummy to make elsif's below compile + } + elsif (defined $callbacks->{'DTDHandler'} and $method = $callbacks->{'DTDHandler'}->can('doctype_decl') ) { + my $handler = $callbacks->{'DTDHandler'}; + $self->{Methods}->{'doctype_decl'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'Handler'} and $method = $callbacks->{'Handler'}->can('doctype_decl') ) { + my $handler = $callbacks->{'Handler'}; + $self->{Methods}->{'doctype_decl'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'DTDHandler'} + and $callbacks->{'DTDHandler'}->can('AUTOLOAD') + and $callbacks->{'DTDHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'DTDHandler'}->doctype_decl(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'DTDHandler'}; + $self->{Methods}->{'doctype_decl'} = sub { $handler->doctype_decl(@_) }; + } + return $res; + } + elsif (defined $callbacks->{'Handler'} + and $callbacks->{'Handler'}->can('AUTOLOAD') + and $callbacks->{'Handler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'Handler'}->doctype_decl(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'Handler'}; + $self->{Methods}->{'doctype_decl'} = sub { $handler->doctype_decl(@_) }; + } + return $res; + } + else { + $self->{Methods}->{'doctype_decl'} = sub { }; + } + } + +} + +sub entity_decl { + my $self = shift; + if (defined $self->{Methods}->{'entity_decl'}) { + $self->{Methods}->{'entity_decl'}->(@_); + } + else { + my $method; + my $callbacks; + if (exists $self->{ParseOptions}) { + $callbacks = $self->{ParseOptions}; + } + else { + $callbacks = $self; + } + if (0) { # dummy to make elsif's below compile + } + elsif (defined $callbacks->{'DTDHandler'} and $method = $callbacks->{'DTDHandler'}->can('entity_decl') ) { + my $handler = $callbacks->{'DTDHandler'}; + $self->{Methods}->{'entity_decl'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'Handler'} and $method = $callbacks->{'Handler'}->can('entity_decl') ) { + my $handler = $callbacks->{'Handler'}; + $self->{Methods}->{'entity_decl'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'DTDHandler'} + and $callbacks->{'DTDHandler'}->can('AUTOLOAD') + and $callbacks->{'DTDHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'DTDHandler'}->entity_decl(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'DTDHandler'}; + $self->{Methods}->{'entity_decl'} = sub { $handler->entity_decl(@_) }; + } + return $res; + } + elsif (defined $callbacks->{'Handler'} + and $callbacks->{'Handler'}->can('AUTOLOAD') + and $callbacks->{'Handler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'Handler'}->entity_decl(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'Handler'}; + $self->{Methods}->{'entity_decl'} = sub { $handler->entity_decl(@_) }; + } + return $res; + } + else { + $self->{Methods}->{'entity_decl'} = sub { }; + } + } + +} + +sub end_document { + my $self = shift; + if (defined $self->{Methods}->{'end_document'}) { + $self->{Methods}->{'end_document'}->(@_); + } + else { + my $method; + my $callbacks; + if (exists $self->{ParseOptions}) { + $callbacks = $self->{ParseOptions}; + } + else { + $callbacks = $self; + } + if (0) { # dummy to make elsif's below compile + } + elsif (defined $callbacks->{'ContentHandler'} and $method = $callbacks->{'ContentHandler'}->can('end_document') ) { + my $handler = $callbacks->{'ContentHandler'}; + $self->{Methods}->{'end_document'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'DocumentHandler'} and $method = $callbacks->{'DocumentHandler'}->can('end_document') ) { + my $handler = $callbacks->{'DocumentHandler'}; + $self->{Methods}->{'end_document'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'Handler'} and $method = $callbacks->{'Handler'}->can('end_document') ) { + my $handler = $callbacks->{'Handler'}; + $self->{Methods}->{'end_document'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'ContentHandler'} + and $callbacks->{'ContentHandler'}->can('AUTOLOAD') + and $callbacks->{'ContentHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'ContentHandler'}->end_document(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'ContentHandler'}; + $self->{Methods}->{'end_document'} = sub { $handler->end_document(@_) }; + } + return $res; + } + elsif (defined $callbacks->{'DocumentHandler'} + and $callbacks->{'DocumentHandler'}->can('AUTOLOAD') + and $callbacks->{'DocumentHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'DocumentHandler'}->end_document(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'DocumentHandler'}; + $self->{Methods}->{'end_document'} = sub { $handler->end_document(@_) }; + } + return $res; + } + elsif (defined $callbacks->{'Handler'} + and $callbacks->{'Handler'}->can('AUTOLOAD') + and $callbacks->{'Handler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'Handler'}->end_document(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'Handler'}; + $self->{Methods}->{'end_document'} = sub { $handler->end_document(@_) }; + } + return $res; + } + else { + $self->{Methods}->{'end_document'} = sub { }; + } + } + +} + +sub start_element { + my $self = shift; + if (defined $self->{Methods}->{'start_element'}) { + $self->{Methods}->{'start_element'}->(@_); + } + else { + my $method; + my $callbacks; + if (exists $self->{ParseOptions}) { + $callbacks = $self->{ParseOptions}; + } + else { + $callbacks = $self; + } + if (0) { # dummy to make elsif's below compile + } + elsif (defined $callbacks->{'ContentHandler'} and $method = $callbacks->{'ContentHandler'}->can('start_element') ) { + my $handler = $callbacks->{'ContentHandler'}; + $self->{Methods}->{'start_element'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'DocumentHandler'} and $method = $callbacks->{'DocumentHandler'}->can('start_element') ) { + my $handler = $callbacks->{'DocumentHandler'}; + $self->{Methods}->{'start_element'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'Handler'} and $method = $callbacks->{'Handler'}->can('start_element') ) { + my $handler = $callbacks->{'Handler'}; + $self->{Methods}->{'start_element'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'ContentHandler'} + and $callbacks->{'ContentHandler'}->can('AUTOLOAD') + and $callbacks->{'ContentHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'ContentHandler'}->start_element(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'ContentHandler'}; + $self->{Methods}->{'start_element'} = sub { $handler->start_element(@_) }; + } + return $res; + } + elsif (defined $callbacks->{'DocumentHandler'} + and $callbacks->{'DocumentHandler'}->can('AUTOLOAD') + and $callbacks->{'DocumentHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'DocumentHandler'}->start_element(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'DocumentHandler'}; + $self->{Methods}->{'start_element'} = sub { $handler->start_element(@_) }; + } + return $res; + } + elsif (defined $callbacks->{'Handler'} + and $callbacks->{'Handler'}->can('AUTOLOAD') + and $callbacks->{'Handler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'Handler'}->start_element(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'Handler'}; + $self->{Methods}->{'start_element'} = sub { $handler->start_element(@_) }; + } + return $res; + } + else { + $self->{Methods}->{'start_element'} = sub { }; + } + } + +} + +sub start_dtd { + my $self = shift; + if (defined $self->{Methods}->{'start_dtd'}) { + $self->{Methods}->{'start_dtd'}->(@_); + } + else { + my $method; + my $callbacks; + if (exists $self->{ParseOptions}) { + $callbacks = $self->{ParseOptions}; + } + else { + $callbacks = $self; + } + if (0) { # dummy to make elsif's below compile + } + elsif (defined $callbacks->{'LexicalHandler'} and $method = $callbacks->{'LexicalHandler'}->can('start_dtd') ) { + my $handler = $callbacks->{'LexicalHandler'}; + $self->{Methods}->{'start_dtd'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'Handler'} and $method = $callbacks->{'Handler'}->can('start_dtd') ) { + my $handler = $callbacks->{'Handler'}; + $self->{Methods}->{'start_dtd'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'LexicalHandler'} + and $callbacks->{'LexicalHandler'}->can('AUTOLOAD') + and $callbacks->{'LexicalHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'LexicalHandler'}->start_dtd(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'LexicalHandler'}; + $self->{Methods}->{'start_dtd'} = sub { $handler->start_dtd(@_) }; + } + return $res; + } + elsif (defined $callbacks->{'Handler'} + and $callbacks->{'Handler'}->can('AUTOLOAD') + and $callbacks->{'Handler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'Handler'}->start_dtd(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'Handler'}; + $self->{Methods}->{'start_dtd'} = sub { $handler->start_dtd(@_) }; + } + return $res; + } + else { + $self->{Methods}->{'start_dtd'} = sub { }; + } + } + +} + +sub end_prefix_mapping { + my $self = shift; + if (defined $self->{Methods}->{'end_prefix_mapping'}) { + $self->{Methods}->{'end_prefix_mapping'}->(@_); + } + else { + my $method; + my $callbacks; + if (exists $self->{ParseOptions}) { + $callbacks = $self->{ParseOptions}; + } + else { + $callbacks = $self; + } + if (0) { # dummy to make elsif's below compile + } + elsif (defined $callbacks->{'ContentHandler'} and $method = $callbacks->{'ContentHandler'}->can('end_prefix_mapping') ) { + my $handler = $callbacks->{'ContentHandler'}; + $self->{Methods}->{'end_prefix_mapping'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'Handler'} and $method = $callbacks->{'Handler'}->can('end_prefix_mapping') ) { + my $handler = $callbacks->{'Handler'}; + $self->{Methods}->{'end_prefix_mapping'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'ContentHandler'} + and $callbacks->{'ContentHandler'}->can('AUTOLOAD') + and $callbacks->{'ContentHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'ContentHandler'}->end_prefix_mapping(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'ContentHandler'}; + $self->{Methods}->{'end_prefix_mapping'} = sub { $handler->end_prefix_mapping(@_) }; + } + return $res; + } + elsif (defined $callbacks->{'Handler'} + and $callbacks->{'Handler'}->can('AUTOLOAD') + and $callbacks->{'Handler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'Handler'}->end_prefix_mapping(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'Handler'}; + $self->{Methods}->{'end_prefix_mapping'} = sub { $handler->end_prefix_mapping(@_) }; + } + return $res; + } + else { + $self->{Methods}->{'end_prefix_mapping'} = sub { }; + } + } + +} + +sub end_dtd { + my $self = shift; + if (defined $self->{Methods}->{'end_dtd'}) { + $self->{Methods}->{'end_dtd'}->(@_); + } + else { + my $method; + my $callbacks; + if (exists $self->{ParseOptions}) { + $callbacks = $self->{ParseOptions}; + } + else { + $callbacks = $self; + } + if (0) { # dummy to make elsif's below compile + } + elsif (defined $callbacks->{'LexicalHandler'} and $method = $callbacks->{'LexicalHandler'}->can('end_dtd') ) { + my $handler = $callbacks->{'LexicalHandler'}; + $self->{Methods}->{'end_dtd'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'Handler'} and $method = $callbacks->{'Handler'}->can('end_dtd') ) { + my $handler = $callbacks->{'Handler'}; + $self->{Methods}->{'end_dtd'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'LexicalHandler'} + and $callbacks->{'LexicalHandler'}->can('AUTOLOAD') + and $callbacks->{'LexicalHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'LexicalHandler'}->end_dtd(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'LexicalHandler'}; + $self->{Methods}->{'end_dtd'} = sub { $handler->end_dtd(@_) }; + } + return $res; + } + elsif (defined $callbacks->{'Handler'} + and $callbacks->{'Handler'}->can('AUTOLOAD') + and $callbacks->{'Handler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'Handler'}->end_dtd(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'Handler'}; + $self->{Methods}->{'end_dtd'} = sub { $handler->end_dtd(@_) }; + } + return $res; + } + else { + $self->{Methods}->{'end_dtd'} = sub { }; + } + } + +} + +sub characters { + my $self = shift; + if (defined $self->{Methods}->{'characters'}) { + $self->{Methods}->{'characters'}->(@_); + } + else { + my $method; + my $callbacks; + if (exists $self->{ParseOptions}) { + $callbacks = $self->{ParseOptions}; + } + else { + $callbacks = $self; + } + if (0) { # dummy to make elsif's below compile + } + elsif (defined $callbacks->{'ContentHandler'} and $method = $callbacks->{'ContentHandler'}->can('characters') ) { + my $handler = $callbacks->{'ContentHandler'}; + $self->{Methods}->{'characters'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'DocumentHandler'} and $method = $callbacks->{'DocumentHandler'}->can('characters') ) { + my $handler = $callbacks->{'DocumentHandler'}; + $self->{Methods}->{'characters'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'Handler'} and $method = $callbacks->{'Handler'}->can('characters') ) { + my $handler = $callbacks->{'Handler'}; + $self->{Methods}->{'characters'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'ContentHandler'} + and $callbacks->{'ContentHandler'}->can('AUTOLOAD') + and $callbacks->{'ContentHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'ContentHandler'}->characters(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'ContentHandler'}; + $self->{Methods}->{'characters'} = sub { $handler->characters(@_) }; + } + return $res; + } + elsif (defined $callbacks->{'DocumentHandler'} + and $callbacks->{'DocumentHandler'}->can('AUTOLOAD') + and $callbacks->{'DocumentHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'DocumentHandler'}->characters(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'DocumentHandler'}; + $self->{Methods}->{'characters'} = sub { $handler->characters(@_) }; + } + return $res; + } + elsif (defined $callbacks->{'Handler'} + and $callbacks->{'Handler'}->can('AUTOLOAD') + and $callbacks->{'Handler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'Handler'}->characters(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'Handler'}; + $self->{Methods}->{'characters'} = sub { $handler->characters(@_) }; + } + return $res; + } + else { + $self->{Methods}->{'characters'} = sub { }; + } + } + +} + +sub end_cdata { + my $self = shift; + if (defined $self->{Methods}->{'end_cdata'}) { + $self->{Methods}->{'end_cdata'}->(@_); + } + else { + my $method; + my $callbacks; + if (exists $self->{ParseOptions}) { + $callbacks = $self->{ParseOptions}; + } + else { + $callbacks = $self; + } + if (0) { # dummy to make elsif's below compile + } + elsif (defined $callbacks->{'DocumentHandler'} and $method = $callbacks->{'DocumentHandler'}->can('end_cdata') ) { + my $handler = $callbacks->{'DocumentHandler'}; + $self->{Methods}->{'end_cdata'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'LexicalHandler'} and $method = $callbacks->{'LexicalHandler'}->can('end_cdata') ) { + my $handler = $callbacks->{'LexicalHandler'}; + $self->{Methods}->{'end_cdata'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'Handler'} and $method = $callbacks->{'Handler'}->can('end_cdata') ) { + my $handler = $callbacks->{'Handler'}; + $self->{Methods}->{'end_cdata'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'DocumentHandler'} + and $callbacks->{'DocumentHandler'}->can('AUTOLOAD') + and $callbacks->{'DocumentHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'DocumentHandler'}->end_cdata(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'DocumentHandler'}; + $self->{Methods}->{'end_cdata'} = sub { $handler->end_cdata(@_) }; + } + return $res; + } + elsif (defined $callbacks->{'LexicalHandler'} + and $callbacks->{'LexicalHandler'}->can('AUTOLOAD') + and $callbacks->{'LexicalHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'LexicalHandler'}->end_cdata(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'LexicalHandler'}; + $self->{Methods}->{'end_cdata'} = sub { $handler->end_cdata(@_) }; + } + return $res; + } + elsif (defined $callbacks->{'Handler'} + and $callbacks->{'Handler'}->can('AUTOLOAD') + and $callbacks->{'Handler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'Handler'}->end_cdata(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'Handler'}; + $self->{Methods}->{'end_cdata'} = sub { $handler->end_cdata(@_) }; + } + return $res; + } + else { + $self->{Methods}->{'end_cdata'} = sub { }; + } + } + +} + +sub skipped_entity { + my $self = shift; + if (defined $self->{Methods}->{'skipped_entity'}) { + $self->{Methods}->{'skipped_entity'}->(@_); + } + else { + my $method; + my $callbacks; + if (exists $self->{ParseOptions}) { + $callbacks = $self->{ParseOptions}; + } + else { + $callbacks = $self; + } + if (0) { # dummy to make elsif's below compile + } + elsif (defined $callbacks->{'ContentHandler'} and $method = $callbacks->{'ContentHandler'}->can('skipped_entity') ) { + my $handler = $callbacks->{'ContentHandler'}; + $self->{Methods}->{'skipped_entity'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'Handler'} and $method = $callbacks->{'Handler'}->can('skipped_entity') ) { + my $handler = $callbacks->{'Handler'}; + $self->{Methods}->{'skipped_entity'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'ContentHandler'} + and $callbacks->{'ContentHandler'}->can('AUTOLOAD') + and $callbacks->{'ContentHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'ContentHandler'}->skipped_entity(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'ContentHandler'}; + $self->{Methods}->{'skipped_entity'} = sub { $handler->skipped_entity(@_) }; + } + return $res; + } + elsif (defined $callbacks->{'Handler'} + and $callbacks->{'Handler'}->can('AUTOLOAD') + and $callbacks->{'Handler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'Handler'}->skipped_entity(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'Handler'}; + $self->{Methods}->{'skipped_entity'} = sub { $handler->skipped_entity(@_) }; + } + return $res; + } + else { + $self->{Methods}->{'skipped_entity'} = sub { }; + } + } + +} + +sub ignorable_whitespace { + my $self = shift; + if (defined $self->{Methods}->{'ignorable_whitespace'}) { + $self->{Methods}->{'ignorable_whitespace'}->(@_); + } + else { + my $method; + my $callbacks; + if (exists $self->{ParseOptions}) { + $callbacks = $self->{ParseOptions}; + } + else { + $callbacks = $self; + } + if (0) { # dummy to make elsif's below compile + } + elsif (defined $callbacks->{'ContentHandler'} and $method = $callbacks->{'ContentHandler'}->can('ignorable_whitespace') ) { + my $handler = $callbacks->{'ContentHandler'}; + $self->{Methods}->{'ignorable_whitespace'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'DocumentHandler'} and $method = $callbacks->{'DocumentHandler'}->can('ignorable_whitespace') ) { + my $handler = $callbacks->{'DocumentHandler'}; + $self->{Methods}->{'ignorable_whitespace'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'Handler'} and $method = $callbacks->{'Handler'}->can('ignorable_whitespace') ) { + my $handler = $callbacks->{'Handler'}; + $self->{Methods}->{'ignorable_whitespace'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'ContentHandler'} + and $callbacks->{'ContentHandler'}->can('AUTOLOAD') + and $callbacks->{'ContentHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'ContentHandler'}->ignorable_whitespace(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'ContentHandler'}; + $self->{Methods}->{'ignorable_whitespace'} = sub { $handler->ignorable_whitespace(@_) }; + } + return $res; + } + elsif (defined $callbacks->{'DocumentHandler'} + and $callbacks->{'DocumentHandler'}->can('AUTOLOAD') + and $callbacks->{'DocumentHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'DocumentHandler'}->ignorable_whitespace(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'DocumentHandler'}; + $self->{Methods}->{'ignorable_whitespace'} = sub { $handler->ignorable_whitespace(@_) }; + } + return $res; + } + elsif (defined $callbacks->{'Handler'} + and $callbacks->{'Handler'}->can('AUTOLOAD') + and $callbacks->{'Handler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'Handler'}->ignorable_whitespace(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'Handler'}; + $self->{Methods}->{'ignorable_whitespace'} = sub { $handler->ignorable_whitespace(@_) }; + } + return $res; + } + else { + $self->{Methods}->{'ignorable_whitespace'} = sub { }; + } + } + +} + +sub internal_entity_decl { + my $self = shift; + if (defined $self->{Methods}->{'internal_entity_decl'}) { + $self->{Methods}->{'internal_entity_decl'}->(@_); + } + else { + my $method; + my $callbacks; + if (exists $self->{ParseOptions}) { + $callbacks = $self->{ParseOptions}; + } + else { + $callbacks = $self; + } + if (0) { # dummy to make elsif's below compile + } + elsif (defined $callbacks->{'DeclHandler'} and $method = $callbacks->{'DeclHandler'}->can('internal_entity_decl') ) { + my $handler = $callbacks->{'DeclHandler'}; + $self->{Methods}->{'internal_entity_decl'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'Handler'} and $method = $callbacks->{'Handler'}->can('internal_entity_decl') ) { + my $handler = $callbacks->{'Handler'}; + $self->{Methods}->{'internal_entity_decl'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'DeclHandler'} + and $callbacks->{'DeclHandler'}->can('AUTOLOAD') + and $callbacks->{'DeclHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'DeclHandler'}->internal_entity_decl(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'DeclHandler'}; + $self->{Methods}->{'internal_entity_decl'} = sub { $handler->internal_entity_decl(@_) }; + } + return $res; + } + elsif (defined $callbacks->{'Handler'} + and $callbacks->{'Handler'}->can('AUTOLOAD') + and $callbacks->{'Handler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'Handler'}->internal_entity_decl(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'Handler'}; + $self->{Methods}->{'internal_entity_decl'} = sub { $handler->internal_entity_decl(@_) }; + } + return $res; + } + else { + $self->{Methods}->{'internal_entity_decl'} = sub { }; + } + } + +} + +sub start_entity { + my $self = shift; + if (defined $self->{Methods}->{'start_entity'}) { + $self->{Methods}->{'start_entity'}->(@_); + } + else { + my $method; + my $callbacks; + if (exists $self->{ParseOptions}) { + $callbacks = $self->{ParseOptions}; + } + else { + $callbacks = $self; + } + if (0) { # dummy to make elsif's below compile + } + elsif (defined $callbacks->{'LexicalHandler'} and $method = $callbacks->{'LexicalHandler'}->can('start_entity') ) { + my $handler = $callbacks->{'LexicalHandler'}; + $self->{Methods}->{'start_entity'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'Handler'} and $method = $callbacks->{'Handler'}->can('start_entity') ) { + my $handler = $callbacks->{'Handler'}; + $self->{Methods}->{'start_entity'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'LexicalHandler'} + and $callbacks->{'LexicalHandler'}->can('AUTOLOAD') + and $callbacks->{'LexicalHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'LexicalHandler'}->start_entity(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'LexicalHandler'}; + $self->{Methods}->{'start_entity'} = sub { $handler->start_entity(@_) }; + } + return $res; + } + elsif (defined $callbacks->{'Handler'} + and $callbacks->{'Handler'}->can('AUTOLOAD') + and $callbacks->{'Handler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'Handler'}->start_entity(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'Handler'}; + $self->{Methods}->{'start_entity'} = sub { $handler->start_entity(@_) }; + } + return $res; + } + else { + $self->{Methods}->{'start_entity'} = sub { }; + } + } + +} + +#-------------------------------------------------------------------# +# Class->new(%options) +#-------------------------------------------------------------------# +sub new { + my $proto = shift; + my $class = ref($proto) || $proto; + my $options = ($#_ == 0) ? shift : { @_ }; + + unless ( defined( $options->{Handler} ) or + defined( $options->{ContentHandler} ) or + defined( $options->{DTDHandler} ) or + defined( $options->{DocumentHandler} ) or + defined( $options->{LexicalHandler} ) or + defined( $options->{ErrorHandler} ) or + defined( $options->{DeclHandler} ) ) { + + $options->{Handler} = XML::SAX::Base::NoHandler->new; + } + + my $self = bless $options, $class; + # turn NS processing on by default + $self->set_feature('http://xml.org/sax/features/namespaces', 1); + return $self; +} +#-------------------------------------------------------------------# + +#-------------------------------------------------------------------# +# $p->parse(%options) +#-------------------------------------------------------------------# +sub parse { + my $self = shift; + my $parse_options = $self->get_options(@_); + local $self->{ParseOptions} = $parse_options; + if ($self->{Parent}) { # calling parse on a filter for some reason + return $self->{Parent}->parse($parse_options); + } + else { + my $method; + if (defined $parse_options->{Source}{CharacterStream} and $method = $self->can('_parse_characterstream')) { + warn("parse charstream???\n"); + return $method->($self, $parse_options->{Source}{CharacterStream}); + } + elsif (defined $parse_options->{Source}{ByteStream} and $method = $self->can('_parse_bytestream')) { + return $method->($self, $parse_options->{Source}{ByteStream}); + } + elsif (defined $parse_options->{Source}{String} and $method = $self->can('_parse_string')) { + return $method->($self, $parse_options->{Source}{String}); + } + elsif (defined $parse_options->{Source}{SystemId} and $method = $self->can('_parse_systemid')) { + return $method->($self, $parse_options->{Source}{SystemId}); + } + else { + die "No _parse_* routine defined on this driver (If it is a filter, remember to set the Parent property. If you call the parse() method, make sure to set a Source. You may want to call parse_uri, parse_string or parse_file instead.) [$self]"; + } + } +} +#-------------------------------------------------------------------# + +#-------------------------------------------------------------------# +# $p->parse_file(%options) +#-------------------------------------------------------------------# +sub parse_file { + my $self = shift; + my $file = shift; + return $self->parse_uri($file, @_) if ref(\$file) eq 'SCALAR'; + my $parse_options = $self->get_options(@_); + $parse_options->{Source}{ByteStream} = $file; + return $self->parse($parse_options); +} +#-------------------------------------------------------------------# + +#-------------------------------------------------------------------# +# $p->parse_uri(%options) +#-------------------------------------------------------------------# +sub parse_uri { + my $self = shift; + my $file = shift; + my $parse_options = $self->get_options(@_); + $parse_options->{Source}{SystemId} = $file; + return $self->parse($parse_options); +} +#-------------------------------------------------------------------# + +#-------------------------------------------------------------------# +# $p->parse_string(%options) +#-------------------------------------------------------------------# +sub parse_string { + my $self = shift; + my $string = shift; + my $parse_options = $self->get_options(@_); + $parse_options->{Source}{String} = $string; + return $self->parse($parse_options); +} +#-------------------------------------------------------------------# + +#-------------------------------------------------------------------# +# get_options +#-------------------------------------------------------------------# +sub get_options { + my $self = shift; + + if (@_ == 1) { + return { %$self, %{$_[0]} }; + } else { + return { %$self, @_ }; + } +} +#-------------------------------------------------------------------# + +#-------------------------------------------------------------------# +# get_features +#-------------------------------------------------------------------# +sub get_features { + return ( + 'http://xml.org/sax/features/external-general-entities' => undef, + 'http://xml.org/sax/features/external-parameter-entities' => undef, + 'http://xml.org/sax/features/is-standalone' => undef, + 'http://xml.org/sax/features/lexical-handler' => undef, + 'http://xml.org/sax/features/parameter-entities' => undef, + 'http://xml.org/sax/features/namespaces' => 1, + 'http://xml.org/sax/features/namespace-prefixes' => 0, + 'http://xml.org/sax/features/string-interning' => undef, + 'http://xml.org/sax/features/use-attributes2' => undef, + 'http://xml.org/sax/features/use-locator2' => undef, + 'http://xml.org/sax/features/validation' => undef, + + 'http://xml.org/sax/properties/dom-node' => undef, + 'http://xml.org/sax/properties/xml-string' => undef, + ); +} +#-------------------------------------------------------------------# + +#-------------------------------------------------------------------# +# get_feature +#-------------------------------------------------------------------# +sub get_feature { + my $self = shift; + my $feat = shift; + + # check %FEATURES to see if it's there, and return it if so + # throw XML::SAX::Exception::NotRecognized if it's not there + # throw XML::SAX::Exception::NotSupported if it's there but we + # don't support it + + my %features = $self->get_features(); + if (exists $features{$feat}) { + my %supported = map { $_ => 1 } $self->supported_features(); + if ($supported{$feat}) { + return $self->{__PACKAGE__ . "::Features"}{$feat}; + } + throw XML::SAX::Exception::NotSupported( + Message => "The feature '$feat' is not supported by " . ref($self), + Exception => undef, + ); + } + throw XML::SAX::Exception::NotRecognized( + Message => "The feature '$feat' is not recognized by " . ref($self), + Exception => undef, + ); +} +#-------------------------------------------------------------------# + +#-------------------------------------------------------------------# +# set_feature +#-------------------------------------------------------------------# +sub set_feature { + my $self = shift; + my $feat = shift; + my $value = shift; + # check %FEATURES to see if it's there, and set it if so + # throw XML::SAX::Exception::NotRecognized if it's not there + # throw XML::SAX::Exception::NotSupported if it's there but we + # don't support it + + my %features = $self->get_features(); + if (exists $features{$feat}) { + my %supported = map { $_ => 1 } $self->supported_features(); + if ($supported{$feat}) { + return $self->{__PACKAGE__ . "::Features"}{$feat} = $value; + } + throw XML::SAX::Exception::NotSupported( + Message => "The feature '$feat' is not supported by " . ref($self), + Exception => undef, + ); + } + throw XML::SAX::Exception::NotRecognized( + Message => "The feature '$feat' is not recognized by " . ref($self), + Exception => undef, + ); +} +#-------------------------------------------------------------------# + +#-------------------------------------------------------------------# +# get_handler and friends +#-------------------------------------------------------------------# +sub get_handler { + my $self = shift; + my $handler_type = shift; + $handler_type ||= 'Handler'; + return defined( $self->{$handler_type} ) ? $self->{$handler_type} : undef; +} + +sub get_document_handler { + my $self = shift; + return $self->get_handler('DocumentHandler', @_); +} + +sub get_content_handler { + my $self = shift; + return $self->get_handler('ContentHandler', @_); +} + +sub get_dtd_handler { + my $self = shift; + return $self->get_handler('DTDHandler', @_); +} + +sub get_lexical_handler { + my $self = shift; + return $self->get_handler('LexicalHandler', @_); +} + +sub get_decl_handler { + my $self = shift; + return $self->get_handler('DeclHandler', @_); +} + +sub get_error_handler { + my $self = shift; + return $self->get_handler('ErrorHandler', @_); +} + +sub get_entity_resolver { + my $self = shift; + return $self->get_handler('EntityResolver', @_); +} +#-------------------------------------------------------------------# + +#-------------------------------------------------------------------# +# set_handler and friends +#-------------------------------------------------------------------# +sub set_handler { + my $self = shift; + my ($new_handler, $handler_type) = reverse @_; + $handler_type ||= 'Handler'; + $self->{Methods} = {} if $self->{Methods}; + $self->{$handler_type} = $new_handler; + $self->{ParseOptions}->{$handler_type} = $new_handler; + return 1; +} + +sub set_document_handler { + my $self = shift; + return $self->set_handler('DocumentHandler', @_); +} + +sub set_content_handler { + my $self = shift; + return $self->set_handler('ContentHandler', @_); +} +sub set_dtd_handler { + my $self = shift; + return $self->set_handler('DTDHandler', @_); +} +sub set_lexical_handler { + my $self = shift; + return $self->set_handler('LexicalHandler', @_); +} +sub set_decl_handler { + my $self = shift; + return $self->set_handler('DeclHandler', @_); +} +sub set_error_handler { + my $self = shift; + return $self->set_handler('ErrorHandler', @_); +} +sub set_entity_resolver { + my $self = shift; + return $self->set_handler('EntityResolver', @_); +} + +#-------------------------------------------------------------------# + +#-------------------------------------------------------------------# +# supported_features +#-------------------------------------------------------------------# +sub supported_features { + my $self = shift; + # Only namespaces are required by all parsers + return ( + 'http://xml.org/sax/features/namespaces', + ); +} +#-------------------------------------------------------------------# + +sub no_op { + # this space intentionally blank +} + + +package XML::SAX::Base::NoHandler; + +# we need a fake handler that doesn't implement anything, this +# simplifies the code a lot (though given the recent changes, +# it may be better to do without) +sub new { + #warn "no handler called\n"; + return bless {}; +} + +1; + +__END__ + +=head1 NAME + +XML::SAX::Base - Base class SAX Drivers and Filters + +=head1 SYNOPSIS + + package MyFilter; + use XML::SAX::Base; + @ISA = ('XML::SAX::Base'); + +=head1 DESCRIPTION + +This module has a very simple task - to be a base class for PerlSAX +drivers and filters. It's default behaviour is to pass the input directly +to the output unchanged. It can be useful to use this module as a base class +so you don't have to, for example, implement the characters() callback. + +The main advantages that it provides are easy dispatching of events the right +way (ie it takes care for you of checking that the handler has implemented +that method, or has defined an AUTOLOAD), and the guarantee that filters +will pass along events that they aren't implementing to handlers downstream +that might nevertheless be interested in them. + +=head1 WRITING SAX DRIVERS AND FILTERS + +Writing SAX Filters is tremendously easy: all you need to do is +inherit from this module, and define the events you want to handle. A +more detailed explanation can be found at +http://www.xml.com/pub/a/2001/10/10/sax-filters.html. + +Writing Drivers is equally simple. The one thing you need to pay +attention to is B to call events yourself (this applies to Filters +as well). For instance: + + package MyFilter; + use base qw(XML::SAX::Base); + + sub start_element { + my $self = shift; + my $data = shift; + # do something + $self->{Handler}->start_element($data); # BAD + } + +The above example works well as precisely that: an example. But it has +several faults: 1) it doesn't test to see whether the handler defines +start_element. Perhaps it doesn't want to see that event, in which +case you shouldn't throw it (otherwise it'll die). 2) it doesn't check +ContentHandler and then Handler (ie it doesn't look to see that the +user hasn't requested events on a specific handler, and if not on the +default one), 3) if it did check all that, not only would the code be +cumbersome (see this module's source to get an idea) but it would also +probably have to check for a DocumentHandler (in case this were SAX1) +and for AUTOLOADs potentially defined in all these packages. As you can +tell, that would be fairly painful. Instead of going through that, +simply remember to use code similar to the following instead: + + package MyFilter; + use base qw(XML::SAX::Base); + + sub start_element { + my $self = shift; + my $data = shift; + # do something to filter + $self->SUPER::start_element($data); # GOOD (and easy) ! + } + +This way, once you've done your job you hand the ball back to +XML::SAX::Base and it takes care of all those problems for you! + +Note that the above example doesn't apply to filters only, drivers +will benefit from the exact same feature. + +=head1 METHODS + +A number of methods are defined within this class for the purpose of +inheritance. Some probably don't need to be overridden (eg parse_file) +but some clearly should be (eg parse). Options for these methods are +described in the PerlSAX2 specification available from +http://cvs.sourceforge.net/cgi-bin/viewcvs.cgi/~checkout~/perl-xml/libxml-perl/doc/sax-2.0.html?rev=HEAD&content-type=text/html. + +=over 4 + +=item * parse + +The parse method is the main entry point to parsing documents. Internally +the parse method will detect what type of "thing" you are parsing, and +call the appropriate method in your implementation class. Here is the +mapping table of what is in the Source options (see the Perl SAX 2.0 +specification for the meaning of these values): + + Source Contains parse() calls + =============== ============= + CharacterStream (*) _parse_characterstream($stream, $options) + ByteStream _parse_bytestream($stream, $options) + String _parse_string($string, $options) + SystemId _parse_systemid($string, $options) + +However note that these methods may not be sensible if your driver class +is not for parsing XML. An example might be a DBI driver that generates +XML/SAX from a database table. If that is the case, you likely want to +write your own parse() method. + +Also note that the Source may contain both a PublicId entry, and an +Encoding entry. To get at these, examine $options->{Source} as passed +to your method. + +(*) A CharacterStream is a filehandle that does not need any encoding +translation done on it. This is implemented as a regular filehandle +and only works under Perl 5.7.2 or higher using PerlIO. To get a single +character, or number of characters from it, use the perl core read() +function. To get a single byte from it (or number of bytes), you can +use sysread(). The encoding of the stream should be in the Encoding +entry for the Source. + +=item * parse_file, parse_uri, parse_string + +These are all convenience variations on parse(), and in fact simply +set up the options before calling it. You probably don't need to +override these. + +=item * get_options + +This is a convenience method to get options in SAX2 style, or more +generically either as hashes or as hashrefs (it returns a hashref). +You will probably want to use this method in your own implementations +of parse() and of new(). + +=item * get_feature, set_feature + +These simply get and set features, and throw the +appropriate exceptions defined in the specification if need be. + +If your subclass defines features not defined in this one, +then you should override these methods in such a way that they check for +your features first, and then call the base class's methods +for features not defined by your class. An example would be: + + sub get_feature { + my $self = shift; + my $feat = shift; + if (exists $MY_FEATURES{$feat}) { + # handle the feature in various ways + } + else { + return $self->SUPER::get_feature($feat); + } + } + +Currently this part is unimplemented. + + +=item * set_handler + +This method takes a handler type (Handler, ContentHandler, etc.) and a +handler object as arguments, and changes the current handler for that +handler type, while taking care of resetting the internal state that +needs to be reset. This allows one to change a handler during parse +without running into problems (changing it on the parser object +directly will most likely cause trouble). + +=item * set_document_handler, set_content_handler, set_dtd_handler, set_lexical_handler, set_decl_handler, set_error_handler, set_entity_resolver + +These are just simple wrappers around the former method, and take a +handler object as their argument. Internally they simply call +set_handler with the correct arguments. + +=item * get_handler + +The inverse of set_handler, this method takes a an optional string containing a handler type (DTDHandler, +ContentHandler, etc. 'Handler' is used if no type is passed). It returns a reference to the object that implements +that that class, or undef if that handler type is not set for the current driver/filter. + +=item * get_document_handler, get_content_handler, get_dtd_handler, get_lexical_handler, get_decl_handler, +get_error_handler, get_entity_resolver + +These are just simple wrappers around the get_handler() method, and take no arguments. Internally +they simply call get_handler with the correct handler type name. + +=back + +It would be rather useless to describe all the methods that this +module implements here. They are all the methods supported in SAX1 and +SAX2. In case your memory is a little short, here is a list. The +apparent duplicates are there so that both versions of SAX can be +supported. + +=over 4 + +=item * start_document + +=item * end_document + +=item * start_element + +=item * start_document + +=item * end_document + +=item * start_element + +=item * end_element + +=item * characters + +=item * processing_instruction + +=item * ignorable_whitespace + +=item * set_document_locator + +=item * start_prefix_mapping + +=item * end_prefix_mapping + +=item * skipped_entity + +=item * start_cdata + +=item * end_cdata + +=item * comment + +=item * entity_reference + +=item * notation_decl + +=item * unparsed_entity_decl + +=item * element_decl + +=item * attlist_decl + +=item * doctype_decl + +=item * xml_decl + +=item * entity_decl + +=item * attribute_decl + +=item * internal_entity_decl + +=item * external_entity_decl + +=item * resolve_entity + +=item * start_dtd + +=item * end_dtd + +=item * start_entity + +=item * end_entity + +=item * warning + +=item * error + +=item * fatal_error + +=back + +=head1 TODO + + - more tests + - conform to the "SAX Filters" and "Java and DOM compatibility" + sections of the SAX2 document. + +=head1 AUTHOR + +Kip Hampton (khampton@totalcinema.com) did most of the work, after porting +it from XML::Filter::Base. + +Robin Berjon (robin@knowscape.com) pitched in with patches to make it +usable as a base for drivers as well as filters, along with other patches. + +Matt Sergeant (matt@sergeant.org) wrote the original XML::Filter::Base, +and patched a few things here and there, and imported it into +the XML::SAX distribution. + +=head1 SEE ALSO + +L + +=cut + diff -r 266a7e9b9237 -r 6d3c3db11e72 uh_parser/XML/SAX/DocumentLocator.pm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/uh_parser/XML/SAX/DocumentLocator.pm Wed Mar 03 16:51:26 2010 +0000 @@ -0,0 +1,134 @@ +# $Id: DocumentLocator.pm,v 1.3 2005/10/14 20:31:20 matt Exp $ + +package XML::SAX::DocumentLocator; +use strict; + +sub new { + my $class = shift; + my %object; + tie %object, $class, @_; + + return bless \%object, $class; +} + +sub TIEHASH { + my $class = shift; + my ($pubmeth, $sysmeth, $linemeth, $colmeth, $encmeth, $xmlvmeth) = @_; + return bless { + pubmeth => $pubmeth, + sysmeth => $sysmeth, + linemeth => $linemeth, + colmeth => $colmeth, + encmeth => $encmeth, + xmlvmeth => $xmlvmeth, + }, $class; +} + +sub FETCH { + my ($self, $key) = @_; + my $method; + if ($key eq 'PublicId') { + $method = $self->{pubmeth}; + } + elsif ($key eq 'SystemId') { + $method = $self->{sysmeth}; + } + elsif ($key eq 'LineNumber') { + $method = $self->{linemeth}; + } + elsif ($key eq 'ColumnNumber') { + $method = $self->{colmeth}; + } + elsif ($key eq 'Encoding') { + $method = $self->{encmeth}; + } + elsif ($key eq 'XMLVersion') { + $method = $self->{xmlvmeth}; + } + if ($method) { + my $value = $method->($key); + return $value; + } + return undef; +} + +sub EXISTS { + my ($self, $key) = @_; + if ($key =~ /^(PublicId|SystemId|LineNumber|ColumnNumber|Encoding|XMLVersion)$/) { + return 1; + } + return 0; +} + +sub STORE { + my ($self, $key, $value) = @_; +} + +sub DELETE { + my ($self, $key) = @_; +} + +sub CLEAR { + my ($self) = @_; +} + +sub FIRSTKEY { + my ($self) = @_; + # assignment resets. + $self->{keys} = { + PublicId => 1, + SystemId => 1, + LineNumber => 1, + ColumnNumber => 1, + Encoding => 1, + XMLVersion => 1, + }; + return each %{$self->{keys}}; +} + +sub NEXTKEY { + my ($self, $lastkey) = @_; + return each %{$self->{keys}}; +} + +1; +__END__ + +=head1 NAME + +XML::SAX::DocumentLocator - Helper class for document locators + +=head1 SYNOPSIS + + my $locator = XML::SAX::DocumentLocator->new( + sub { $object->get_public_id }, + sub { $object->get_system_id }, + sub { $reader->current_line }, + sub { $reader->current_column }, + sub { $reader->get_encoding }, + sub { $reader->get_xml_version }, + ); + +=head1 DESCRIPTION + +This module gives you a tied hash reference that calls the +specified closures when asked for PublicId, SystemId, +LineNumber and ColumnNumber. + +It is useful for writing SAX Parsers so that you don't have +to constantly update the line numbers in a hash reference on +the object you pass to set_document_locator(). See the source +code for XML::SAX::PurePerl for a usage example. + +=head1 API + +There is only 1 method: C. Simply pass it a list of +closures that when called will return the PublicId, the +SystemId, the LineNumber, the ColumnNumber, the Encoding +and the XMLVersion respectively. + +The closures are passed a single parameter, the key being +requested. But you're free to ignore that. + +=cut + diff -r 266a7e9b9237 -r 6d3c3db11e72 uh_parser/XML/SAX/Exception.pm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/uh_parser/XML/SAX/Exception.pm Wed Mar 03 16:51:26 2010 +0000 @@ -0,0 +1,126 @@ +package XML::SAX::Exception; + +use strict; + +use overload '""' => "stringify", + 'fallback' => 1; + +use vars qw/$StackTrace $VERSION/; +$VERSION = '1.01'; +use Carp; + +$StackTrace = $ENV{XML_DEBUG} || 0; + +# Other exception classes: + +@XML::SAX::Exception::NotRecognized::ISA = ('XML::SAX::Exception'); +@XML::SAX::Exception::NotSupported::ISA = ('XML::SAX::Exception'); +@XML::SAX::Exception::Parse::ISA = ('XML::SAX::Exception'); + + +sub throw { + my $class = shift; + if (ref($class)) { + die $class; + } + die $class->new(@_); +} + +sub new { + my $class = shift; + my %opts = @_; + confess "Invalid options: " . join(', ', keys %opts) unless exists $opts{Message}; + + bless { ($StackTrace ? (StackTrace => stacktrace()) : ()), %opts }, + $class; +} + +sub stringify { + my $self = shift; + local $^W; + my $error; + if (exists $self->{LineNumber}) { + $error = $self->{Message} . " [Ln: " . $self->{LineNumber} . + ", Col: " . $self->{ColumnNumber} . "]"; + } + else { + $error = $self->{Message}; + } + if ($StackTrace) { + $error .= stackstring($self->{StackTrace}); + } + $error .= "\n"; + return $error; +} + +sub stacktrace { + my $i = 2; + my @fulltrace; + while (my @trace = caller($i++)) { + my %hash; + @hash{qw(Package Filename Line)} = @trace[0..2]; + push @fulltrace, \%hash; + } + return \@fulltrace; +} + +sub stackstring { + my $stacktrace = shift; + my $string = "\nFrom:\n"; + foreach my $current (@$stacktrace) { + $string .= $current->{Filename} . " Line: " . $current->{Line} . "\n"; + } + return $string; +} + +1; + +__END__ + +=head1 NAME + +XML::SAX::Exception - Exception classes for XML::SAX + +=head1 SYNOPSIS + + throw XML::SAX::Exception::NotSupported( + Message => "The foo feature is not supported", + ); + +=head1 DESCRIPTION + +This module is the base class for all SAX Exceptions, those defined in +the spec as well as those that one may create for one's own SAX errors. + +There are three subclasses included, corresponding to those of the SAX +spec: + + XML::SAX::Exception::NotSupported + XML::SAX::Exception::NotRecognized + XML::SAX::Exception::Parse + +Use them wherever you want, and as much as possible when you encounter +such errors. SAX is meant to use exceptions as much as possible to +flag problems. + +=head1 CREATING NEW EXCEPTION CLASSES + +All you need to do to create a new exception class is: + + @XML::SAX::Exception::MyException::ISA = ('XML::SAX::Exception') + +The given package doesn't need to exist, it'll behave correctly this +way. If your exception refines an existing exception class, then you +may also inherit from that instead of from the base class. + +=head1 THROWING EXCEPTIONS + +This is as simple as exemplified in the SYNOPSIS. In fact, there's +nothing more to know. All you have to do is: + + throw XML::SAX::Exception::MyException( Message => 'Something went wrong' ); + +and voila, you've thrown an exception which can be caught in an eval block. + +=cut + diff -r 266a7e9b9237 -r 6d3c3db11e72 uh_parser/XML/SAX/Intro.pod --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/uh_parser/XML/SAX/Intro.pod Wed Mar 03 16:51:26 2010 +0000 @@ -0,0 +1,407 @@ +=head1 NAME + +XML::SAX::Intro - An Introduction to SAX Parsing with Perl + +=head1 Introduction + +XML::SAX is a new way to work with XML Parsers in Perl. In this article +we'll discuss why you should be using SAX, why you should be using +XML::SAX, and we'll see some of the finer implementation details. The +text below assumes some familiarity with callback, or push based +parsing, but if you are unfamiliar with these techniques then a good +place to start is Kip Hampton's excellent series of articles on XML.com. + +=head1 Replacing XML::Parser + +The de-facto way of parsing XML under perl is to use Larry Wall and +Clark Cooper's XML::Parser. This module is a Perl and XS wrapper around +the expat XML parser library by James Clark. It has been a hugely +successful project, but suffers from a couple of rather major flaws. +Firstly it is a proprietary API, designed before the SAX API was +conceived, which means that it is not easily replaceable by other +streaming parsers. Secondly it's callbacks are subrefs. This doesn't +sound like much of an issue, but unfortunately leads to code like: + + sub handle_start { + my ($e, $el, %attrs) = @_; + if ($el eq 'foo') { + $e->{inside_foo}++; # BAD! $e is an XML::Parser::Expat object. + } + } + +As you can see, we're using the $e object to hold our state +information, which is a bad idea because we don't own that object - we +didn't create it. It's an internal object of XML::Parser, that happens +to be a hashref. We could all too easily overwrite XML::Parser internal +state variables by using this, or Clark could change it to an array ref +(not that he would, because it would break so much code, but he could). + +The only way currently with XML::Parser to safely maintain state is to +use a closure: + + my $state = MyState->new(); + $parser->setHandlers(Start => sub { handle_start($state, @_) }); + +This closure traps the $state variable, which now gets passed as the +first parameter to your callback. Unfortunately very few people use +this technique, as it is not documented in the XML::Parser POD files. + +Another reason you might not want to use XML::Parser is because you +need some feature that it doesn't provide (such as validation), or you +might need to use a library that doesn't use expat, due to it not being +installed on your system, or due to having a restrictive ISP. Using SAX +allows you to work around these restrictions. + +=head1 Introducing SAX + +SAX stands for the Simple API for XML. And simple it really is. +Constructing a SAX parser and passing events to handlers is done as +simply as: + + use XML::SAX; + use MySAXHandler; + + my $parser = XML::SAX::ParserFactory->parser( + Handler => MySAXHandler->new + ); + + $parser->parse_uri("foo.xml"); + +The important concept to grasp here is that SAX uses a factory class +called XML::SAX::ParserFactory to create a new parser instance. The +reason for this is so that you can support other underlying +parser implementations for different feature sets. This is one thing +that XML::Parser has always sorely lacked. + +In the code above we see the parse_uri method used, but we could +have equally well +called parse_file, parse_string, or parse(). Please see XML::SAX::Base +for what these methods take as parameters, but don't be fooled into +believing parse_file takes a filename. No, it takes a file handle, a +glob, or a subclass of IO::Handle. Beware. + +SAX works very similarly to XML::Parser's default callback method, +except it has one major difference: rather than setting individual +callbacks, you create a new class in which to recieve the callbacks. +Each callback is called as a method call on an instance of that handler +class. An example will best demonstrate this: + + package MySAXHandler; + use base qw(XML::SAX::Base); + + sub start_document { + my ($self, $doc) = @_; + # process document start event + } + + sub start_element { + my ($self, $el) = @_; + # process element start event + } + +Now, when we instantiate this as above, and parse some XML with this as +the handler, the methods start_document and start_element will be +called as method calls, so this would be the equivalent of directly +calling: + + $object->start_element($el); + +Notice how this is different to XML::Parser's calling style, which +calls: + + start_element($e, $name, %attribs); + +It's the difference between function calling and method calling which +allows you to subclass SAX handlers which contributes to SAX being a +powerful solution. + +As you can see, unlike XML::Parser, we have to define a new package in +which to do our processing (there are hacks you can do to make this +uneccessary, but I'll leave figuring those out to the experts). The +biggest benefit of this is that you maintain your own state variable +($self in the above example) thus freeing you of the concerns listed +above. It is also an improvement in maintainability - you can place the +code in a separate file if you wish to, and your callback methods are +always called the same thing, rather than having to choose a suitable +name for them as you had to with XML::Parser. This is an obvious win. + +SAX parsers are also very flexible in how you pass a handler to them. +You can use a constructor parameter as we saw above, or we can pass the +handler directly in the call to one of the parse methods: + + $parser->parse(Handler => $handler, + Source => { SystemId => "foo.xml" }); + # or... + $parser->parse_file($fh, Handler => $handler); + +This flexibility allows for one parser to be used in many different +scenarios throughout your script (though one shouldn't feel pressure to +use this method, as parser construction is generally not a time +consuming process). + +=head1 Callback Parameters + +The only other thing you need to know to understand basic SAX is the +structure of the parameters passed to each of the callbacks. In +XML::Parser, all parameters are passed as multiple options to the +callbacks, so for example the Start callback would be called as +my_start($e, $name, %attributes), and the PI callback would be called +as my_processing_instruction($e, $target, $data). In SAX, every +callback is passed a hash reference, containing entries that define our +"node". The key callbacks and the structures they receive are: + +=head2 start_element + +The start_element handler is called whenever a parser sees an opening +tag. It is passed an element structure consisting of: + +=over 4 + +=item LocalName + +The name of the element minus any namespace prefix it may +have come with in the document. + +=item NamespaceURI + +The URI of the namespace associated with this element, +or the empty string for none. + +=item Attributes + +A set of attributes as described below. + +=item Name + +The name of the element as it was seen in the document (i.e. +including any prefix associated with it) + +=item Prefix + +The prefix used to qualify this element's namespace, or the +empty string if none. + +=back + +The B are a hash reference, keyed by what we have called +"James Clark" notation. This means that the attribute name has been +expanded to include any associated namespace URI, and put together as +{ns}name, where "ns" is the expanded namespace URI of the attribute if +and only if the attribute had a prefix, and "name" is the LocalName of +the attribute. + +The value of each entry in the attributes hash is another hash +structure consisting of: + +=over 4 + +=item LocalName + +The name of the attribute minus any namespace prefix it may have +come with in the document. + +=item NamespaceURI + +The URI of the namespace associated with this attribute. If the +attribute had no prefix, then this consists of just the empty string. + +=item Name + +The attribute's name as it appeared in the document, including any +namespace prefix. + +=item Prefix + +The prefix used to qualify this attribute's namepace, or the +empty string if none. + +=item Value + +The value of the attribute. + +=back + +So a full example, as output by Data::Dumper might be: + + .... + +=head2 end_element + +The end_element handler is called either when a parser sees a closing +tag, or after start_element has been called for an empty element (do +note however that a parser may if it is so inclined call characters +with an empty string when it sees an empty element. There is no simple +way in SAX to determine if the parser in fact saw an empty element, a +start and end element with no content.. + +The end_element handler receives exactly the same structure as +start_element, minus the Attributes entry. One must note though that it +should not be a reference to the same data as start_element receives, +so you may change the values in start_element but this will not affect +the values later seen by end_element. + +=head2 characters + +The characters callback may be called in serveral circumstances. The +most obvious one is when seeing ordinary character data in the markup. +But it is also called for text in a CDATA section, and is also called +in other situations. A SAX parser has to make no guarantees whatsoever +about how many times it may call characters for a stretch of text in an +XML document - it may call once, or it may call once for every +character in the text. In order to work around this it is often +important for the SAX developer to use a bundling technique, where text +is gathered up and processed in one of the other callbacks. This is not +always necessary, but it is a worthwhile technique to learn, which we +will cover in XML::SAX::Advanced (when I get around to writing it). + +The characters handler is called with a very simple structure - a hash +reference consisting of just one entry: + +=over 4 + +=item Data + +The text data that was received. + +=back + +=head2 comment + +The comment callback is called for comment text. Unlike with +C, the comment callback *must* be invoked just once for an +entire comment string. It receives a single simple structure - a hash +reference containing just one entry: + +=over 4 + +=item Data + +The text of the comment. + +=back + +=head2 processing_instruction + +The processing instruction handler is called for all processing +instructions in the document. Note that these processing instructions +may appear before the document root element, or after it, or anywhere +where text and elements would normally appear within the document, +according to the XML specification. + +The handler is passed a structure containing just two entries: + +=over 4 + +=item Target + +The target of the processing instrcution + +=item Data + +The text data in the processing instruction. Can be an empty +string for a processing instruction that has no data element. +For example E?wiggle?E is a perfectly valid processing instruction. + +=back + +=head1 Tip of the iceberg + +What we have discussed above is really the tip of the SAX iceberg. And +so far it looks like there's not much of interest to SAX beyond what we +have seen with XML::Parser. But it does go much further than that, I +promise. + +People who hate Object Oriented code for the sake of it may be thinking +here that creating a new package just to parse something is a waste +when they've been parsing things just fine up to now using procedural +code. But there's reason to all this madness. And that reason is SAX +Filters. + +As you saw right at the very start, to let the parser know about our +class, we pass it an instance of our class as the Handler to the +parser. But now imagine what would happen if our class could also take +a Handler option, and simply do some processing and pass on our data +further down the line? That in a nutshell is how SAX filters work. It's +Unix pipes for the 21st century! + +There are two downsides to this. Number 1 - writing SAX filters can be +tricky. If you look into the future and read the advanced tutorial I'm +writing, you'll see that Handler can come in several shapes and sizes. +So making sure your filter does the right thing can be tricky. +Secondly, constructing complex filter chains can be difficult, and +simple thinking tells us that we only get one pass at our document, +when often we'll need more than that. + +Luckily though, those downsides have been fixed by the release of two +very cool modules. What's even better is that I didn't write either of +them! + +The first module is XML::SAX::Base. This is a VITAL SAX module that +acts as a base class for all SAX parsers and filters. It provides an +abstraction away from calling the handler methods, that makes sure your +filter or parser does the right thing, and it does it FAST. So, if you +ever need to write a SAX filter, which if you're processing XML -> XML, +or XML -> HTML, then you probably do, then you need to be writing it as +a subclass of XML::SAX::Base. Really - this is advice not to ignore +lightly. I will not go into the details of writing a SAX filter here. +Kip Hampton, the author of XML::SAX::Base has covered this nicely in +his article on XML.com here . + +To construct SAX pipelines, Barrie Slaymaker, a long time Perl hacker +who's modules you will probably have heard of or used, wrote a very +clever module called XML::SAX::Machines. This combines some really +clever SAX filter-type modules, with a construction toolkit for filters +that makes building pipelines easy. But before we see how it makes +things easy, first lets see how tricky it looks to build complex SAX +filter pipelines. + + use XML::SAX::ParserFactory; + use XML::Filter::Filter1; + use XML::Filter::Filter2; + use XML::SAX::Writer; + + my $output_string; + my $writer = XML::SAX::Writer->new(Output => \$output_string); + my $filter2 = XML::SAX::Filter2->new(Handler => $writer); + my $filter1 = XML::SAX::Filter1->new(Handler => $filter2); + my $parser = XML::SAX::ParserFactory->parser(Handler => $filter1); + + $parser->parse_uri("foo.xml"); + +This is a lot easier with XML::SAX::Machines: + + use XML::SAX::Machines qw(Pipeline); + + my $output_string; + my $parser = Pipeline( + XML::SAX::Filter1 => XML::SAX::Filter2 => \$output_string + ); + + $parser->parse_uri("foo.xml"); + +One of the main benefits of XML::SAX::Machines is that the pipelines +are constructed in natural order, rather than the reverse order we saw +with manual pipeline construction. XML::SAX::Machines takes care of all +the internals of pipe construction, providing you at the end with just +a parser you can use (and you can re-use the same parser as many times +as you need to). + +Just a final tip. If you ever get stuck and are confused about what is +being passed from one SAX filter or parser to the next, then +Devel::TraceSAX will come to your rescue. This perl debugger plugin +will allow you to dump the SAX stream of events as it goes by. Usage is +really very simple just call your perl script that uses SAX as follows: + + $ perl -d:TraceSAX + +And preferably pipe the output to a pager of some sort, such as more or +less. The output is extremely verbose, but should help clear some +issues up. + +=head1 AUTHOR + +Matt Sergeant, matt@sergeant.org + +$Id: Intro.pod,v 1.3 2002/04/30 07:16:00 matt Exp $ + +=cut diff -r 266a7e9b9237 -r 6d3c3db11e72 uh_parser/XML/SAX/ParserDetails.ini --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/uh_parser/XML/SAX/ParserDetails.ini Wed Mar 03 16:51:26 2010 +0000 @@ -0,0 +1,4 @@ +[XML::SAX::PurePerl] +http://xml.org/sax/features/namespaces = 1 + + diff -r 266a7e9b9237 -r 6d3c3db11e72 uh_parser/XML/SAX/ParserFactory.pm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/uh_parser/XML/SAX/ParserFactory.pm Wed Mar 03 16:51:26 2010 +0000 @@ -0,0 +1,232 @@ +# $Id: ParserFactory.pm,v 1.13 2002/11/19 18:25:47 matt Exp $ + +package XML::SAX::ParserFactory; + +use strict; +use vars qw($VERSION); + +$VERSION = '1.01'; + +use Symbol qw(gensym); +use XML::SAX; +use XML::SAX::Exception; + +sub new { + my $class = shift; + my %params = @_; # TODO : Fix this in spec. + my $self = bless \%params, $class; + $self->{KnownParsers} = XML::SAX->parsers(); + return $self; +} + +sub parser { + my $self = shift; + my @parser_params = @_; + if (!ref($self)) { + $self = $self->new(); + } + + my $parser_class = $self->_parser_class(); + + my $version = ''; + if ($parser_class =~ s/\s*\(([\d\.]+)\)\s*$//) { + $version = " $1"; + } + + { + no strict 'refs'; + if (!keys %{"${parser_class}::"}) { + eval "use $parser_class $version;"; + } + } + + return $parser_class->new(@parser_params); +} + +sub require_feature { + my $self = shift; + my ($feature) = @_; + $self->{RequiredFeatures}{$feature}++; + return $self; +} + +sub _parser_class { + my $self = shift; + + # First try ParserPackage + if ($XML::SAX::ParserPackage) { + return $XML::SAX::ParserPackage; + } + + # Now check if required/preferred is there + if ($self->{RequiredFeatures}) { + my %required = %{$self->{RequiredFeatures}}; + # note - we never go onto the next try (ParserDetails.ini), + # because if we can't provide the requested feature + # we need to throw an exception. + PARSER: + foreach my $parser (reverse @{$self->{KnownParsers}}) { + foreach my $feature (keys %required) { + if (!exists $parser->{Features}{$feature}) { + next PARSER; + } + } + # got here - all features must exist! + return $parser->{Name}; + } + # TODO : should this be NotSupported() ? + throw XML::SAX::Exception ( + Message => "Unable to provide required features", + ); + } + + # Next try SAX.ini + for my $dir (@INC) { + my $fh = gensym(); + if (open($fh, "$dir/SAX.ini")) { + my $param_list = XML::SAX->_parse_ini_file($fh); + my $params = $param_list->[0]->{Features}; + if ($params->{ParserPackage}) { + return $params->{ParserPackage}; + } + else { + # we have required features (or nothing?) + PARSER: + foreach my $parser (reverse @{$self->{KnownParsers}}) { + foreach my $feature (keys %$params) { + if (!exists $parser->{Features}{$feature}) { + next PARSER; + } + } + return $parser->{Name}; + } + XML::SAX->do_warn("Unable to provide SAX.ini required features. Using fallback\n"); + } + last; # stop after first INI found + } + } + + if (@{$self->{KnownParsers}}) { + return $self->{KnownParsers}[-1]{Name}; + } + else { + return "XML::SAX::PurePerl"; # backup plan! + } +} + +1; +__END__ + +=head1 NAME + +XML::SAX::ParserFactory - Obtain a SAX parser + +=head1 SYNOPSIS + + use XML::SAX::ParserFactory; + use XML::SAX::XYZHandler; + my $handler = XML::SAX::XYZHandler->new(); + my $p = XML::SAX::ParserFactory->parser(Handler => $handler); + $p->parse_uri("foo.xml"); + # or $p->parse_string("") or $p->parse_file($fh); + +=head1 DESCRIPTION + +XML::SAX::ParserFactory is a factory class for providing an application +with a Perl SAX2 XML parser. It is akin to DBI - a front end for other +parser classes. Each new SAX2 parser installed will register itself +with XML::SAX, and then it will become available to all applications +that use XML::SAX::ParserFactory to obtain a SAX parser. + +Unlike DBI however, XML/SAX parsers almost all work alike (especially +if they subclass XML::SAX::Base, as they should), so rather than +specifying the parser you want in the call to C, XML::SAX +has several ways to automatically choose which parser to use: + +=over 4 + +=item * $XML::SAX::ParserPackage + +If this package variable is set, then this package is Cd +and an instance of this package is returned by calling the C +class method in that package. If it cannot be loaded or there is +an error, an exception will be thrown. The variable can also contain +a version number: + + $XML::SAX::ParserPackage = "XML::SAX::Expat (0.72)"; + +And the number will be treated as a minimum version number. + +=item * Required features + +It is possible to require features from the parsers. For example, you +may wish for a parser that supports validation via a DTD. To do that, +use the following code: + + use XML::SAX::ParserFactory; + my $factory = XML::SAX::ParserFactory->new(); + $factory->require_feature('http://xml.org/sax/features/validation'); + my $parser = $factory->parser(...); + +Alternatively, specify the required features in the call to the +ParserFactory constructor: + + my $factory = XML::SAX::ParserFactory->new( + RequiredFeatures => { + 'http://xml.org/sax/features/validation' => 1, + } + ); + +If the features you have asked for are unavailable (for example the +user might not have a validating parser installed), then an +exception will be thrown. + +The list of known parsers is searched in reverse order, so it will +always return the last installed parser that supports all of your +requested features (Note: this is subject to change if someone +comes up with a better way of making this work). + +=item * SAX.ini + +ParserFactory will search @INC for a file called SAX.ini, which +is in a simple format: + + # a comment looks like this, + ; or like this, and are stripped anywhere in the file + key = value # SAX.in contains key/value pairs. + +All whitespace is non-significant. + +This file can contain either a line: + + ParserPackage = MyParserModule (1.02) + +Where MyParserModule is the module to load and use for the parser, +and the number in brackets is a minimum version to load. + +Or you can list required features: + + http://xml.org/sax/features/validation = 1 + +And each feature with a true value will be required. + +=item * Fallback + +If none of the above works, the last parser installed on the user's +system will be used. The XML::SAX package ships with a pure perl +XML parser, XML::SAX::PurePerl, so that there will always be a +fallback parser. + +=back + +=head1 AUTHOR + +Matt Sergeant, matt@sergeant.org + +=head1 LICENSE + +This is free software, you may use it and distribute it under the same +terms as Perl itself. + +=cut + diff -r 266a7e9b9237 -r 6d3c3db11e72 uh_parser/XML/SAX/PurePerl.pm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/uh_parser/XML/SAX/PurePerl.pm Wed Mar 03 16:51:26 2010 +0000 @@ -0,0 +1,750 @@ +# $Id: PurePerl.pm,v 1.21 2007/02/07 09:33:50 grant Exp $ + +package XML::SAX::PurePerl; + +use strict; +use vars qw/$VERSION/; + +$VERSION = '0.91'; + +use XML::SAX::PurePerl::Productions qw($Any $CharMinusDash $SingleChar); +use XML::SAX::PurePerl::Reader; +use XML::SAX::PurePerl::EncodingDetect (); +use XML::SAX::Exception; +use XML::SAX::PurePerl::DocType (); +use XML::SAX::PurePerl::DTDDecls (); +use XML::SAX::PurePerl::XMLDecl (); +use XML::SAX::DocumentLocator (); +use XML::SAX::Base (); +use XML::SAX qw(Namespaces); +use XML::NamespaceSupport (); +use IO::File; + +if ($] < 5.006) { + require XML::SAX::PurePerl::NoUnicodeExt; +} +else { + require XML::SAX::PurePerl::UnicodeExt; +} + +use vars qw(@ISA); +@ISA = ('XML::SAX::Base'); + +my %int_ents = ( + amp => '&', + lt => '<', + gt => '>', + quot => '"', + apos => "'", + ); + +my $xmlns_ns = "http://www.w3.org/2000/xmlns/"; +my $xml_ns = "http://www.w3.org/XML/1998/namespace"; + +use Carp; +sub _parse_characterstream { + my $self = shift; + my ($fh) = @_; + confess("CharacterStream is not yet correctly implemented"); + my $reader = XML::SAX::PurePerl::Reader::Stream->new($fh); + return $self->_parse($reader); +} + +sub _parse_bytestream { + my $self = shift; + my ($fh) = @_; + my $reader = XML::SAX::PurePerl::Reader::Stream->new($fh); + return $self->_parse($reader); +} + +sub _parse_string { + my $self = shift; + my ($str) = @_; + my $reader = XML::SAX::PurePerl::Reader::String->new($str); + return $self->_parse($reader); +} + +sub _parse_systemid { + my $self = shift; + my ($uri) = @_; + my $reader = XML::SAX::PurePerl::Reader::URI->new($uri); + return $self->_parse($reader); +} + +sub _parse { + my ($self, $reader) = @_; + + $reader->public_id($self->{ParseOptions}{Source}{PublicId}); + $reader->system_id($self->{ParseOptions}{Source}{SystemId}); + + $self->{NSHelper} = XML::NamespaceSupport->new({xmlns => 1}); + + $self->set_document_locator( + XML::SAX::DocumentLocator->new( + sub { $reader->public_id }, + sub { $reader->system_id }, + sub { $reader->line }, + sub { $reader->column }, + sub { $reader->get_encoding }, + sub { $reader->get_xml_version }, + ), + ); + + $self->start_document({}); + + if (defined $self->{ParseOptions}{Source}{Encoding}) { + $reader->set_encoding($self->{ParseOptions}{Source}{Encoding}); + } + else { + $self->encoding_detect($reader); + } + + # parse a document + $self->document($reader); + + return $self->end_document({}); +} + +sub parser_error { + my $self = shift; + my ($error, $reader) = @_; + +# warn("parser error: $error from ", $reader->line, " : ", $reader->column, "\n"); + my $exception = XML::SAX::Exception::Parse->new( + Message => $error, + ColumnNumber => $reader->column, + LineNumber => $reader->line, + PublicId => $reader->public_id, + SystemId => $reader->system_id, + ); + + $self->fatal_error($exception); + $exception->throw; +} + +sub document { + my ($self, $reader) = @_; + + # document ::= prolog element Misc* + + $self->prolog($reader); + $self->element($reader) || + $self->parser_error("Document requires an element", $reader); + + while(length($reader->data)) { + $self->Misc($reader) || + $self->parser_error("Only Comments, PIs and whitespace allowed at end of document", $reader); + } +} + +sub prolog { + my ($self, $reader) = @_; + + $self->XMLDecl($reader); + + # consume all misc bits + 1 while($self->Misc($reader)); + + if ($self->doctypedecl($reader)) { + while (length($reader->data)) { + $self->Misc($reader) || last; + } + } +} + +sub element { + my ($self, $reader) = @_; + + return 0 unless $reader->match('<'); + + my $name = $self->Name($reader) || $self->parser_error("Invalid element name", $reader); + + my %attribs; + + while( my ($k, $v) = $self->Attribute($reader) ) { + $attribs{$k} = $v; + } + + my $have_namespaces = $self->get_feature(Namespaces); + + # Namespace processing + $self->{NSHelper}->push_context; + my @new_ns; +# my %attrs = @attribs; +# while (my ($k,$v) = each %attrs) { + if ($have_namespaces) { + while ( my ($k, $v) = each %attribs ) { + if ($k =~ m/^xmlns(:(.*))?$/) { + my $prefix = $2 || ''; + $self->{NSHelper}->declare_prefix($prefix, $v); + my $ns = + { + Prefix => $prefix, + NamespaceURI => $v, + }; + push @new_ns, $ns; + $self->SUPER::start_prefix_mapping($ns); + } + } + } + + # Create element object and fire event + my %attrib_hash; + while (my ($name, $value) = each %attribs ) { + # TODO normalise value here + my ($ns, $prefix, $lname); + if ($have_namespaces) { + ($ns, $prefix, $lname) = $self->{NSHelper}->process_attribute_name($name); + } + $ns ||= ''; $prefix ||= ''; $lname ||= ''; + $attrib_hash{"{$ns}$lname"} = { + Name => $name, + LocalName => $lname, + Prefix => $prefix, + NamespaceURI => $ns, + Value => $value, + }; + } + + %attribs = (); # lose the memory since we recurse deep + + my ($ns, $prefix, $lname); + if ($self->get_feature(Namespaces)) { + ($ns, $prefix, $lname) = $self->{NSHelper}->process_element_name($name); + } + else { + $lname = $name; + } + $ns ||= ''; $prefix ||= ''; $lname ||= ''; + + # Process remainder of start_element + $self->skip_whitespace($reader); + my $have_content; + my $data = $reader->data(2); + if ($data =~ /^\/>/) { + $reader->move_along(2); + } + else { + $data =~ /^>/ or $self->parser_error("No close element tag", $reader); + $reader->move_along(1); + $have_content++; + } + + my $el = + { + Name => $name, + LocalName => $lname, + Prefix => $prefix, + NamespaceURI => $ns, + Attributes => \%attrib_hash, + }; + $self->start_element($el); + + # warn("($name\n"); + + if ($have_content) { + $self->content($reader); + + my $data = $reader->data(2); + $data =~ /^<\// or $self->parser_error("No close tag marker", $reader); + $reader->move_along(2); + my $end_name = $self->Name($reader); + $end_name eq $name || $self->parser_error("End tag mismatch ($end_name != $name)", $reader); + $self->skip_whitespace($reader); + $reader->match('>') or $self->parser_error("No close '>' on end tag", $reader); + } + + my %end_el = %$el; + delete $end_el{Attributes}; + $self->end_element(\%end_el); + + for my $ns (@new_ns) { + $self->end_prefix_mapping($ns); + } + $self->{NSHelper}->pop_context; + + return 1; +} + +sub content { + my ($self, $reader) = @_; + + while (1) { + $self->CharData($reader); + + my $data = $reader->data(2); + + if ($data =~ /^<\//) { + return 1; + } + elsif ($data =~ /^&/) { + $self->Reference($reader) or $self->parser_error("bare & not allowed in content", $reader); + next; + } + elsif ($data =~ /^CDSect($reader) + or + $self->Comment($reader)) + and next; + } + elsif ($data =~ /^<\?/) { + $self->PI($reader) and next; + } + elsif ($data =~ /^element($reader) and next; + } + last; + } + + return 1; +} + +sub CDSect { + my ($self, $reader) = @_; + + my $data = $reader->data(9); + return 0 unless $data =~ /^move_along(9); + + $self->start_cdata({}); + + $data = $reader->data; + while (1) { + $self->parser_error("EOF looking for CDATA section end", $reader) + unless length($data); + + if ($data =~ /^(.*?)\]\]>/s) { + my $chars = $1; + $reader->move_along(length($chars) + 3); + $self->characters({Data => $chars}); + last; + } + elsif ($data =~ /(.*?)\]+$/s) { + my $chars = $1; + $reader->move_along(length($chars)); + $self->characters({Data => $chars}); + $data = $reader->data(3); + } + else { + $self->characters({Data => $data}); + $reader->move_along(length($data)); + $data = $reader->data; + } + } + $self->end_cdata({}); + return 1; +} + +sub CharData { + my ($self, $reader) = @_; + + my $data = $reader->data; + + while (1) { + return unless length($data); + + if ($data =~ /^([^<&]*)[<&]/s) { + my $chars = $1; + $self->parser_error("String ']]>' not allowed in character data", $reader) + if $chars =~ /\]\]>/; + $reader->move_along(length($chars)); + $self->characters({Data => $chars}) if length($chars); + last; + } + else { + $self->characters({Data => $data}); + $reader->move_along(length($data)); + $data = $reader->data; + } + } +} + +sub Misc { + my ($self, $reader) = @_; + if ($self->Comment($reader)) { + return 1; + } + elsif ($self->PI($reader)) { + return 1; + } + elsif ($self->skip_whitespace($reader)) { + return 1; + } + + return 0; +} + +sub Reference { + my ($self, $reader) = @_; + + return 0 unless $reader->match('&'); + + my $data = $reader->data; + + if ($data =~ /^#x([0-9a-fA-F]+);/) { + my $ref = $1; + $reader->move_along(length($ref) + 3); + my $char = chr_ref(hex($ref)); + $self->parser_error("Character reference &#$ref; refers to an illegal XML character ($char)", $reader) + unless $char =~ /$SingleChar/o; + $self->characters({ Data => $char }); + return 1; + } + elsif ($data =~ /^#([0-9]+);/) { + my $ref = $1; + $reader->move_along(length($ref) + 2); + my $char = chr_ref($ref); + $self->parser_error("Character reference &#$ref; refers to an illegal XML character ($char)", $reader) + unless $char =~ /$SingleChar/o; + $self->characters({ Data => $char }); + return 1; + } + else { + # EntityRef + my $name = $self->Name($reader) + || $self->parser_error("Invalid name in entity", $reader); + $reader->match(';') or $self->parser_error("No semi-colon found after entity name", $reader); + + # warn("got entity: \&$name;\n"); + + # expand it + if ($self->_is_entity($name)) { + + if ($self->_is_external($name)) { + my $value = $self->_get_entity($name); + my $ent_reader = XML::SAX::PurePerl::Reader::URI->new($value); + $self->encoding_detect($ent_reader); + $self->extParsedEnt($ent_reader); + } + else { + my $value = $self->_stringify_entity($name); + my $ent_reader = XML::SAX::PurePerl::Reader::String->new($value); + $self->content($ent_reader); + } + return 1; + } + elsif ($name =~ /^(?:amp|gt|lt|quot|apos)$/) { + $self->characters({ Data => $int_ents{$name} }); + return 1; + } + else { + $self->parser_error("Undeclared entity", $reader); + } + } +} + +sub AttReference { + my ($self, $name, $reader) = @_; + if ($name =~ /^#x([0-9a-fA-F]+)$/) { + my $chr = chr_ref(hex($1)); + $chr =~ /$SingleChar/o or $self->parser_error("Character reference '&$name;' refers to an illegal XML character", $reader); + return $chr; + } + elsif ($name =~ /^#([0-9]+)$/) { + my $chr = chr_ref($1); + $chr =~ /$SingleChar/o or $self->parser_error("Character reference '&$name;' refers to an illegal XML character", $reader); + return $chr; + } + else { + if ($self->_is_entity($name)) { + if ($self->_is_external($name)) { + $self->parser_error("No external entity references allowed in attribute values", $reader); + } + else { + my $value = $self->_stringify_entity($name); + return $value; + } + } + elsif ($name =~ /^(?:amp|lt|gt|quot|apos)$/) { + return $int_ents{$name}; + } + else { + $self->parser_error("Undeclared entity '$name'", $reader); + } + } +} + +sub extParsedEnt { + my ($self, $reader) = @_; + + $self->TextDecl($reader); + $self->content($reader); +} + +sub _is_external { + my ($self, $name) = @_; +# TODO: Fix this to use $reader to store the entities perhaps. + if ($self->{ParseOptions}{external_entities}{$name}) { + return 1; + } + return ; +} + +sub _is_entity { + my ($self, $name) = @_; +# TODO: ditto above + if (exists $self->{ParseOptions}{entities}{$name}) { + return 1; + } + return 0; +} + +sub _stringify_entity { + my ($self, $name) = @_; +# TODO: ditto above + if (exists $self->{ParseOptions}{expanded_entity}{$name}) { + return $self->{ParseOptions}{expanded_entity}{$name}; + } + # expand + my $reader = XML::SAX::PurePerl::Reader::URI->new($self->{ParseOptions}{entities}{$name}); + my $ent = ''; + while(1) { + my $data = $reader->data; + $ent .= $data; + $reader->move_along(length($data)) or last; + } + return $self->{ParseOptions}{expanded_entity}{$name} = $ent; +} + +sub _get_entity { + my ($self, $name) = @_; +# TODO: ditto above + return $self->{ParseOptions}{entities}{$name}; +} + +sub skip_whitespace { + my ($self, $reader) = @_; + + my $data = $reader->data; + + my $found = 0; + while ($data =~ s/^([\x20\x0A\x0D\x09]*)//) { + last unless length($1); + $found++; + $reader->move_along(length($1)); + $data = $reader->data; + } + + return $found; +} + +sub Attribute { + my ($self, $reader) = @_; + + $self->skip_whitespace($reader) || return; + + my $data = $reader->data(2); + return if $data =~ /^\/?>/; + + if (my $name = $self->Name($reader)) { + $self->skip_whitespace($reader); + $reader->match('=') or $self->parser_error("No '=' in Attribute", $reader); + $self->skip_whitespace($reader); + my $value = $self->AttValue($reader); + + if (!$self->cdata_attrib($name)) { + $value =~ s/^\x20*//; # discard leading spaces + $value =~ s/\x20*$//; # discard trailing spaces + $value =~ s/ {1,}/ /g; # all >1 space to single space + } + + return $name, $value; + } + + return; +} + +sub cdata_attrib { + # TODO implement this! + return 1; +} + +sub AttValue { + my ($self, $reader) = @_; + + my $quote = $self->quote($reader); + + my $value = ''; + + while (1) { + my $data = $reader->data; + $self->parser_error("EOF found while looking for the end of attribute value", $reader) + unless length($data); + if ($data =~ /^([^$quote]*)$quote/) { + $reader->move_along(length($1) + 1); + $value .= $1; + last; + } + else { + $value .= $data; + $reader->move_along(length($data)); + } + } + + if ($value =~ /parser_error("< character not allowed in attribute values", $reader); + } + + $value =~ s/[\x09\x0A\x0D]/\x20/g; + $value =~ s/&(#(x[0-9a-fA-F]+)|([0-9]+)|\w+);/$self->AttReference($1, $reader)/geo; + + return $value; +} + +sub Comment { + my ($self, $reader) = @_; + + my $data = $reader->data(4); + if ($data =~ /^/s) { + $comment_str .= $1; + $self->parser_error("Invalid comment (dash)", $reader) if $comment_str =~ /-$/; + $reader->move_along(length($1) + 3); + last; + } + else { + $comment_str .= $data; + $reader->move_along(length($data)); + } + } + + $self->comment({ Data => $comment_str }); + + return 1; + } + return 0; +} + +sub PI { + my ($self, $reader) = @_; + + my $data = $reader->data(2); + + if ($data =~ /^<\?/) { + $reader->move_along(2); + my ($target, $data); + $target = $self->Name($reader) || + $self->parser_error("PI has no target", $reader); + if ($self->skip_whitespace($reader)) { + $target = ''; + while (1) { + my $data = $reader->data; + $self->parser_error("End of data seen while looking for close PI marker", $reader) + unless length($data); + if ($data =~ /^(.*?)\?>/s) { + $target .= $1; + $reader->move_along(length($1) + 2); + last; + } + else { + $target .= $data; + $reader->move_along(length($data)); + } + } + } + else { + my $data = $reader->data(2); + $data =~ /^\?>/ or $self->parser_error("PI closing sequence not found", $reader); + $reader->move_along(2); + } + $self->processing_instruction({ Target => $target, Data => $data }); + + return 1; + } + return 0; +} + +sub Name { + my ($self, $reader) = @_; + + my $name = ''; + while(1) { + my $data = $reader->data; + return unless length($data); + $data =~ /^([^\s>\/&\?;=<\)\(\[\],\%\#\!\*]*)/ or return; + $name .= $1; + my $len = length($1); + $reader->move_along($len); + last if ($len != length($data)); + } + + return unless length($name); + + $name =~ /$NameChar/o or $self->parser_error("Name <$name> does not match NameChar production", $reader); + + return $name; +} + +sub quote { + my ($self, $reader) = @_; + + my $data = $reader->data; + + $data =~ /^(['"])/ or $self->parser_error("Invalid quote token", $reader); + $reader->move_along(1); + return $1; +} + +1; +__END__ + +=head1 NAME + +XML::SAX::PurePerl - Pure Perl XML Parser with SAX2 interface + +=head1 SYNOPSIS + + use XML::Handler::Foo; + use XML::SAX::PurePerl; + my $handler = XML::Handler::Foo->new(); + my $parser = XML::SAX::PurePerl->new(Handler => $handler); + $parser->parse_uri("myfile.xml"); + +=head1 DESCRIPTION + +This module implements an XML parser in pure perl. It is written around the +upcoming perl 5.8's unicode support and support for multiple document +encodings (using the PerlIO layer), however it has been ported to work with +ASCII/UTF8 documents under lower perl versions. + +The SAX2 API is described in detail at http://sourceforge.net/projects/perl-xml/, in +the CVS archive, under libxml-perl/docs. Hopefully those documents will be in a +better location soon. + +Please refer to the SAX2 documentation for how to use this module - it is merely a +front end to SAX2, and implements nothing that is not in that spec (or at least tries +not to - please email me if you find errors in this implementation). + +=head1 BUGS + +XML::SAX::PurePerl is B. Very slow. I suggest you use something else +in fact. However it is great as a fallback parser for XML::SAX, where the +user might not be able to install an XS based parser or C library. + +Currently lots, probably. At the moment the weakest area is parsing DOCTYPE declarations, +though the code is in place to start doing this. Also parsing parameter entity +references is causing me much confusion, since it's not exactly what I would call +trivial, or well documented in the XML grammar. XML documents with internal subsets +are likely to fail. + +I am however trying to work towards full conformance using the Oasis test suite. + +=head1 AUTHOR + +Matt Sergeant, matt@sergeant.org. Copyright 2001. + +Please report all bugs to the Perl-XML mailing list at perl-xml@listserv.activestate.com. + +=head1 LICENSE + +This is free software. You may use it or redistribute it under the same terms as +Perl 5.7.2 itself. + +=cut + diff -r 266a7e9b9237 -r 6d3c3db11e72 uh_parser/XML/SAX/PurePerl/DTDDecls.pm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/uh_parser/XML/SAX/PurePerl/DTDDecls.pm Wed Mar 03 16:51:26 2010 +0000 @@ -0,0 +1,603 @@ +# $Id: DTDDecls.pm,v 1.7 2005/10/14 20:31:20 matt Exp $ + +package XML::SAX::PurePerl; + +use strict; +use XML::SAX::PurePerl::Productions qw($NameChar $SingleChar); + +sub elementdecl { + my ($self, $reader) = @_; + + my $data = $reader->data(9); + return 0 unless $data =~ /^move_along(9); + + $self->skip_whitespace($reader) || + $self->parser_error("No whitespace after ELEMENT declaration", $reader); + + my $name = $self->Name($reader); + + $self->skip_whitespace($reader) || + $self->parser_error("No whitespace after ELEMENT's name", $reader); + + $self->contentspec($reader, $name); + + $self->skip_whitespace($reader); + + $reader->match('>') or $self->parser_error("Closing angle bracket not found on ELEMENT declaration", $reader); + + return 1; +} + +sub contentspec { + my ($self, $reader, $name) = @_; + + my $data = $reader->data(5); + + my $model; + if ($data =~ /^EMPTY/) { + $reader->move_along(5); + $model = 'EMPTY'; + } + elsif ($data =~ /^ANY/) { + $reader->move_along(3); + $model = 'ANY'; + } + else { + $model = $self->Mixed_or_children($reader); + } + + if ($model) { + # call SAX callback now. + $self->element_decl({Name => $name, Model => $model}); + return 1; + } + + $self->parser_error("contentspec not found in ELEMENT declaration", $reader); +} + +sub Mixed_or_children { + my ($self, $reader) = @_; + + my $data = $reader->data(8); + $data =~ /^\(/ or return; # $self->parser_error("No opening bracket in Mixed or children", $reader); + + if ($data =~ /^\(\s*\#PCDATA/) { + $reader->match('('); + $self->skip_whitespace($reader); + $reader->move_along(7); + my $model = $self->Mixed($reader); + return $model; + } + + # not matched - must be Children + return $self->children($reader); +} + +# Mixed ::= ( '(' S* PCDATA ( S* '|' S* QName )* S* ')' '*' ) +# | ( '(' S* PCDATA S* ')' ) +sub Mixed { + my ($self, $reader) = @_; + + # Mixed_or_children already matched '(' S* '#PCDATA' + + my $model = '(#PCDATA'; + + $self->skip_whitespace($reader); + + my %seen; + + while (1) { + last unless $reader->match('|'); + $self->skip_whitespace($reader); + + my $name = $self->Name($reader) || + $self->parser_error("No 'Name' after Mixed content '|'", $reader); + + if ($seen{$name}) { + $self->parser_error("Element '$name' has already appeared in this group", $reader); + } + $seen{$name}++; + + $model .= "|$name"; + + $self->skip_whitespace($reader); + } + + $reader->match(')') || $self->parser_error("no closing bracket on mixed content", $reader); + + $model .= ")"; + + if ($reader->match('*')) { + $model .= "*"; + } + + return $model; +} + +# [[47]] Children ::= ChoiceOrSeq Cardinality? +# [[48]] Cp ::= ( QName | ChoiceOrSeq ) Cardinality? +# ChoiceOrSeq ::= '(' S* Cp ( Choice | Seq )? S* ')' +# [[49]] Choice ::= ( S* '|' S* Cp )+ +# [[50]] Seq ::= ( S* ',' S* Cp )+ +# // Children ::= (Choice | Seq) Cardinality? +# // Cp ::= ( QName | Choice | Seq) Cardinality? +# // Choice ::= '(' S* Cp ( S* '|' S* Cp )+ S* ')' +# // Seq ::= '(' S* Cp ( S* ',' S* Cp )* S* ')' +# [[51]] Mixed ::= ( '(' S* PCDATA ( S* '|' S* QName )* S* ')' MixedCardinality ) +# | ( '(' S* PCDATA S* ')' ) +# Cardinality ::= '?' | '+' | '*' +# MixedCardinality ::= '*' +sub children { + my ($self, $reader) = @_; + + return $self->ChoiceOrSeq($reader) . $self->Cardinality($reader); +} + +sub ChoiceOrSeq { + my ($self, $reader) = @_; + + $reader->match('(') or $self->parser_error("choice/seq contains no opening bracket", $reader); + + my $model = '('; + + $self->skip_whitespace($reader); + + $model .= $self->Cp($reader); + + if (my $choice = $self->Choice($reader)) { + $model .= $choice; + } + else { + $model .= $self->Seq($reader); + } + + $self->skip_whitespace($reader); + + $reader->match(')') or $self->parser_error("choice/seq contains no closing bracket", $reader); + + $model .= ')'; + + return $model; +} + +sub Cardinality { + my ($self, $reader) = @_; + # cardinality is always optional + my $data = $reader->data; + if ($data =~ /^([\?\+\*])/) { + $reader->move_along(1); + return $1; + } + return ''; +} + +sub Cp { + my ($self, $reader) = @_; + + my $model; + my $name = eval + { + if (my $name = $self->Name($reader)) { + return $name . $self->Cardinality($reader); + } + }; + return $name if defined $name; + return $self->ChoiceOrSeq($reader) . $self->Cardinality($reader); +} + +sub Choice { + my ($self, $reader) = @_; + + my $model = ''; + $self->skip_whitespace($reader); + + while ($reader->match('|')) { + $self->skip_whitespace($reader); + $model .= '|'; + $model .= $self->Cp($reader); + $self->skip_whitespace($reader); + } + + return $model; +} + +sub Seq { + my ($self, $reader) = @_; + + my $model = ''; + $self->skip_whitespace($reader); + + while ($reader->match(',')) { + $self->skip_whitespace($reader); + my $cp = $self->Cp($reader); + if ($cp) { + $model .= ','; + $model .= $cp; + } + $self->skip_whitespace($reader); + } + + return $model; +} + +sub AttlistDecl { + my ($self, $reader) = @_; + + my $data = $reader->data(9); + if ($data =~ /^move_along(9); + + $self->skip_whitespace($reader) || + $self->parser_error("No whitespace after ATTLIST declaration", $reader); + my $name = $self->Name($reader); + + $self->AttDefList($reader, $name); + + $self->skip_whitespace($reader); + + $reader->match('>') or $self->parser_error("Closing angle bracket not found on ATTLIST declaration", $reader); + + return 1; + } + + return 0; +} + +sub AttDefList { + my ($self, $reader, $name) = @_; + + 1 while $self->AttDef($reader, $name); +} + +sub AttDef { + my ($self, $reader, $el_name) = @_; + + $self->skip_whitespace($reader) || return 0; + my $att_name = $self->Name($reader) || return 0; + $self->skip_whitespace($reader) || + $self->parser_error("No whitespace after Name in attribute definition", $reader); + my $att_type = $self->AttType($reader); + + $self->skip_whitespace($reader) || + $self->parser_error("No whitespace after AttType in attribute definition", $reader); + my ($mode, $value) = $self->DefaultDecl($reader); + + # fire SAX event here! + $self->attribute_decl({ + eName => $el_name, + aName => $att_name, + Type => $att_type, + Mode => $mode, + Value => $value, + }); + return 1; +} + +sub AttType { + my ($self, $reader) = @_; + + return $self->StringType($reader) || + $self->TokenizedType($reader) || + $self->EnumeratedType($reader) || + $self->parser_error("Can't match AttType", $reader); +} + +sub StringType { + my ($self, $reader) = @_; + + my $data = $reader->data(5); + return unless $data =~ /^CDATA/; + $reader->move_along(5); + return 'CDATA'; +} + +sub TokenizedType { + my ($self, $reader) = @_; + + my $data = $reader->data(8); + if ($data =~ /^(IDREFS?|ID|ENTITIES|ENTITY|NMTOKENS?)/) { + $reader->move_along(length($1)); + return $1; + } + return; +} + +sub EnumeratedType { + my ($self, $reader) = @_; + return $self->NotationType($reader) || $self->Enumeration($reader); +} + +sub NotationType { + my ($self, $reader) = @_; + + my $data = $reader->data(8); + return unless $data =~ /^NOTATION/; + $reader->move_along(8); + + $self->skip_whitespace($reader) || + $self->parser_error("No whitespace after NOTATION", $reader); + $reader->match('(') or $self->parser_error("No opening bracket in notation section", $reader); + + $self->skip_whitespace($reader); + my $model = 'NOTATION ('; + my $name = $self->Name($reader) || + $self->parser_error("No name in notation section", $reader); + $model .= $name; + $self->skip_whitespace($reader); + $data = $reader->data; + while ($data =~ /^\|/) { + $reader->move_along(1); + $model .= '|'; + $self->skip_whitespace($reader); + my $name = $self->Name($reader) || + $self->parser_error("No name in notation section", $reader); + $model .= $name; + $self->skip_whitespace($reader); + $data = $reader->data; + } + $data =~ /^\)/ or $self->parser_error("No closing bracket in notation section", $reader); + $reader->move_along(1); + + $model .= ')'; + + return $model; +} + +sub Enumeration { + my ($self, $reader) = @_; + + return unless $reader->match('('); + + $self->skip_whitespace($reader); + my $model = '('; + my $nmtoken = $self->Nmtoken($reader) || + $self->parser_error("No Nmtoken in enumerated declaration", $reader); + $model .= $nmtoken; + $self->skip_whitespace($reader); + my $data = $reader->data; + while ($data =~ /^\|/) { + $model .= '|'; + $reader->move_along(1); + $self->skip_whitespace($reader); + my $nmtoken = $self->Nmtoken($reader) || + $self->parser_error("No Nmtoken in enumerated declaration", $reader); + $model .= $nmtoken; + $self->skip_whitespace($reader); + $data = $reader->data; + } + $data =~ /^\)/ or $self->parser_error("No closing bracket in enumerated declaration", $reader); + $reader->move_along(1); + + $model .= ')'; + + return $model; +} + +sub Nmtoken { + my ($self, $reader) = @_; + return $self->Name($reader); +} + +sub DefaultDecl { + my ($self, $reader) = @_; + + my $data = $reader->data(9); + if ($data =~ /^(\#REQUIRED|\#IMPLIED)/) { + $reader->move_along(length($1)); + return $1; + } + my $model = ''; + if ($data =~ /^\#FIXED/) { + $reader->move_along(6); + $self->skip_whitespace($reader) || $self->parser_error( + "no whitespace after FIXED specifier", $reader); + my $value = $self->AttValue($reader); + return "#FIXED", $value; + } + my $value = $self->AttValue($reader); + return undef, $value; +} + +sub EntityDecl { + my ($self, $reader) = @_; + + my $data = $reader->data(8); + return 0 unless $data =~ /^move_along(8); + + $self->skip_whitespace($reader) || $self->parser_error( + "No whitespace after ENTITY declaration", $reader); + + $self->PEDecl($reader) || $self->GEDecl($reader); + + $self->skip_whitespace($reader); + + $reader->match('>') or $self->parser_error("No closing '>' in entity definition", $reader); + + return 1; +} + +sub GEDecl { + my ($self, $reader) = @_; + + my $name = $self->Name($reader) || $self->parser_error("No entity name given", $reader); + $self->skip_whitespace($reader) || $self->parser_error("No whitespace after entity name", $reader); + + # TODO: ExternalID calls lexhandler method. Wrong place for it. + my $value; + if ($value = $self->ExternalID($reader)) { + $value .= $self->NDataDecl($reader); + } + else { + $value = $self->EntityValue($reader); + } + + if ($self->{ParseOptions}{entities}{$name}) { + warn("entity $name already exists\n"); + } else { + $self->{ParseOptions}{entities}{$name} = 1; + $self->{ParseOptions}{expanded_entity}{$name} = $value; # ??? + } + # do callback? + return 1; +} + +sub PEDecl { + my ($self, $reader) = @_; + + return 0 unless $reader->match('%'); + + $self->skip_whitespace($reader) || $self->parser_error("No whitespace after parameter entity marker", $reader); + my $name = $self->Name($reader) || $self->parser_error("No parameter entity name given", $reader); + $self->skip_whitespace($reader) || $self->parser_error("No whitespace after parameter entity name", $reader); + my $value = $self->ExternalID($reader) || + $self->EntityValue($reader) || + $self->parser_error("PE is not a value or an external resource", $reader); + # do callback? + return 1; +} + +my $quotre = qr/[^%&\"]/; +my $aposre = qr/[^%&\']/; + +sub EntityValue { + my ($self, $reader) = @_; + + my $data = $reader->data; + my $quote = '"'; + my $re = $quotre; + if (!$data =~ /^"/) { + $data =~ /^'/ or $self->parser_error("Not a quote character", $reader); + $quote = "'"; + $re = $aposre; + } + $reader->move_along(1); + + my $value = ''; + + while (1) { + my $data = $reader->data; + + $self->parser_error("EOF found while reading entity value", $reader) + unless length($data); + + if ($data =~ /^($re+)/) { + my $match = $1; + $value .= $match; + $reader->move_along(length($match)); + } + elsif ($reader->match('&')) { + # if it's a char ref, expand now: + if ($reader->match('#')) { + my $char; + my $ref = ''; + if ($reader->match('x')) { + my $data = $reader->data; + while (1) { + $self->parser_error("EOF looking for reference end", $reader) + unless length($data); + if ($data !~ /^([0-9a-fA-F]*)/) { + last; + } + $ref .= $1; + $reader->move_along(length($1)); + if (length($1) == length($data)) { + $data = $reader->data; + } + else { + last; + } + } + $char = chr_ref(hex($ref)); + $ref = "x$ref"; + } + else { + my $data = $reader->data; + while (1) { + $self->parser_error("EOF looking for reference end", $reader) + unless length($data); + if ($data !~ /^([0-9]*)/) { + last; + } + $ref .= $1; + $reader->move_along(length($1)); + if (length($1) == length($data)) { + $data = $reader->data; + } + else { + last; + } + } + $char = chr($ref); + } + $reader->match(';') || + $self->parser_error("No semi-colon found after character reference", $reader); + if ($char !~ $SingleChar) { # match a single character + $self->parser_error("Character reference '&#$ref;' refers to an illegal XML character ($char)", $reader); + } + $value .= $char; + } + else { + # entity refs in entities get expanded later, so don't parse now. + $value .= '&'; + } + } + elsif ($reader->match('%')) { + $value .= $self->PEReference($reader); + } + elsif ($reader->match($quote)) { + # end of attrib + last; + } + else { + $self->parser_error("Invalid character in attribute value: " . substr($reader->data, 0, 1), $reader); + } + } + + return $value; +} + +sub NDataDecl { + my ($self, $reader) = @_; + $self->skip_whitespace($reader) || return ''; + my $data = $reader->data(5); + return '' unless $data =~ /^NDATA/; + $reader->move_along(5); + $self->skip_whitespace($reader) || $self->parser_error("No whitespace after NDATA declaration", $reader); + my $name = $self->Name($reader) || $self->parser_error("NDATA declaration lacks a proper Name", $reader); + return " NDATA $name"; +} + +sub NotationDecl { + my ($self, $reader) = @_; + + my $data = $reader->data(10); + return 0 unless $data =~ /^move_along(10); + $self->skip_whitespace($reader) || + $self->parser_error("No whitespace after NOTATION declaration", $reader); + $data = $reader->data; + my $value = ''; + while(1) { + $self->parser_error("EOF found while looking for end of NotationDecl", $reader) + unless length($data); + + if ($data =~ /^([^>]*)>/) { + $value .= $1; + $reader->move_along(length($1) + 1); + $self->notation_decl({Name => "FIXME", SystemId => "FIXME", PublicId => "FIXME" }); + last; + } + else { + $value .= $data; + $reader->move_along(length($data)); + $data = $reader->data; + } + } + return 1; +} + +1; diff -r 266a7e9b9237 -r 6d3c3db11e72 uh_parser/XML/SAX/PurePerl/DebugHandler.pm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/uh_parser/XML/SAX/PurePerl/DebugHandler.pm Wed Mar 03 16:51:26 2010 +0000 @@ -0,0 +1,95 @@ +# $Id: DebugHandler.pm,v 1.3 2001/11/24 17:47:53 matt Exp $ + +package XML::SAX::PurePerl::DebugHandler; + +use strict; + +sub new { + my $class = shift; + my %opts = @_; + return bless \%opts, $class; +} + +# DocumentHandler + +sub set_document_locator { + my $self = shift; + print "set_document_locator\n" if $ENV{DEBUG_XML}; + $self->{seen}{set_document_locator}++; +} + +sub start_document { + my $self = shift; + print "start_document\n" if $ENV{DEBUG_XML}; + $self->{seen}{start_document}++; +} + +sub end_document { + my $self = shift; + print "end_document\n" if $ENV{DEBUG_XML}; + $self->{seen}{end_document}++; +} + +sub start_element { + my $self = shift; + print "start_element\n" if $ENV{DEBUG_XML}; + $self->{seen}{start_element}++; +} + +sub end_element { + my $self = shift; + print "end_element\n" if $ENV{DEBUG_XML}; + $self->{seen}{end_element}++; +} + +sub characters { + my $self = shift; + print "characters\n" if $ENV{DEBUG_XML}; +# warn "Char: ", $_[0]->{Data}, "\n"; + $self->{seen}{characters}++; +} + +sub processing_instruction { + my $self = shift; + print "processing_instruction\n" if $ENV{DEBUG_XML}; + $self->{seen}{processing_instruction}++; +} + +sub ignorable_whitespace { + my $self = shift; + print "ignorable_whitespace\n" if $ENV{DEBUG_XML}; + $self->{seen}{ignorable_whitespace}++; +} + +# LexHandler + +sub comment { + my $self = shift; + print "comment\n" if $ENV{DEBUG_XML}; + $self->{seen}{comment}++; +} + +# DTDHandler + +sub notation_decl { + my $self = shift; + print "notation_decl\n" if $ENV{DEBUG_XML}; + $self->{seen}{notation_decl}++; +} + +sub unparsed_entity_decl { + my $self = shift; + print "unparsed_entity_decl\n" if $ENV{DEBUG_XML}; + $self->{seen}{entity_decl}++; +} + +# EntityResolver + +sub resolve_entity { + my $self = shift; + print "resolve_entity\n" if $ENV{DEBUG_XML}; + $self->{seen}{resolve_entity}++; + return ''; +} + +1; diff -r 266a7e9b9237 -r 6d3c3db11e72 uh_parser/XML/SAX/PurePerl/DocType.pm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/uh_parser/XML/SAX/PurePerl/DocType.pm Wed Mar 03 16:51:26 2010 +0000 @@ -0,0 +1,180 @@ +# $Id: DocType.pm,v 1.3 2003/07/30 13:39:22 matt Exp $ + +package XML::SAX::PurePerl; + +use strict; +use XML::SAX::PurePerl::Productions qw($PubidChar); + +sub doctypedecl { + my ($self, $reader) = @_; + + my $data = $reader->data(9); + if ($data =~ /^move_along(9); + $self->skip_whitespace($reader) || + $self->parser_error("No whitespace after doctype declaration", $reader); + + my $root_name = $self->Name($reader) || + $self->parser_error("Doctype declaration has no root element name", $reader); + + if ($self->skip_whitespace($reader)) { + # might be externalid... + my %dtd = $self->ExternalID($reader); + # TODO: Call SAX event + } + + $self->skip_whitespace($reader); + + $self->InternalSubset($reader); + + $reader->match('>') or $self->parser_error("Doctype not closed", $reader); + + return 1; + } + + return 0; +} + +sub ExternalID { + my ($self, $reader) = @_; + + my $data = $reader->data(6); + + if ($data =~ /^SYSTEM/) { + $reader->move_along(6); + $self->skip_whitespace($reader) || + $self->parser_error("No whitespace after SYSTEM identifier", $reader); + return (SYSTEM => $self->SystemLiteral($reader)); + } + elsif ($data =~ /^PUBLIC/) { + $reader->move_along(6); + $self->skip_whitespace($reader) || + $self->parser_error("No whitespace after PUBLIC identifier", $reader); + + my $quote = $self->quote($reader) || + $self->parser_error("Not a quote character in PUBLIC identifier", $reader); + + my $data = $reader->data; + my $pubid = ''; + while(1) { + $self->parser_error("EOF while looking for end of PUBLIC identifiier", $reader) + unless length($data); + + if ($data =~ /^([^$quote]*)$quote/) { + $pubid .= $1; + $reader->move_along(length($1) + 1); + last; + } + else { + $pubid .= $data; + $reader->move_along(length($data)); + $data = $reader->data; + } + } + + if ($pubid !~ /^($PubidChar)+$/) { + $self->parser_error("Invalid characters in PUBLIC identifier", $reader); + } + + $self->skip_whitespace($reader) || + $self->parser_error("Not whitespace after PUBLIC ID in DOCTYPE", $reader); + + return (PUBLIC => $pubid, + SYSTEM => $self->SystemLiteral($reader)); + } + else { + return; + } + + return 1; +} + +sub SystemLiteral { + my ($self, $reader) = @_; + + my $quote = $self->quote($reader); + + my $data = $reader->data; + my $systemid = ''; + while (1) { + $self->parser_error("EOF found while looking for end of Sytem Literal", $reader) + unless length($data); + if ($data =~ /^([^$quote]*)$quote/) { + $systemid .= $1; + $reader->move_along(length($1) + 1); + return $systemid; + } + else { + $systemid .= $data; + $reader->move_along(length($data)); + $data = $reader->data; + } + } +} + +sub InternalSubset { + my ($self, $reader) = @_; + + return 0 unless $reader->match('['); + + 1 while $self->IntSubsetDecl($reader); + + $reader->match(']') or $self->parser_error("No close bracket on internal subset (found: " . $reader->data, $reader); + $self->skip_whitespace($reader); + return 1; +} + +sub IntSubsetDecl { + my ($self, $reader) = @_; + + return $self->DeclSep($reader) || $self->markupdecl($reader); +} + +sub DeclSep { + my ($self, $reader) = @_; + + if ($self->skip_whitespace($reader)) { + return 1; + } + + if ($self->PEReference($reader)) { + return 1; + } + +# if ($self->ParsedExtSubset($reader)) { +# return 1; +# } + + return 0; +} + +sub PEReference { + my ($self, $reader) = @_; + + return 0 unless $reader->match('%'); + + my $peref = $self->Name($reader) || + $self->parser_error("PEReference did not find a Name", $reader); + # TODO - load/parse the peref + + $reader->match(';') or $self->parser_error("Invalid token in PEReference", $reader); + return 1; +} + +sub markupdecl { + my ($self, $reader) = @_; + + if ($self->elementdecl($reader) || + $self->AttlistDecl($reader) || + $self->EntityDecl($reader) || + $self->NotationDecl($reader) || + $self->PI($reader) || + $self->Comment($reader)) + { + return 1; + } + + return 0; +} + +1; diff -r 266a7e9b9237 -r 6d3c3db11e72 uh_parser/XML/SAX/PurePerl/EncodingDetect.pm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/uh_parser/XML/SAX/PurePerl/EncodingDetect.pm Wed Mar 03 16:51:26 2010 +0000 @@ -0,0 +1,105 @@ +# $Id: EncodingDetect.pm,v 1.6 2007/02/07 09:33:50 grant Exp $ + +package XML::SAX::PurePerl; # NB, not ::EncodingDetect! + +use strict; + +sub encoding_detect { + my ($parser, $reader) = @_; + + my $error = "Invalid byte sequence at start of file"; + + my $data = $reader->data; + if ($data =~ /^\x00\x00\xFE\xFF/) { + # BO-UCS4-be + $reader->move_along(4); + $reader->set_encoding('UCS-4BE'); + return; + } + elsif ($data =~ /^\x00\x00\xFF\xFE/) { + # BO-UCS-4-2143 + $reader->move_along(4); + $reader->set_encoding('UCS-4-2143'); + return; + } + elsif ($data =~ /^\x00\x00\x00\x3C/) { + $reader->set_encoding('UCS-4BE'); + return; + } + elsif ($data =~ /^\x00\x00\x3C\x00/) { + $reader->set_encoding('UCS-4-2143'); + return; + } + elsif ($data =~ /^\x00\x3C\x00\x00/) { + $reader->set_encoding('UCS-4-3412'); + return; + } + elsif ($data =~ /^\x00\x3C\x00\x3F/) { + $reader->set_encoding('UTF-16BE'); + return; + } + elsif ($data =~ /^\xFF\xFE\x00\x00/) { + # BO-UCS-4LE + $reader->move_along(4); + $reader->set_encoding('UCS-4LE'); + return; + } + elsif ($data =~ /^\xFF\xFE/) { + $reader->move_along(2); + $reader->set_encoding('UTF-16LE'); + return; + } + elsif ($data =~ /^\xFE\xFF\x00\x00/) { + $reader->move_along(4); + $reader->set_encoding('UCS-4-3412'); + return; + } + elsif ($data =~ /^\xFE\xFF/) { + $reader->move_along(2); + $reader->set_encoding('UTF-16BE'); + return; + } + elsif ($data =~ /^\xEF\xBB\xBF/) { # UTF-8 BOM + $reader->move_along(3); + $reader->set_encoding('UTF-8'); + return; + } + elsif ($data =~ /^\x3C\x00\x00\x00/) { + $reader->set_encoding('UCS-4LE'); + return; + } + elsif ($data =~ /^\x3C\x00\x3F\x00/) { + $reader->set_encoding('UTF-16LE'); + return; + } + elsif ($data =~ /^\x3C\x3F\x78\x6D/) { + # $reader->set_encoding('UTF-8'); + return; + } + elsif ($data =~ /^\x3C\x3F\x78/) { + # $reader->set_encoding('UTF-8'); + return; + } + elsif ($data =~ /^\x3C\x3F/) { + # $reader->set_encoding('UTF-8'); + return; + } + elsif ($data =~ /^\x3C/) { + # $reader->set_encoding('UTF-8'); + return; + } + elsif ($data =~ /^[\x20\x09\x0A\x0D]+\x3C[^\x3F]/) { + # $reader->set_encoding('UTF-8'); + return; + } + elsif ($data =~ /^\x4C\x6F\xA7\x94/) { + $reader->set_encoding('EBCDIC'); + return; + } + + warn("Unable to recognise encoding of this document"); + return; +} + +1; + diff -r 266a7e9b9237 -r 6d3c3db11e72 uh_parser/XML/SAX/PurePerl/Exception.pm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/uh_parser/XML/SAX/PurePerl/Exception.pm Wed Mar 03 16:51:26 2010 +0000 @@ -0,0 +1,67 @@ +# $Id: Exception.pm,v 1.2 2001/11/14 11:07:25 matt Exp $ + +package XML::SAX::PurePerl::Exception; + +use strict; + +use overload '""' => "stringify"; + +use vars qw/$StackTrace/; + +$StackTrace = $ENV{XML_DEBUG} || 0; + +sub throw { + my $class = shift; + die $class->new(@_); +} + +sub new { + my $class = shift; + my %opts = @_; + die "Invalid options" unless exists $opts{Message}; + + if ($opts{reader}) { + return bless { Message => $opts{Message}, + Exception => undef, # not sure what this is for!!! + ColumnNumber => $opts{reader}->column, + LineNumber => $opts{reader}->line, + PublicId => $opts{reader}->public_id, + SystemId => $opts{reader}->system_id, + $StackTrace ? (StackTrace => stacktrace()) : (), + }, $class; + } + return bless { Message => $opts{Message}, + Exception => undef, # not sure what this is for!!! + }, $class; +} + +sub stringify { + my $self = shift; + local $^W; + return $self->{Message} . " [Ln: " . $self->{LineNumber} . + ", Col: " . $self->{ColumnNumber} . "]" . + ($StackTrace ? stackstring($self->{StackTrace}) : "") . "\n"; +} + +sub stacktrace { + my $i = 2; + my @fulltrace; + while (my @trace = caller($i++)) { + my %hash; + @hash{qw(Package Filename Line)} = @trace[0..2]; + push @fulltrace, \%hash; + } + return \@fulltrace; +} + +sub stackstring { + my $stacktrace = shift; + my $string = "\nFrom:\n"; + foreach my $current (@$stacktrace) { + $string .= $current->{Filename} . " Line: " . $current->{Line} . "\n"; + } + return $string; +} + +1; + diff -r 266a7e9b9237 -r 6d3c3db11e72 uh_parser/XML/SAX/PurePerl/NoUnicodeExt.pm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/uh_parser/XML/SAX/PurePerl/NoUnicodeExt.pm Wed Mar 03 16:51:26 2010 +0000 @@ -0,0 +1,28 @@ +# $Id: NoUnicodeExt.pm,v 1.1 2002/01/30 17:35:21 matt Exp $ + +package XML::SAX::PurePerl; +use strict; + +sub chr_ref { + my $n = shift; + if ($n < 0x80) { + return chr ($n); + } + elsif ($n < 0x800) { + return pack ("CC", (($n >> 6) | 0xc0), (($n & 0x3f) | 0x80)); + } + elsif ($n < 0x10000) { + return pack ("CCC", (($n >> 12) | 0xe0), ((($n >> 6) & 0x3f) | 0x80), + (($n & 0x3f) | 0x80)); + } + elsif ($n < 0x110000) + { + return pack ("CCCC", (($n >> 18) | 0xf0), ((($n >> 12) & 0x3f) | 0x80), + ((($n >> 6) & 0x3f) | 0x80), (($n & 0x3f) | 0x80)); + } + else { + return undef; + } +} + +1; diff -r 266a7e9b9237 -r 6d3c3db11e72 uh_parser/XML/SAX/PurePerl/Productions.pm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/uh_parser/XML/SAX/PurePerl/Productions.pm Wed Mar 03 16:51:26 2010 +0000 @@ -0,0 +1,151 @@ +# $Id: Productions.pm,v 1.11 2003/07/30 13:39:22 matt Exp $ + +package XML::SAX::PurePerl::Productions; + +use Exporter; +@ISA = ('Exporter'); +@EXPORT_OK = qw($S $Char $VersionNum $BaseChar $Letter $Ideographic + $Extender $Digit $CombiningChar $EncNameStart $EncNameEnd $NameChar $CharMinusDash + $PubidChar $Any $SingleChar); + +### WARNING!!! All productions here must *only* match a *single* character!!! ### + +BEGIN { +$S = qr/[\x20\x09\x0D\x0A]/; + +$CharMinusDash = qr/[^-]/x; + +$Any = qr/ . /xms; + +$VersionNum = qr/ [a-zA-Z0-9_.:-]+ /x; + +$EncNameStart = qr/ [A-Za-z] /x; +$EncNameEnd = qr/ [A-Za-z0-9\._-] /x; + +$PubidChar = qr/ [\x20\x0D\x0Aa-zA-Z0-9'()\+,.\/:=\?;!*\#@\$_\%-] /x; + +if ($] < 5.006) { + eval <<' PERL'; + $Char = qr/^ [\x09\x0A\x0D\x20-\x7F]|([\xC0-\xFD][\x80-\xBF]+) $/x; + + $SingleChar = qr/^$Char$/; + + $BaseChar = qr/ [\x41-\x5A\x61-\x7A]|([\xC0-\xFD][\x80-\xBF]+) /x; + + $Extender = qr/ \xB7 /x; + + $Digit = qr/ [\x30-\x39] /x; + + $Letter = qr/^ $BaseChar $/x; + + # can't do this one without unicode + # $CombiningChar = qr/^$/msx; + + $NameChar = qr/^ $BaseChar | $Digit | [._:-] | $Extender $/x; + PERL + die $@ if $@; +} +else { + eval <<' PERL'; + + use utf8; # for 5.6 + + $Char = qr/^ [\x09\x0A\x0D\x{0020}-\x{D7FF}\x{E000}-\x{FFFD}\x{10000}-\x{10FFFF}] $/x; + + $SingleChar = qr/^$Char$/; + + $BaseChar = qr/ +[\x{0041}-\x{005A}\x{0061}-\x{007A}\x{00C0}-\x{00D6}\x{00D8}-\x{00F6}] | +[\x{00F8}-\x{00FF}\x{0100}-\x{0131}\x{0134}-\x{013E}\x{0141}-\x{0148}] | +[\x{014A}-\x{017E}\x{0180}-\x{01C3}\x{01CD}-\x{01F0}\x{01F4}-\x{01F5}] | +[\x{01FA}-\x{0217}\x{0250}-\x{02A8}\x{02BB}-\x{02C1}\x{0386}\x{0388}-\x{038A}] | +[\x{038C}\x{038E}-\x{03A1}\x{03A3}-\x{03CE}\x{03D0}-\x{03D6}\x{03DA}] | +[\x{03DC}\x{03DE}\x{03E0}\x{03E2}-\x{03F3}\x{0401}-\x{040C}\x{040E}-\x{044F}] | +[\x{0451}-\x{045C}\x{045E}-\x{0481}\x{0490}-\x{04C4}\x{04C7}-\x{04C8}] | +[\x{04CB}-\x{04CC}\x{04D0}-\x{04EB}\x{04EE}-\x{04F5}\x{04F8}-\x{04F9}] | +[\x{0531}-\x{0556}\x{0559}\x{0561}-\x{0586}\x{05D0}-\x{05EA}\x{05F0}-\x{05F2}] | +[\x{0621}-\x{063A}\x{0641}-\x{064A}\x{0671}-\x{06B7}\x{06BA}-\x{06BE}] | +[\x{06C0}-\x{06CE}\x{06D0}-\x{06D3}\x{06D5}\x{06E5}-\x{06E6}\x{0905}-\x{0939}] | +[\x{093D}\x{0958}-\x{0961}\x{0985}-\x{098C}\x{098F}-\x{0990}] | +[\x{0993}-\x{09A8}\x{09AA}-\x{09B0}\x{09B2}\x{09B6}-\x{09B9}\x{09DC}-\x{09DD}] | +[\x{09DF}-\x{09E1}\x{09F0}-\x{09F1}\x{0A05}-\x{0A0A}\x{0A0F}-\x{0A10}] | +[\x{0A13}-\x{0A28}\x{0A2A}-\x{0A30}\x{0A32}-\x{0A33}\x{0A35}-\x{0A36}] | +[\x{0A38}-\x{0A39}\x{0A59}-\x{0A5C}\x{0A5E}\x{0A72}-\x{0A74}\x{0A85}-\x{0A8B}] | +[\x{0A8D}\x{0A8F}-\x{0A91}\x{0A93}-\x{0AA8}\x{0AAA}-\x{0AB0}] | +[\x{0AB2}-\x{0AB3}\x{0AB5}-\x{0AB9}\x{0ABD}\x{0AE0}\x{0B05}-\x{0B0C}] | +[\x{0B0F}-\x{0B10}\x{0B13}-\x{0B28}\x{0B2A}-\x{0B30}\x{0B32}-\x{0B33}] | +[\x{0B36}-\x{0B39}\x{0B3D}\x{0B5C}-\x{0B5D}\x{0B5F}-\x{0B61}\x{0B85}-\x{0B8A}] | +[\x{0B8E}-\x{0B90}\x{0B92}-\x{0B95}\x{0B99}-\x{0B9A}\x{0B9C}] | +[\x{0B9E}-\x{0B9F}\x{0BA3}-\x{0BA4}\x{0BA8}-\x{0BAA}\x{0BAE}-\x{0BB5}] | +[\x{0BB7}-\x{0BB9}\x{0C05}-\x{0C0C}\x{0C0E}-\x{0C10}\x{0C12}-\x{0C28}] | +[\x{0C2A}-\x{0C33}\x{0C35}-\x{0C39}\x{0C60}-\x{0C61}\x{0C85}-\x{0C8C}] | +[\x{0C8E}-\x{0C90}\x{0C92}-\x{0CA8}\x{0CAA}-\x{0CB3}\x{0CB5}-\x{0CB9}\x{0CDE}] | +[\x{0CE0}-\x{0CE1}\x{0D05}-\x{0D0C}\x{0D0E}-\x{0D10}\x{0D12}-\x{0D28}] | +[\x{0D2A}-\x{0D39}\x{0D60}-\x{0D61}\x{0E01}-\x{0E2E}\x{0E30}\x{0E32}-\x{0E33}] | +[\x{0E40}-\x{0E45}\x{0E81}-\x{0E82}\x{0E84}\x{0E87}-\x{0E88}\x{0E8A}] | +[\x{0E8D}\x{0E94}-\x{0E97}\x{0E99}-\x{0E9F}\x{0EA1}-\x{0EA3}\x{0EA5}\x{0EA7}] | +[\x{0EAA}-\x{0EAB}\x{0EAD}-\x{0EAE}\x{0EB0}\x{0EB2}-\x{0EB3}\x{0EBD}] | +[\x{0EC0}-\x{0EC4}\x{0F40}-\x{0F47}\x{0F49}-\x{0F69}\x{10A0}-\x{10C5}] | +[\x{10D0}-\x{10F6}\x{1100}\x{1102}-\x{1103}\x{1105}-\x{1107}\x{1109}] | +[\x{110B}-\x{110C}\x{110E}-\x{1112}\x{113C}\x{113E}\x{1140}\x{114C}\x{114E}] | +[\x{1150}\x{1154}-\x{1155}\x{1159}\x{115F}-\x{1161}\x{1163}\x{1165}] | +[\x{1167}\x{1169}\x{116D}-\x{116E}\x{1172}-\x{1173}\x{1175}\x{119E}\x{11A8}] | +[\x{11AB}\x{11AE}-\x{11AF}\x{11B7}-\x{11B8}\x{11BA}\x{11BC}-\x{11C2}] | +[\x{11EB}\x{11F0}\x{11F9}\x{1E00}-\x{1E9B}\x{1EA0}-\x{1EF9}\x{1F00}-\x{1F15}] | +[\x{1F18}-\x{1F1D}\x{1F20}-\x{1F45}\x{1F48}-\x{1F4D}\x{1F50}-\x{1F57}] | +[\x{1F59}\x{1F5B}\x{1F5D}\x{1F5F}-\x{1F7D}\x{1F80}-\x{1FB4}\x{1FB6}-\x{1FBC}] | +[\x{1FBE}\x{1FC2}-\x{1FC4}\x{1FC6}-\x{1FCC}\x{1FD0}-\x{1FD3}] | +[\x{1FD6}-\x{1FDB}\x{1FE0}-\x{1FEC}\x{1FF2}-\x{1FF4}\x{1FF6}-\x{1FFC}] | +[\x{2126}\x{212A}-\x{212B}\x{212E}\x{2180}-\x{2182}\x{3041}-\x{3094}] | +[\x{30A1}-\x{30FA}\x{3105}-\x{312C}\x{AC00}-\x{D7A3}] + /x; + + $Extender = qr/ +[\x{00B7}\x{02D0}\x{02D1}\x{0387}\x{0640}\x{0E46}\x{0EC6}\x{3005}\x{3031}-\x{3035}\x{309D}-\x{309E}\x{30FC}-\x{30FE}] +/x; + + $Digit = qr/ +[\x{0030}-\x{0039}\x{0660}-\x{0669}\x{06F0}-\x{06F9}\x{0966}-\x{096F}] | +[\x{09E6}-\x{09EF}\x{0A66}-\x{0A6F}\x{0AE6}-\x{0AEF}\x{0B66}-\x{0B6F}] | +[\x{0BE7}-\x{0BEF}\x{0C66}-\x{0C6F}\x{0CE6}-\x{0CEF}\x{0D66}-\x{0D6F}] | +[\x{0E50}-\x{0E59}\x{0ED0}-\x{0ED9}\x{0F20}-\x{0F29}] +/x; + + $CombiningChar = qr/ +[\x{0300}-\x{0345}\x{0360}-\x{0361}\x{0483}-\x{0486}\x{0591}-\x{05A1}] | +[\x{05A3}-\x{05B9}\x{05BB}-\x{05BD}\x{05BF}\x{05C1}-\x{05C2}\x{05C4}] | +[\x{064B}-\x{0652}\x{0670}\x{06D6}-\x{06DC}\x{06DD}-\x{06DF}\x{06E0}-\x{06E4}] | +[\x{06E7}-\x{06E8}\x{06EA}-\x{06ED}\x{0901}-\x{0903}\x{093C}] | +[\x{093E}-\x{094C}\x{094D}\x{0951}-\x{0954}\x{0962}-\x{0963}\x{0981}-\x{0983}] | +[\x{09BC}\x{09BE}\x{09BF}\x{09C0}-\x{09C4}\x{09C7}-\x{09C8}] | +[\x{09CB}-\x{09CD}\x{09D7}\x{09E2}-\x{09E3}\x{0A02}\x{0A3C}\x{0A3E}\x{0A3F}] | +[\x{0A40}-\x{0A42}\x{0A47}-\x{0A48}\x{0A4B}-\x{0A4D}\x{0A70}-\x{0A71}] | +[\x{0A81}-\x{0A83}\x{0ABC}\x{0ABE}-\x{0AC5}\x{0AC7}-\x{0AC9}\x{0ACB}-\x{0ACD}] | +[\x{0B01}-\x{0B03}\x{0B3C}\x{0B3E}-\x{0B43}\x{0B47}-\x{0B48}] | +[\x{0B4B}-\x{0B4D}\x{0B56}-\x{0B57}\x{0B82}-\x{0B83}\x{0BBE}-\x{0BC2}] | +[\x{0BC6}-\x{0BC8}\x{0BCA}-\x{0BCD}\x{0BD7}\x{0C01}-\x{0C03}\x{0C3E}-\x{0C44}] | +[\x{0C46}-\x{0C48}\x{0C4A}-\x{0C4D}\x{0C55}-\x{0C56}\x{0C82}-\x{0C83}] | +[\x{0CBE}-\x{0CC4}\x{0CC6}-\x{0CC8}\x{0CCA}-\x{0CCD}\x{0CD5}-\x{0CD6}] | +[\x{0D02}-\x{0D03}\x{0D3E}-\x{0D43}\x{0D46}-\x{0D48}\x{0D4A}-\x{0D4D}\x{0D57}] | +[\x{0E31}\x{0E34}-\x{0E3A}\x{0E47}-\x{0E4E}\x{0EB1}\x{0EB4}-\x{0EB9}] | +[\x{0EBB}-\x{0EBC}\x{0EC8}-\x{0ECD}\x{0F18}-\x{0F19}\x{0F35}\x{0F37}\x{0F39}] | +[\x{0F3E}\x{0F3F}\x{0F71}-\x{0F84}\x{0F86}-\x{0F8B}\x{0F90}-\x{0F95}] | +[\x{0F97}\x{0F99}-\x{0FAD}\x{0FB1}-\x{0FB7}\x{0FB9}\x{20D0}-\x{20DC}\x{20E1}] | +[\x{302A}-\x{302F}\x{3099}\x{309A}] +/x; + + $Ideographic = qr/ +[\x{4E00}-\x{9FA5}\x{3007}\x{3021}-\x{3029}] +/x; + + $Letter = qr/^ $BaseChar | $Ideographic $/x; + + $NameChar = qr/^ $Letter | $Digit | [._:-] | $CombiningChar | $Extender $/x; + PERL + + die $@ if $@; +} + +} + +1; diff -r 266a7e9b9237 -r 6d3c3db11e72 uh_parser/XML/SAX/PurePerl/Reader.pm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/uh_parser/XML/SAX/PurePerl/Reader.pm Wed Mar 03 16:51:26 2010 +0000 @@ -0,0 +1,137 @@ +# $Id: Reader.pm,v 1.11 2005/10/14 20:31:20 matt Exp $ + +package XML::SAX::PurePerl::Reader; + +use strict; +use XML::SAX::PurePerl::Reader::URI; +use XML::SAX::PurePerl::Productions qw( $SingleChar $Letter $NameChar ); +use Exporter (); + +use vars qw(@ISA @EXPORT_OK); +@ISA = qw(Exporter); +@EXPORT_OK = qw( + EOF + BUFFER + LINE + COLUMN + ENCODING + XML_VERSION +); + +use constant EOF => 0; +use constant BUFFER => 1; +use constant LINE => 2; +use constant COLUMN => 3; +use constant ENCODING => 4; +use constant SYSTEM_ID => 5; +use constant PUBLIC_ID => 6; +use constant XML_VERSION => 7; + +require XML::SAX::PurePerl::Reader::Stream; +require XML::SAX::PurePerl::Reader::String; + +if ($] >= 5.007002) { + require XML::SAX::PurePerl::Reader::UnicodeExt; +} +else { + require XML::SAX::PurePerl::Reader::NoUnicodeExt; +} + +sub new { + my $class = shift; + my $thing = shift; + + # try to figure if this $thing is a handle of some sort + if (ref($thing) && UNIVERSAL::isa($thing, 'IO::Handle')) { + return XML::SAX::PurePerl::Reader::Stream->new($thing)->init; + } + my $ioref; + if (tied($thing)) { + my $class = ref($thing); + no strict 'refs'; + $ioref = $thing if defined &{"${class}::TIEHANDLE"}; + } + else { + eval { + $ioref = *{$thing}{IO}; + }; + undef $@; + } + if ($ioref) { + return XML::SAX::PurePerl::Reader::Stream->new($thing)->init; + } + + if ($thing =~ /new($thing)->init; + } + + # assume it is a uri + return XML::SAX::PurePerl::Reader::URI->new($thing)->init; +} + +sub init { + my $self = shift; + $self->[LINE] = 1; + $self->[COLUMN] = 1; + $self->read_more; + return $self; +} + +sub data { + my ($self, $min_length) = (@_, 1); + if (length($self->[BUFFER]) < $min_length) { + $self->read_more; + } + return $self->[BUFFER]; +} + +sub match { + my ($self, $char) = @_; + my $data = $self->data; + if (substr($data, 0, 1) eq $char) { + $self->move_along(1); + return 1; + } + return 0; +} + +sub public_id { + my $self = shift; + @_ and $self->[PUBLIC_ID] = shift; + $self->[PUBLIC_ID]; +} + +sub system_id { + my $self = shift; + @_ and $self->[SYSTEM_ID] = shift; + $self->[SYSTEM_ID]; +} + +sub line { + shift->[LINE]; +} + +sub column { + shift->[COLUMN]; +} + +sub get_encoding { + my $self = shift; + return $self->[ENCODING]; +} + +sub get_xml_version { + my $self = shift; + return $self->[XML_VERSION]; +} + +1; + +__END__ + +=head1 NAME + +XML::Parser::PurePerl::Reader - Abstract Reader factory class + +=cut diff -r 266a7e9b9237 -r 6d3c3db11e72 uh_parser/XML/SAX/PurePerl/Reader/NoUnicodeExt.pm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/uh_parser/XML/SAX/PurePerl/Reader/NoUnicodeExt.pm Wed Mar 03 16:51:26 2010 +0000 @@ -0,0 +1,25 @@ +# $Id: NoUnicodeExt.pm,v 1.3 2003/07/30 13:39:23 matt Exp $ + +package XML::SAX::PurePerl::Reader; +use strict; + +sub set_raw_stream { + # no-op +} + +sub switch_encoding_stream { + my ($fh, $encoding) = @_; + throw XML::SAX::Exception::Parse ( + Message => "Only ASCII encoding allowed without perl 5.7.2 or higher. You tried: $encoding", + ) if $encoding !~ /(ASCII|UTF\-?8)/i; +} + +sub switch_encoding_string { + my (undef, $encoding) = @_; + throw XML::SAX::Exception::Parse ( + Message => "Only ASCII encoding allowed without perl 5.7.2 or higher. You tried: $encoding", + ) if $encoding !~ /(ASCII|UTF\-?8)/i; +} + +1; + diff -r 266a7e9b9237 -r 6d3c3db11e72 uh_parser/XML/SAX/PurePerl/Reader/Stream.pm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/uh_parser/XML/SAX/PurePerl/Reader/Stream.pm Wed Mar 03 16:51:26 2010 +0000 @@ -0,0 +1,84 @@ +# $Id: Stream.pm,v 1.7 2005/10/14 20:31:20 matt Exp $ + +package XML::SAX::PurePerl::Reader::Stream; + +use strict; +use vars qw(@ISA); + +use XML::SAX::PurePerl::Reader qw( + EOF + BUFFER + LINE + COLUMN + ENCODING + XML_VERSION +); +use XML::SAX::Exception; + +@ISA = ('XML::SAX::PurePerl::Reader'); + +# subclassed by adding 1 to last element +use constant FH => 8; +use constant BUFFER_SIZE => 4096; + +sub new { + my $class = shift; + my $ioref = shift; + XML::SAX::PurePerl::Reader::set_raw_stream($ioref); + my @parts; + @parts[FH, LINE, COLUMN, BUFFER, EOF, XML_VERSION] = + ($ioref, 1, 0, '', 0, '1.0'); + return bless \@parts, $class; +} + +sub read_more { + my $self = shift; + my $buf; + my $bytesread = read($self->[FH], $buf, BUFFER_SIZE); + if ($bytesread) { + $self->[BUFFER] .= $buf; + return 1; + } + elsif (defined($bytesread)) { + $self->[EOF]++; + return 0; + } + else { + throw XML::SAX::Exception::Parse( + Message => "Error reading from filehandle: $!", + ); + } +} + +sub move_along { + my $self = shift; + my $discarded = substr($self->[BUFFER], 0, $_[0], ''); + + # Wish I could skip this lot - tells us where we are in the file + my $lines = $discarded =~ tr/\n//; + $self->[LINE] += $lines; + if ($lines) { + $discarded =~ /\n([^\n]*)$/; + $self->[COLUMN] = length($1); + } + else { + $self->[COLUMN] += $_[0]; + } +} + +sub set_encoding { + my $self = shift; + my ($encoding) = @_; + # warn("set encoding to: $encoding\n"); + XML::SAX::PurePerl::Reader::switch_encoding_stream($self->[FH], $encoding); + XML::SAX::PurePerl::Reader::switch_encoding_string($self->[BUFFER], $encoding); + $self->[ENCODING] = $encoding; +} + +sub bytepos { + my $self = shift; + tell($self->[FH]); +} + +1; + diff -r 266a7e9b9237 -r 6d3c3db11e72 uh_parser/XML/SAX/PurePerl/Reader/String.pm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/uh_parser/XML/SAX/PurePerl/Reader/String.pm Wed Mar 03 16:51:26 2010 +0000 @@ -0,0 +1,61 @@ +# $Id: String.pm,v 1.5 2003/07/30 13:39:23 matt Exp $ + +package XML::SAX::PurePerl::Reader::String; + +use strict; +use vars qw(@ISA); + +use XML::SAX::PurePerl::Reader qw( + LINE + COLUMN + BUFFER + ENCODING + EOF +); + +@ISA = ('XML::SAX::PurePerl::Reader'); + +use constant DISCARDED => 7; + +sub new { + my $class = shift; + my $string = shift; + my @parts; + @parts[BUFFER, EOF, LINE, COLUMN, DISCARDED] = + ($string, 0, 1, 0, ''); + return bless \@parts, $class; +} + +sub read_more () { } + +sub move_along { + my $self = shift; + my $discarded = substr($self->[BUFFER], 0, $_[0], ''); + $self->[DISCARDED] .= $discarded; + + # Wish I could skip this lot - tells us where we are in the file + my $lines = $discarded =~ tr/\n//; + $self->[LINE] += $lines; + if ($lines) { + $discarded =~ /\n([^\n]*)$/; + $self->[COLUMN] = length($1); + } + else { + $self->[COLUMN] += $_[0]; + } +} + +sub set_encoding { + my $self = shift; + my ($encoding) = @_; + + XML::SAX::PurePerl::Reader::switch_encoding_string($self->[BUFFER], $encoding, "utf-8"); + $self->[ENCODING] = $encoding; +} + +sub bytepos { + my $self = shift; + length($self->[DISCARDED]); +} + +1; diff -r 266a7e9b9237 -r 6d3c3db11e72 uh_parser/XML/SAX/PurePerl/Reader/URI.pm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/uh_parser/XML/SAX/PurePerl/Reader/URI.pm Wed Mar 03 16:51:26 2010 +0000 @@ -0,0 +1,57 @@ +# $Id: URI.pm,v 1.1 2001/11/11 18:41:51 matt Exp $ + +package XML::SAX::PurePerl::Reader::URI; + +use strict; + +use XML::SAX::PurePerl::Reader; +use File::Temp qw(tempfile); +use Symbol; + +## NOTE: This is *not* a subclass of Reader. It just returns Stream or String +## Reader objects depending on what it's capabilities are. + +sub new { + my $class = shift; + my $uri = shift; + # request the URI + if (-e $uri && -f _) { + my $fh = gensym; + open($fh, $uri) || die "Cannot open file $uri : $!"; + return XML::SAX::PurePerl::Reader::Stream->new($fh); + } + elsif ($uri =~ /^file:(.*)$/ && -e $1 && -f _) { + my $file = $1; + my $fh = gensym; + open($fh, $file) || die "Cannot open file $file : $!"; + return XML::SAX::PurePerl::Reader::Stream->new($fh); + } + else { + # request URI, return String reader + require LWP::UserAgent; + my $ua = LWP::UserAgent->new; + $ua->agent("Perl/XML/SAX/PurePerl/1.0 " . $ua->agent); + + my $req = HTTP::Request->new(GET => $uri); + + my $fh = tempfile(); + + my $callback = sub { + my ($data, $response, $protocol) = @_; + print $fh $data; + }; + + my $res = $ua->request($req, $callback, 4096); + + if ($res->is_success) { + seek($fh, 0, 0); + return XML::SAX::PurePerl::Reader::Stream->new($fh); + } + else { + die "LWP Request Failed"; + } + } +} + + +1; diff -r 266a7e9b9237 -r 6d3c3db11e72 uh_parser/XML/SAX/PurePerl/Reader/UnicodeExt.pm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/uh_parser/XML/SAX/PurePerl/Reader/UnicodeExt.pm Wed Mar 03 16:51:26 2010 +0000 @@ -0,0 +1,23 @@ +# $Id: UnicodeExt.pm,v 1.4 2003/07/30 13:39:23 matt Exp $ + +package XML::SAX::PurePerl::Reader; +use strict; + +use Encode; + +sub set_raw_stream { + my ($fh) = @_; + binmode($fh, ":bytes"); +} + +sub switch_encoding_stream { + my ($fh, $encoding) = @_; + binmode($fh, ":encoding($encoding)"); +} + +sub switch_encoding_string { + Encode::from_to($_[0], $_[1], "utf-8"); +} + +1; + diff -r 266a7e9b9237 -r 6d3c3db11e72 uh_parser/XML/SAX/PurePerl/UnicodeExt.pm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/uh_parser/XML/SAX/PurePerl/UnicodeExt.pm Wed Mar 03 16:51:26 2010 +0000 @@ -0,0 +1,22 @@ +# $Id: UnicodeExt.pm,v 1.1 2002/01/30 17:35:21 matt Exp $ + +package XML::SAX::PurePerl; +use strict; + +no warnings 'utf8'; + +sub chr_ref { + return chr(shift); +} + +if ($] >= 5.007002) { + require Encode; + + Encode::define_alias( "UTF-16" => "UCS-2" ); + Encode::define_alias( "UTF-16BE" => "UCS-2" ); + Encode::define_alias( "UTF-16LE" => "ucs-2le" ); + Encode::define_alias( "UTF16LE" => "ucs-2le" ); +} + +1; + diff -r 266a7e9b9237 -r 6d3c3db11e72 uh_parser/XML/SAX/PurePerl/XMLDecl.pm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/uh_parser/XML/SAX/PurePerl/XMLDecl.pm Wed Mar 03 16:51:26 2010 +0000 @@ -0,0 +1,129 @@ +# $Id: XMLDecl.pm,v 1.3 2003/07/30 13:39:22 matt Exp $ + +package XML::SAX::PurePerl; + +use strict; +use XML::SAX::PurePerl::Productions qw($S $VersionNum $EncNameStart $EncNameEnd); + +sub XMLDecl { + my ($self, $reader) = @_; + + my $data = $reader->data(5); + # warn("Looking for xmldecl in: $data"); + if ($data =~ /^<\?xml$S/o) { + $reader->move_along(5); + $self->skip_whitespace($reader); + + # get version attribute + $self->VersionInfo($reader) || + $self->parser_error("XML Declaration lacks required version attribute, or version attribute does not match XML specification", $reader); + + if (!$self->skip_whitespace($reader)) { + my $data = $reader->data(2); + $data =~ /^\?>/ or $self->parser_error("Syntax error", $reader); + $reader->move_along(2); + return; + } + + if ($self->EncodingDecl($reader)) { + if (!$self->skip_whitespace($reader)) { + my $data = $reader->data(2); + $data =~ /^\?>/ or $self->parser_error("Syntax error", $reader); + $reader->move_along(2); + return; + } + } + + $self->SDDecl($reader); + + $self->skip_whitespace($reader); + + my $data = $reader->data(2); + $data =~ /^\?>/ or $self->parser_error("Syntax error", $reader); + $reader->move_along(2); + } + else { + # warn("first 5 bytes: ", join(',', unpack("CCCCC", $data)), "\n"); + # no xml decl + if (!$reader->get_encoding) { + $reader->set_encoding("UTF-8"); + } + } +} + +sub VersionInfo { + my ($self, $reader) = @_; + + my $data = $reader->data(11); + + # warn("Looking for version in $data"); + + $data =~ /^(version$S*=$S*(["'])($VersionNum)\2)/o or return 0; + $reader->move_along(length($1)); + my $vernum = $3; + + if ($vernum ne "1.0") { + $self->parser_error("Only XML version 1.0 supported. Saw: '$vernum'", $reader); + } + + return 1; +} + +sub SDDecl { + my ($self, $reader) = @_; + + my $data = $reader->data(15); + + $data =~ /^(standalone$S*=$S*(["'])(yes|no)\2)/o or return 0; + $reader->move_along(length($1)); + my $yesno = $3; + + if ($yesno eq 'yes') { + $self->{standalone} = 1; + } + else { + $self->{standalone} = 0; + } + + return 1; +} + +sub EncodingDecl { + my ($self, $reader) = @_; + + my $data = $reader->data(12); + + $data =~ /^(encoding$S*=$S*(["'])($EncNameStart$EncNameEnd*)\2)/o or return 0; + $reader->move_along(length($1)); + my $encoding = $3; + + $reader->set_encoding($encoding); + + return 1; +} + +sub TextDecl { + my ($self, $reader) = @_; + + my $data = $reader->data(6); + $data =~ /^<\?xml$S+/ or return; + $reader->move_along(5); + $self->skip_whitespace($reader); + + if ($self->VersionInfo($reader)) { + $self->skip_whitespace($reader) || + $self->parser_error("Lack of whitespace after version attribute in text declaration", $reader); + } + + $self->EncodingDecl($reader) || + $self->parser_error("Encoding declaration missing from external entity text declaration", $reader); + + $self->skip_whitespace($reader); + + $data = $reader->data(2); + $data =~ /^\?>/ or $self->parser_error("Syntax error", $reader); + + return 1; +} + +1; diff -r 266a7e9b9237 -r 6d3c3db11e72 uh_parser/XML/SAX/placeholder.pl --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/uh_parser/XML/SAX/placeholder.pl Wed Mar 03 16:51:26 2010 +0000 @@ -0,0 +1,1 @@ +# ignore me diff -r 266a7e9b9237 -r 6d3c3db11e72 uh_parser/preprocess_log.pl --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/uh_parser/preprocess_log.pl Wed Mar 03 16:51:26 2010 +0000 @@ -0,0 +1,111 @@ +#!perl -w +# Copyright (c) 2009 Symbian Foundation Ltd +# This component and the accompanying materials are made available +# under the terms of the License "Eclipse Public License v1.0" +# which accompanies this distribution, and is available +# at the URL "http://www.eclipse.org/legal/epl-v10.html". +# +# Initial Contributors: +# Symbian Foundation Ltd - initial contribution. +# +# Contributors: +# +# Description: +# Preprocess a raptor log, trying to countermeasure a list of known anomalies + +use strict; + +use Getopt::Long; + +my $help = 0; +GetOptions( + 'help!' => \$help, +); + +if ($help) +{ + warn <<"EOF"; +Preprocess a raptor log, trying to countermeasure a list of known anomalies + +Usage: perl preprocess_log.pl < INFILE > OUTFILE +EOF + exit(0); +} + +while (my $line = <>) +{ + if ($line =~ m{<[^<^>]+>.*&.*]+>}) + { + $line = escape_ampersand($line); + } + elsif ($line =~ m{<\?xml\s.*encoding=.*\".*\?>}) + { + $line = set_encoding_utf8($line); + } + elsif ($line =~ m{}) + { + $line = unterminated_archive_tag($line, scalar <>, $.) + } + elsif ($line =~ m{make.exe: Circular .* <- .* dependency dropped.}) + { + $line = escape_left_angle_bracket($line); + } + + print $line; +} + +sub escape_ampersand +{ + my ($line) = @_; + + warn "escape_ampersand\n"; + warn "in: $line"; + + $line =~ s,&,&,g; + + warn "out: $line"; + return $line; +} + +sub set_encoding_utf8 +{ + my ($line) = @_; + + warn "set_encoding_utf8\n"; + warn "in: $line"; + + $line =~ s,encoding=".*",encoding="utf-8",; + + warn "out: $line"; + return $line; +} + +sub unterminated_archive_tag +{ + my $line = shift; + my $nextLine = shift; + my $lineNum = shift; + + if ($nextLine !~ m{()|()}) + { + warn "unterminated_archive_tag\n"; + warn "in: $line"; + $line =~ s{>}{/>}; + warn "out: $line"; + } + + return $line . $nextLine; +} + +sub escape_left_angle_bracket +{ + my ($line) = @_; + + warn "escape_left_angle_bracket\n"; + warn "in: $line"; + + $line =~ s,<,<,g; + + warn "out: $line"; + return $line; +} diff -r 266a7e9b9237 -r 6d3c3db11e72 uh_parser/releaseables.pl --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/uh_parser/releaseables.pl Wed Mar 03 16:51:26 2010 +0000 @@ -0,0 +1,55 @@ +# Copyright (c) 2009 Symbian Foundation Ltd +# This component and the accompanying materials are made available +# under the terms of the License "Eclipse Public License v1.0" +# which accompanies this distribution, and is available +# at the URL "http://www.eclipse.org/legal/epl-v10.html". +# +# Initial Contributors: +# Symbian Foundation Ltd - initial contribution. +# +# Contributors: +# +# Description: +# Extract releaseable (whatlog) information from Raptor log files + +use strict; +use releaseables; +use FindBin; +use lib $FindBin::Bin; +use XML::SAX; +use RaptorSAXHandler; +use Getopt::Long; + +our $basedir = '.'; +my $help = 0; +GetOptions(( + 'basedir=s' => \$basedir, + 'help!' => \$help +)); +my @logfiles = @ARGV; + +$help = 1 if (!@logfiles); + +if ($help) +{ + print "Extract releaseable (whatlog) information from Raptor log files\n"; + print "Usage: perl releaseables.pl [OPTIONS] FILE1 FILE2 ...\n"; + print "where OPTIONS are:\n"; + print "\t--basedir=DIR Generate output under DIR (defaults to current dir)\n"; + exit(0); +} + +my $releaseablesdir = "$::basedir/releaseables"; +$releaseablesdir =~ s,/,\\,g; # this is because rmdir doens't cope correctly with the forward slashes +system("rmdir /S /Q $releaseablesdir") if (-d "$releaseablesdir"); +mkdir("$releaseablesdir"); + +my $saxhandler = RaptorSAXHandler->new(); +$saxhandler->add_observer('releaseables', $releaseables::reset_status); + +my $parser = XML::SAX::ParserFactory->parser(Handler=>$saxhandler); +for (@logfiles) +{ + $parser->parse_uri($_); +} + diff -r 266a7e9b9237 -r 6d3c3db11e72 uh_parser/releaseables.pm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/uh_parser/releaseables.pm Wed Mar 03 16:51:26 2010 +0000 @@ -0,0 +1,292 @@ +# Copyright (c) 2009 Symbian Foundation Ltd +# This component and the accompanying materials are made available +# under the terms of the License "Eclipse Public License v1.0" +# which accompanies this distribution, and is available +# at the URL "http://www.eclipse.org/legal/epl-v10.html". +# +# Initial Contributors: +# Symbian Foundation Ltd - initial contribution. +# +# Contributors: +# +# Description: +# Raptor parser module. +# Extract releaseable (whatlog) information + +package releaseables; + +use strict; + +our $reset_status = {}; +my $buildlog_status = {}; +my $whatlog_status = {}; +my $bitmap_status = {}; +my $resource_status = {}; +my $build_status = {}; +my $export_status = {}; +my $stringtable_status = {}; +my $archive_status = {}; +my $archive_member_status = {}; +my $whatlog_default_status = {}; + +$reset_status->{name} = 'reset_status'; +$reset_status->{next_status} = {buildlog=>$buildlog_status}; + +$buildlog_status->{name} = 'buildlog_status'; +$buildlog_status->{next_status} = {whatlog=>$whatlog_status}; +$buildlog_status->{on_start} = 'releaseables::on_start_buildlog'; + +$whatlog_status->{name} = 'whatlog_status'; +$whatlog_status->{next_status} = {bitmap=>$bitmap_status, resource=>$resource_status, build=>$build_status, export=>$export_status, stringtable=>$stringtable_status, archive=>$archive_status, '?default?'=>$whatlog_default_status}; +$whatlog_status->{on_start} = 'releaseables::on_start_whatlog'; +$whatlog_status->{on_end} = 'releaseables::on_end_whatlog'; + +$bitmap_status->{name} = 'bitmap_status'; +$bitmap_status->{next_status} = {}; +$bitmap_status->{on_start} = 'releaseables::on_start_bitmap'; +$bitmap_status->{on_end} = 'releaseables::on_end_whatlog_subtag'; +$bitmap_status->{on_chars} = 'releaseables::on_chars_whatlog_subtag'; + +$resource_status->{name} = 'resource_status'; +$resource_status->{next_status} = {}; +$resource_status->{on_start} = 'releaseables::on_start_resource'; +$resource_status->{on_end} = 'releaseables::on_end_whatlog_subtag'; +$resource_status->{on_chars} = 'releaseables::on_chars_whatlog_subtag'; + +$build_status->{name} = 'build_status'; +$build_status->{next_status} = {}; +$build_status->{on_start} = 'releaseables::on_start_build'; +$build_status->{on_end} = 'releaseables::on_end_whatlog_subtag'; +$build_status->{on_chars} = 'releaseables::on_chars_whatlog_subtag'; + +$stringtable_status->{name} = 'stringtable_status'; +$stringtable_status->{next_status} = {}; +$stringtable_status->{on_start} = 'releaseables::on_start_stringtable'; +$stringtable_status->{on_end} = 'releaseables::on_end_whatlog_subtag'; +$stringtable_status->{on_chars} = 'releaseables::on_chars_whatlog_subtag'; + +$archive_status->{name} = 'archive_status'; +$archive_status->{next_status} = {member=>$archive_member_status}; + +$archive_member_status->{name} = 'archive_member_status'; +$archive_member_status->{next_status} = {}; +$archive_member_status->{on_start} = 'releaseables::on_start_archive_member'; +$archive_member_status->{on_end} = 'releaseables::on_end_whatlog_subtag'; +$archive_member_status->{on_chars} = 'releaseables::on_chars_whatlog_subtag'; + +$export_status->{name} = 'export_status'; +$export_status->{next_status} = {}; +$export_status->{on_start} = 'releaseables::on_start_export'; + +$whatlog_default_status->{name} = 'whatlog_default_status'; +$whatlog_default_status->{next_status} = {}; +$whatlog_default_status->{on_start} = 'releaseables::on_start_whatlog_default'; + +my $whatlog_info = {}; +my $curbldinf = 'unknown'; +my $curconfig = 'unknown'; +my $curfiletype = 'unknown'; +my $characters = ''; + +sub on_start_buildlog +{ + +} + +sub on_start_whatlog +{ + my ($el) = @_; + + $whatlog_info = {}; + + my $bldinf = ''; + my $config = ''; + my $attributes = $el->{Attributes}; + for (keys %{$attributes}) + { + #print "reading attribute $_\n"; + if ($attributes->{$_}->{'LocalName'} eq 'bldinf') + { + $bldinf = $attributes->{$_}->{'Value'}; + #print "bldinf=$bldinf\n"; + } + elsif ($attributes->{$_}->{'LocalName'} eq 'config') + { + $config = $attributes->{$_}->{'Value'}; + $config =~ s,\.whatlog$,,; + } + } + + if ($bldinf eq '') + { + print "WARNING: whatlog tag with no bldinf attribute. Skipping\n"; + return; + } + + $curbldinf = $bldinf; + $curconfig = $config; + $whatlog_info->{$curbldinf} = {} if (!defined $whatlog_info->{$curbldinf}); + $whatlog_info->{$curbldinf}->{$curconfig} = {} if (!defined $whatlog_info->{$curbldinf}->{$curconfig}); +} + +sub on_start_whatlog_subtag +{ + my ($ft) = @_; + + $curfiletype = $ft; + $characters = ''; + $whatlog_info->{$curbldinf}->{$curconfig}->{$curfiletype} = [] if (! defined $whatlog_info->{$curbldinf}->{$curconfig}->{$curfiletype}); +} + +sub on_chars_whatlog_subtag +{ + my ($ch) = @_; + + $characters .= $ch->{Data}; + + #print "characters is now -->$characters<--\n"; +} + +sub on_end_whatlog_subtag +{ + $characters = normalize_filepath($characters); + + push(@{$whatlog_info->{$curbldinf}->{$curconfig}->{$curfiletype}}, $characters); + + $curfiletype = 'unknown'; + $characters = ''; +} + +sub on_start_bitmap +{ + on_start_whatlog_subtag('bitmap'); +} + +sub on_start_resource +{ + on_start_whatlog_subtag('resource'); +} + +sub on_start_build +{ + on_start_whatlog_subtag('build'); +} + +sub on_start_stringtable +{ + on_start_whatlog_subtag('stringtable'); +} + +sub on_start_archive_member +{ + on_start_whatlog_subtag('export'); +} + +sub on_start_export +{ + my ($el) = @_; + + $whatlog_info->{$curbldinf}->{$curconfig}->{export} = [] if (! defined $whatlog_info->{$curbldinf}->{$curconfig}->{export}); + + my $destination = ''; + my $attributes = $el->{Attributes}; + for (keys %{$attributes}) + { + #print "reading attribute $_\n"; + if ($attributes->{$_}->{'LocalName'} eq 'destination') + { + $destination = $attributes->{$_}->{'Value'}; + #print "destination=$destination\n"; + last; + } + } + + if ($destination eq '') + { + print "WARNING: export tag with no destination attribute. Skipping\n"; + return; + } + + $destination = normalize_filepath($destination); + + push(@{$whatlog_info->{$curbldinf}->{$curconfig}->{export}}, $destination); +} + +sub on_end_whatlog +{ + my $unknown_counter = 0; + + for my $bldinf (keys %{$whatlog_info}) + { + for my $config (keys %{$whatlog_info->{$bldinf}}) + { + my $normalized = lc($bldinf); + $normalized =~ s,^[A-Za-z]:,,; + $normalized =~ s,[\\],/,g; + + $normalized =~ m,^/sf/([^/]+)/([^/]+)/,; + my $layer = $1; + my $package = $2; + + mkdir("$::basedir/releaseables/$layer"); + mkdir("$::basedir/releaseables/$layer/$package"); + + my $filename = "$::basedir/releaseables/$layer/$package/info.tsv"; + + print "Writing info file $filename\n" if (!-f$filename); + open(FILE, ">>$filename"); + + for my $filetype (keys %{$whatlog_info->{$bldinf}->{$config}}) + { + for (sort(@{$whatlog_info->{$bldinf}->{$config}->{$filetype}})) + { + print FILE "$_\t$filetype\t$config\n"; + } + } + + close(FILE); + } + } +} + +sub normalize_filepath +{ + my ($filepath) = @_; + + if ($filepath =~ m,[^\s^\r^\n]+(.*)[\r\n]+(.*)[^\s^\r^\n]+,) + { + print "WARNING: file path string extends over multiple line: $filepath. Removing all NL's and CR's\n"; + } + + # strip all CR's and NL's + $filepath =~ s,[\r\n],,g; + + # strip all whitespaces at string start/end + $filepath =~ s,^\s+,,g; + $filepath =~ s,\s+$,,g; + + # remove drive letter and colon from the beginning of the string + $filepath =~ s,^[A-Za-z]:,,; + + # normalize slashes + $filepath =~ s,\\,/,g; + $filepath =~ s,//,/,g; + + if ($filepath !~ m,^/epoc32/,i) + { + print "WARNING: file '$filepath' doesn't seem valid. Writing to info file anyway\n"; + } + + return $filepath; +} + +sub on_start_whatlog_default +{ + my ($el) = @_; + + my $tagname = $el->{LocalName}; + + print "WARNING: unsupported tag '$tagname' in context\n"; +} + +1; \ No newline at end of file diff -r 266a7e9b9237 -r 6d3c3db11e72 uh_parser/truclean.pl --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/uh_parser/truclean.pl Wed Mar 03 16:51:26 2010 +0000 @@ -0,0 +1,110 @@ +# Copyright (c) 2009 Symbian Foundation Ltd +# This component and the accompanying materials are made available +# under the terms of the License "Eclipse Public License v1.0" +# which accompanies this distribution, and is available +# at the URL "http://www.eclipse.org/legal/epl-v10.html". +# +# Initial Contributors: +# Symbian Foundation Ltd - initial contribution. +# +# Contributors: +# +# Description: +# Extracts output text in context which doesn't belong to 's + +use strict; +use Getopt::Long; + +my $RELEASEABLES_DIR = "/releaseables"; + +my $releaseablesdir = ""; +my $packageexpr = ''; +my $help = 0; +GetOptions(( + 'packageexpr:s' => \$packageexpr, + 'releaseablesdir:s' => \$RELEASEABLES_DIR, + 'help!' => \$help +)); + +$packageexpr =~ m,([^/^\\]+)[/\\]([^/^\\]+),; +my $layer_expr = $1; +my $package_expr = $2; +$help = 1 if (!$layer_expr or !$package_expr); + +if ($help) +{ + print "Extracts text which doesn't belong to recipes from a raptor log file\n"; + print "Usage: perl truclean.pl --packageexpr=LAYER_EXPR/PACKAGE_EXPR [OPTIONS]\n"; + print "where:\n"; + print "\tLAYER_EXPR can be * or the name of a layer\n"; + print "\tPACKAGE_EXPR can be * or the name of a package\n"; + print "and OPTIONS are:\n"; + print "\t--releaseablesdir=DIR Use DIR as the root of the releaseables dir (default: $RELEASEABLES_DIR\n"; + exit(0); +} + +$RELEASEABLES_DIR = $releaseablesdir if ($releaseablesdir); + +my @layers = (); +if ($layer_expr eq '*') +{ + opendir(DIR, $RELEASEABLES_DIR); + @layers = readdir(DIR); + closedir(DIR); + @layers = grep(!/^\.\.?$/, @layers); +} +else +{ + push(@layers, $layer_expr); +} +#for (@layers) {print "$_\n"}; + +for my $layer (@layers) +{ + my @packages = (); + if ($package_expr eq '*') + { + opendir(DIR, "$RELEASEABLES_DIR/$layer"); + @packages = readdir(DIR); + closedir(DIR); + @packages = grep(!/^\.\.?$/, @packages); + } + else + { + push(@packages, $package_expr); + } + #for (@pacakges) {print "$_\n"}; + + for my $package (@packages) + { + print "Processing package $layer/$package...\n"; + + open(FILE, "$RELEASEABLES_DIR/$layer/$package/info.tsv"); + while () + { + my $line = $_; + + if ($line =~ m,([^\t]*)\t([^\t]*)\t([^\t]*),) + { + my $file = $1; + my $type = $2; + my $config = $3; + + if (-f $file) + { + print "removing file: '$file'\n"; + unlink($file); + } + else + { + print "WARNING: file '$file' doesn't exist.\n"; + } + } + else + { + print "WARNING: line '$line' doesn't match the expected tab-separated pattern\n"; + } + } + close(FILE); + } +} \ No newline at end of file diff -r 266a7e9b9237 -r 6d3c3db11e72 uh_parser/uh.pl --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/uh_parser/uh.pl Wed Mar 03 16:51:26 2010 +0000 @@ -0,0 +1,403 @@ +# Copyright (c) 2009 Symbian Foundation Ltd +# This component and the accompanying materials are made available +# under the terms of the License "Eclipse Public License v1.0" +# which accompanies this distribution, and is available +# at the URL "http://www.eclipse.org/legal/epl-v10.html". +# +# Initial Contributors: +# Symbian Foundation Ltd - initial contribution. +# +# Contributors: +# +# Description: +# Unite and HTML-ize Raptor log files + +use strict; +use FindBin; +use lib $FindBin::Bin; +use RaptorError; +use RaptorWarning; +use RaptorInfo; +use RaptorUnreciped; +use RaptorRecipe; + +use XML::SAX; +use RaptorSAXHandler; +use Getopt::Long; + +our $raptorbitsdir = 'raptorbits'; +our $basedir = ''; +my $outputdir = "html"; +our $raptor_config = 'dummy_config'; +our $current_log_file = ''; +my $help = 0; +GetOptions(( + 'basedir=s' => \$basedir, + 'help!' => \$help +)); +my @logfiles = @ARGV; + +$help = 1 if (!@logfiles); + +if ($help) +{ + print "Unite and HTML-ize Raptor log files.\n"; + print "Usage: perl uh.pl [OPTIONS] FILE1 FILE2 ...\n"; + print "where OPTIONS are:\n"; + print "\t--basedir=DIR Generate output under DIR (defaults to current dir)\n"; + exit(0); +} + +if ($basedir) +{ + $raptorbitsdir = "$basedir/raptorbits"; + $outputdir = "$basedir/html"; +} +mkdir($basedir) if (!-d$basedir); + +$raptorbitsdir =~ s,/,\\,g; # this is because rmdir doens't cope correctly with the forward slashes + +system("rmdir /S /Q $raptorbitsdir") if (-d $raptorbitsdir); +mkdir($raptorbitsdir); +#print "Created dir $raptorbitsdir.\n"; + +# create empty summary file anyway +open(SUMMARY, ">$raptorbitsdir/summary.csv"); +close(SUMMARY); + +my $saxhandler = RaptorSAXHandler->new(); +$saxhandler->add_observer('RaptorError', $RaptorError::reset_status); +$saxhandler->add_observer('RaptorWarning', $RaptorWarning::reset_status); +$saxhandler->add_observer('RaptorInfo', $RaptorInfo::reset_status); +$saxhandler->add_observer('RaptorUnreciped', $RaptorUnreciped::reset_status); +$saxhandler->add_observer('RaptorRecipe', $RaptorRecipe::reset_status); + +our $allbldinfs = {}; + +my $parser = XML::SAX::ParserFactory->parser(Handler=>$saxhandler); +for (@logfiles) +{ + print "Reading file: $_\n"; + $current_log_file = $_; + $parser->parse_uri($_); +} + +my @allpackages = distinct_packages($allbldinfs); + +print "Generating HTML...\n"; + +system("rd /S /Q $outputdir") if (-d $outputdir); +mkdir ($outputdir); + +my $raptor_errors = {}; +my $raptor_warnings = {}; +my $raptor_unreciped = {}; +my $general_failures_num_by_severity = {}; +my $general_failures_by_category_severity = {}; +my $recipe_failures_num_by_severity = {}; +my $recipe_failures_by_package_severity = {}; +#my $severities = {}; +my @severities = ('critical', 'major', 'minor', 'unknown'); + +# READ SUMMARY.CSV FILE +my $csv_file = "$raptorbitsdir/summary.csv"; +my $csv_linenum = 0; +open(CSV, $csv_file); +while() +{ + $csv_linenum ++; + my $line = $_; + + if ($line =~ /([^,]*),([^,]*),([^,]*),([^,]*),([^,]*),([^,]*),([^,]*),([^,]*),([^,]*),([^,]*)/) + { + my $failure = {}; + $failure->{category} = $1; + $failure->{subcategory} = $2; + $failure->{severity} = $3; + $failure->{config} = $4; + $failure->{component} = $5; + $failure->{mmp} = $6; + $failure->{phase} = $7; + $failure->{recipe} = $8; + $failure->{file} = $9; + $failure->{linenum} = $10; + + my $failure_package = ''; + + if (!$failure->{category}) + { + print "WARNING: summary line without a category at $csv_file line $csv_linenum. Skipping\n"; + next; + } + + if ($failure->{category} =~ m,^recipe_failure$,i and !$failure->{component}) + { + print "WARNING: recipe_failure with component field empty at $csv_file line $csv_linenum. Skipping\n"; + next; + } + if ($failure->{component}) + { + if ($failure->{component} =~ m,/((os|mw|app|tools|ostools|adaptation)/[^/]*),) + { + $failure_package = $1; + } + else + { + print "WARNING: summary line with wrong component path at $csv_file line $csv_linenum. Skipping\n"; + next; + } + } + + $failure->{subcategory} = 'uncategorized' if (!$failure->{subcategory}); + $failure->{severity} = 'unknown' if (!$failure->{severity}); + $failure->{mmp} = '-' if (!$failure->{mmp}); + + # populate severities dynamically. + #$severities->{$failure->{severity}} = 1; + + # put failure items into their category container + if ($failure->{category} =~ /^raptor_(error|warning|unreciped)$/i) + { + $general_failures_num_by_severity->{$failure->{category}} = {} if (!defined $general_failures_num_by_severity->{$failure->{category}}); + my $general_failure = $general_failures_num_by_severity->{$failure->{category}}; + + if (!defined $general_failure->{$failure->{severity}}) + { + $general_failure->{$failure->{severity}} = 1; + } + else + { + $general_failure->{$failure->{severity}} ++; + } + + $general_failures_by_category_severity->{$failure->{category}} = {} if (!defined $general_failures_by_category_severity->{$failure->{category}}); + $general_failures_by_category_severity->{$failure->{category}}->{$failure->{severity}} = [] if (!defined $general_failures_by_category_severity->{$failure->{category}}->{$failure->{severity}}); + push(@{$general_failures_by_category_severity->{$failure->{category}}->{$failure->{severity}}}, $failure); + } + elsif ($failure->{category} =~ /^recipe_failure$/i) + { + $recipe_failures_num_by_severity->{$failure_package} = {} if (!defined $recipe_failures_num_by_severity->{$failure_package}); + my $package_failure = $recipe_failures_num_by_severity->{$failure_package}; + + if (!defined $package_failure->{$failure->{severity}}) + { + $package_failure->{$failure->{severity}} = 1; + } + else + { + $package_failure->{$failure->{severity}} ++; + } + + $recipe_failures_by_package_severity->{$failure_package} = {} if (!defined $recipe_failures_by_package_severity->{$failure_package}); + $recipe_failures_by_package_severity->{$failure_package}->{$failure->{severity}} = [] if (!defined $recipe_failures_by_package_severity->{$failure_package}->{$failure->{severity}}); + push(@{$recipe_failures_by_package_severity->{$failure_package}->{$failure->{severity}}}, $failure); + } + } + else + { + print "WARNING: line does not match expected format at $csv_file line $csv_linenum. Skipping\n"; + } +} +close(CSV); + +# PRINT HTML SUMMARY +my $aggregated_html = "$outputdir/index.html"; +open(AGGREGATED, ">$aggregated_html"); +print AGGREGATED "RAPTOR BUILD SUMMARY
\n"; + +print AGGREGATED "
GENERAL FAILURES
\n"; +print AGGREGATED "\n"; +my $tableheader = ""; +for (@severities) { $tableheader .= ""; } +$tableheader .= ""; +print AGGREGATED "$tableheader\n"; +for my $category (keys %{$general_failures_num_by_severity}) +{ + print_category_specific_summary($category, $general_failures_by_category_severity->{$category}); + my $categoryline = ""; + for (@severities) + { + my $failuresbyseverity = 0; + $failuresbyseverity = $general_failures_num_by_severity->{$category}->{$_} if (defined $general_failures_num_by_severity->{$category}->{$_}); + $categoryline .= ""; + } + $categoryline .= ""; + print AGGREGATED "$categoryline\n"; +} +print AGGREGATED "
category$_
$category$failuresbyseverity
\n"; +print AGGREGATED "
\n"; + +print AGGREGATED "
PACKAGE-SPECIFIC FAILURES
\n"; +print AGGREGATED "\n"; +$tableheader = ""; +for (@severities) { $tableheader .= ""; } +$tableheader .= ""; +print AGGREGATED "$tableheader\n"; +for my $package (@allpackages) +{ + if (defined $recipe_failures_num_by_severity->{$package}) + { + print_package_specific_summary($package, $recipe_failures_by_package_severity->{$package}); + my $packagesummaryhtml = $package; + $packagesummaryhtml =~ s,/,_,; + $packagesummaryhtml .= ".html"; + my $packageline = ""; + for (@severities) + { + my $failuresbyseverity = 0; + $failuresbyseverity = $recipe_failures_num_by_severity->{$package}->{$_} if (defined $recipe_failures_num_by_severity->{$package}->{$_}); + $packageline .= ""; + } + $packageline .= ""; + print AGGREGATED "$packageline\n"; + } + else + { + my $packageline = ""; + for (@severities) { $packageline .= ""; } + $packageline .= ""; + print AGGREGATED "$packageline\n"; + } +} +print AGGREGATED "
package$_
$package$failuresbyseverity
$package0
\n"; +close(AGGREGATED); + +translate_detail_files_to_html(); + +print "OK, done. Please open $outputdir/index.html.\n"; + + +sub print_category_specific_summary +{ + my ($category, $failures_by_severity) = @_; + + my $filenamebase = $category; + $filenamebase =~ s,/,_,; + + open(SPECIFIC, ">$outputdir/$filenamebase.html"); + print SPECIFIC "FAILURES FOR CATEGORY $category
\n"; + + for my $severity (@severities) + { + if (defined $failures_by_severity->{$severity}) + { + print SPECIFIC "
".uc($severity)."
\n"; + print SPECIFIC "\n"; + # $subcategory, $severity, $mmp, $phase, $recipe, $file, $line + my $tableheader = ""; + print SPECIFIC "$tableheader\n"; + + for my $failure (@{$failures_by_severity->{$severity}}) + { + my $failureline = ""; + $failureline .= ""; + $failureline .= ""; + $failureline .= ""; + print SPECIFIC "$failureline\n"; + } + + print SPECIFIC "
categorylog filelog snippet
$failure->{subcategory}$failure->{config}item $failure->{linenum}
\n"; + print SPECIFIC "
\n"; + } + } + + close(SPECIFIC); +} + +sub print_package_specific_summary +{ + my ($package, $failures_by_severity) = @_; + + my $filenamebase = $package; + $filenamebase =~ s,/,_,; + + open(SPECIFIC, ">$outputdir/$filenamebase.html"); + print SPECIFIC "FAILURES FOR PACKAGE $package
\n"; + + for my $severity (@severities) + { + if (defined $failures_by_severity->{$severity}) + { + print SPECIFIC "
".uc($severity)."
\n"; + print SPECIFIC "\n"; + # $subcategory, $severity, $mmp, $phase, $recipe, $file, $line + my $tableheader = ""; + print SPECIFIC "$tableheader\n"; + + for my $failure (@{$failures_by_severity->{$severity}}) + { + my $failureline = ""; + $failureline .= ""; + $failureline .= ""; + $failureline .= ""; + $failureline .= ""; + $failureline .= ""; + $failureline .= ""; + print SPECIFIC "$failureline\n"; + } + + print SPECIFIC "
categoryconfigurationmmpphaserecipelog snippet
$failure->{subcategory}$failure->{config}$failure->{mmp}$failure->{phase}$failure->{recipe}item $failure->{linenum}
\n"; + print SPECIFIC "
\n"; + } + } + + close(SPECIFIC); +} + +sub translate_detail_files_to_html +{ + opendir(DIR, $raptorbitsdir); + my @failurefiles = readdir(DIR); + closedir(DIR); + @failurefiles = grep(/\.txt$/, @failurefiles); + + for my $file (@failurefiles) + { + $file =~ /(.*)\.txt$/; + my $filenamebase = $1; + + my $filecontent = ''; + open(FILE, "$raptorbitsdir/$file"); + { + local $/=undef; + $filecontent = ; + } + close(FILE); + + $filecontent =~ s,---(failure_item_\d+)---,---$1---,g; + $filecontent = "
$filecontent
"; + + open(FILE, ">$outputdir/$filenamebase\_failures.html"); + print FILE $filecontent; + close(FILE); + } +} + +sub distinct_packages +{ + my ($allbldinfs) = @_; + + my $allpackages = {}; + + for my $bldinf (keys %{$allbldinfs}) + { + # normalize bldinf path + $bldinf = lc($bldinf); + $bldinf =~ s,^[A-Za-z]:,,; + $bldinf =~ s,[\\],/,g; + + my $package = ''; + if ($bldinf =~ m,/((os|mw|app|tools|ostools|adaptation)/[^/]*),) + { + $package = $1; + } + else + { + print "WARNING: can't understand bldinf attribute of recipe: $bldinf. Won't dump to failed recipes file.\n"; + } + + $allpackages->{$package} = 1; + } + + return sort {$a cmp $b} keys %{$allpackages}; +} \ No newline at end of file