--- a/common/build.postbuild.xml Thu Mar 11 13:20:26 2010 +0000
+++ b/common/build.postbuild.xml Thu Mar 11 13:23:18 2010 +0000
@@ -402,25 +402,6 @@
</target>
<target name="sf-run-analysis-raptor">
- <echo message="Preprocessing *_compile.log files"/>
- <delete file="${build.log.dir}/analysis/${build.id}_preprocess.log"/>
- <for param="logfile">
- <path>
- <fileset dir="${build.log.dir}">
- <include name="*_compile.log"/>
- <exclude name="*build_check_compile.log"/>
- </fileset>
- </path>
- <sequential>
- <propertyregex override="yes" property="preprocessedlogfile" input="@{logfile}" regexp=".*[\\/](.*)_compile\.log" replace="\1_compile_preprocessed.log"/>
- <echo message="Preprocessing @{logfile}..."/>
- <exec executable="perl" dir="${sf.common.config.dir}/tools/raptor" failonerror="false" input="@{logfile}" output="${build.log.dir}/analysis/${preprocessedlogfile}" errorProperty="@{logfile}" >
- <arg value="${sf.common.config.dir}/tools/raptor/preprocess_log.pl"/>
- </exec>
- <echo file="${build.log.dir}/analysis/${build.id}_preprocess.log" append="true" message="${@{logfile}}${line.separator}"/>
- </sequential>
- </for>
-
<!-- Cook the processed raptor logs to produce something in the right format for the BRAG system -->
<mkdir dir="${build.log.dir}/summary/"/>
<!-- exec executable="perl" output="${build.log.dir}/summary/sbs_BRAG.xml" logError="yes" failonerror="false">
@@ -428,21 +409,22 @@
<arg value="${build.log.dir}/analysis/*_compile_preprocessed.log"/>
</exec -->
- <echo message="Extracting whatlog information from *whatlog*_compile_preprocessed.log files"/>
- <apply executable="perl" dir="${sf.common.config.dir}/tools/raptor" failonerror="false" output="${build.log.dir}/analysis/${build.id}_whatlog.log" parallel="true">
+ <echo message="Extracting whatlog information from *whatlog*_compile.log files"/>
+ <apply executable="perl" dir="${build.drive}/utilities/uh_parser" failonerror="false" output="${build.log.dir}/analysis/${build.id}_whatlog.log" parallel="true">
<arg value="releaseables.pl"/>
<arg value="--basedir=${build.log.dir}"/>
- <fileset dir="${build.log.dir}/analysis">
- <include name="*whatlog*_compile_preprocessed.log"/>
+ <fileset dir="${build.log.dir}">
+ <include name="*whatlog*_compile.log"/>
</fileset>
</apply>
- <echo message="Extracting error information from *_compile_preprocessed.log files"/>
- <apply executable="perl" dir="${sf.common.config.dir}/tools/raptor" failonerror="false" output="${build.log.dir}/analysis/${build.id}_raptorparse.log" parallel="true">
+ <echo message="Running UH parser on *_compile.log files"/>
+ <apply executable="perl" dir="${build.drive}/utilities/uh_parser" failonerror="false" output="${build.log.dir}/analysis/${build.id}_raptorparse.log" parallel="true">
<arg value="uh.pl"/>
<arg value="--basedir=${build.log.dir}"/>
- <fileset dir="${build.log.dir}/analysis">
- <include name="*_compile_preprocessed.log"/>
+ <fileset dir="${build.log.dir}">
+ <include name="*_compile.log"/>
+ <exclude name="*build_check_compile.log"/>
</fileset>
</apply>
--- a/common/build.xml Thu Mar 11 13:20:26 2010 +0000
+++ b/common/build.xml Thu Mar 11 13:23:18 2010 +0000
@@ -230,7 +230,7 @@
</target>
<target name="sf-prebuild" depends="sf-prep,sf-prebuild-noprep"/>
- <target name="sf-prebuild-noprep" depends="sf-prebuild-announce,sf-diamonds-connect,sf-diamonds-envinfo,sf-diamonds-tag-build,sf-getenvs,sf-syncsource,sf-diamondize-bom">
+ <target name="sf-prebuild-noprep" depends="sf-prebuild-announce,sf-diamonds-connect,sf-diamonds-envinfo,sf-diamonds-tag-build,sf-get-utils,sf-getenvs,sf-syncsource,sf-diamondize-bom">
<stopwatch name="sf-prebuild" action="elapsed"/>
</target>
@@ -310,6 +310,18 @@
</exec>
<echo message="${sf.job.bom.project.repo},build/config,${sf.job.bom.project.checksum}" file="${build.drive}/output/logs/BOM/project.csv"/>
</target>
+
+ <target name="sf-get-utils">
+ <stopwatch name="sf-get-utils"/>
+ <echo message="Cloning utilities repository to ${build.drive}/utilities"/>
+ <exec executable="hg">
+ <arg value="clone"/>
+ <arg value="-rdefault"/>
+ <arg value="http://developer.symbian.org/oss/MCL/utilities"/>
+ <arg value="${build.drive}/utilities"/>
+ </exec>
+ <stopwatch name="sf-get-utils" action="elapsed"/>
+ </target>
<target name="sf-getenvs">
<stopwatch name="sf-getenvs"/>
--- a/common/tools/envinfo.pl Thu Mar 11 13:20:26 2010 +0000
+++ b/common/tools/envinfo.pl Thu Mar 11 13:23:18 2010 +0000
@@ -135,6 +135,25 @@
}
push @environment_info, {name=>'GCC4.4.1', version=>$gcc441_ver};
+# Helium
+my $helium_ver = 'N.A.';
+if ($ENV{'HELIUM_HOME'} && -f "$ENV{'HELIUM_HOME'}\\config\\version.txt")
+{
+ open(VERSION, "$ENV{'HELIUM_HOME'}\\config\\version.txt");
+ my $line = '';
+ while ($line = <VERSION>)
+ {
+ $helium_ver = $1 if ($line =~ /^helium\.version=(.*)/);
+ }
+ close(VERSION);
+}
+push @environment_info, {name=>'helium', version=>$helium_ver};
+
+# java
+my $java_ver = 'N.A.';
+my $java_out = `java -version`;
+$java_ver = $1 if ($zip_out =~ /^java version (.*)/m);
+push @environment_info, {name=>'java', version=>$java_ver};
for my $tool_info (@environment_info)
{
--- a/common/tools/raptor/RaptorCommon.pm Thu Mar 11 13:20:26 2010 +0000
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,41 +0,0 @@
-# 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;
--- a/common/tools/raptor/RaptorError.pm Thu Mar 11 13:20:26 2010 +0000
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,170 +0,0 @@
-# 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 <error> 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 = <FILE>;
- $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
--- a/common/tools/raptor/RaptorInfo.pm Thu Mar 11 13:20:26 2010 +0000
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,89 +0,0 @@
-# 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 <info> 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
--- a/common/tools/raptor/RaptorRecipe.pm Thu Mar 11 13:20:26 2010 +0000
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,279 +0,0 @@
-# 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 <recipe> 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 = <FILE>;
- $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
--- a/common/tools/raptor/RaptorSAXHandler.pm Thu Mar 11 13:20:26 2010 +0000
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,108 +0,0 @@
-# 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;
--- a/common/tools/raptor/RaptorUnreciped.pm Thu Mar 11 13:20:26 2010 +0000
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,184 +0,0 @@
-# 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 <buildlog> context which doesn't belong to any <recipe> 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 = <FILE>;
- $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;
--- a/common/tools/raptor/RaptorWarning.pm Thu Mar 11 13:20:26 2010 +0000
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,128 +0,0 @@
-# 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 <warning> 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 = <FILE>;
- $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
--- a/common/tools/raptor/XML/NamespaceSupport.pm Thu Mar 11 13:20:26 2010 +0000
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,565 +0,0 @@
-
-###
-# XML::NamespaceSupport - a simple generic namespace processor
-# Robin Berjon <robin@knowscape.com>
-###
-
-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<xmlns>, C<fatal_errors>, and C<auto_prefix>
-
-If C<xmlns> 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<fatal_errors> 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<auto_prefix> is turned on (it is off by default) when one
-provides a prefix of C<undef> to C<declare_prefix> 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<auto_prefix> 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<fatal_errors>.
-
-=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<fatal_errors>.
-
-=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<fatal_errors>.
-
-=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
-
--- a/common/tools/raptor/XML/SAX.pm Thu Mar 11 13:20:26 2010 +0000
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,379 +0,0 @@
-# $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<XML::SAX::ParserFactory>. 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("<foo/>") 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<XML::SAX::Intro> and for reference, L<XML::SAX::Specification>.
-
-=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<XML::SAX::Base> 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("<tag/>");
- 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<Namespaces> and C<Validation> 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<XML::SAX::Base> for writing SAX Filters and Parsers
-
-L<XML::SAX::PurePerl> for an XML parser written in 100%
-pure perl.
-
-L<XML::SAX::Exception> for details on exception handling
-
-=cut
-
--- a/common/tools/raptor/XML/SAX/Base.pm Thu Mar 11 13:20:26 2010 +0000
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,3164 +0,0 @@
-package XML::SAX::Base;
-
-# version 0.10 - Kip Hampton <khampton@totalcinema.com>
-# version 0.13 - Robin Berjon <robin@knowscape.com>
-# version 0.15 - Kip Hampton <khampton@totalcinema.com>
-# version 0.17 - Kip Hampton <khampton@totalcinema.com>
-# version 0.19 - Kip Hampton <khampton@totalcinema.com>
-# version 0.21 - Kip Hampton <khampton@totalcinema.com>
-# version 0.22 - Robin Berjon <robin@knowscape.com>
-# version 0.23 - Matt Sergeant <matt@sergeant.org>
-# version 0.24 - Robin Berjon <robin@knowscape.com>
-# version 0.25 - Kip Hampton <khampton@totalcinema.com>
-# version 1.00 - Kip Hampton <khampton@totalcinema.com>
-# version 1.01 - Kip Hampton <khampton@totalcinema.com>
-# version 1.02 - Robin Berjon <robin@knowscape.com>
-# version 1.03 - Matt Sergeant <matt@sergeant.org>
-# version 1.04 - Kip Hampton <khampton@totalcinema.com>
-
-#-----------------------------------------------------#
-# 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<NOT> 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<XML::SAX>
-
-=cut
-
--- a/common/tools/raptor/XML/SAX/DocumentLocator.pm Thu Mar 11 13:20:26 2010 +0000
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,134 +0,0 @@
-# $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<new>. 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
-
--- a/common/tools/raptor/XML/SAX/Exception.pm Thu Mar 11 13:20:26 2010 +0000
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,126 +0,0 @@
-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
-
--- a/common/tools/raptor/XML/SAX/Intro.pod Thu Mar 11 13:20:26 2010 +0000
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,407 +0,0 @@
-=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<Attributes> 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<characters()>, 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<lt>?wiggle?E<gt> 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 <URI>.
-
-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 <scriptname>
-
-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
--- a/common/tools/raptor/XML/SAX/ParserDetails.ini Thu Mar 11 13:20:26 2010 +0000
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,4 +0,0 @@
-[XML::SAX::PurePerl]
-http://xml.org/sax/features/namespaces = 1
-
-
--- a/common/tools/raptor/XML/SAX/ParserFactory.pm Thu Mar 11 13:20:26 2010 +0000
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,232 +0,0 @@
-# $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("<foo/>") 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<parser()>, 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 C<require()>d
-and an instance of this package is returned by calling the C<new()>
-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
-
--- a/common/tools/raptor/XML/SAX/PurePerl.pm Thu Mar 11 13:20:26 2010 +0000
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,750 +0,0 @@
-# $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 =~ /^<!/) {
- ($self->CDSect($reader)
- or
- $self->Comment($reader))
- and next;
- }
- elsif ($data =~ /^<\?/) {
- $self->PI($reader) and next;
- }
- elsif ($data =~ /^</) {
- $self->element($reader) and next;
- }
- last;
- }
-
- return 1;
-}
-
-sub CDSect {
- my ($self, $reader) = @_;
-
- my $data = $reader->data(9);
- return 0 unless $data =~ /^<!\[CDATA\[/;
- $reader->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 =~ /</) {
- $self->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 =~ /^<!--/) {
- $reader->move_along(4);
- my $comment_str = '';
- while (1) {
- my $data = $reader->data;
- $self->parser_error("End of data seen while looking for close comment marker", $reader)
- unless length($data);
- 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<slow>. 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
-
--- a/common/tools/raptor/XML/SAX/PurePerl/DTDDecls.pm Thu Mar 11 13:20:26 2010 +0000
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,603 +0,0 @@
-# $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 =~ /^<!ELEMENT/;
- $reader->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 =~ /^<!ATTLIST/) {
- # It's an attlist
-
- $reader->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 =~ /^<!ENTITY/;
- $reader->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 =~ /^<!NOTATION/;
- $reader->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;
--- a/common/tools/raptor/XML/SAX/PurePerl/DebugHandler.pm Thu Mar 11 13:20:26 2010 +0000
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,95 +0,0 @@
-# $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;
--- a/common/tools/raptor/XML/SAX/PurePerl/DocType.pm Thu Mar 11 13:20:26 2010 +0000
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,180 +0,0 @@
-# $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 =~ /^<!DOCTYPE/) {
- $reader->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;
--- a/common/tools/raptor/XML/SAX/PurePerl/EncodingDetect.pm Thu Mar 11 13:20:26 2010 +0000
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,105 +0,0 @@
-# $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;
-
--- a/common/tools/raptor/XML/SAX/PurePerl/Exception.pm Thu Mar 11 13:20:26 2010 +0000
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,67 +0,0 @@
-# $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;
-
--- a/common/tools/raptor/XML/SAX/PurePerl/NoUnicodeExt.pm Thu Mar 11 13:20:26 2010 +0000
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,28 +0,0 @@
-# $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;
--- a/common/tools/raptor/XML/SAX/PurePerl/Productions.pm Thu Mar 11 13:20:26 2010 +0000
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,151 +0,0 @@
-# $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;
--- a/common/tools/raptor/XML/SAX/PurePerl/Reader.pm Thu Mar 11 13:20:26 2010 +0000
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,137 +0,0 @@
-# $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 =~ /</) {
- # assume it's a string
- return XML::SAX::PurePerl::Reader::String->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
--- a/common/tools/raptor/XML/SAX/PurePerl/Reader/NoUnicodeExt.pm Thu Mar 11 13:20:26 2010 +0000
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,25 +0,0 @@
-# $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;
-
--- a/common/tools/raptor/XML/SAX/PurePerl/Reader/Stream.pm Thu Mar 11 13:20:26 2010 +0000
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,84 +0,0 @@
-# $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;
-
--- a/common/tools/raptor/XML/SAX/PurePerl/Reader/String.pm Thu Mar 11 13:20:26 2010 +0000
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,61 +0,0 @@
-# $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;
--- a/common/tools/raptor/XML/SAX/PurePerl/Reader/URI.pm Thu Mar 11 13:20:26 2010 +0000
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,57 +0,0 @@
-# $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;
--- a/common/tools/raptor/XML/SAX/PurePerl/Reader/UnicodeExt.pm Thu Mar 11 13:20:26 2010 +0000
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,23 +0,0 @@
-# $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;
-
--- a/common/tools/raptor/XML/SAX/PurePerl/UnicodeExt.pm Thu Mar 11 13:20:26 2010 +0000
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,22 +0,0 @@
-# $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;
-
--- a/common/tools/raptor/XML/SAX/PurePerl/XMLDecl.pm Thu Mar 11 13:20:26 2010 +0000
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,129 +0,0 @@
-# $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;
--- a/common/tools/raptor/XML/SAX/placeholder.pl Thu Mar 11 13:20:26 2010 +0000
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,1 +0,0 @@
-# ignore me
--- a/common/tools/raptor/preprocess_log.pl Thu Mar 11 13:20:26 2010 +0000
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,111 +0,0 @@
-#!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{<archive.*?[^/]>})
- {
- $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{(<member>)|(</archive>)})
- {
- 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;
-}
--- a/common/tools/raptor/releaseables.pl Thu Mar 11 13:20:26 2010 +0000
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,55 +0,0 @@
-# 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($_);
-}
-
--- a/common/tools/raptor/releaseables.pm Thu Mar 11 13:20:26 2010 +0000
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,292 +0,0 @@
-# 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 <whatlog> context\n";
-}
-
-1;
\ No newline at end of file
--- a/common/tools/raptor/truclean.pl Thu Mar 11 13:20:26 2010 +0000
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,110 +0,0 @@
-# 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 <buildlog> context which doesn't belong to <recipe>'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 (<FILE>)
- {
- 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
--- a/common/tools/raptor/uh.pl Thu Mar 11 13:20:26 2010 +0000
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,403 +0,0 @@
-# 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>)
-{
- $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<br/>\n";
-
-print AGGREGATED "<br/>GENERAL FAILURES<br/>\n";
-print AGGREGATED "<table border='1'>\n";
-my $tableheader = "<tr><th>category</th>";
-for (@severities) { $tableheader .= "<th>$_</th>"; }
-$tableheader .= "</tr>";
-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 = "<tr><td><a href='$category.html'>$category</a></td>";
- for (@severities)
- {
- my $failuresbyseverity = 0;
- $failuresbyseverity = $general_failures_num_by_severity->{$category}->{$_} if (defined $general_failures_num_by_severity->{$category}->{$_});
- $categoryline .= "<td>$failuresbyseverity</td>";
- }
- $categoryline .= "</tr>";
- print AGGREGATED "$categoryline\n";
-}
-print AGGREGATED "</table>\n";
-print AGGREGATED "<br/>\n";
-
-print AGGREGATED "<br/>PACKAGE-SPECIFIC FAILURES<br/>\n";
-print AGGREGATED "<table border='1'>\n";
-$tableheader = "<tr><th>package</th>";
-for (@severities) { $tableheader .= "<th>$_</th>"; }
-$tableheader .= "</tr>";
-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 = "<tr><td><a href='$packagesummaryhtml'>$package</a></td>";
- for (@severities)
- {
- my $failuresbyseverity = 0;
- $failuresbyseverity = $recipe_failures_num_by_severity->{$package}->{$_} if (defined $recipe_failures_num_by_severity->{$package}->{$_});
- $packageline .= "<td>$failuresbyseverity</td>";
- }
- $packageline .= "</tr>";
- print AGGREGATED "$packageline\n";
- }
- else
- {
- my $packageline = "<tr><td>$package</td>";
- for (@severities) { $packageline .= "<td>0</td>"; }
- $packageline .= "</tr>";
- print AGGREGATED "$packageline\n";
- }
-}
-print AGGREGATED "</table>\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<br/>\n";
-
- for my $severity (@severities)
- {
- if (defined $failures_by_severity->{$severity})
- {
- print SPECIFIC "<br/>".uc($severity)."<br/>\n";
- print SPECIFIC "<table border='1'>\n";
- # $subcategory, $severity, $mmp, $phase, $recipe, $file, $line
- my $tableheader = "<tr><th>category</th><th>log file</th><th>log snippet</th></tr>";
- print SPECIFIC "$tableheader\n";
-
- for my $failure (@{$failures_by_severity->{$severity}})
- {
- my $failureline = "<tr><td>$failure->{subcategory}</td>";
- $failureline .= "<td>$failure->{config}</td>";
- $failureline .= "<td><a href='$filenamebase\_failures.html#failure_item_$failure->{linenum}'>item $failure->{linenum}</a></td>";
- $failureline .= "</tr>";
- print SPECIFIC "$failureline\n";
- }
-
- print SPECIFIC "</table>\n";
- print SPECIFIC "<br/>\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<br/>\n";
-
- for my $severity (@severities)
- {
- if (defined $failures_by_severity->{$severity})
- {
- print SPECIFIC "<br/>".uc($severity)."<br/>\n";
- print SPECIFIC "<table border='1'>\n";
- # $subcategory, $severity, $mmp, $phase, $recipe, $file, $line
- my $tableheader = "<tr><th>category</th><th>configuration</th><th>mmp</th><th>phase</th><th>recipe</th><th>log snippet</th></tr>";
- print SPECIFIC "$tableheader\n";
-
- for my $failure (@{$failures_by_severity->{$severity}})
- {
- my $failureline = "<tr><td>$failure->{subcategory}</td>";
- $failureline .= "<td>$failure->{config}</td>";
- $failureline .= "<td>$failure->{mmp}</td>";
- $failureline .= "<td>$failure->{phase}</td>";
- $failureline .= "<td>$failure->{recipe}</td>";
- $failureline .= "<td><a href='$filenamebase\_failures.html#failure_item_$failure->{linenum}'>item $failure->{linenum}</a></td>";
- $failureline .= "</tr>";
- print SPECIFIC "$failureline\n";
- }
-
- print SPECIFIC "</table>\n";
- print SPECIFIC "<br/>\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 = <FILE>;
- }
- close(FILE);
-
- $filecontent =~ s,---(failure_item_\d+)---,<a name="$1">---$1---</a>,g;
- $filecontent = "<pre>$filecontent</pre>";
-
- 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
--- a/sf-package/CompilerCompatibility_props.ant.xml Thu Mar 11 13:20:26 2010 +0000
+++ b/sf-package/CompilerCompatibility_props.ant.xml Thu Mar 11 13:23:18 2010 +0000
@@ -1,6 +1,6 @@
<?xml version="1.0"?>
<project name="COMPILERCOMPATIBILITY-PROPS">
- <property name="sf.spec.baseline.location" value="\\v800020\releases\PDK_3.0.f"/>
+ <property name="sf.spec.baseline.location" value="\\v800020\releases\PDK_3.0.g"/>
</project>
--- a/sf-package/symbian2_props.ant.xml Thu Mar 11 13:20:26 2010 +0000
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,6 +0,0 @@
-<?xml version="1.0"?>
-
-<project name="SYMBIAN2-PROPS">
- <property name="sf.spec.baseline.location" value="\\v800020\releases\PDK_2.0.2"/>
-</project>
-
--- a/sf-package/symbian3_props.ant.xml Thu Mar 11 13:20:26 2010 +0000
+++ b/sf-package/symbian3_props.ant.xml Thu Mar 11 13:23:18 2010 +0000
@@ -1,6 +1,6 @@
<?xml version="1.0"?>
<project name="SYMBIAN3-PROPS">
- <property name="sf.spec.baseline.location" value="\\v800020\releases\PDK_3.0.f"/>
+ <property name="sf.spec.baseline.location" value="\\v800020\releases\PDK_3.0.g"/>
</project>