# HG changeset patch # User Brendan Donegan brendand@symbian.org # Date 1251108097 -3600 # Node ID 0c558d696e7a70e9f71f78e9931d88968452a46f # Parent 57a2cac6870fe9e41a105b10f8fd6db914f0f98b# Parent fcb6057a80094beccbc15368f127c04b7f96a143 Build machine registration files removed. diff -r 57a2cac6870f -r 0c558d696e7a build.xml --- a/build.xml Tue Aug 18 13:48:35 2009 +0100 +++ b/build.xml Mon Aug 24 11:01:37 2009 +0100 @@ -1,17 +1,31 @@ - + - + + + - + + + + + + + + + + + + + - + \ No newline at end of file diff -r 57a2cac6870f -r 0c558d696e7a common/build.postbuild.xml --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/common/build.postbuild.xml Mon Aug 24 11:01:37 2009 +0100 @@ -0,0 +1,641 @@ + + + + [SF-POSTBUILD] + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + ant: antProperties() + data: csv(${sf.spec.sourcesync.sourcespecdir}/${sf.spec.sourcesync.sourcespecfile}, {separator:','}) + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + ant: antProperties() + raptor_summary: csv(${build.log.dir}/raptorbits/summary.csv,{separator:',',headers:[category,subcategory,severity,component,phase,recipe,file,line]}) + files: csv(${build.drive}/output/logs/analysis/tmp_yarp_files.csv,{separator:',',headers:[name,path,localpath]}) + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff -r 57a2cac6870f -r 0c558d696e7a common/build.xml --- a/common/build.xml Tue Aug 18 13:48:35 2009 +0100 +++ b/common/build.xml Mon Aug 24 11:01:37 2009 +0100 @@ -5,7 +5,7 @@ - + @@ -27,16 +27,25 @@ + + + + + + - + - + + + + @@ -54,17 +63,48 @@ - [SF-PREP] + + + + + + + + + + +Insufficient space to run this build to completion. (Was looking for ${sf.drive.space.needed}.) To suppress this check, set the property sf.suppress.drive.space.check to any value. + + + + + + + + + + + [SF-BUILD-ALL] + + [SF-SUMMARY] + + + + + + + + [SF-BUILD-AND-PACK] @@ -85,6 +125,7 @@ + @@ -97,6 +138,7 @@ + @@ -107,103 +149,6 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - @@ -230,6 +175,7 @@ + @@ -257,19 +203,19 @@ - + - + - + - + @@ -328,15 +274,8 @@ - - - - - - - - - + + @@ -352,67 +291,15 @@ - - [SF-POSTBUILD] - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + [SF-TAG-BUILD] + + + ant: antProperties() + + - + @@ -420,46 +307,22 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - + - - - + + + + @@ -502,22 +365,12 @@ - + [SF-BUILD-NOPREP] - - - - - - - - - - - + @@ -539,40 +392,31 @@ - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + - - - - - ant: antProperties() - data: csv(${sf.spec.sourcesync.sourcespecdir}/${sf.spec.sourcesync.sourcespecfile}, {separator:','}) - - - - - @@ -591,12 +435,24 @@ + + + + + + + + + + + + @@ -619,75 +475,6 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - @@ -697,348 +484,34 @@ + + + + + + + + + - + - + - + - - + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ant: antProperties() - raptor_summary: csv(${build.log.dir}/raptorbits/summary.csv,{separator:',',headers:[category,subcategory,severity,component,phase,recipe,file,line]}) - files: csv(${build.drive}/output/logs/analysis/tmp_yarp_files.csv,{separator:',',headers:[name,path,localpath]}) - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff -r 57a2cac6870f -r 0c558d696e7a common/common_props.ant.xml --- a/common/common_props.ant.xml Tue Aug 18 13:48:35 2009 +0100 +++ b/common/common_props.ant.xml Mon Aug 24 11:01:37 2009 +0100 @@ -2,6 +2,8 @@ + + @@ -13,19 +15,20 @@ - + + - - @@ -54,6 +57,7 @@ + @@ -82,12 +86,12 @@ - + - + diff -r 57a2cac6870f -r 0c558d696e7a common/diamonds/config.xml.ftl --- a/common/diamonds/config.xml.ftl Tue Aug 18 13:48:35 2009 +0100 +++ b/common/diamonds/config.xml.ftl Mon Aug 24 11:01:37 2009 +0100 @@ -71,6 +71,7 @@ defer="true"/> + diff -r 57a2cac6870f -r 0c558d696e7a common/diamonds/sf-run-analysis.xml.ftl --- a/common/diamonds/sf-run-analysis.xml.ftl Tue Aug 18 13:48:35 2009 +0100 +++ b/common/diamonds/sf-run-analysis.xml.ftl Mon Aug 24 11:01:37 2009 +0100 @@ -3,19 +3,20 @@ 10 -<#assign raptor_count=0/> +<#assign raptor_errors=0/> +<#assign raptor_warnings=0/> <#list raptor_summary as raptor_item> -<#assign raptor_count=raptor_count+1 /> +<#if raptor_item.category = "raptor_error"> + <#assign raptor_errors=raptor_errors+1 /> +<#elseif raptor_item.category = "raptor_warning"> + <#assign raptor_warnings=raptor_warnings+1 /> + - ${ant['sf.job.totalyarperrors']} - 0 - ${raptor_count} - 0 - 0 - 0 - 0 + ${raptor_errors} + ${raptor_warnings} + ${ant['sf.job.totalyarperrors']} @@ -31,6 +32,11 @@ Raptor summary file:///${ant['sf.spec.publish.networkdrive']}\${ant['sf.spec.job.name']}\builds\${ant['sf.spec.job.codeline']}\${ant['build.id']}\logs\raptorbits\summary.csv + + log + Build Summary + file:///${ant['sf.spec.publish.networkdrive']}\${ant['sf.spec.job.name']}\builds\${ant['sf.spec.job.codeline']}\${ant['build.id']}\build_summary.html + \ No newline at end of file diff -r 57a2cac6870f -r 0c558d696e7a common/diamonds/sf-tag-build.xml.ftl --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/common/diamonds/sf-tag-build.xml.ftl Mon Aug 24 11:01:37 2009 +0100 @@ -0,0 +1,8 @@ + + + + 10 + + ${ant['sf.spec.publish.diamonds.tag']} + + \ No newline at end of file diff -r 57a2cac6870f -r 0c558d696e7a common/sysdefdowngrade/sysdefdowngrade.pl --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/common/sysdefdowngrade/sysdefdowngrade.pl Mon Aug 24 11:01:37 2009 +0100 @@ -0,0 +1,93 @@ +# Copyright (c) 2009 Symbian Foundation Ltd +# This component and the accompanying materials are made available +# under the terms of the License "Eclipse Public License v1.0" +# which accompanies this distribution, and is available +# at the URL "http://www.eclipse.org/legal/epl-v10.html". +# +# Initial Contributors: +# Symbian Foundation Ltd - initial contribution. +# +# Contributors: +# +# Description: +# Extracts output text in context which doesn't belong to 's + +use strict; +use Getopt::Long; + +my $XALAN_PATH = "xalan-j_2_7_1"; +my $XSLT_FILE = "sysdefdowngrade.xsl"; + +my $modelfile = ''; +my $csvsourcesfile = ''; +my $help = 0; +GetOptions(( + 'model=s' => \$modelfile, + 'sources=s' => \$csvsourcesfile, + 'help!' => \$help +)); + +$help = 1 if (!$modelfile or !$csvsourcesfile); + +if ($help) +{ + print "Checks that a model file is not in version 3.0.0. If it is transforms it to a version usable by Raptor\n"; + print "Usage: perl sysdefdowngrade.pl --model=MODELFILE --sources=SOURCESFILE\n\n"; + exit(0); +} + +my $isversion3 = 0; +open(MODELFILE, "$modelfile") or die("Can't open model file $modelfile"); +while() +{ + if ($_ =~ /) +{ + if ($_ =~ m{[^,]*,([\\/]sf[\\/][^,]*),[^,]*,[^,]*,[^,]*}) + { + $param_path = $1; + #print "param_path= $param_path\n"; + last; + } +} +close(SOURCESFILE); + +if (!$param_path) +{ + print "Error: could not determine path parameter from sources file. Quitting.\n"; + exit(0); +} + +$param_path =~ s,\\,/,g; + +my $transformcmd = "java -jar $XALAN_PATH\\xalan.jar -xsl $XSLT_FILE -in $modelfile -out $modelfile.transformed"; +$transformcmd .= " -param Path $param_path"; + +print "Executing: $transformcmd\n"; +system("$transformcmd"); + +# ren doesn't work with forward slashes +$modelfile =~ s,/,\\,g; + +$modelfile =~ m,.*[\\/](.*),; +my $modelfile_name = $1; +print "Executing: ren $modelfile $modelfile_name.orig\n"; +system("ren $modelfile $modelfile_name.orig"); + +print "Executing: ren $modelfile.transformed $modelfile_name\n"; +system("ren $modelfile.transformed $modelfile_name"); diff -r 57a2cac6870f -r 0c558d696e7a common/sysdefdowngrade/sysdefdowngrade.xsl --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/common/sysdefdowngrade/sysdefdowngrade.xsl Mon Aug 24 11:01:37 2009 +0100 @@ -0,0 +1,355 @@ + + + + + os/deviceplatformrelease/foundation_system/system_model + + + + Cannot process this document + + + + + + + + + + + + + + + + + + + + Package definition cannot link another package + + + + + + + + + + + + + + + + + + +

+ + + + + + + + + + + + + + + +

+ + + + +

+ + + + + + + + + + + + + + + + + + + + + + Error: IDs do not match: vs + + + +

+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + Excessive nesting of packages: Ignoring + + + + + + + + + + + + + + + + + + + + + Y + + + plugin + + placeholder + PC + + + + + + + + + + + + + + + + + + + + + + + Y + N + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +

+ + + + + + + + + + +

+ +

+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + +

+ + + + + + + /

+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +]> +]]> + + \ No newline at end of file diff -r 57a2cac6870f -r 0c558d696e7a common/sysdefdowngrade/xalan-j_2_7_1/serializer.jar Binary file common/sysdefdowngrade/xalan-j_2_7_1/serializer.jar has changed diff -r 57a2cac6870f -r 0c558d696e7a common/sysdefdowngrade/xalan-j_2_7_1/xalan.jar Binary file common/sysdefdowngrade/xalan-j_2_7_1/xalan.jar has changed diff -r 57a2cac6870f -r 0c558d696e7a common/sysdefdowngrade/xalan-j_2_7_1/xercesImpl.jar Binary file common/sysdefdowngrade/xalan-j_2_7_1/xercesImpl.jar has changed diff -r 57a2cac6870f -r 0c558d696e7a common/sysdefdowngrade/xalan-j_2_7_1/xml-apis.jar Binary file common/sysdefdowngrade/xalan-j_2_7_1/xml-apis.jar has changed diff -r 57a2cac6870f -r 0c558d696e7a common/templates/source-spec.ant.xml.ftl --- a/common/templates/source-spec.ant.xml.ftl Tue Aug 18 13:48:35 2009 +0100 +++ b/common/templates/source-spec.ant.xml.ftl Mon Aug 24 11:01:37 2009 +0100 @@ -7,6 +7,16 @@ <#assign dollar = "$"/> <#assign count = 0 /> +<#if ("${ant['sf.spec.sourcesync.archive']}")??> + <#if "${ant['sf.spec.sourcesync.archive']}" == "true"> + <#assign fast_sync = true /> + <#else> + <#assign fast_sync = false /> + +<#else> + <#assign fast_sync = false /> + + @@ -19,17 +29,32 @@ - - - + + + <#if fast_sync && ("${pkg_detail.type}"!="tag") > + + + + + + + + + + + + + + + <#else> - + <#if "${pkg_detail.type}"=="tag" > @@ -46,18 +71,18 @@ + + + + + - - - - - diff -r 57a2cac6870f -r 0c558d696e7a common/templates/truclean.ant.xml.ftl --- a/common/templates/truclean.ant.xml.ftl Tue Aug 18 13:48:35 2009 +0100 +++ b/common/templates/truclean.ant.xml.ftl Mon Aug 24 11:01:37 2009 +0100 @@ -6,6 +6,8 @@ <#assign dollar="$"/> <#list data as pkg_detail> + <#if pkg_detail.sysdef != ""> + @@ -25,6 +27,8 @@ <#assign target_depends="${target_depends}"+","+"sf-truclean-${count}"/> <#assign count=count+1/> + + diff -r 57a2cac6870f -r 0c558d696e7a common/tools/BuildEnv.xml --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/common/tools/BuildEnv.xml Mon Aug 24 11:01:37 2009 +0100 @@ -0,0 +1,160 @@ + + + + + + + + + + + + + + + + + ]> + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff -r 57a2cac6870f -r 0c558d696e7a common/tools/BuildEnvXML.pm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/common/tools/BuildEnvXML.pm Mon Aug 24 11:01:37 2009 +0100 @@ -0,0 +1,386 @@ +## @file BuildEnvXML.pm +# @ingroup userscripts clientscripts +# +# Uses information which is defined in the BuildEnvXML.xml to set up a machine +# specific environment, such as path for compilers. +# +# @todo Document this script. +# +# Copyright (c) 2009 Symbian Foundation Ltd. All rights reserved. +# + +package BuildEnvXML; +use strict; +use XML::DOM; +use Cwd; +use Exporter; +our @ISA = qw(Exporter); +our @EXPORT_OK = qw(&getToolEnvironment &getLastErrorMsg &setDbgFile); + +my $sToolEnv = ""; +my $sLocalDir = cwd(); +my $hParser = XML::DOM::Parser->new(); +my $sErrorMsg = ""; +my $toolSummary = ""; +my $execLog = ""; +my $dbgfile = ""; + +sub getToolEnvironment +{ + my $sBuildEnvXML = shift; + my (@aCat) = @_; + + my $hXMLfile = $hParser->parsefile ($sBuildEnvXML); + my $hNodes = $hXMLfile->getElementsByTagName ("context"); + my $hSystemTools, my $hP4Tools, my $hCBRTools, my $sCat, my $nNumNodes; + + if ($dbgfile ne "") + { + print "Logging output to file $dbgfile\n"; + open DBGFILE, ">>$dbgfile" or die; + } + + $sErrorMsg = ""; + $sToolEnv = ""; + my $nCatDepth = scalar(@aCat); + subTrace("Context Depth: $nCatDepth\n"); + my $nLevel = ($nCatDepth-1); + $sCat = $aCat[$nLevel]; + $nNumNodes = $hNodes->getLength; + + my $hParentNode, my $sParentId; + for (my $nI = 0; $nI < $nNumNodes ; $nI++) + { + my $hNode = $hNodes->item ($nI); + my $hId = $hNode->getAttributeNode ("id"); + # Discriminating Stages + subTrace("Context found: \"".$hId->getValue()."\""); + if (uc($hId->getValue()) eq uc($sCat)) + { + subTrace("---> requested! analyzing..."); + $hParentNode = $hNode->getParentNode; + for (;$nLevel>0;$nLevel--) + { + $sParentId = $hParentNode->getAttributeNode("id")->getValue; + subTrace("...from Parent context= ".$sParentId); + if ($sParentId ne $aCat[$nLevel-1]){ $nLevel =-1;} + $hParentNode = $hParentNode->getParentNode; + }; + if (($nLevel>-1)&&($hParentNode->getNodeName ne "context")) + { + $hSystemTools = $hNode->getElementsByTagName ("tool", 0); + $nI = $nNumNodes; + } + } + } + if (!defined $hSystemTools) + { + subTrace("No Stage found for category $sCat !"); + subTrace("Program Terminated."); + exit(0); + } + subTrace(""); + subTrace("----------------------"); + subTrace("Number of $sCat tools: ".$hSystemTools->getLength); + for (my $nI = 0; $nI < $hSystemTools->getLength; $nI++) + { + my $hTool = $hSystemTools->item ($nI); + my $hToolName = $hTool->getAttributeNode ("name"); + subTrace(""); + subTrace("----------------------"); + subTrace("Verifying tool: ".$hToolName->getValue()); + my $isToolNotFound = "true"; + + # Location element + my $hToolLocation = $hTool->getElementsByTagName("location")->item(0); + my $hToolLocationPath, my $hToolLocationStrict; + if (defined $hToolLocation) + { + $hToolLocationPath = $hToolLocation->getAttributeNode("value"); + $hToolLocationStrict = $hToolLocation->getAttributeNode("strict"); + subTrace("Expected Location: ".$hToolLocationPath->getValue()); + } + + # Verify element + my $hToolVerifys = $hTool->getElementsByTagName("verify"); + my $nNumOfVerifys = $hToolVerifys->getLength; + for (my $nZ = 0; $nZ < $nNumOfVerifys; $nZ++) + { + my $hToolVerify = $hTool->getElementsByTagName("verify")->item($nZ); + my $hToolVerifyVersion = $hToolVerify->getAttributeNode("version"); + my $hToolVerifyShowStopper = $hToolVerify->getAttributeNode("showstopper"); + subTrace("Expected Version: ".$hToolVerifyVersion->getValue()); + subPrint("\nVerifying tool: ".$hToolName->getValue()." (version ".$hToolVerifyVersion->getValue().")\n"); + + # Tool checks + my $hToolChecks = $hToolVerify->getElementsByTagName("check"); + my $nNumOfChecks= $hToolChecks->getLength; + my $nCheckNum; + for (my $nJ = 0; $nJ < $nNumOfChecks; $nJ++) + { + $nCheckNum = $nJ+1; + subTrace(""); + subTrace("Check #$nCheckNum:"); + subPrint("Check #$nCheckNum"); + my $hCheck = $hToolChecks->item($nJ); + my $hCheckCmd = $hCheck->getAttributeNode ("execute"); + my $hCheckVar = $hCheck->getAttributeNode ("var"); + my $hCheckValues = $hCheck->getAttributeNode ("values"); + my $hCheckLog = $hCheck->getAttributeNode ("log"); + my $hCheckExclu = $hCheck->getAttributeNode ("exclusive"); + my $hCheckName = $hCheck->getAttributeNode ("name"); + my $hCheckLocator= $hCheck->getAttributeNode ("locator"); + my $hCheckSilent = $hCheck->getAttributeNode ("silent"); + my $sCommand, my $sPattern, my $sToolCmd, my $sOut, my $sOutLocal, my $sCheckName; + my $versionFound = ""; + my $sMsg = ""; + # If Check is exclusive, we will only test this one: + if ($hCheckExclu->getValue() eq "true") + { + $nJ = $nNumOfChecks; + subTrace("This check is exclusive: the remaining checks will not be tested"); + } + # Preparing system command to execute + if (defined $hCheckCmd) + { + $sCommand = $hCheckCmd->getValue(); + if (defined $hToolLocation) + { + $sToolCmd= $hToolLocationPath->getValue(); + $sCommand =~ s/\%location\%/$sToolCmd/g; + } + + # Execute the command + subTrace("Check cmd: ".$sCommand.""); + $sOut = `$sCommand 2>&1`; + $sOutLocal = $sOut; + + # Check if tool cannot be found at expected location + if ($sOut =~/(not\srecognized)|(system\scannot\sfind)/) + { + $sOutLocal = ""; + subTrace("Tool cannot be found at location: ".$hToolLocationPath->getValue()); + subLogErrorMsg($hToolLocationStrict->getValue(), $hToolName->getValue()." CANNOT BE FOUND IN THE EXPECTED LOCATION: " + .$hToolLocationPath->getValue()); + if ($hToolLocationStrict->getValue() eq "true") + { + subTrace("LOCATION STRICT activated, program terminated"); + $sMsg .= "[ERROR] wrong location\n"; + #return ""; + } + else + { + $sMsg .= "[WARNING] wrong location\n"; + } + } + else + { + if ((defined $hToolLocation)&&(defined $hCheckCmd)) + { + $sCommand =~ /(.*)(\\).*$/i; + my $sTmp = $1; + $sTmp =~ s/^\s+//; + $sTmp =~ s/\s+$//; + $sToolEnv = $sTmp.";".$sToolEnv; + subTrace("Tool path OK."); + subTrace("New appender: \"".$sToolEnv."\""); + } + $isToolNotFound = "false"; + } + + # Check if tool can be found with the Environment PATH + $sCommand =~ s/.*(\\)(.*)$/\2/i; + subTrace("Try command from ENV PATH: ".$sCommand); + if (!defined $hCheckName) + { + $sCheckName = $sCommand; + } + else + { + $sCheckName = $hCheckName->getValue(); + } + subPrint(" [$sCheckName]: "); + $sOut = `$sCommand 2>&1`; + if ($sOut =~/(not\srecognized)|(system\scannot\sfind)/) + { + $sOut = ""; + my $type = "ERROR"; + if ($isToolNotFound eq "false") {$type = "WARNING";} + subTrace("$type: ".$hToolName->getValue()." CANNOT BE FOUND IN THE SYSTEM PATH"); + subLogErrorMsg($isToolNotFound, $hToolName->getValue()." CANNOT BE FOUND IN THE SYSTEM PATH"); + $sMsg .= "[$type] NOT FOUND IN SYSTEM PATH\n"; + if ($isToolNotFound eq "true") {next;} + #return ""; + } + } + else + { # Check by verifying an env variable + subPrint(" [".$hCheckVar->getValue()."]: "); + $sCommand = "ECHO %".$hCheckVar->getValue()."%"; + subTrace("Check var: ".$hCheckVar->getValue()); + $sOut = `$sCommand 2>&1`; + $sOut =~ s/^\s*//; + $sOut =~ s/\s*$//; + } + + # Log the output if necessary + if ($hCheckLog->getValue() eq "true") + { + subTrace("command: $sCommand"); + subTrace("logged output: "); + subLog("Verifying \"".$hToolName->getValue()." [version ".$hToolVerifyVersion->getValue(). + "]\" -- check #$nCheckNum:"); + subLog("Executing: $sCommand"); + subLog($sOut); + } + + # Perform the check against given values + if (defined $hCheckValues) + { + my $sOutCopy = $sOut; + my $bResultOk = "false"; + $sPattern = $hCheckValues->getValue(); + if (defined $hCheckLocator) + { + my $sLocator = $hCheckLocator->getValue(); + $sOut =~ s/.*$sLocator.*/\1/msi; + subTrace("Searching in locator: ".$sOut); + $sOutLocal =~ s/.*$sLocator.*/\1/msi; + } + else + { + $sOut =~ s/.*($sPattern).*/\1/smi; + $sOutLocal =~ s/.*($sPattern).*/\1/smi; + } + + # Log the current version found + $versionFound = $sOut.$sOutLocal; + if ($sOut eq $sOutLocal) + { + $versionFound = $sOut; + } + elsif (($sOut.$sOutLocal ne $sOut) and ($sOut.$sOutLocal ne $sOutLocal) and ($sOut ne $sOutLocal)) + { + $versionFound = "$sOut or $sOutLocal [Value Mismatch]"; + } + if ($versionFound eq "") {$versionFound = "not found";} + + #$sPattern =~ s/(\\|\/|\.|\*|\[|\]|$|$|\$|\{|\})/\\\1/g; + #$sPattern = "($sPattern)"; + subTrace("Check against pattern: ".$sPattern); + # Check the Environment Variable + if (defined $hCheckVar) + { + $sOut = $sOutCopy; + my $valueTested = $hCheckVar->getValue(); + if ($sOut =~ /%$valueTested%/) {$sOut = "not defined!";} + elsif ( $sOut =~ m/$sPattern/smi ) + { + $bResultOk = "true"; + if ($hCheckSilent->getValue() eq "true") { $sOut = "ok. ";} + } + $versionFound = "$sOut"; + } # Or Check the command executed (for version checking...) + elsif ( ( ( $sOut =~ s/.*($sPattern).*/\1/smi ) and (( $sOutLocal =~ s/.*($sPattern).*/\1/smi ) or ($sOutLocal eq "")) ) || + ( ( $sOutLocal =~ s/.*($sPattern).*/\1/smi ) and ($sOut eq "") ) ) + { + $bResultOk = "true"; + subTrace("Value OK"); + if ($versionFound eq "" || $hCheckSilent->getValue() eq "true") { $versionFound = "ok. ";} + + } + elsif (!defined $hCheckLocator) + { + $versionFound = ""; + } + + # Log the warnings/errors regarding version checking + if ($bResultOk eq "false") + { + if ($versionFound eq "") { $versionFound = "wrong value. ";} + subTrace("ERROR: VALUE CHECK FAILED"); + subLogErrorMsg($hToolVerifyShowStopper->getValue(), $hToolName->getValue()." VALUE INCORRECT"); + if ($hToolVerifyShowStopper->getValue() eq "true") + { + $sMsg .= "[ERROR] WRONG VALUE\n"; + subTrace("SHOWSTOPPER RAISED: program should be terminated"); + } + else + { + subTrace("No Showstopper, continuing analysis..."); + $sMsg .= "[WARNING] Wrong Value\n"; + } + + } + } + chomp($versionFound); + &subPrint ("$versionFound\n$sMsg"); + &printToolSummary; + &printLog; + } + } + + + } + close DBGFILE; + return $sToolEnv; +} + +sub subTrace +{ + my $sString = $_[0]; + if ($dbgfile ne "") + { + print DBGFILE "$sString\n"; + } +} + +sub subPrint +{ + my $sString = $_[0]; + $toolSummary .= "$sString"; +} + +sub printToolSummary +{ + print $toolSummary."\n"; + $toolSummary=""; +} + +sub subLog +{ + my $sString = $_[0]; + $execLog .= "[LOG] $sString\n"; + + if ($dbgfile ne "") + { + print DBGFILE "[LOG] $sString\n"; + } +} + +sub printLog +{ + #print $execLog; + $execLog=""; +} + +sub subLogErrorMsg +{ + my $isError = shift; + my $msg = shift; + my $type = "WARNING"; + if ($isError eq "true") {$type = "ERROR";} + $sErrorMsg = $sErrorMsg."\n[$type] ".$msg; +} + +sub getLastErrorMsg +{ + return $sErrorMsg; +} + +sub setDbgFile +{ + $dbgfile = shift; +} + +1; diff -r 57a2cac6870f -r 0c558d696e7a common/tools/CheckBuildEnv.pl --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/common/tools/CheckBuildEnv.pl Mon Aug 24 11:01:37 2009 +0100 @@ -0,0 +1,73 @@ +## @file BuildEnvXML.pl +# @ingroup userscripts clientscripts +# +# Uses information which is defined in the BuildEnvXML.xml to set up a machine +# specific environment, such as path for compilers. +# +# @todo Document this script. +# +# Copyright (c) 2009 Symbian Foundation Ltd. All rights reserved. +# + +package BuildEnvXML; + +use Getopt::Long; +use BuildEnvXML qw(&getToolEnvironment &getLastErrorMsg); + +my $toolenvxml = ""; +my $dbgfile = ""; +my $sbsconfig = ""; +my $toolsconfig = ""; + +GetOptions ("xml=s" => \$toolenvxml, "dbg:s" => \$dbgfile, "sbs:s" => \$sbsconfig, "tools:s" => \$sbsconfig); + +my @contexts = @ARGV; + +if ($toolenvxml eq "") +{ + print ("ERROR: XML file cannot be found!\n"); +} + +# Checking the SBS config to test only what's necessary for that build +if ($sbsconfig =~ /armv5/i) +{ + push @contexts, "ARMv5"; +} + +# Checking the tools config to test only what's necessary for that build +if ($sbsconfig =~ /tools[^2]?(,|$|_)/i) +{ + push @contexts, "tools"; +} + +my $sErrMsg; +my $result = 0; + +if (-e $dbgfile) +{ + unlink($dbgfile); +} + +&setDbgFile($dbgfile); + +foreach my $context (@contexts){ + print "\n\n### Checking $context Tools ###\n"; + my $sSystemPath = &getToolEnvironment($toolenvxml, $context); + + $sErrMsg = &getLastErrorMsg; + if ($sErrMsg eq "") { $sErrMsg = "\nAll OK.\n";} + if($sErrMsg =~ /ERROR/) + { + print "\n$context Tools VERIFICATION FAILED:"; + print $sErrMsg."\n\n"; + $result = -1; + }else{ + print "\n$context tools VERIFICATION PASSED:"; + print $sErrMsg."\n\n"; + } +} +if ($result ne 0) +{ + print "\n ==> PROGRAM STOPPED!!\n"; +} +exit($result); diff -r 57a2cac6870f -r 0c558d696e7a common/tools/ats/STAF/STAF_security.txt --- a/common/tools/ats/STAF/STAF_security.txt Tue Aug 18 13:48:35 2009 +0100 +++ b/common/tools/ats/STAF/STAF_security.txt Mon Aug 24 11:01:37 2009 +0100 @@ -3,3 +3,6 @@ TRUST LEVEL 5 MACHINE sym-build02.* TRUST LEVEL 5 MACHINE lon-engbuild87.* TRUST LEVEL 5 MACHINE lon-engbuild89.* +TRUST LEVEL 5 MACHINE C100725 +TRUST LEVEL 5 MACHINE C100726 +TRUST LEVEL 5 MACHINE UK-ARNAUDL.* diff -r 57a2cac6870f -r 0c558d696e7a common/tools/ats/ats_specialise_test_drop.pl --- a/common/tools/ats/ats_specialise_test_drop.pl Tue Aug 18 13:48:35 2009 +0100 +++ b/common/tools/ats/ats_specialise_test_drop.pl Mon Aug 24 11:01:37 2009 +0100 @@ -114,7 +114,7 @@ # Parse the input XML into hashref. my $test_drop = XMLin("./$xml_in", keeproot => 1, - forcearray => [ 'name', 'id','owner','priority','buildid','target','device', 'property', 'command', 'param'],# + forcearray => [ 'name', 'id','owner','priority','buildid','postaction','type','target','device', 'property', 'command', 'param'],# keyattr => [] ); diff -r 57a2cac6870f -r 0c558d696e7a common/tools/ats/bctest/multimedia/multimediasvs.pl --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/common/tools/ats/bctest/multimedia/multimediasvs.pl Mon Aug 24 11:01:37 2009 +0100 @@ -0,0 +1,176 @@ +#!/usr/bin/perl +# 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: +# Louis Henry Nayegon +# +# Description: +# Script to build ATS test drop multimedia svs tests + + +use strict; +use File::Copy; +use File::Path; + +unlink "multimediatest.zip"; +##rmtree "temp"; +mkpath "temp/multimediatest/general/multimedia/t_imagedecoder"; +mkpath "temp/multimediatest/general/multimedia/t_imageencoder"; +mkpath "temp/multimediatest/general/multimedia/t_mdaaudioconvertutility"; +mkpath "temp/multimediatest/general/multimedia/t_mdaaudiooutputstream"; +mkpath "temp/multimediatest/general/multimedia/t_mdaaudioplayerutility"; +mkpath "temp/multimediatest/general/multimedia/t_audiotoneutility"; +mkpath "temp/multimediatest/general/multimedia/t_midiclientutility"; +mkpath "temp/multimediatest/general/multimedia/t_videoplayerutility"; +mkpath "temp/multimediatest/winscw_udeb/z/resource/plugins"; + +my $epoc=$ENV{'EPOCROOT'} . "epoc32/"; +copy("multimediatest.xml", "temp/test.xml"); + +copy($epoc . "data/z/resource/plugins/ecamtestplugin.rsc", "temp/multimediatest/winscw_udeb/z/resource/plugins/ecamtestplugin.rsc"); +copy($epoc . "release/winscw/udeb/ecamtestplugin.dll", "temp/multimediatest/winscw_udeb/ecamtestplugin.dll"); + +copy($epoc . "data/z/resource/plugins/xvidencoderdevice.rsc", "temp/multimediatest/winscw_udeb/z/resource/plugins/xvidencoderdevice.rsc"); +copy($epoc . "data/z/resource/plugins/xviddecoderdevice.rsc", "temp/multimediatest/winscw_udeb/z/resource/plugins/xviddecoderdevice.rsc"); +copy($epoc . "release/winscw/udeb/xvidencoderdevice.dll", "temp/multimediatest/winscw_udeb/xvidencoderdevice.dll"); +copy($epoc . "release/winscw/udeb/xviddecoderdevice.dll", "temp/multimediatest/winscw_udeb/xviddecoderdevice.dll"); + +copy($epoc . "release/winscw/udeb/testframeworkserver.exe", "temp/multimediatest/winscw_udeb/testframeworkserver.exe"); +copy($epoc . "release/winscw/udeb/testframeworkclient.dll", "temp/multimediatest/winscw_udeb/testframeworkclient.dll"); + +copy($epoc . "data/z/resource/plugins/xvidhwdeviceplugins.rsc", "temp/multimediatest/winscw_udeb/z/resource/plugins/xvidhwdeviceplugins.rsc"); +copy($epoc . "release/winscw/udeb/xvidhwdeviceplugins.dll", "temp/multimediatest/winscw_udeb/xvidhwdeviceplugins.dll"); + +copy($epoc . "data/z/resource/plugins/ts_miditstcntrl.rsc", "temp/multimediatest/winscw_udeb/z/resource/plugins/ts_miditstcntrl.rsc"); +copy($epoc . "release/winscw/udeb/ts_miditstcntrl.dll", "temp/multimediatest/winscw_udeb/ts_miditstcntrl.dll"); + +copy($epoc . "data/z/multimedia/t_multimedia.tcs", "temp/multimediatest/general/multimedia/t_multimedia.tcs"); +copy($epoc . "data/z/multimedia/t_multimedia.ini", "temp/multimediatest/general/multimedia/t_multimedia.ini"); +copy($epoc . "data/z/multimedia/t_multimedia_location.ini", "temp/multimediatest/general/multimedia/t_multimedia_location.ini"); + +copy($epoc . "data/z/multimedia/102070cc.txt", "temp/multimediatest/general/102070CC.txt"); +copy($epoc . "data/z/multimedia/mm-ecm-publicapi.script", "temp/multimediatest/general/multimedia/mm-ecm-publicapi.script"); +copy($epoc . "data/z/multimedia/mm-ecm-publicapi.ini", "temp/multimediatest/general/multimedia/mm-ecm-publicapi.ini"); + +copy($epoc . "data/z/multimedia/mm-icl-decde-publicapi.script", "temp/multimediatest/general/multimedia/mm-icl-decde-publicapi.script"); +copy($epoc . "data/z/multimedia/mm-icl-decde-publicapi.ini", "temp/multimediatest/general/multimedia/mm-icl-decde-publicapi.ini"); +copy($epoc . "data/z/multimedia/t_imagedecoder/24bit.apm", "temp/multimediatest/general/multimedia/t_imagedecoder/24bit.apm"); +copy($epoc . "data/z/multimedia/t_imagedecoder/1bit.bmp", "temp/multimediatest/general/multimedia/t_imagedecoder/1bit.bmp"); +copy($epoc . "data/z/multimedia/t_imagedecoder/4bit.bmp", "temp/multimediatest/general/multimedia/t_imagedecoder/4bit.bmp"); +copy($epoc . "data/z/multimedia/t_imagedecoder/8bit.bmp", "temp/multimediatest/general/multimedia/t_imagedecoder/8bit.bmp"); +copy($epoc . "data/z/multimedia/t_imagedecoder/24bit.bmp", "temp/multimediatest/general/multimedia/t_imagedecoder/24bit.bmp"); +copy($epoc . "data/z/multimedia/t_imagedecoder/24bit.clp", "temp/multimediatest/general/multimedia/t_imagedecoder/24bit.clp"); +copy($epoc . "data/z/multimedia/t_imagedecoder/1bit.gif", "temp/multimediatest/general/multimedia/t_imagedecoder/1bit.gif"); +copy($epoc . "data/z/multimedia/t_imagedecoder/2bit.gif", "temp/multimediatest/general/multimedia/t_imagedecoder/2bit.gif"); +copy($epoc . "data/z/multimedia/t_imagedecoder/4bit.gif", "temp/multimediatest/general/multimedia/t_imagedecoder/4bit.gif"); +copy($epoc . "data/z/multimedia/t_imagedecoder/6bit.gif", "temp/multimediatest/general/multimedia/t_imagedecoder/6bit.gif"); +copy($epoc . "data/z/multimedia/t_imagedecoder/8bit.gif", "temp/multimediatest/general/multimedia/t_imagedecoder/8bit.gif"); +copy($epoc . "data/z/multimedia/t_imagedecoder/commented.gif", "temp/multimediatest/general/multimedia/t_imagedecoder/commented.gif"); +copy($epoc . "data/z/multimedia/t_imagedecoder/4bit.ico", "temp/multimediatest/general/multimedia/t_imagedecoder/4bit.ico"); +copy($epoc . "data/z/multimedia/t_imagedecoder/8bit.ico", "temp/multimediatest/general/multimedia/t_imagedecoder/8bit.ico"); +copy($epoc . "data/z/multimedia/t_imagedecoder/8bit.jpg", "temp/multimediatest/general/multimedia/t_imagedecoder/8bit.jpg"); +copy($epoc . "data/z/multimedia/t_imagedecoder/24bit.jpg", "temp/multimediatest/general/multimedia/t_imagedecoder/24bit.jpg"); +copy($epoc . "data/z/multimedia/t_imagedecoder/thumbnail.jpg", "temp/multimediatest/general/multimedia/t_imagedecoder/thumbnail.jpg"); +copy($epoc . "data/z/multimedia/t_imagedecoder/commented.jpg", "temp/multimediatest/general/multimedia/t_imagedecoder/commented.jpg"); +copy($epoc . "data/z/multimedia/t_imagedecoder/dec1bit.mbm", "temp/multimediatest/general/multimedia/t_imagedecoder/dec1bit.mbm"); +copy($epoc . "data/z/multimedia/t_imagedecoder/dec2bit.mbm", "temp/multimediatest/general/multimedia/t_imagedecoder/dec2bit.mbm"); +copy($epoc . "data/z/multimedia/t_imagedecoder/dec4bit.mbm", "temp/multimediatest/general/multimedia/t_imagedecoder/dec4bit.mbm"); +copy($epoc . "data/z/multimedia/t_imagedecoder/dec8bit.mbm", "temp/multimediatest/general/multimedia/t_imagedecoder/dec8bit.mbm"); +copy($epoc . "data/z/multimedia/t_imagedecoder/dec16bit.mbm", "temp/multimediatest/general/multimedia/t_imagedecoder/dec16bit.mbm"); +copy($epoc . "data/z/multimedia/t_imagedecoder/dec24bit.mbm", "temp/multimediatest/general/multimedia/t_imagedecoder/dec24bit.mbm"); +copy($epoc . "data/z/multimedia/t_imagedecoder/24bit.mng", "temp/multimediatest/general/multimedia/t_imagedecoder/24bit.mng"); +copy($epoc . "data/z/multimedia/t_imagedecoder/1bit.ota", "temp/multimediatest/general/multimedia/t_imagedecoder/1bit.ota"); +copy($epoc . "data/z/multimedia/t_imagedecoder/1bit.png", "temp/multimediatest/general/multimedia/t_imagedecoder/1bit.png"); +copy($epoc . "data/z/multimedia/t_imagedecoder/4bit.png", "temp/multimediatest/general/multimedia/t_imagedecoder/4bit.png"); +copy($epoc . "data/z/multimedia/t_imagedecoder/8bit.png", "temp/multimediatest/general/multimedia/t_imagedecoder/8bit.png"); +copy($epoc . "data/z/multimedia/t_imagedecoder/24bit.png", "temp/multimediatest/general/multimedia/t_imagedecoder/24bit.png"); +copy($epoc . "data/z/multimedia/t_imagedecoder/1bitg3.tif", "temp/multimediatest/general/multimedia/t_imagedecoder/1bitg3.tif"); +copy($epoc . "data/z/multimedia/t_imagedecoder/1bitg4.tif", "temp/multimediatest/general/multimedia/t_imagedecoder/1bitg4.tif"); +copy($epoc . "data/z/multimedia/t_imagedecoder/1bit.tif", "temp/multimediatest/general/multimedia/t_imagedecoder/1bit.tif"); +copy($epoc . "data/z/multimedia/t_imagedecoder/4bit.tif", "temp/multimediatest/general/multimedia/t_imagedecoder/4bit.tif"); +copy($epoc . "data/z/multimedia/t_imagedecoder/8bit.tif", "temp/multimediatest/general/multimedia/t_imagedecoder/8bit.tif"); +copy($epoc . "data/z/multimedia/t_imagedecoder/24bit.tif", "temp/multimediatest/general/multimedia/t_imagedecoder/24bit.tif"); +copy($epoc . "data/z/multimedia/t_imagedecoder/1bit.wbmp", "temp/multimediatest/general/multimedia/t_imagedecoder/1bit.wbmp"); +copy($epoc . "data/z/multimedia/t_imagedecoder/24bit.wmf", "temp/multimediatest/general/multimedia/t_imagedecoder/24bit.wmf"); +copy($epoc . "data/z/multimedia/t_imagedecoder/corrupted.bmp", "temp/multimediatest/general/multimedia/t_imagedecoder/corrupted.bmp"); +copy($epoc . "data/z/multimedia/t_imagedecoder/partial.bmp", "temp/multimediatest/general/multimedia/t_imagedecoder/partial.bmp"); + +copy($epoc . "data/z/multimedia/mm-icl-encde-publicapi.script", "temp/multimediatest/general/multimedia/mm-icl-encde-publicapi.script"); +copy($epoc . "data/z/multimedia/mm-icl-encde-publicapi.ini", "temp/multimediatest/general/multimedia/mm-icl-encde-publicapi.ini"); +copy($epoc . "data/z/multimedia/t_imageencoder/enc1bit.mbm", "temp/multimediatest/general/multimedia/t_imageencoder/enc1bit.mbm"); +copy($epoc . "data/z/multimedia/t_imageencoder/enc2bit.mbm", "temp/multimediatest/general/multimedia/t_imageencoder/enc2bit.mbm"); +copy($epoc . "data/z/multimedia/t_imageencoder/enc4bit.mbm", "temp/multimediatest/general/multimedia/t_imageencoder/enc4bit.mbm"); +copy($epoc . "data/z/multimedia/t_imageencoder/enc8bit.mbm", "temp/multimediatest/general/multimedia/t_imageencoder/enc8bit.mbm"); +copy($epoc . "data/z/multimedia/t_imageencoder/enc16bit.mbm", "temp/multimediatest/general/multimedia/t_imageencoder/enc16bit.mbm"); +copy($epoc . "data/z/multimedia/t_imageencoder/enc24bit.mbm", "temp/multimediatest/general/multimedia/t_imageencoder/enc24bit.mbm"); + +copy($epoc . "data/z/multimedia/mm-mmf-aclnt-cnvrt-publicapi.script", "temp/multimediatest/general/multimedia/mm-mmf-aclnt-cnvrt-publicapi.script"); +copy($epoc . "data/z/multimedia/mm-mmf-aclnt-cnvrt-publicapi.ini", "temp/multimediatest/general/multimedia/mm-mmf-aclnt-cnvrt-publicapi.ini"); +copy($epoc . "data/z/multimedia/t_mdaaudioconvertutility/note.wav", "temp/multimediatest/general/multimedia/t_mdaaudioconvertutility/note.wav"); +copy($epoc . "data/z/multimedia/t_mdaaudioconvertutility/note.raw", "temp/multimediatest/general/multimedia/t_mdaaudioconvertutility/note.raw"); +copy($epoc . "data/z/multimedia/t_mdaaudioconvertutility/corrupted.wav", "temp/multimediatest/general/multimedia/t_mdaaudioconvertutility/corrupted.wav"); +copy($epoc . "release/winscw/udeb/z/multimedia/t_mdaaudioconvertutility/explode.wav", "temp/multimediatest/general/multimedia/t_mdaaudioconvertutility/explode.wav"); + +copy($epoc . "data/z/multimedia/mm-mmf-aclnt-inpt-publicapi.script", "temp/multimediatest/general/multimedia/mm-mmf-aclnt-inpt-publicapi.script"); +copy($epoc . "data/z/multimedia/mm-mmf-aclnt-inpt-publicapi.ini", "temp/multimediatest/general/multimedia/mm-mmf-aclnt-inpt-publicapi.ini"); + +copy($epoc . "data/z/multimedia/mm-mmf-aclnt-outpt-publicapi.script", "temp/multimediatest/general/multimedia/mm-mmf-aclnt-outpt-publicapi.script"); +copy($epoc . "data/z/multimedia/mm-mmf-aclnt-outpt-publicapi.ini", "temp/multimediatest/general/multimedia/mm-mmf-aclnt-outpt-publicapi.ini"); +copy($epoc . "data/z/multimedia/t_mdaaudiooutputstream/mm-mmf-aclnt-outpt-publicapi.raw", "temp/multimediatest/general/multimedia/t_mdaaudiooutputstream/mm-mmf-aclnt-outpt-publicapi.raw"); + +copy($epoc . "data/z/multimedia/mm-mmf-aclnt-plyr-publicapi.script", "temp/multimediatest/general/multimedia/mm-mmf-aclnt-plyr-publicapi.script"); +copy($epoc . "data/z/multimedia/mm-mmf-aclnt-plyr-publicapi.ini", "temp/multimediatest/general/multimedia/mm-mmf-aclnt-plyr-publicapi.ini"); +copy($epoc . "data/z/multimedia/t_mdaaudioplayerutility/test.wav", "temp/multimediatest/general/multimedia/t_mdaaudioplayerutility/test.wav"); +copy($epoc . "data/z/multimedia/t_mdaaudioplayerutility/test.bad", "temp/multimediatest/general/multimedia/t_mdaaudioplayerutility/test.bad"); +copy($epoc . "data/z/multimedia/t_mdaaudioplayerutility/test_err.wav", "temp/multimediatest/general/multimedia/t_mdaaudioplayerutility/test_err.wav"); +copy($epoc . "data/z/multimedia/t_mdaaudioplayerutility/empty.wav", "temp/multimediatest/general/multimedia/t_mdaaudioplayerutility/empty.wav"); +copy($epoc . "data/z/multimedia/t_mdaaudioplayerutility/answeringmachine.wav", "temp/multimediatest/general/multimedia/t_mdaaudioplayerutility/answeringmachine.wav"); +copy($epoc . "data/z/multimedia/t_mdaaudioplayerutility/explode.au", "temp/multimediatest/general/multimedia/t_mdaaudioplayerutility/explode.au"); + +copy($epoc . "data/z/multimedia/mm-mmf-aclnt-rcrdr-publicapi.script", "temp/multimediatest/general/multimedia/mm-mmf-aclnt-rcrdr-publicapi.script"); +copy($epoc . "data/z/multimedia/mm-mmf-aclnt-rcrdr-publicapi.ini", "temp/multimediatest/general/multimedia/mm-mmf-aclnt-rcrdr-publicapi.ini"); +copy($epoc . "data/z/multimedia/t_mdaaudiorecorderutility/pcm16stereo8khz.wav", "temp/multimediatest/general/multimedia/t_mdaaudiorecorderutility/pcm16stereo8khz.wav"); +copy($epoc . "data/z/multimedia/t_mdaaudiorecorderutility/corrupted.wav", "temp/multimediatest/general/multimedia/t_mdaaudiorecorderutility/corrupted.wav"); + +copy($epoc . "data/z/multimedia/mm-mmf-aclnt-tone-publicapi.script", "temp/multimediatest/general/multimedia/mm-mmf-aclnt-tone-publicapi.script"); +copy($epoc . "data/z/multimedia/mm-mmf-aclnt-tone-publicapi.ini", "temp/multimediatest/general/multimedia/mm-mmf-aclnt-tone-publicapi.ini"); +copy($epoc . "data/z/multimedia/t_audiotoneutility/sequence1.sqn", "temp/multimediatest/general/multimedia/t_audiotoneutility/sequence1.sqn"); +copy($epoc . "data/z/multimedia/t_audiotoneutility/sequence2.sqn", "temp/multimediatest/general/multimedia/t_audiotoneutility/sequence2.sqn"); +copy($epoc . "data/z/multimedia/t_audiotoneutility/badsequence.sqn", "temp/multimediatest/general/multimedia/t_audiotoneutility/badsequence.sqn"); + +copy($epoc . "data/z/multimedia/mm-mmf-midi-publicapi.script", "temp/multimediatest/general/multimedia/mm-mmf-midi-publicapi.script"); +copy($epoc . "data/z/multimedia/mm-mmf-midi-publicapi.ini", "temp/multimediatest/general/multimedia/mm-mmf-midi-publicapi.ini"); +copy($epoc . "data/z/multimedia/t_midiclientutility/midi.mid", "temp/multimediatest/general/multimedia/t_midiclientutility/midi.mid"); +copy($epoc . "data/z/multimedia/t_midiclientutility/textmidi.mid", "temp/multimediatest/general/multimedia/t_midiclientutility/textmidi.mid"); +copy($epoc . "data/z/multimedia/t_midiclientutility/midiclienttest.gm", "temp/multimediatest/general/multimedia/t_midiclientutility/midiclienttest.gm"); + +copy($epoc . "data/z/multimedia/mm-mmf-vclnt-plyr-publicapi.script", "temp/multimediatest/general/multimedia/mm-mmf-vclnt-plyr-publicapi.script"); +copy($epoc . "data/z/multimedia/mm-mmf-vclnt-plyr-publicapi.ini", "temp/multimediatest/general/multimedia/mm-mmf-vclnt-plyr-publicapi.ini"); +copy($epoc . "data/z/multimedia/t_videoplayerutility/alter.mp4", "temp/multimediatest/general/multimedia/t_videoplayerutility/alter.mp4"); +copy($epoc . "data/z/multimedia/t_videoplayerutility/xvid_clock.avi", "temp/multimediatest/general/multimedia/t_videoplayerutility/xvid_clock.avi"); +copy($epoc . "data/z/multimedia/t_videoplayerutility/corrupted.avi", "temp/multimediatest/general/multimedia/t_videoplayerutility/corrupted.avi"); + +copy($epoc . "data/z/multimedia/mm-mmf-vclnt-rcrdr-publicapi.script", "temp/multimediatest/general/multimedia/mm-mmf-vclnt-rcrdr-publicapi.script"); +copy($epoc . "data/z/multimedia/mm-mmf-vclnt-rcrdr-publicapi.ini", "temp/multimediatest/general/multimedia/mm-mmf-vclnt-rcrdr-publicapi.ini"); + +copy($epoc . "release/winscw/udeb/t_camera.exe", "temp/multimediatest/winscw_udeb/t_camera.exe"); +copy($epoc . "release/winscw/udeb/t_imagedecoder.exe", "temp/multimediatest/winscw_udeb/t_imagedecoder.exe"); +copy($epoc . "release/winscw/udeb/t_imageencoder.exe", "temp/multimediatest/winscw_udeb/t_imageencoder.exe"); +copy($epoc . "release/winscw/udeb/t_mdaaudioconvertutility.exe", "temp/multimediatest/winscw_udeb/t_mdaaudioconvertutility.exe"); +copy($epoc . "release/winscw/udeb/t_mdaaudioinputstream.exe", "temp/multimediatest/winscw_udeb/t_mdaaudioinputstream.exe"); +copy($epoc . "release/winscw/udeb/t_mdaaudiooutputstream.exe", "temp/multimediatest/winscw_udeb/t_mdaaudiooutputstream.exe"); +copy($epoc . "release/winscw/udeb/t_mdaaudioplayerutility.exe", "temp/multimediatest/winscw_udeb/t_mdaaudioplayerutility.exe"); +copy($epoc . "release/winscw/udeb/t_mdaaudiorecorderutility.exe", "temp/multimediatest/winscw_udeb/t_mdaaudiorecorderutility.exe"); +copy($epoc . "release/winscw/udeb/t_mdaaudiotoneutility.exe", "temp/multimediatest/winscw_udeb/t_mdaaudiotoneutility.exe"); +copy($epoc . "release/winscw/udeb/t_midiclientutility.exe", "temp/multimediatest/winscw_udeb/t_midiclientutility.exe"); +copy($epoc . "release/winscw/udeb/t_videoplayerutility.exe", "temp/multimediatest/winscw_udeb/t_videoplayerutility.exe"); +copy($epoc . "release/winscw/udeb/t_videorecorderutility.exe", "temp/multimediatest/winscw_udeb/t_videorecorderutility.exe"); + +system("7z a -tzip multimediatest.zip ./temp/*"); diff -r 57a2cac6870f -r 0c558d696e7a common/tools/ats/bctest/multimedia/multimediatest.xml --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/common/tools/ats/bctest/multimedia/multimediatest.xml Mon Aug 24 11:01:37 2009 +0100 @@ -0,0 +1,1256 @@ + + + 1 + admin + 10 + + multimediaSVStest + + + + + + + + + + + + + + + install + + + + + + + + + install + + + + + + + + + install + + + + + + + + + install + + + + + + + + + install + + + + + + + + + install + + + + + + + + + install + + + + + + + + + install + + + + + + + + + install + + + + + + + + + execute + + + + + + + + + + + + + + install + + + + + + + + + install + + + + + + + + + install + + + + + + + + + install + + + + + + + + + install + + + + + + + + + install + + + + + + + + + install + + + + + + + + + execute + + + + + + + + + + + + install + + + + + + + + + install + + + + + + + + + install + + + + + + + + + install + + + + + + + + + install + + + + + + + + + install + + + + + + + + + install + + + + + + + + + execute + + + + + + + + + + + + + + install + + + + + + + + + install + + + + + + + + + install + + + + + + + + + install + + + + + + + + + install + + + + + + + + + install + + + + + + + + + install + + + + + + + + + execute + + + + + + + + + + + + install + + + + + + + + + install + + + + + + + + + install + + + + + + + + + install + + + + + + + + + install + + + + + + + + + install + + + + + + + + + execute + + + + + + + + + + + + install + + + + + + + + + install + + + + + + + + + install + + + + + + + + + install + + + + + + + + + install + + + + + + + + + install + + + + + + + + + install + + + + + + + + + execute + + + + + + + + + + + + install + + + + + + + + + install + + + + + + + + + install + + + + + + + + + install + + + + + + + + + install + + + + + + + + + install + + + + + + + + + install + + + + + + + + + execute + + + + + + + + + + + + install + + + + + + + + + install + + + + + + + + + install + + + + + + + + + install + + + + + + + + + install + + + + + + + + + install + + + + + + + + + install + + + + + + + + + execute + + + + + + + + + + + + install + + + + + + + + + install + + + + + + + + + install + + + + + + + + + install + + + + + + + + + install + + + + + + + + + install + + + + + + + + + install + + + + + + + + + execute + + + + + + + + + + + + install + + + + + + + + + install + + + + + + + + + install + + + + + + + + + install + + + + + + + + + install + + + + + + + + + install + + + + + + + + + install + + + + + + + + + install + + + + + + + + + install + + + + + + + + + install + + + + + + + + + install + + + + + + + + + execute + + + + + + + + + + + + install + + + + + + + + + install + + + + + + + + + install + + + + + + + + + install + + + + + + + + + install + + + + + + + + + install + + + + + + + + + install + + + + + + + + + install + + + + + + + + + install + + + + + + + + + install + + + + + + + + + install + + + + + + + + + install + + + + + + + + + install + + + + + + + + + install + + + + + + + + + install + + + + + + + + + execute + + + + + + + + + + + + install + + + + + + + + + install + + + + + + + + + install + + + + + + + + + install + + + + + + + + + install + + + + + + + + + install + + + + + + + + + install + + + + + + + + + install + + + + + + + + + install + + + + + + + + + install + + + + + + + + + install + + + + + + + + + install + + + + + + + + + install + + + + + + + + + install + + + + + + + + + install + + + + + + + + + install + + + + + + + + + install + + + + + + + + + execute + + + + + + + + + + + + + + multimediatest/winscw_udeb/z/resource/plugins/ecamtestplugin.rsc + multimediatest/winscw_udeb/ecamtestplugin.dll + multimediatest/winscw_udeb/z/resource/plugins/xvidencoderdevice.rsc + multimediatest/winscw_udeb/z/resource/plugins/xviddecoderdevice.rsc + multimediatest/winscw_udeb/xvidencoderdevice.dll + multimediatest/winscw_udeb/xviddecoderdevice.dll + multimediatest/winscw_udeb/z/resource/plugins/xvidhwdeviceplugins.rsc + multimediatest/winscw_udeb/xvidhwdeviceplugins.dll + multimediatest/winscw_udeb/testframeworkserver.exe + multimediatest/winscw_udeb/testframeworkclient.dll + multimediatest/winscw_udeb/z/resource/plugins/ts_miditstcntrl.rsc + multimediatest/winscw_udeb/ts_miditstcntrl.dll + multimediatest/general/102070CC.txt + multimediatest/general/multimedia/t_multimedia.tcs + multimediatest/general/multimedia/t_multimedia.ini + multimediatest/general/multimedia/t_multimedia_location.ini + multimediatest/general/multimedia/mm-ecm-publicapi.script + multimediatest/general/multimedia/mm-ecm-publicapi.ini + multimediatest/general/multimedia/mm-icl-decde-publicapi.script + multimediatest/general/multimedia/mm-icl-decde-publicapi.ini + multimediatest/general/multimedia/t_imagedecoder/24bit.apm + multimediatest/general/multimedia/t_imagedecoder/1bit.bmp + multimediatest/general/multimedia/t_imagedecoder/4bit.bmp + multimediatest/general/multimedia/t_imagedecoder/8bit.bmp + multimediatest/general/multimedia/t_imagedecoder/24bit.bmp + multimediatest/general/multimedia/t_imagedecoder/24bit.clp + multimediatest/general/multimedia/t_imagedecoder/1bit.gif + multimediatest/general/multimedia/t_imagedecoder/2bit.gif + multimediatest/general/multimedia/t_imagedecoder/4bit.gif + multimediatest/general/multimedia/t_imagedecoder/6bit.gif + multimediatest/general/multimedia/t_imagedecoder/8bit.gif + multimediatest/general/multimedia/t_imagedecoder/commented.gif + multimediatest/general/multimedia/t_imagedecoder/4bit.ico + multimediatest/general/multimedia/t_imagedecoder/8bit.ico + multimediatest/general/multimedia/t_imagedecoder/8bit.jpg + multimediatest/general/multimedia/t_imagedecoder/24bit.jpg + multimediatest/general/multimedia/t_imagedecoder/thumbnail.jpg + multimediatest/general/multimedia/t_imagedecoder/commented.jpg + multimediatest/general/multimedia/t_imagedecoder/dec1bit.mbm + multimediatest/general/multimedia/t_imagedecoder/dec2bit.mbm + multimediatest/general/multimedia/t_imagedecoder/dec4bit.mbm + multimediatest/general/multimedia/t_imagedecoder/dec8bit.mbm + multimediatest/general/multimedia/t_imagedecoder/dec16bit.mbm + multimediatest/general/multimedia/t_imagedecoder/dec24bit.mbm + multimediatest/general/multimedia/t_imagedecoder/24bit.mng + multimediatest/general/multimedia/t_imagedecoder/1bit.ota + multimediatest/general/multimedia/t_imagedecoder/1bit.png + multimediatest/general/multimedia/t_imagedecoder/4bit.png + multimediatest/general/multimedia/t_imagedecoder/8bit.png + multimediatest/general/multimedia/t_imagedecoder/24bit.png + multimediatest/general/multimedia/t_imagedecoder/1bitg3.tif + multimediatest/general/multimedia/t_imagedecoder/1bitg4.tif + multimediatest/general/multimedia/t_imagedecoder/1bit.tif + multimediatest/general/multimedia/t_imagedecoder/4bit.tif + multimediatest/general/multimedia/t_imagedecoder/8bit.tif + multimediatest/general/multimedia/t_imagedecoder/24bit.tif + multimediatest/general/multimedia/t_imagedecoder/1bit.wbmp + multimediatest/general/multimedia/t_imagedecoder/24bit.wmf + multimediatest/general/multimedia/t_imagedecoder/corrupted.bmp + multimediatest/general/multimedia/t_imagedecoder/partial.bmp + multimediatest/general/multimedia/mm-icl-encde-publicapi.script + multimediatest/general/multimedia/mm-icl-encde-publicapi.ini + multimediatest/general/multimedia/t_imageencoder/enc1bit.mbm + multimediatest/general/multimedia/t_imageencoder/enc2bit.mbm + multimediatest/general/multimedia/t_imageencoder/enc4bit.mbm + multimediatest/general/multimedia/t_imageencoder/enc8bit.mbm + multimediatest/general/multimedia/t_imageencoder/enc16bit.mbm + multimediatest/general/multimedia/t_imageencoder/enc24bit.mbm + multimediatest/general/multimedia/mm-mmf-aclnt-cnvrt-publicapi.script + multimediatest/general/multimedia/mm-mmf-aclnt-cnvrt-publicapi.ini + multimediatest/general/multimedia/t_mdaaudioconvertutility/note.wav + multimediatest/general/multimedia/t_mdaaudioconvertutility/note.raw + multimediatest/general/multimedia/t_mdaaudioconvertutility/corrupted.wav + multimediatest/general/multimedia/t_mdaaudioconvertutility/explode.wav + multimediatest/general/multimedia/mm-mmf-aclnt-inpt-publicapi.script + multimediatest/general/multimedia/mm-mmf-aclnt-inpt-publicapi.ini + multimediatest/general/multimedia/mm-mmf-aclnt-outpt-publicapi.script + multimediatest/general/multimedia/mm-mmf-aclnt-outpt-publicapi.ini + multimediatest/general/multimedia/t_mdaaudiooutputstream/mm-mmf-aclnt-outpt-publicapi.raw + multimediatest/general/multimedia/mm-mmf-aclnt-plyr-publicapi.script + multimediatest/general/multimedia/mm-mmf-aclnt-plyr-publicapi.ini + multimediatest/general/multimedia/t_mdaaudioplayerutility/test.wav + multimediatest/general/multimedia/t_mdaaudioplayerutility/test.bad + multimediatest/general/multimedia/t_mdaaudioplayerutility/test_err.wav + multimediatest/general/multimedia/t_mdaaudioplayerutility/empty.wav + multimediatest/general/multimedia/t_mdaaudioplayerutility/answeringmachine.wav + multimediatest/general/multimedia/t_mdaaudioplayerutility/explode.au + multimediatest/general/multimedia/mm-mmf-aclnt-rcrdr-publicapi.script + multimediatest/general/multimedia/mm-mmf-aclnt-rcrdr-publicapi.ini + multimediatest/general/multimedia/t_mdaaudioplayerutility/pcm16stereo8khz.wav + multimediatest/general/multimedia/t_mdaaudioplayerutility/corrupted.wav + multimediatest/general/multimedia/mm-mmf-aclnt-tone-publicapi.script + multimediatest/general/multimedia/mm-mmf-aclnt-tone-publicapi.ini + multimediatest/general/multimedia/t_audiotoneutility/sequence1.sqn + multimediatest/general/multimedia/t_audiotoneutility/sequence2.sqn + multimediatest/general/multimedia/t_audiotoneutility/badsequence.sqn + multimediatest/general/multimedia/mm-mmf-midi-publicapi.script + multimediatest/general/multimedia/mm-mmf-midi-publicapi.ini + multimediatest/general/multimedia/t_midiclientutility/midi.mid + multimediatest/general/multimedia/t_midiclientutility/textmidi.mid + multimediatest/general/multimedia/t_midiclientutility/midiclienttest.gm + multimediatest/general/multimedia/mm-mmf-vclnt-plyr-publicapi.script + multimediatest/general/multimedia/mm-mmf-vclnt-plyr-publicapi.ini + multimediatest/general/multimedia/t_videoplayerutility/alter.mp4 + multimediatest/general/multimedia/t_videoplayerutility/xvid_clock.avi + multimediatest/general/multimedia/t_videoplayerutility/corrupted.avi + multimediatest/general/multimedia/mm-mmf-vclnt-rcrdr-publicapi.script + multimediatest/general/multimedia/mm-mmf-vclnt-rcrdr-publicapi.ini + multimediatest/winscw_udeb/t_camera.exe + multimediatest/winscw_udeb/t_imagedecoder.exe + multimediatest/winscw_udeb/t_imageencoder.exe + multimediatest/winscw_udeb/t_mdaaudioconvertutility.exe + multimediatest/winscw_udeb/t_mdaaudioinputstream.exe + multimediatest/winscw_udeb/t_mdaaudiooutputstream.exe + multimediatest/winscw_udeb/t_mdaaudioplayerutility.exe + multimediatest/winscw_udeb/t_mdaaudiorecorderutility.exe + multimediatest/winscw_udeb/t_mdaaudiotoneutility.exe + multimediatest/winscw_udeb/t_midiclientutility.exe + multimediatest/winscw_udeb/t_videoplayerutility.exe + multimediatest/winscw_udeb/t_videorecorderutility.exe + + diff -r 57a2cac6870f -r 0c558d696e7a common/tools/ats/bctest/syslibs/syslibssvs.pl --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/common/tools/ats/bctest/syslibs/syslibssvs.pl Mon Aug 24 11:01:37 2009 +0100 @@ -0,0 +1,43 @@ +#!/usr/bin/perl +# 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: +# Louis Henry Nayegon +# +# Description: +# Script to build ATS test drop syslibs svs tests + + +use strict; +use File::Copy; +use File::Path; + +unlink "syslibstest.zip"; +rmtree "temp"; +mkpath "temp/syslibstest/general/syslibs"; +mkpath "temp/syslibstest/general/ecom"; +mkpath "temp/syslibstest/winscw_udeb/z/resource/plugins"; + +my $epoc=$ENV{'EPOCROOT'} . "epoc32/"; +copy("syslibstest.xml", "temp/test.xml"); + +copy($epoc . "data/z/syslibs/t_syslibs.tcs", "temp/syslibstest/general/syslibs/t_syslibs.tcs"); +copy($epoc . "data/z/syslibs/winscw/t_syslibs.ini", "temp/syslibstest/general/syslibs/t_syslibs.ini"); + +copy($epoc . "data/z/ecom/syslib-ecom-publicapi.script", "temp/syslibstest/general/ecom/syslib-ecom-publicapi.script"); +copy($epoc . "data/z/ecom/syslib-ecom-publicapi.ini", "temp/syslibstest/general/ecom/syslib-ecom-publicapi.ini"); +copy($epoc . "data/z/ecom/testproduct_plugin.rsc", "temp/syslibstest/general/ecom/testproduct_plugin.rsc"); +copy($epoc . "release/winscw/udeb/testproduct_plugin.dll", "temp/syslibstest/general/ecom/testproduct_plugin.dll"); + +copy($epoc . "release/winscw/udeb/t_ecom.exe", "temp/syslibstest/winscw_udeb/t_ecom.exe"); +copy($epoc . "release/winscw/udeb/tpcopyfileutility.exe", "temp/syslibstest/winscw_udeb/tpcopyfileutility.exe"); +copy($epoc . "release/winscw/udeb/tpdeletefileutility.exe", "temp/syslibstest/winscw_udeb/tpdeletefileutility.exe"); + +system("7z a -tzip syslibstest.zip ./temp/*"); diff -r 57a2cac6870f -r 0c558d696e7a common/tools/ats/bctest/syslibs/syslibstest.xml --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/common/tools/ats/bctest/syslibs/syslibstest.xml Mon Aug 24 11:01:37 2009 +0100 @@ -0,0 +1,129 @@ + + + 1 + admin + 10 + + multimediaSVStest + + + + + + + + + + + + + + + install + + + + + + + + + install + + + + + + + + + install + + + + + + + + + install + + + + + + + + + install + + + + + + + + + install + + + + + + + + + install + + + + + + + + + install + + + + + + + + + + install + + + + + + + + + + execute + + + + + + + + + + + + + + syslibstest/general/syslibs/t_syslibs.tcs + syslibstest/general/syslibs/t_syslibs.ini + syslibstest/general/ecom/syslib-ecom-publicapi.script + syslibstest/general/ecom/syslib-ecom-publicapi.ini + syslibstest/general/ecom/testproduct_plugin.rsc + syslibstest/general/ecom/testproduct_plugin.dll + syslibstest/winscw_udeb/t_ecom.exe + syslibstest/winscw_udeb/tpcopyfileutility.exe + syslibstest/winscw_udeb/tpdeletefileutility.exe + + diff -r 57a2cac6870f -r 0c558d696e7a common/tools/ats/devices/c100725/EMULATOR_GENERIC_c100725.properties --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/common/tools/ats/devices/c100725/EMULATOR_GENERIC_c100725.properties Mon Aug 24 11:01:37 2009 +0100 @@ -0,0 +1,24 @@ + +NAME=GENERIC EMULATOR on c100725 + +CATEGORY=hardware + +TYPE=WINSCW + +CONNECTION=emulator + +TEMPDIR=D:\\ats3 + +CLASS=GenericTestableDevice + +HARNESS=GENERIC + +#reinstall files after reboot +REINSTALL=false + +PLATFORM=WINSCW +BUILD=udeb + +IMAGE=winscw_smoketest + + diff -r 57a2cac6870f -r 0c558d696e7a common/tools/ats/devices/c100726/EMULATOR_GENERIC_c100726.properties --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/common/tools/ats/devices/c100726/EMULATOR_GENERIC_c100726.properties Mon Aug 24 11:01:37 2009 +0100 @@ -0,0 +1,24 @@ + +NAME=GENERIC EMULATOR on c100726 + +CATEGORY=hardware + +TYPE=WINSCW + +CONNECTION=emulator + +TEMPDIR=C:\\apps\\ATS3\\tmp\\emulator + +CLASS=GenericTestableDevice + +HARNESS=GENERIC + +#reinstall files after reboot +REINSTALL=false + +PLATFORM=WINSCW +BUILD=udeb + +IMAGE=winscw_smoketest + + diff -r 57a2cac6870f -r 0c558d696e7a common/tools/ats/devices/lon-engbuild87/EMULATOR_GENERIC_LON-ENGBUILD87.properties --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/common/tools/ats/devices/lon-engbuild87/EMULATOR_GENERIC_LON-ENGBUILD87.properties Mon Aug 24 11:01:37 2009 +0100 @@ -0,0 +1,24 @@ + +NAME=GENERIC EMULATOR on LON-ENGBUILD87 + +CATEGORY=hardware + +TYPE=WINSCW + +CONNECTION=emulator + +TEMPDIR=D:\\ats3 + +CLASS=GenericTestableDevice + +HARNESS=GENERIC + +#reinstall files after reboot +REINSTALL=false + +PLATFORM=WINSCW +BUILD=udeb + +IMAGE=winscw_smoketest + + diff -r 57a2cac6870f -r 0c558d696e7a common/tools/ats/devices/lon-engbuild87/EMULATOR_GENERIC_LONENGBUILD87.properties --- a/common/tools/ats/devices/lon-engbuild87/EMULATOR_GENERIC_LONENGBUILD87.properties Tue Aug 18 13:48:35 2009 +0100 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,24 +0,0 @@ - -NAME=GENERIC EMULATOR on LON-ENGBUILD87 - -CATEGORY=hardware - -TYPE=WINSCW - -CONNECTION=emulator - -TEMPDIR=D:\\ats3 - -CLASS=GenericTestableDevice - -HARNESS=GENERIC - -#reinstall files after reboot -REINSTALL=false - -PLATFORM=WINSCW -BUILD=udeb - -IMAGE=winscw_smoketest - - diff -r 57a2cac6870f -r 0c558d696e7a common/tools/ats/devices/lon-engbuild89/EMULATOR_GENERIC_LON-ENGBUILD89.properties --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/common/tools/ats/devices/lon-engbuild89/EMULATOR_GENERIC_LON-ENGBUILD89.properties Mon Aug 24 11:01:37 2009 +0100 @@ -0,0 +1,22 @@ + +NAME=GENERIC EMULATOR on LON-ENGBUILD89 + +CATEGORY=hardware + +TYPE=WINSCW + +CONNECTION=emulator + +TEMPDIR=D:\\ATS3 + +CLASS=GenericTestableDevice + +HARNESS=GENERIC + +#reinstall files after reboot +REINSTALL=false + +PLATFORM=WINSCW +BUILD=udeb + +IMAGE=winscw_smoketest diff -r 57a2cac6870f -r 0c558d696e7a common/tools/ats/devices/lon-engbuild89/EMULATOR_GENERIC_LONENGBUILD89.properties --- a/common/tools/ats/devices/lon-engbuild89/EMULATOR_GENERIC_LONENGBUILD89.properties Tue Aug 18 13:48:35 2009 +0100 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,22 +0,0 @@ - -NAME=GENERIC EMULATOR on LON-ENGBUILD89 - -CATEGORY=hardware - -TYPE=WINSCW - -CONNECTION=emulator - -TEMPDIR=D:\\ATS3 - -CLASS=GenericTestableDevice - -HARNESS=GENERIC - -#reinstall files after reboot -REINSTALL=false - -PLATFORM=WINSCW -BUILD=udeb - -IMAGE=winscw_smoketest diff -r 57a2cac6870f -r 0c558d696e7a common/tools/ats/devices/sym-build02/EMULATOR_GENERIC_SYM-BUILD02.properties --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/common/tools/ats/devices/sym-build02/EMULATOR_GENERIC_SYM-BUILD02.properties Mon Aug 24 11:01:37 2009 +0100 @@ -0,0 +1,22 @@ + +NAME=GENERIC EMULATOR on SYM-BUILD02 + +CATEGORY=hardware + +TYPE=WINSCW + +CONNECTION=emulator + +TEMPDIR=C:\\ATS3 + +CLASS=GenericTestableDevice + +HARNESS=GENERIC + +#reinstall files after reboot +REINSTALL=false + +PLATFORM=WINSCW +BUILD=udeb + +IMAGE=winscw_smoketest diff -r 57a2cac6870f -r 0c558d696e7a common/tools/ats/devices/sym-build02/EMULATOR_GENERIC_SYMBUILD02.properties --- a/common/tools/ats/devices/sym-build02/EMULATOR_GENERIC_SYMBUILD02.properties Tue Aug 18 13:48:35 2009 +0100 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,22 +0,0 @@ - -NAME=GENERIC EMULATOR on SYM-BUILD02 - -CATEGORY=hardware - -TYPE=WINSCW - -CONNECTION=emulator - -TEMPDIR=D:\\ATS3 - -CLASS=GenericTestableDevice - -HARNESS=GENERIC - -#reinstall files after reboot -REINSTALL=false - -PLATFORM=WINSCW -BUILD=udeb - -IMAGE=winscw_smoketest diff -r 57a2cac6870f -r 0c558d696e7a common/tools/ats/smoketest/Group/smoketest.xml --- a/common/tools/ats/smoketest/Group/smoketest.xml Tue Aug 18 13:48:35 2009 +0100 +++ b/common/tools/ats/smoketest/Group/smoketest.xml Mon Aug 24 11:01:37 2009 +0100 @@ -4,6 +4,9 @@ admin 10 + + DiamondsAction + smoketest diff -r 57a2cac6870f -r 0c558d696e7a common/tools/csvToSysDef.pl --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/common/tools/csvToSysDef.pl Mon Aug 24 11:01:37 2009 +0100 @@ -0,0 +1,195 @@ +#!perl -w + +use strict; + +use FindBin; +use lib "$FindBin::Bin/lib"; + +use XML::Parser; +use Text::CSV; + +my $sourcesCSV = shift or die "First arg must be source csv file"; +my $backupBaseDir = shift or die "Second arg must be path to tree of package_definitions to use if not found in the source packages"; +shift and die "No more than two arguments please"; + +# Load CSV +open my $csvText, "<", $sourcesCSV or die; +my $csv = Text::CSV->new(); +my @keys; +my @packages; +while (my $line = <$csvText>) +{ + chomp $line; + next unless $line; + unless ($csv->parse($line)) + { + my $err = $csv->error_input(); + die "Failed to parse line '$line': $err"; + } + + if (! @keys) + { + # First line - note the column names + @keys = $csv->fields(); + } + else + { + # Already got the keys, so get the data + my %package; + # Read into a hash slice + @package{@keys} = $csv->fields(); + push @packages, \%package; + } +} +close $csvText; + +my $parser = new XML::Parser(Style => "Objects") or die; +my $outTree; + +# For each package in CSV... +foreach my $package (@packages) +{ + # If the sources.csv does not include a sys def for this package, it doesn't get built + next unless $package->{sysdef}; + # If it's in the "backup" location, use that one (ie our copy overrides the package's own copy) + my $pkgDef = "$package->{dst}/$package->{sysdef}"; + $pkgDef =~ s{^/sf/}{}; + $pkgDef =~ s{/[^/]*$}{}; + $pkgDef = "$backupBaseDir/$pkgDef/package_definition.xml"; + if (!-f $pkgDef) + { + # Not there, so look for the pkg defn in the root of the package tree + warn "Warning: Package $package->{dst} does not appear on the local system\n" unless -d $package->{dst}; + $pkgDef = "$package->{dst}/$package->{sysdef}"; + } + die "Unable to locate any package_definition at all for $package->{dst}" unless -f $pkgDef; + + warn "Including $pkgDef for $package->{dst}\n"; + my $pkgTree = eval { $parser->parsefile($pkgDef) } or die "Failed to parse $pkgDef : $@"; + if (!$outTree) + { + # The first file is taken verbatim + $outTree = $pkgTree; + } + else + { + # Merge into output Tree + mergeTrees($outTree->[0], $pkgTree->[0]); + } +} + +# Output total tree +print "\n"; +printTree($outTree->[0]); +print "\n"; + +exit; + +sub mergeTrees +{ + my $baseTree = shift or die; + my $extrasTree = shift or die; + + die ("Package Definitions do not match: ".(ref $baseTree)." vs ".(ref $extrasTree)) unless ref $baseTree eq ref $extrasTree; + return if ref $baseTree eq "main::Characters"; + + foreach my $extraChild (@{$extrasTree->{Kids}}) + { + # Work out whether this child should be merged with a namesake, or appended + my $mergeIt = undef; + + my $extraChildTag = ref $extraChild; + $extraChildTag =~ s{^main::}{}; + + if ($extraChildTag =~ m{^(SystemDefinition|systemModel)$}) + { + # Should be merged if there's already one there + # Look for a namesake in the base + $mergeIt = matchTag($baseTree->{Kids}, $extraChild, undef); + } + elsif ($extraChildTag =~ m{layer|block|package|collection|component}) + { + # Should be merged if there is another tag with the same "name" attribute + # Look for a namesake in the base + $mergeIt = matchTag($baseTree->{Kids}, $extraChild, "name"); + } + + if ($mergeIt) + { + # Merge children + mergeTrees($mergeIt, $extraChild); + } + else + { + # Add this child + push @{$baseTree->{Kids}}, $extraChild; + } + } +} + +sub matchTag +{ + my $peers = shift; + my $outsider = shift; + my $attr = shift; + + foreach my $peer (@$peers) + { + if (ref $peer eq ref $outsider && (!defined $attr || $peer->{$attr} eq $outsider->{$attr})) + { + return $peer; + } + } + + return undef; +} + +sub printTree +{ + my $tree = shift or die; + die unless ref $tree; + + my $tagName = ref $tree; + $tagName =~ s{^main::}{}; + if ($tagName eq "Characters") + { + print $tree->{Text}; + return; + } + + print "<$tagName"; + + foreach my $attr ( + sort { + my $order = "name long-name tech_domain level span schema levels filter introduced deprecated purpose class plugin origin-model bldFile mrp version priority"; + my $ixA = index $order, $a; + my $ixB = index $order, $b; + die "$a $b" if $ixA + $ixB == -2; + $ixA - $ixB; + } + grep { + ! ref $tree->{$_} + } + keys %$tree) + { + print " $attr=\"$tree->{$attr}\""; + } + + my $children = $tree->{Kids}; + if (scalar @$children) + { + print ">"; + foreach my $child (@$children) + { + printTree($child); + } + print ""; +} + diff -r 57a2cac6870f -r 0c558d696e7a common/tools/listdir.py --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/common/tools/listdir.py Mon Aug 24 11:01:37 2009 +0100 @@ -0,0 +1,43 @@ +# 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: +# mattd +# +# Description: +# listdir.py - Lists a directory contents. +# listdir.py () + +import os +import re +import sys +import string +from os.path import join, isfile + +def main(): + directory = sys.argv[1] + exclude_dirs = [] + if(len(sys.argv)>2): + x_dirs = string.lower(sys.argv[2]) + exclude_dirs = re.split(',', x_dirs) + scandir(directory, exclude_dirs) + +def scandir(top, exclude_dirs): + fixpath = re.compile('\\\\') + fixroot = re.compile('^%s\\\\' % top) + for root, dirs, files in os.walk(top, topdown=True): + for dirname in dirs: + if(string.lower(fixpath.sub('/',os.path.join(root,dirname))) in exclude_dirs): + dirs.remove(dirname) + for name in files: + filename = os.path.join(root, name) + fn = string.lower(fixpath.sub('/',fixroot.sub('',filename))) + print fn + +main() diff -r 57a2cac6870f -r 0c558d696e7a common/tools/populateziptemplate.pl --- a/common/tools/populateziptemplate.pl Tue Aug 18 13:48:35 2009 +0100 +++ b/common/tools/populateziptemplate.pl Mon Aug 24 11:01:37 2009 +0100 @@ -26,7 +26,11 @@ my $template = shift or die "Second arg must be template file"; my $ftl = shift or die "Third arg must be output file"; my $rndExcludes = shift or die "Fourth arg must be rnd-excludes file"; -shift and die "No more than four arguments please"; +my $nosource = shift; +if(defined $nosource && $nosource !~ m/--nosource/i) +{ + die "fifth argument can only be \'--nosource\'"; +} # Load CSV open my $csvText, "<", $sourcesCSV or die; @@ -73,21 +77,24 @@ warn "Warning: Package $package->{dst} does not appear on the local system\n" unless -d $package->{dst}; $package->{dst} =~ s{^/}{}g; if ($package->{source} =~ m{/(sfl|oss)/(MCL|FCL)/sf/([^/]+)/([^/]+)}) - { - push @{$zipConfig->{config}->{config}->{src}->{config}->{$1}->{config}}, - { - set => - [ - { - name => "name", - value=> "src_$1_$3_$4", - }, - { - name => "include", - value => "$package->{dst}/**", - }, - ] - }; + { + if(!defined $nosource) + { + push @{$zipConfig->{config}->{config}->{src}->{config}->{$1}->{config}}, + { + set => + [ + { + name => "name", + value=> "src_$1_$3_$4", + }, + { + name => "include", + value => "$package->{dst}/**", + }, + ] + }; + } } elsif ($package->{source} =~ m{/rnd/([^/]+)/([^/]+)}) { diff -r 57a2cac6870f -r 0c558d696e7a common/tools/raptor/RaptorCommon.pm --- a/common/tools/raptor/RaptorCommon.pm Tue Aug 18 13:48:35 2009 +0100 +++ b/common/tools/raptor/RaptorCommon.pm Mon Aug 24 11:01:37 2009 +0100 @@ -19,9 +19,29 @@ our $CATEGORY_RAPTORERROR = 'raptor_error'; our $CATEGORY_RAPTORERROR_CANNOTPROCESSSCHEMAVERSION = 'cannot_process_schema_version'; our $CATEGORY_RAPTORERROR_NOBLDINFFOUND = 'no_bld_inf_found'; +our $CATEGORY_RAPTORERROR_CANTFINDMMPFILE = 'cant_find_mmp_file'; +our $CATEGORY_RAPTORERROR_MAKEEXITEDWITHERRORS = 'make_exited_with_errors'; +our $CATEGORY_RAPTORERROR_TOOLDIDNOTRETURNVERSION = 'tool_didnot_return_version'; + +our $CATEGORY_RAPTORWARNING = 'raptor_warning'; +our $CATEGORY_RAPTORWARNING_MISSINGFLAGABIV2 = 'missing_enable_abiv2_mode'; our $SEVERITY_UNKNOWN = 'unknown'; our $SEVERITY_CRITICAL = 'critical'; +our $SEVERITY_MAJOR = 'major'; +our $SEVERITY_NORMAL = 'normal'; +our $SEVERITY_MINOR = 'minor'; + +sub init +{ + my $filename = "$::basedir/summary.csv"; + if (!-f$filename) + { + print "Writing summary file $filename\n"; + open(SUMMARY, ">$filename"); + close(SUMMARY); + } +} sub dump_fault { diff -r 57a2cac6870f -r 0c558d696e7a common/tools/raptor/RaptorError.pm --- a/common/tools/raptor/RaptorError.pm Tue Aug 18 13:48:35 2009 +0100 +++ b/common/tools/raptor/RaptorError.pm Mon Aug 24 11:01:37 2009 +0100 @@ -27,6 +27,7 @@ $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} = {}; @@ -54,22 +55,51 @@ } elsif ($text =~ m,No bld\.inf found at,) { + $severity = $RaptorCommon::SEVERITY_MAJOR; + my $subcategory = $RaptorCommon::CATEGORY_RAPTORERROR_NOBLDINFFOUND; + RaptorCommon::dump_fault($category, $subcategory, $severity, $component, $phase, $recipe, $file, $line); + } + elsif ($text =~ m,Can't find mmp file,) + { + $severity = $RaptorCommon::SEVERITY_NORMAL; + my $subcategory = $RaptorCommon::CATEGORY_RAPTORERROR_CANTFINDMMPFILE; + RaptorCommon::dump_fault($category, $subcategory, $severity, $component, $phase, $recipe, $file, $line); + } + elsif ($text =~ m,The make-engine exited with errors,) + { $severity = $RaptorCommon::SEVERITY_CRITICAL; - my $subcategory = $RaptorCommon::CATEGORY_RAPTORERROR_NOBLDINFFOUND; + my $subcategory = $RaptorCommon::CATEGORY_RAPTORERROR_MAKEEXITEDWITHERRORS; + RaptorCommon::dump_fault($category, $subcategory, $severity, $component, $phase, $recipe, $file, $line); + } + elsif ($text =~ m,tool .* from config .* did not return version .* as required,) + { + $severity = $RaptorCommon::SEVERITY_CRITICAL; + my $subcategory = $RaptorCommon::CATEGORY_RAPTORERROR_TOOLDIDNOTRETURNVERSION; RaptorCommon::dump_fault($category, $subcategory, $severity, $component, $phase, $recipe, $file, $line); } else # log everything by default { - $severity = $RaptorCommon::SEVERITY_UNKNOWN; + $severity = $RaptorCommon::SEVERITY_NORMAL; my $subcategory = ''; RaptorCommon::dump_fault($category, $subcategory, $severity, $component, $phase, $recipe, $file, $line); } } +sub on_start_buildlog +{ + RaptorCommon::init(); + + $filename = "$::basedir/errors.txt"; + if (!-f$filename) + { + print "Writing errors file $filename\n"; + open(FILE, ">$filename"); + close(FILE); + } +} + sub on_start_buildlog_error { - $filename = "$::basedir/errors.txt"; - print "Writing error file $filename\n" if (!-f$filename); open(FILE, ">>$filename"); } diff -r 57a2cac6870f -r 0c558d696e7a common/tools/raptor/RaptorReleaseable.pm --- a/common/tools/raptor/RaptorReleaseable.pm Tue Aug 18 13:48:35 2009 +0100 +++ b/common/tools/raptor/RaptorReleaseable.pm Mon Aug 24 11:01:37 2009 +0100 @@ -35,6 +35,7 @@ $buildlog_status->{name} = 'buildlog_status'; $buildlog_status->{next_status} = {whatlog=>$whatlog_status}; +$buildlog_status->{on_start} = 'RaptorReleaseable::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}; @@ -88,6 +89,11 @@ my $curfiletype = 'unknown'; my $characters = ''; +sub on_start_buildlog +{ + mkdir("$::basedir/releaseables"); +} + sub on_start_whatlog { my ($el) = @_; @@ -223,7 +229,6 @@ my $layer = $1; my $package = $2; - mkdir("$::basedir/releaseables"); mkdir("$::basedir/releaseables/$layer"); mkdir("$::basedir/releaseables/$layer/$package"); diff -r 57a2cac6870f -r 0c558d696e7a common/tools/raptor/RaptorWarning.pm --- a/common/tools/raptor/RaptorWarning.pm Tue Aug 18 13:48:35 2009 +0100 +++ b/common/tools/raptor/RaptorWarning.pm Mon Aug 24 11:01:37 2009 +0100 @@ -27,6 +27,7 @@ $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} = {}; @@ -34,29 +35,46 @@ $buildlog_warning_status->{on_end} = 'RaptorWarning::on_end_buildlog_warning'; $buildlog_warning_status->{on_chars} = 'RaptorWarning::on_chars_buildlog_warning'; +my $filename = ''; + my $characters = ''; my $category = $RaptorCommon::CATEGORY_RAPTORWARNING; sub process { - my ($text) = @_; + my ($text, $component, $phase, $recipe, $file, $line) = @_; my $severity = $RaptorCommon::SEVERITY_UNKNOWN; - if ($text =~ m,unmatchable,) + if ($text =~ m,missing flag ENABLE_ABIV2_MODE,) { - $severity = $RaptorCommon::SEVERITY_CRITICAL; - - #dump_error($category, $severity, $text); - print "$category, $severity, $text\n"; + $severity = $RaptorCommon::SEVERITY_NORMAL; + my $subcategory = $RaptorCommon::CATEGORY_RAPTORWARNING_MISSINGFLAGABIV2; + RaptorCommon::dump_fault($category, $subcategory, $severity, $component, $phase, $recipe, $file, $line); + } + else # log everything by default + { + $severity = $RaptorCommon::SEVERITY_NORMAL; + my $subcategory = ''; + RaptorCommon::dump_fault($category, $subcategory, $severity, $component, $phase, $recipe, $file, $line); } } +sub on_start_buildlog +{ + RaptorCommon::init(); + + $filename = "$::basedir/warnings.txt"; + if (!-f$filename) + { + print "Writing warnings file $filename\n"; + open(FILE, ">$filename"); + close(FILE); + } +} sub on_start_buildlog_warning { - my $filename = "$::basedir/warnings.txt"; - print "Writing warning file $filename\n" if (!-f$filename); open(FILE, ">>$filename"); } @@ -75,14 +93,19 @@ { #print "on_end_buildlog_warning\n"; - process($characters); - print FILE $characters if ($characters =~ m,[^\s^\r^\n],); print FILE "\n" if ($characters !~ m,[\r\n]$, ); + close(FILE); + + # get the line number - not really optimized + my $linecount = 0; + open(FILE, "$filename"); + for ($linecount = 0; ; $linecount++) { } + close(FILE); + + process($characters, '', '', '', "warnings.txt", $linecount); $characters = ''; - - close(FILE); } diff -r 57a2cac6870f -r 0c558d696e7a common/tools/raptor/XML/NamespaceSupport.pm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/common/tools/raptor/XML/NamespaceSupport.pm Mon Aug 24 11:01:37 2009 +0100 @@ -0,0 +1,565 @@ + +### +# XML::NamespaceSupport - a simple generic namespace processor +# Robin Berjon +### + +package XML::NamespaceSupport; +use strict; +use constant FATALS => 0; # root object +use constant NSMAP => 1; +use constant UNKNOWN_PREF => 2; +use constant AUTO_PREFIX => 3; +use constant DEFAULT => 0; # maps +use constant PREFIX_MAP => 1; +use constant DECLARATIONS => 2; + +use vars qw($VERSION $NS_XMLNS $NS_XML); +$VERSION = '1.07'; +$NS_XMLNS = 'http://www.w3.org/2000/xmlns/'; +$NS_XML = 'http://www.w3.org/XML/1998/namespace'; + + +# add the ns stuff that baud wants based on Java's xml-writer + + +#-------------------------------------------------------------------# +# constructor +#-------------------------------------------------------------------# +sub new { + my $class = ref($_[0]) ? ref(shift) : shift; + my $options = shift; + my $self = [ + 1, # FATALS + [[ # NSMAP + undef, # DEFAULT + { xml => $NS_XML }, # PREFIX_MAP + undef, # DECLARATIONS + ]], + 'aaa', # UNKNOWN_PREF + 0, # AUTO_PREFIX + ]; + $self->[NSMAP]->[0]->[PREFIX_MAP]->{xmlns} = $NS_XMLNS if $options->{xmlns}; + $self->[FATALS] = $options->{fatal_errors} if defined $options->{fatal_errors}; + $self->[AUTO_PREFIX] = $options->{auto_prefix} if defined $options->{auto_prefix}; + return bless $self, $class; +} +#-------------------------------------------------------------------# + +#-------------------------------------------------------------------# +# reset() - return to the original state (for reuse) +#-------------------------------------------------------------------# +sub reset { + my $self = shift; + $#{$self->[NSMAP]} = 0; +} +#-------------------------------------------------------------------# + +#-------------------------------------------------------------------# +# push_context() - add a new empty context to the stack +#-------------------------------------------------------------------# +sub push_context { + my $self = shift; + push @{$self->[NSMAP]}, [ + $self->[NSMAP]->[-1]->[DEFAULT], + { %{$self->[NSMAP]->[-1]->[PREFIX_MAP]} }, + [], + ]; +} +#-------------------------------------------------------------------# + +#-------------------------------------------------------------------# +# pop_context() - remove the topmost context fromt the stack +#-------------------------------------------------------------------# +sub pop_context { + my $self = shift; + die 'Trying to pop context without push context' unless @{$self->[NSMAP]} > 1; + pop @{$self->[NSMAP]}; +} +#-------------------------------------------------------------------# + +#-------------------------------------------------------------------# +# declare_prefix() - declare a prefix in the current scope +#-------------------------------------------------------------------# +sub declare_prefix { + my $self = shift; + my $prefix = shift; + my $value = shift; + + warn <<' EOWARN' unless defined $prefix or $self->[AUTO_PREFIX]; + Prefix was undefined. + If you wish to set the default namespace, use the empty string ''. + If you wish to autogenerate prefixes, set the auto_prefix option + to a true value. + EOWARN + + return 0 if index(lc($prefix), 'xml') == 0; + + if (defined $prefix and $prefix eq '') { + $self->[NSMAP]->[-1]->[DEFAULT] = $value; + } + else { + die "Cannot undeclare prefix $prefix" if $value eq ''; + if (not defined $prefix and $self->[AUTO_PREFIX]) { + while (1) { + $prefix = $self->[UNKNOWN_PREF]++; + last if not exists $self->[NSMAP]->[-1]->[PREFIX_MAP]->{$prefix}; + } + } + elsif (not defined $prefix and not $self->[AUTO_PREFIX]) { + return 0; + } + $self->[NSMAP]->[-1]->[PREFIX_MAP]->{$prefix} = $value; + } + push @{$self->[NSMAP]->[-1]->[DECLARATIONS]}, $prefix; + return 1; +} +#-------------------------------------------------------------------# + +#-------------------------------------------------------------------# +# declare_prefixes() - declare several prefixes in the current scope +#-------------------------------------------------------------------# +sub declare_prefixes { + my $self = shift; + my %prefixes = @_; + while (my ($k,$v) = each %prefixes) { + $self->declare_prefix($k,$v); + } +} +#-------------------------------------------------------------------# + +#-------------------------------------------------------------------# +# undeclare_prefix +#-------------------------------------------------------------------# +sub undeclare_prefix { + my $self = shift; + my $prefix = shift; + return unless not defined $prefix or $prefix eq ''; + return unless exists $self->[NSMAP]->[-1]->[PREFIX_MAP]->{$prefix}; + + my ( $tfix ) = grep { $_ eq $prefix } @{$self->[NSMAP]->[-1]->[DECLARATIONS]}; + if ( not defined $tfix ) { + die "prefix $prefix not declared in this context\n"; + } + + @{$self->[NSMAP]->[-1]->[DECLARATIONS]} = grep { $_ ne $prefix } @{$self->[NSMAP]->[-1]->[DECLARATIONS]}; + delete $self->[NSMAP]->[-1]->[PREFIX_MAP]->{$prefix}; +} +#-------------------------------------------------------------------# + +#-------------------------------------------------------------------# +# get_prefix() - get a (random) prefix for a given URI +#-------------------------------------------------------------------# +sub get_prefix { + my $self = shift; + my $uri = shift; + + # we have to iterate over the whole hash here because if we don't + # the iterator isn't reset and the next pass will fail + my $pref; + while (my ($k, $v) = each %{$self->[NSMAP]->[-1]->[PREFIX_MAP]}) { + $pref = $k if $v eq $uri; + } + return $pref; +} +#-------------------------------------------------------------------# + +#-------------------------------------------------------------------# +# get_prefixes() - get all the prefixes for a given URI +#-------------------------------------------------------------------# +sub get_prefixes { + my $self = shift; + my $uri = shift; + + return keys %{$self->[NSMAP]->[-1]->[PREFIX_MAP]} unless defined $uri; + return grep { $self->[NSMAP]->[-1]->[PREFIX_MAP]->{$_} eq $uri } keys %{$self->[NSMAP]->[-1]->[PREFIX_MAP]}; +} +#-------------------------------------------------------------------# + +#-------------------------------------------------------------------# +# get_declared_prefixes() - get all prefixes declared in the last context +#-------------------------------------------------------------------# +sub get_declared_prefixes { + return @{$_[0]->[NSMAP]->[-1]->[DECLARATIONS]}; +} +#-------------------------------------------------------------------# + +#-------------------------------------------------------------------# +# get_uri() - get an URI given a prefix +#-------------------------------------------------------------------# +sub get_uri { + my $self = shift; + my $prefix = shift; + + warn "Prefix must not be undef in get_uri(). The emtpy prefix must be ''" unless defined $prefix; + + return $self->[NSMAP]->[-1]->[DEFAULT] if $prefix eq ''; + return $self->[NSMAP]->[-1]->[PREFIX_MAP]->{$prefix} if exists $self->[NSMAP]->[-1]->[PREFIX_MAP]->{$prefix}; + return undef; +} +#-------------------------------------------------------------------# + +#-------------------------------------------------------------------# +# process_name() - provide details on a name +#-------------------------------------------------------------------# +sub process_name { + my $self = shift; + my $qname = shift; + my $aflag = shift; + + if ($self->[FATALS]) { + return( ($self->_get_ns_details($qname, $aflag))[0,2], $qname ); + } + else { + eval { return( ($self->_get_ns_details($qname, $aflag))[0,2], $qname ); } + } +} +#-------------------------------------------------------------------# + +#-------------------------------------------------------------------# +# process_element_name() - provide details on a element's name +#-------------------------------------------------------------------# +sub process_element_name { + my $self = shift; + my $qname = shift; + + if ($self->[FATALS]) { + return $self->_get_ns_details($qname, 0); + } + else { + eval { return $self->_get_ns_details($qname, 0); } + } +} +#-------------------------------------------------------------------# + + +#-------------------------------------------------------------------# +# process_attribute_name() - provide details on a attribute's name +#-------------------------------------------------------------------# +sub process_attribute_name { + my $self = shift; + my $qname = shift; + + if ($self->[FATALS]) { + return $self->_get_ns_details($qname, 1); + } + else { + eval { return $self->_get_ns_details($qname, 1); } + } +} +#-------------------------------------------------------------------# + + +#-------------------------------------------------------------------# +# ($ns, $prefix, $lname) = $self->_get_ns_details($qname, $f_attr) +# returns ns, prefix, and lname for a given attribute name +# >> the $f_attr flag, if set to one, will work for an attribute +#-------------------------------------------------------------------# +sub _get_ns_details { + my $self = shift; + my $qname = shift; + my $aflag = shift; + + my ($ns, $prefix, $lname); + (my ($tmp_prefix, $tmp_lname) = split /:/, $qname, 3) + < 3 or die "Invalid QName: $qname"; + + # no prefix + my $cur_map = $self->[NSMAP]->[-1]; + if (not defined($tmp_lname)) { + $prefix = undef; + $lname = $qname; + # attr don't have a default namespace + $ns = ($aflag) ? undef : $cur_map->[DEFAULT]; + } + + # prefix + else { + if (exists $cur_map->[PREFIX_MAP]->{$tmp_prefix}) { + $prefix = $tmp_prefix; + $lname = $tmp_lname; + $ns = $cur_map->[PREFIX_MAP]->{$prefix} + } + else { # no ns -> lname == name, all rest undef + die "Undeclared prefix: $tmp_prefix"; + } + } + + return ($ns, $prefix, $lname); +} +#-------------------------------------------------------------------# + +#-------------------------------------------------------------------# +# parse_jclark_notation() - parse the Clarkian notation +#-------------------------------------------------------------------# +sub parse_jclark_notation { + shift; + my $jc = shift; + $jc =~ m/^\{(.*)\}([^}]+)$/; + return $1, $2; +} +#-------------------------------------------------------------------# + + +#-------------------------------------------------------------------# +# Java names mapping +#-------------------------------------------------------------------# +*XML::NamespaceSupport::pushContext = \&push_context; +*XML::NamespaceSupport::popContext = \&pop_context; +*XML::NamespaceSupport::declarePrefix = \&declare_prefix; +*XML::NamespaceSupport::declarePrefixes = \&declare_prefixes; +*XML::NamespaceSupport::getPrefix = \&get_prefix; +*XML::NamespaceSupport::getPrefixes = \&get_prefixes; +*XML::NamespaceSupport::getDeclaredPrefixes = \&get_declared_prefixes; +*XML::NamespaceSupport::getURI = \&get_uri; +*XML::NamespaceSupport::processName = \&process_name; +*XML::NamespaceSupport::processElementName = \&process_element_name; +*XML::NamespaceSupport::processAttributeName = \&process_attribute_name; +*XML::NamespaceSupport::parseJClarkNotation = \&parse_jclark_notation; +*XML::NamespaceSupport::undeclarePrefix = \&undeclare_prefix; +#-------------------------------------------------------------------# + + +1; +#,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,# +#`,`, Documentation `,`,`,`,`,`,`,`,`,`,`,`,`,`,`,`,`,`,`,`,`,`,`,`,# +#```````````````````````````````````````````````````````````````````# + +=pod + +=head1 NAME + +XML::NamespaceSupport - a simple generic namespace support class + +=head1 SYNOPSIS + + use XML::NamespaceSupport; + my $nsup = XML::NamespaceSupport->new; + + # add a new empty context + $nsup->push_context; + # declare a few prefixes + $nsup->declare_prefix($prefix1, $uri1); + $nsup->declare_prefix($prefix2, $uri2); + # the same shorter + $nsup->declare_prefixes($prefix1 => $uri1, $prefix2 => $uri2); + + # get a single prefix for a URI (randomly) + $prefix = $nsup->get_prefix($uri); + # get all prefixes for a URI (probably better) + @prefixes = $nsup->get_prefixes($uri); + # get all prefixes in scope + @prefixes = $nsup->get_prefixes(); + # get all prefixes that were declared for the current scope + @prefixes = $nsup->get_declared_prefixes; + # get a URI for a given prefix + $uri = $nsup->get_uri($prefix); + + # get info on a qname (java-ish way, it's a bit weird) + ($ns_uri, $local_name, $qname) = $nsup->process_name($qname, $is_attr); + # the same, more perlish + ($ns_uri, $prefix, $local_name) = $nsup->process_element_name($qname); + ($ns_uri, $prefix, $local_name) = $nsup->process_attribute_name($qname); + + # remove the current context + $nsup->pop_context; + + # reset the object for reuse in another document + $nsup->reset; + + # a simple helper to process Clarkian Notation + my ($ns, $lname) = $nsup->parse_jclark_notation('{http://foo}bar'); + # or (given that it doesn't care about the object + my ($ns, $lname) = XML::NamespaceSupport->parse_jclark_notation('{http://foo}bar'); + + +=head1 DESCRIPTION + +This module offers a simple to process namespaced XML names (unames) +from within any application that may need them. It also helps maintain +a prefix to namespace URI map, and provides a number of basic checks. + +The model for this module is SAX2's NamespaceSupport class, readable at +http://www.megginson.com/SAX/Java/javadoc/org/xml/sax/helpers/NamespaceSupport.html. +It adds a few perlisations where we thought it appropriate. + +=head1 METHODS + +=over 4 + +=item * XML::NamespaceSupport->new(\%options) + +A simple constructor. + +The options are C, C, and C + +If C is turned on (it is off by default) the mapping from the +xmlns prefix to the URI defined for it in DOM level 2 is added to the +list of predefined mappings (which normally only contains the xml +prefix mapping). + +If C is turned off (it is on by default) a number of +validity errors will simply be flagged as failures, instead of +die()ing. + +If C is turned on (it is off by default) when one +provides a prefix of C to C it will generate a +random prefix mapped to that namespace. Otherwise an undef prefix will +trigger a warning (you should probably know what you're doing if you +turn this option on). + +=item * $nsup->push_context + +Adds a new empty context to the stack. You can then populate it with +new prefixes defined at this level. + +=item * $nsup->pop_context + +Removes the topmost context in the stack and reverts to the previous +one. It will die() if you try to pop more than you have pushed. + +=item * $nsup->declare_prefix($prefix, $uri) + +Declares a mapping of $prefix to $uri, at the current level. + +Note that with C turned on, if you declare a prefix +mapping in which $prefix is undef(), you will get an automatic prefix +selected for you. If it is off you will get a warning. + +This is useful when you deal with code that hasn't kept prefixes around +and need to reserialize the nodes. It also means that if you want to +set the default namespace (ie with an empty prefix) you must use the +empty string instead of undef. This behaviour is consistent with the +SAX 2.0 specification. + +=item * $nsup->declare_prefixes(%prefixes2uris) + +Declares a mapping of several prefixes to URIs, at the current level. + +=item * $nsup->get_prefix($uri) + +Returns a prefix given an URI. Note that as several prefixes may be +mapped to the same URI, it returns an arbitrary one. It'll return +undef on failure. + +=item * $nsup->get_prefixes($uri) + +Returns an array of prefixes given an URI. It'll return all the +prefixes if the uri is undef. + +=item * $nsup->get_declared_prefixes + +Returns an array of all the prefixes that have been declared within +this context, ie those that were declared on the last element, not +those that were declared above and are simply in scope. + +=item * $nsup->get_uri($prefix) + +Returns a URI for a given prefix. Returns undef on failure. + +=item * $nsup->process_name($qname, $is_attr) + +Given a qualified name and a boolean indicating whether this is an +attribute or another type of name (those are differently affected by +default namespaces), it returns a namespace URI, local name, qualified +name tuple. I know that that is a rather abnormal list to return, but +it is so for compatibility with the Java spec. See below for more +Perlish alternatives. + +If the prefix is not declared, or if the name is not valid, it'll +either die or return undef depending on the current setting of +C. + +=item * $nsup->undeclare_prefix($prefix); + +Removes a namespace prefix from the current context. This function may +be used in SAX's end_prefix_mapping when there is fear that a namespace +declaration might be available outside their scope (which shouldn't +normally happen, but you never know ;). This may be needed in order to +properly support Namespace 1.1. + +=item * $nsup->process_element_name($qname) + +Given a qualified name, it returns a namespace URI, prefix, and local +name tuple. This method applies to element names. + +If the prefix is not declared, or if the name is not valid, it'll +either die or return undef depending on the current setting of +C. + +=item * $nsup->process_attribute_name($qname) + +Given a qualified name, it returns a namespace URI, prefix, and local +name tuple. This method applies to attribute names. + +If the prefix is not declared, or if the name is not valid, it'll +either die or return undef depending on the current setting of +C. + +=item * $nsup->reset + +Resets the object so that it can be reused on another document. + +=back + +All methods of the interface have an alias that is the name used in +the original Java specification. You can use either name +interchangeably. Here is the mapping: + + Java name Perl name + --------------------------------------------------- + pushContext push_context + popContext pop_context + declarePrefix declare_prefix + declarePrefixes declare_prefixes + getPrefix get_prefix + getPrefixes get_prefixes + getDeclaredPrefixes get_declared_prefixes + getURI get_uri + processName process_name + processElementName process_element_name + processAttributeName process_attribute_name + parseJClarkNotation parse_jclark_notation + undeclarePrefix undeclare_prefix + +=head1 VARIABLES + +Two global variables are made available to you. They used to be constants but +simple scalars are easier to use in a number of contexts. They are not +exported but can easily be accessed from any package, or copied into it. + +=over 4 + +=item * C<$NS_XMLNS> + +The namespace for xmlns prefixes, http://www.w3.org/2000/xmlns/. + +=item * C<$NS_XML> + +The namespace for xml prefixes, http://www.w3.org/XML/1998/namespace. + +=back + +=head1 TODO + + - add more tests + - optimise here and there + +=head1 AUTHOR + +Robin Berjon, robin@knowscape.com, with lots of it having been done +by Duncan Cameron, and a number of suggestions from the perl-xml +list. + +=head1 COPYRIGHT + +Copyright (c) 2001 Robin Berjon. All rights reserved. This program is +free software; you can redistribute it and/or modify it under the same +terms as Perl itself. + +=head1 SEE ALSO + +XML::Parser::PerlSAX + +=cut + diff -r 57a2cac6870f -r 0c558d696e7a common/tools/raptor/XML/SAX.pm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/common/tools/raptor/XML/SAX.pm Mon Aug 24 11:01:37 2009 +0100 @@ -0,0 +1,379 @@ +# $Id: SAX.pm,v 1.27 2007/02/07 09:33:50 grant Exp $ + +package XML::SAX; + +use strict; +use vars qw($VERSION @ISA @EXPORT_OK); + +$VERSION = '0.15'; + +use Exporter (); +@ISA = ('Exporter'); + +@EXPORT_OK = qw(Namespaces Validation); + +use File::Basename qw(dirname); +use File::Spec (); +use Symbol qw(gensym); +use XML::SAX::ParserFactory (); # loaded for simplicity + +use constant PARSER_DETAILS => "ParserDetails.ini"; + +use constant Namespaces => "http://xml.org/sax/features/namespaces"; +use constant Validation => "http://xml.org/sax/features/validation"; + +my $known_parsers = undef; + +# load_parsers takes the ParserDetails.ini file out of the same directory +# that XML::SAX is in, and looks at it. Format in POD below + +=begin EXAMPLE + +[XML::SAX::PurePerl] +http://xml.org/sax/features/namespaces = 1 +http://xml.org/sax/features/validation = 0 +# a comment + +# blank lines ignored + +[XML::SAX::AnotherParser] +http://xml.org/sax/features/namespaces = 0 +http://xml.org/sax/features/validation = 1 + +=end EXAMPLE + +=cut + +sub load_parsers { + my $class = shift; + my $dir = shift; + + # reset parsers + $known_parsers = []; + + # get directory from wherever XML::SAX is installed + if (!$dir) { + $dir = $INC{'XML/SAX.pm'}; + $dir = dirname($dir); + } + + my $fh = gensym(); + if (!open($fh, File::Spec->catfile($dir, "SAX", PARSER_DETAILS))) { + XML::SAX->do_warn("could not find " . PARSER_DETAILS . " in $dir/SAX\n"); + return $class; + } + + $known_parsers = $class->_parse_ini_file($fh); + + return $class; +} + +sub _parse_ini_file { + my $class = shift; + my ($fh) = @_; + + my @config; + + my $lineno = 0; + while (defined(my $line = <$fh>)) { + $lineno++; + my $original = $line; + # strip whitespace + $line =~ s/\s*$//m; + $line =~ s/^\s*//m; + # strip comments + $line =~ s/[#;].*$//m; + # ignore blanks + next if $line =~ /^$/m; + + # heading + if ($line =~ /^\[\s*(.*)\s*\]$/m) { + push @config, { Name => $1 }; + next; + } + + # instruction + elsif ($line =~ /^(.*?)\s*?=\s*(.*)$/) { + unless(@config) { + push @config, { Name => '' }; + } + $config[-1]{Features}{$1} = $2; + } + + # not whitespace, comment, or instruction + else { + die "Invalid line in ini: $lineno\n>>> $original\n"; + } + } + + return \@config; +} + +sub parsers { + my $class = shift; + if (!$known_parsers) { + $class->load_parsers(); + } + return $known_parsers; +} + +sub remove_parser { + my $class = shift; + my ($parser_module) = @_; + + if (!$known_parsers) { + $class->load_parsers(); + } + + @$known_parsers = grep { $_->{Name} ne $parser_module } @$known_parsers; + + return $class; +} + +sub add_parser { + my $class = shift; + my ($parser_module) = @_; + + if (!$known_parsers) { + $class->load_parsers(); + } + + # first load module, then query features, then push onto known_parsers, + + my $parser_file = $parser_module; + $parser_file =~ s/::/\//g; + $parser_file .= ".pm"; + + require $parser_file; + + my @features = $parser_module->supported_features(); + + my $new = { Name => $parser_module }; + foreach my $feature (@features) { + $new->{Features}{$feature} = 1; + } + + # If exists in list already, move to end. + my $done = 0; + my $pos = undef; + for (my $i = 0; $i < @$known_parsers; $i++) { + my $p = $known_parsers->[$i]; + if ($p->{Name} eq $parser_module) { + $pos = $i; + } + } + if (defined $pos) { + splice(@$known_parsers, $pos, 1); + push @$known_parsers, $new; + $done++; + } + + # Otherwise (not in list), add at end of list. + if (!$done) { + push @$known_parsers, $new; + } + + return $class; +} + +sub save_parsers { + my $class = shift; + + # get directory from wherever XML::SAX is installed + my $dir = $INC{'XML/SAX.pm'}; + $dir = dirname($dir); + + my $file = File::Spec->catfile($dir, "SAX", PARSER_DETAILS); + chmod 0644, $file; + unlink($file); + + my $fh = gensym(); + open($fh, ">$file") || + die "Cannot write to $file: $!"; + + foreach my $p (@$known_parsers) { + print $fh "[$p->{Name}]\n"; + foreach my $key (keys %{$p->{Features}}) { + print $fh "$key = $p->{Features}{$key}\n"; + } + print $fh "\n"; + } + + print $fh "\n"; + + close $fh; + + return $class; +} + +sub do_warn { + my $class = shift; + # Don't output warnings if running under Test::Harness + warn(@_) unless $ENV{HARNESS_ACTIVE}; +} + +1; +__END__ + +=head1 NAME + +XML::SAX - Simple API for XML + +=head1 SYNOPSIS + + use XML::SAX; + + # get a list of known parsers + my $parsers = XML::SAX->parsers(); + + # add/update a parser + XML::SAX->add_parser(q(XML::SAX::PurePerl)); + + # remove parser + XML::SAX->remove_parser(q(XML::SAX::Foodelberry)); + + # save parsers + XML::SAX->save_parsers(); + +=head1 DESCRIPTION + +XML::SAX is a SAX parser access API for Perl. It includes classes +and APIs required for implementing SAX drivers, along with a factory +class for returning any SAX parser installed on the user's system. + +=head1 USING A SAX2 PARSER + +The factory class is XML::SAX::ParserFactory. Please see the +documentation of that module for how to instantiate a SAX parser: +L. However if you don't want to load up +another manual page, here's a short synopsis: + + use XML::SAX::ParserFactory; + use XML::SAX::XYZHandler; + my $handler = XML::SAX::XYZHandler->new(); + my $p = XML::SAX::ParserFactory->parser(Handler => $handler); + $p->parse_uri("foo.xml"); + # or $p->parse_string("") or $p->parse_file($fh); + +This will automatically load a SAX2 parser (defaulting to +XML::SAX::PurePerl if no others are found) and return it to you. + +In order to learn how to use SAX to parse XML, you will need to read +L and for reference, L. + +=head1 WRITING A SAX2 PARSER + +The first thing to remember in writing a SAX2 parser is to subclass +XML::SAX::Base. This will make your life infinitely easier, by providing +a number of methods automagically for you. See L for more +details. + +When writing a SAX2 parser that is compatible with XML::SAX, you need +to inform XML::SAX of the presence of that driver when you install it. +In order to do that, XML::SAX contains methods for saving the fact that +the parser exists on your system to a "INI" file, which is then loaded +to determine which parsers are installed. + +The best way to do this is to follow these rules: + +=over 4 + +=item * Add XML::SAX as a prerequisite in Makefile.PL: + + WriteMakefile( + ... + PREREQ_PM => { 'XML::SAX' => 0 }, + ... + ); + +Alternatively you may wish to check for it in other ways that will +cause more than just a warning. + +=item * Add the following code snippet to your Makefile.PL: + + sub MY::install { + package MY; + my $script = shift->SUPER::install(@_); + if (ExtUtils::MakeMaker::prompt( + "Do you want to modify ParserDetails.ini?", 'Y') + =~ /^y/i) { + $script =~ s/install :: (.*)$/install :: $1 install_sax_driver/m; + $script .= <<"INSTALL"; + + install_sax_driver : + \t\@\$(PERL) -MXML::SAX -e "XML::SAX->add_parser(q(\$(NAME)))->save_parsers()" + + INSTALL + } + return $script; + } + +Note that you should check the output of this - \$(NAME) will use the name of +your distribution, which may not be exactly what you want. For example XML::LibXML +has a driver called XML::LibXML::SAX::Generator, which is used in place of +\$(NAME) in the above. + +=item * Add an XML::SAX test: + +A test file should be added to your t/ directory containing something like the +following: + + use Test; + BEGIN { plan tests => 3 } + use XML::SAX; + use XML::SAX::PurePerl::DebugHandler; + XML::SAX->add_parser(q(XML::SAX::MyDriver)); + local $XML::SAX::ParserPackage = 'XML::SAX::MyDriver'; + eval { + my $handler = XML::SAX::PurePerl::DebugHandler->new(); + ok($handler); + my $parser = XML::SAX::ParserFactory->parser(Handler => $handler); + ok($parser); + ok($parser->isa('XML::SAX::MyDriver'); + $parser->parse_string(""); + ok($handler->{seen}{start_element}); + }; + +=back + +=head1 EXPORTS + +By default, XML::SAX exports nothing into the caller's namespace. However you +can request the symbols C and C which are the +URIs for those features, allowing an easier way to request those features +via ParserFactory: + + use XML::SAX qw(Namespaces Validation); + my $factory = XML::SAX::ParserFactory->new(); + $factory->require_feature(Namespaces); + $factory->require_feature(Validation); + my $parser = $factory->parser(); + +=head1 AUTHOR + +Current maintainer: Grant McLean, grantm@cpan.org + +Originally written by: + +Matt Sergeant, matt@sergeant.org + +Kip Hampton, khampton@totalcinema.com + +Robin Berjon, robin@knowscape.com + +=head1 LICENSE + +This is free software, you may use it and distribute it under +the same terms as Perl itself. + +=head1 SEE ALSO + +L for writing SAX Filters and Parsers + +L for an XML parser written in 100% +pure perl. + +L for details on exception handling + +=cut + diff -r 57a2cac6870f -r 0c558d696e7a common/tools/raptor/XML/SAX/Base.pm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/common/tools/raptor/XML/SAX/Base.pm Mon Aug 24 11:01:37 2009 +0100 @@ -0,0 +1,3164 @@ +package XML::SAX::Base; + +# version 0.10 - Kip Hampton +# version 0.13 - Robin Berjon +# version 0.15 - Kip Hampton +# version 0.17 - Kip Hampton +# version 0.19 - Kip Hampton +# version 0.21 - Kip Hampton +# version 0.22 - Robin Berjon +# version 0.23 - Matt Sergeant +# version 0.24 - Robin Berjon +# version 0.25 - Kip Hampton +# version 1.00 - Kip Hampton +# version 1.01 - Kip Hampton +# version 1.02 - Robin Berjon +# version 1.03 - Matt Sergeant +# version 1.04 - Kip Hampton + +#-----------------------------------------------------# +# STOP!!!!! +# +# This file is generated by the 'Makefile.PL' file +# that ships with the XML::SAX distribution. +# If you need to make changes, patch that file NOT +# this one. +#-----------------------------------------------------# + +use strict; +use vars qw($VERSION); +use XML::SAX::Exception qw(); + +$VERSION = '1.04'; + +sub notation_decl { + my $self = shift; + if (defined $self->{Methods}->{'notation_decl'}) { + $self->{Methods}->{'notation_decl'}->(@_); + } + else { + my $method; + my $callbacks; + if (exists $self->{ParseOptions}) { + $callbacks = $self->{ParseOptions}; + } + else { + $callbacks = $self; + } + if (0) { # dummy to make elsif's below compile + } + elsif (defined $callbacks->{'DTDHandler'} and $method = $callbacks->{'DTDHandler'}->can('notation_decl') ) { + my $handler = $callbacks->{'DTDHandler'}; + $self->{Methods}->{'notation_decl'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'Handler'} and $method = $callbacks->{'Handler'}->can('notation_decl') ) { + my $handler = $callbacks->{'Handler'}; + $self->{Methods}->{'notation_decl'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'DTDHandler'} + and $callbacks->{'DTDHandler'}->can('AUTOLOAD') + and $callbacks->{'DTDHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'DTDHandler'}->notation_decl(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'DTDHandler'}; + $self->{Methods}->{'notation_decl'} = sub { $handler->notation_decl(@_) }; + } + return $res; + } + elsif (defined $callbacks->{'Handler'} + and $callbacks->{'Handler'}->can('AUTOLOAD') + and $callbacks->{'Handler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'Handler'}->notation_decl(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'Handler'}; + $self->{Methods}->{'notation_decl'} = sub { $handler->notation_decl(@_) }; + } + return $res; + } + else { + $self->{Methods}->{'notation_decl'} = sub { }; + } + } + +} + +sub resolve_entity { + my $self = shift; + if (defined $self->{Methods}->{'resolve_entity'}) { + $self->{Methods}->{'resolve_entity'}->(@_); + } + else { + my $method; + my $callbacks; + if (exists $self->{ParseOptions}) { + $callbacks = $self->{ParseOptions}; + } + else { + $callbacks = $self; + } + if (0) { # dummy to make elsif's below compile + } + elsif (defined $callbacks->{'EntityResolver'} and $method = $callbacks->{'EntityResolver'}->can('resolve_entity') ) { + my $handler = $callbacks->{'EntityResolver'}; + $self->{Methods}->{'resolve_entity'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'Handler'} and $method = $callbacks->{'Handler'}->can('resolve_entity') ) { + my $handler = $callbacks->{'Handler'}; + $self->{Methods}->{'resolve_entity'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'EntityResolver'} + and $callbacks->{'EntityResolver'}->can('AUTOLOAD') + and $callbacks->{'EntityResolver'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'EntityResolver'}->resolve_entity(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'EntityResolver'}; + $self->{Methods}->{'resolve_entity'} = sub { $handler->resolve_entity(@_) }; + } + return $res; + } + elsif (defined $callbacks->{'Handler'} + and $callbacks->{'Handler'}->can('AUTOLOAD') + and $callbacks->{'Handler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'Handler'}->resolve_entity(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'Handler'}; + $self->{Methods}->{'resolve_entity'} = sub { $handler->resolve_entity(@_) }; + } + return $res; + } + else { + $self->{Methods}->{'resolve_entity'} = sub { }; + } + } + +} + +sub start_cdata { + my $self = shift; + if (defined $self->{Methods}->{'start_cdata'}) { + $self->{Methods}->{'start_cdata'}->(@_); + } + else { + my $method; + my $callbacks; + if (exists $self->{ParseOptions}) { + $callbacks = $self->{ParseOptions}; + } + else { + $callbacks = $self; + } + if (0) { # dummy to make elsif's below compile + } + elsif (defined $callbacks->{'DocumentHandler'} and $method = $callbacks->{'DocumentHandler'}->can('start_cdata') ) { + my $handler = $callbacks->{'DocumentHandler'}; + $self->{Methods}->{'start_cdata'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'LexicalHandler'} and $method = $callbacks->{'LexicalHandler'}->can('start_cdata') ) { + my $handler = $callbacks->{'LexicalHandler'}; + $self->{Methods}->{'start_cdata'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'Handler'} and $method = $callbacks->{'Handler'}->can('start_cdata') ) { + my $handler = $callbacks->{'Handler'}; + $self->{Methods}->{'start_cdata'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'DocumentHandler'} + and $callbacks->{'DocumentHandler'}->can('AUTOLOAD') + and $callbacks->{'DocumentHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'DocumentHandler'}->start_cdata(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'DocumentHandler'}; + $self->{Methods}->{'start_cdata'} = sub { $handler->start_cdata(@_) }; + } + return $res; + } + elsif (defined $callbacks->{'LexicalHandler'} + and $callbacks->{'LexicalHandler'}->can('AUTOLOAD') + and $callbacks->{'LexicalHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'LexicalHandler'}->start_cdata(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'LexicalHandler'}; + $self->{Methods}->{'start_cdata'} = sub { $handler->start_cdata(@_) }; + } + return $res; + } + elsif (defined $callbacks->{'Handler'} + and $callbacks->{'Handler'}->can('AUTOLOAD') + and $callbacks->{'Handler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'Handler'}->start_cdata(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'Handler'}; + $self->{Methods}->{'start_cdata'} = sub { $handler->start_cdata(@_) }; + } + return $res; + } + else { + $self->{Methods}->{'start_cdata'} = sub { }; + } + } + +} + +sub set_document_locator { + my $self = shift; + if (defined $self->{Methods}->{'set_document_locator'}) { + $self->{Methods}->{'set_document_locator'}->(@_); + } + else { + my $method; + my $callbacks; + if (exists $self->{ParseOptions}) { + $callbacks = $self->{ParseOptions}; + } + else { + $callbacks = $self; + } + if (0) { # dummy to make elsif's below compile + } + elsif (defined $callbacks->{'ContentHandler'} and $method = $callbacks->{'ContentHandler'}->can('set_document_locator') ) { + my $handler = $callbacks->{'ContentHandler'}; + $self->{Methods}->{'set_document_locator'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'DocumentHandler'} and $method = $callbacks->{'DocumentHandler'}->can('set_document_locator') ) { + my $handler = $callbacks->{'DocumentHandler'}; + $self->{Methods}->{'set_document_locator'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'Handler'} and $method = $callbacks->{'Handler'}->can('set_document_locator') ) { + my $handler = $callbacks->{'Handler'}; + $self->{Methods}->{'set_document_locator'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'ContentHandler'} + and $callbacks->{'ContentHandler'}->can('AUTOLOAD') + and $callbacks->{'ContentHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'ContentHandler'}->set_document_locator(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'ContentHandler'}; + $self->{Methods}->{'set_document_locator'} = sub { $handler->set_document_locator(@_) }; + } + return $res; + } + elsif (defined $callbacks->{'DocumentHandler'} + and $callbacks->{'DocumentHandler'}->can('AUTOLOAD') + and $callbacks->{'DocumentHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'DocumentHandler'}->set_document_locator(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'DocumentHandler'}; + $self->{Methods}->{'set_document_locator'} = sub { $handler->set_document_locator(@_) }; + } + return $res; + } + elsif (defined $callbacks->{'Handler'} + and $callbacks->{'Handler'}->can('AUTOLOAD') + and $callbacks->{'Handler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'Handler'}->set_document_locator(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'Handler'}; + $self->{Methods}->{'set_document_locator'} = sub { $handler->set_document_locator(@_) }; + } + return $res; + } + else { + $self->{Methods}->{'set_document_locator'} = sub { }; + } + } + +} + +sub xml_decl { + my $self = shift; + if (defined $self->{Methods}->{'xml_decl'}) { + $self->{Methods}->{'xml_decl'}->(@_); + } + else { + my $method; + my $callbacks; + if (exists $self->{ParseOptions}) { + $callbacks = $self->{ParseOptions}; + } + else { + $callbacks = $self; + } + if (0) { # dummy to make elsif's below compile + } + elsif (defined $callbacks->{'DTDHandler'} and $method = $callbacks->{'DTDHandler'}->can('xml_decl') ) { + my $handler = $callbacks->{'DTDHandler'}; + $self->{Methods}->{'xml_decl'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'Handler'} and $method = $callbacks->{'Handler'}->can('xml_decl') ) { + my $handler = $callbacks->{'Handler'}; + $self->{Methods}->{'xml_decl'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'DTDHandler'} + and $callbacks->{'DTDHandler'}->can('AUTOLOAD') + and $callbacks->{'DTDHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'DTDHandler'}->xml_decl(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'DTDHandler'}; + $self->{Methods}->{'xml_decl'} = sub { $handler->xml_decl(@_) }; + } + return $res; + } + elsif (defined $callbacks->{'Handler'} + and $callbacks->{'Handler'}->can('AUTOLOAD') + and $callbacks->{'Handler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'Handler'}->xml_decl(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'Handler'}; + $self->{Methods}->{'xml_decl'} = sub { $handler->xml_decl(@_) }; + } + return $res; + } + else { + $self->{Methods}->{'xml_decl'} = sub { }; + } + } + +} + +sub processing_instruction { + my $self = shift; + if (defined $self->{Methods}->{'processing_instruction'}) { + $self->{Methods}->{'processing_instruction'}->(@_); + } + else { + my $method; + my $callbacks; + if (exists $self->{ParseOptions}) { + $callbacks = $self->{ParseOptions}; + } + else { + $callbacks = $self; + } + if (0) { # dummy to make elsif's below compile + } + elsif (defined $callbacks->{'ContentHandler'} and $method = $callbacks->{'ContentHandler'}->can('processing_instruction') ) { + my $handler = $callbacks->{'ContentHandler'}; + $self->{Methods}->{'processing_instruction'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'DocumentHandler'} and $method = $callbacks->{'DocumentHandler'}->can('processing_instruction') ) { + my $handler = $callbacks->{'DocumentHandler'}; + $self->{Methods}->{'processing_instruction'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'Handler'} and $method = $callbacks->{'Handler'}->can('processing_instruction') ) { + my $handler = $callbacks->{'Handler'}; + $self->{Methods}->{'processing_instruction'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'ContentHandler'} + and $callbacks->{'ContentHandler'}->can('AUTOLOAD') + and $callbacks->{'ContentHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'ContentHandler'}->processing_instruction(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'ContentHandler'}; + $self->{Methods}->{'processing_instruction'} = sub { $handler->processing_instruction(@_) }; + } + return $res; + } + elsif (defined $callbacks->{'DocumentHandler'} + and $callbacks->{'DocumentHandler'}->can('AUTOLOAD') + and $callbacks->{'DocumentHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'DocumentHandler'}->processing_instruction(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'DocumentHandler'}; + $self->{Methods}->{'processing_instruction'} = sub { $handler->processing_instruction(@_) }; + } + return $res; + } + elsif (defined $callbacks->{'Handler'} + and $callbacks->{'Handler'}->can('AUTOLOAD') + and $callbacks->{'Handler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'Handler'}->processing_instruction(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'Handler'}; + $self->{Methods}->{'processing_instruction'} = sub { $handler->processing_instruction(@_) }; + } + return $res; + } + else { + $self->{Methods}->{'processing_instruction'} = sub { }; + } + } + +} + +sub start_prefix_mapping { + my $self = shift; + if (defined $self->{Methods}->{'start_prefix_mapping'}) { + $self->{Methods}->{'start_prefix_mapping'}->(@_); + } + else { + my $method; + my $callbacks; + if (exists $self->{ParseOptions}) { + $callbacks = $self->{ParseOptions}; + } + else { + $callbacks = $self; + } + if (0) { # dummy to make elsif's below compile + } + elsif (defined $callbacks->{'ContentHandler'} and $method = $callbacks->{'ContentHandler'}->can('start_prefix_mapping') ) { + my $handler = $callbacks->{'ContentHandler'}; + $self->{Methods}->{'start_prefix_mapping'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'Handler'} and $method = $callbacks->{'Handler'}->can('start_prefix_mapping') ) { + my $handler = $callbacks->{'Handler'}; + $self->{Methods}->{'start_prefix_mapping'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'ContentHandler'} + and $callbacks->{'ContentHandler'}->can('AUTOLOAD') + and $callbacks->{'ContentHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'ContentHandler'}->start_prefix_mapping(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'ContentHandler'}; + $self->{Methods}->{'start_prefix_mapping'} = sub { $handler->start_prefix_mapping(@_) }; + } + return $res; + } + elsif (defined $callbacks->{'Handler'} + and $callbacks->{'Handler'}->can('AUTOLOAD') + and $callbacks->{'Handler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'Handler'}->start_prefix_mapping(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'Handler'}; + $self->{Methods}->{'start_prefix_mapping'} = sub { $handler->start_prefix_mapping(@_) }; + } + return $res; + } + else { + $self->{Methods}->{'start_prefix_mapping'} = sub { }; + } + } + +} + +sub entity_reference { + my $self = shift; + if (defined $self->{Methods}->{'entity_reference'}) { + $self->{Methods}->{'entity_reference'}->(@_); + } + else { + my $method; + my $callbacks; + if (exists $self->{ParseOptions}) { + $callbacks = $self->{ParseOptions}; + } + else { + $callbacks = $self; + } + if (0) { # dummy to make elsif's below compile + } + elsif (defined $callbacks->{'DocumentHandler'} and $method = $callbacks->{'DocumentHandler'}->can('entity_reference') ) { + my $handler = $callbacks->{'DocumentHandler'}; + $self->{Methods}->{'entity_reference'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'Handler'} and $method = $callbacks->{'Handler'}->can('entity_reference') ) { + my $handler = $callbacks->{'Handler'}; + $self->{Methods}->{'entity_reference'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'DocumentHandler'} + and $callbacks->{'DocumentHandler'}->can('AUTOLOAD') + and $callbacks->{'DocumentHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'DocumentHandler'}->entity_reference(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'DocumentHandler'}; + $self->{Methods}->{'entity_reference'} = sub { $handler->entity_reference(@_) }; + } + return $res; + } + elsif (defined $callbacks->{'Handler'} + and $callbacks->{'Handler'}->can('AUTOLOAD') + and $callbacks->{'Handler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'Handler'}->entity_reference(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'Handler'}; + $self->{Methods}->{'entity_reference'} = sub { $handler->entity_reference(@_) }; + } + return $res; + } + else { + $self->{Methods}->{'entity_reference'} = sub { }; + } + } + +} + +sub attlist_decl { + my $self = shift; + if (defined $self->{Methods}->{'attlist_decl'}) { + $self->{Methods}->{'attlist_decl'}->(@_); + } + else { + my $method; + my $callbacks; + if (exists $self->{ParseOptions}) { + $callbacks = $self->{ParseOptions}; + } + else { + $callbacks = $self; + } + if (0) { # dummy to make elsif's below compile + } + elsif (defined $callbacks->{'DTDHandler'} and $method = $callbacks->{'DTDHandler'}->can('attlist_decl') ) { + my $handler = $callbacks->{'DTDHandler'}; + $self->{Methods}->{'attlist_decl'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'Handler'} and $method = $callbacks->{'Handler'}->can('attlist_decl') ) { + my $handler = $callbacks->{'Handler'}; + $self->{Methods}->{'attlist_decl'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'DTDHandler'} + and $callbacks->{'DTDHandler'}->can('AUTOLOAD') + and $callbacks->{'DTDHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'DTDHandler'}->attlist_decl(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'DTDHandler'}; + $self->{Methods}->{'attlist_decl'} = sub { $handler->attlist_decl(@_) }; + } + return $res; + } + elsif (defined $callbacks->{'Handler'} + and $callbacks->{'Handler'}->can('AUTOLOAD') + and $callbacks->{'Handler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'Handler'}->attlist_decl(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'Handler'}; + $self->{Methods}->{'attlist_decl'} = sub { $handler->attlist_decl(@_) }; + } + return $res; + } + else { + $self->{Methods}->{'attlist_decl'} = sub { }; + } + } + +} + +sub error { + my $self = shift; + if (defined $self->{Methods}->{'error'}) { + $self->{Methods}->{'error'}->(@_); + } + else { + my $method; + my $callbacks; + if (exists $self->{ParseOptions}) { + $callbacks = $self->{ParseOptions}; + } + else { + $callbacks = $self; + } + if (0) { # dummy to make elsif's below compile + } + elsif (defined $callbacks->{'ErrorHandler'} and $method = $callbacks->{'ErrorHandler'}->can('error') ) { + my $handler = $callbacks->{'ErrorHandler'}; + $self->{Methods}->{'error'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'Handler'} and $method = $callbacks->{'Handler'}->can('error') ) { + my $handler = $callbacks->{'Handler'}; + $self->{Methods}->{'error'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'ErrorHandler'} + and $callbacks->{'ErrorHandler'}->can('AUTOLOAD') + and $callbacks->{'ErrorHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'ErrorHandler'}->error(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'ErrorHandler'}; + $self->{Methods}->{'error'} = sub { $handler->error(@_) }; + } + return $res; + } + elsif (defined $callbacks->{'Handler'} + and $callbacks->{'Handler'}->can('AUTOLOAD') + and $callbacks->{'Handler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'Handler'}->error(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'Handler'}; + $self->{Methods}->{'error'} = sub { $handler->error(@_) }; + } + return $res; + } + else { + $self->{Methods}->{'error'} = sub { }; + } + } + +} + +sub unparsed_entity_decl { + my $self = shift; + if (defined $self->{Methods}->{'unparsed_entity_decl'}) { + $self->{Methods}->{'unparsed_entity_decl'}->(@_); + } + else { + my $method; + my $callbacks; + if (exists $self->{ParseOptions}) { + $callbacks = $self->{ParseOptions}; + } + else { + $callbacks = $self; + } + if (0) { # dummy to make elsif's below compile + } + elsif (defined $callbacks->{'DTDHandler'} and $method = $callbacks->{'DTDHandler'}->can('unparsed_entity_decl') ) { + my $handler = $callbacks->{'DTDHandler'}; + $self->{Methods}->{'unparsed_entity_decl'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'Handler'} and $method = $callbacks->{'Handler'}->can('unparsed_entity_decl') ) { + my $handler = $callbacks->{'Handler'}; + $self->{Methods}->{'unparsed_entity_decl'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'DTDHandler'} + and $callbacks->{'DTDHandler'}->can('AUTOLOAD') + and $callbacks->{'DTDHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'DTDHandler'}->unparsed_entity_decl(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'DTDHandler'}; + $self->{Methods}->{'unparsed_entity_decl'} = sub { $handler->unparsed_entity_decl(@_) }; + } + return $res; + } + elsif (defined $callbacks->{'Handler'} + and $callbacks->{'Handler'}->can('AUTOLOAD') + and $callbacks->{'Handler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'Handler'}->unparsed_entity_decl(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'Handler'}; + $self->{Methods}->{'unparsed_entity_decl'} = sub { $handler->unparsed_entity_decl(@_) }; + } + return $res; + } + else { + $self->{Methods}->{'unparsed_entity_decl'} = sub { }; + } + } + +} + +sub end_entity { + my $self = shift; + if (defined $self->{Methods}->{'end_entity'}) { + $self->{Methods}->{'end_entity'}->(@_); + } + else { + my $method; + my $callbacks; + if (exists $self->{ParseOptions}) { + $callbacks = $self->{ParseOptions}; + } + else { + $callbacks = $self; + } + if (0) { # dummy to make elsif's below compile + } + elsif (defined $callbacks->{'LexicalHandler'} and $method = $callbacks->{'LexicalHandler'}->can('end_entity') ) { + my $handler = $callbacks->{'LexicalHandler'}; + $self->{Methods}->{'end_entity'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'Handler'} and $method = $callbacks->{'Handler'}->can('end_entity') ) { + my $handler = $callbacks->{'Handler'}; + $self->{Methods}->{'end_entity'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'LexicalHandler'} + and $callbacks->{'LexicalHandler'}->can('AUTOLOAD') + and $callbacks->{'LexicalHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'LexicalHandler'}->end_entity(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'LexicalHandler'}; + $self->{Methods}->{'end_entity'} = sub { $handler->end_entity(@_) }; + } + return $res; + } + elsif (defined $callbacks->{'Handler'} + and $callbacks->{'Handler'}->can('AUTOLOAD') + and $callbacks->{'Handler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'Handler'}->end_entity(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'Handler'}; + $self->{Methods}->{'end_entity'} = sub { $handler->end_entity(@_) }; + } + return $res; + } + else { + $self->{Methods}->{'end_entity'} = sub { }; + } + } + +} + +sub end_element { + my $self = shift; + if (defined $self->{Methods}->{'end_element'}) { + $self->{Methods}->{'end_element'}->(@_); + } + else { + my $method; + my $callbacks; + if (exists $self->{ParseOptions}) { + $callbacks = $self->{ParseOptions}; + } + else { + $callbacks = $self; + } + if (0) { # dummy to make elsif's below compile + } + elsif (defined $callbacks->{'ContentHandler'} and $method = $callbacks->{'ContentHandler'}->can('end_element') ) { + my $handler = $callbacks->{'ContentHandler'}; + $self->{Methods}->{'end_element'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'DocumentHandler'} and $method = $callbacks->{'DocumentHandler'}->can('end_element') ) { + my $handler = $callbacks->{'DocumentHandler'}; + $self->{Methods}->{'end_element'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'Handler'} and $method = $callbacks->{'Handler'}->can('end_element') ) { + my $handler = $callbacks->{'Handler'}; + $self->{Methods}->{'end_element'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'ContentHandler'} + and $callbacks->{'ContentHandler'}->can('AUTOLOAD') + and $callbacks->{'ContentHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'ContentHandler'}->end_element(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'ContentHandler'}; + $self->{Methods}->{'end_element'} = sub { $handler->end_element(@_) }; + } + return $res; + } + elsif (defined $callbacks->{'DocumentHandler'} + and $callbacks->{'DocumentHandler'}->can('AUTOLOAD') + and $callbacks->{'DocumentHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'DocumentHandler'}->end_element(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'DocumentHandler'}; + $self->{Methods}->{'end_element'} = sub { $handler->end_element(@_) }; + } + return $res; + } + elsif (defined $callbacks->{'Handler'} + and $callbacks->{'Handler'}->can('AUTOLOAD') + and $callbacks->{'Handler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'Handler'}->end_element(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'Handler'}; + $self->{Methods}->{'end_element'} = sub { $handler->end_element(@_) }; + } + return $res; + } + else { + $self->{Methods}->{'end_element'} = sub { }; + } + } + +} + +sub comment { + my $self = shift; + if (defined $self->{Methods}->{'comment'}) { + $self->{Methods}->{'comment'}->(@_); + } + else { + my $method; + my $callbacks; + if (exists $self->{ParseOptions}) { + $callbacks = $self->{ParseOptions}; + } + else { + $callbacks = $self; + } + if (0) { # dummy to make elsif's below compile + } + elsif (defined $callbacks->{'DocumentHandler'} and $method = $callbacks->{'DocumentHandler'}->can('comment') ) { + my $handler = $callbacks->{'DocumentHandler'}; + $self->{Methods}->{'comment'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'LexicalHandler'} and $method = $callbacks->{'LexicalHandler'}->can('comment') ) { + my $handler = $callbacks->{'LexicalHandler'}; + $self->{Methods}->{'comment'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'Handler'} and $method = $callbacks->{'Handler'}->can('comment') ) { + my $handler = $callbacks->{'Handler'}; + $self->{Methods}->{'comment'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'DocumentHandler'} + and $callbacks->{'DocumentHandler'}->can('AUTOLOAD') + and $callbacks->{'DocumentHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'DocumentHandler'}->comment(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'DocumentHandler'}; + $self->{Methods}->{'comment'} = sub { $handler->comment(@_) }; + } + return $res; + } + elsif (defined $callbacks->{'LexicalHandler'} + and $callbacks->{'LexicalHandler'}->can('AUTOLOAD') + and $callbacks->{'LexicalHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'LexicalHandler'}->comment(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'LexicalHandler'}; + $self->{Methods}->{'comment'} = sub { $handler->comment(@_) }; + } + return $res; + } + elsif (defined $callbacks->{'Handler'} + and $callbacks->{'Handler'}->can('AUTOLOAD') + and $callbacks->{'Handler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'Handler'}->comment(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'Handler'}; + $self->{Methods}->{'comment'} = sub { $handler->comment(@_) }; + } + return $res; + } + else { + $self->{Methods}->{'comment'} = sub { }; + } + } + +} + +sub element_decl { + my $self = shift; + if (defined $self->{Methods}->{'element_decl'}) { + $self->{Methods}->{'element_decl'}->(@_); + } + else { + my $method; + my $callbacks; + if (exists $self->{ParseOptions}) { + $callbacks = $self->{ParseOptions}; + } + else { + $callbacks = $self; + } + if (0) { # dummy to make elsif's below compile + } + elsif (defined $callbacks->{'DeclHandler'} and $method = $callbacks->{'DeclHandler'}->can('element_decl') ) { + my $handler = $callbacks->{'DeclHandler'}; + $self->{Methods}->{'element_decl'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'Handler'} and $method = $callbacks->{'Handler'}->can('element_decl') ) { + my $handler = $callbacks->{'Handler'}; + $self->{Methods}->{'element_decl'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'DeclHandler'} + and $callbacks->{'DeclHandler'}->can('AUTOLOAD') + and $callbacks->{'DeclHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'DeclHandler'}->element_decl(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'DeclHandler'}; + $self->{Methods}->{'element_decl'} = sub { $handler->element_decl(@_) }; + } + return $res; + } + elsif (defined $callbacks->{'Handler'} + and $callbacks->{'Handler'}->can('AUTOLOAD') + and $callbacks->{'Handler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'Handler'}->element_decl(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'Handler'}; + $self->{Methods}->{'element_decl'} = sub { $handler->element_decl(@_) }; + } + return $res; + } + else { + $self->{Methods}->{'element_decl'} = sub { }; + } + } + +} + +sub attribute_decl { + my $self = shift; + if (defined $self->{Methods}->{'attribute_decl'}) { + $self->{Methods}->{'attribute_decl'}->(@_); + } + else { + my $method; + my $callbacks; + if (exists $self->{ParseOptions}) { + $callbacks = $self->{ParseOptions}; + } + else { + $callbacks = $self; + } + if (0) { # dummy to make elsif's below compile + } + elsif (defined $callbacks->{'DeclHandler'} and $method = $callbacks->{'DeclHandler'}->can('attribute_decl') ) { + my $handler = $callbacks->{'DeclHandler'}; + $self->{Methods}->{'attribute_decl'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'Handler'} and $method = $callbacks->{'Handler'}->can('attribute_decl') ) { + my $handler = $callbacks->{'Handler'}; + $self->{Methods}->{'attribute_decl'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'DeclHandler'} + and $callbacks->{'DeclHandler'}->can('AUTOLOAD') + and $callbacks->{'DeclHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'DeclHandler'}->attribute_decl(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'DeclHandler'}; + $self->{Methods}->{'attribute_decl'} = sub { $handler->attribute_decl(@_) }; + } + return $res; + } + elsif (defined $callbacks->{'Handler'} + and $callbacks->{'Handler'}->can('AUTOLOAD') + and $callbacks->{'Handler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'Handler'}->attribute_decl(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'Handler'}; + $self->{Methods}->{'attribute_decl'} = sub { $handler->attribute_decl(@_) }; + } + return $res; + } + else { + $self->{Methods}->{'attribute_decl'} = sub { }; + } + } + +} + +sub fatal_error { + my $self = shift; + if (defined $self->{Methods}->{'fatal_error'}) { + $self->{Methods}->{'fatal_error'}->(@_); + } + else { + my $method; + my $callbacks; + if (exists $self->{ParseOptions}) { + $callbacks = $self->{ParseOptions}; + } + else { + $callbacks = $self; + } + if (0) { # dummy to make elsif's below compile + } + elsif (defined $callbacks->{'ErrorHandler'} and $method = $callbacks->{'ErrorHandler'}->can('fatal_error') ) { + my $handler = $callbacks->{'ErrorHandler'}; + $self->{Methods}->{'fatal_error'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'Handler'} and $method = $callbacks->{'Handler'}->can('fatal_error') ) { + my $handler = $callbacks->{'Handler'}; + $self->{Methods}->{'fatal_error'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'ErrorHandler'} + and $callbacks->{'ErrorHandler'}->can('AUTOLOAD') + and $callbacks->{'ErrorHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'ErrorHandler'}->fatal_error(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'ErrorHandler'}; + $self->{Methods}->{'fatal_error'} = sub { $handler->fatal_error(@_) }; + } + return $res; + } + elsif (defined $callbacks->{'Handler'} + and $callbacks->{'Handler'}->can('AUTOLOAD') + and $callbacks->{'Handler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'Handler'}->fatal_error(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'Handler'}; + $self->{Methods}->{'fatal_error'} = sub { $handler->fatal_error(@_) }; + } + return $res; + } + else { + $self->{Methods}->{'fatal_error'} = sub { }; + } + } + +} + +sub start_document { + my $self = shift; + if (defined $self->{Methods}->{'start_document'}) { + $self->{Methods}->{'start_document'}->(@_); + } + else { + my $method; + my $callbacks; + if (exists $self->{ParseOptions}) { + $callbacks = $self->{ParseOptions}; + } + else { + $callbacks = $self; + } + if (0) { # dummy to make elsif's below compile + } + elsif (defined $callbacks->{'ContentHandler'} and $method = $callbacks->{'ContentHandler'}->can('start_document') ) { + my $handler = $callbacks->{'ContentHandler'}; + $self->{Methods}->{'start_document'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'DocumentHandler'} and $method = $callbacks->{'DocumentHandler'}->can('start_document') ) { + my $handler = $callbacks->{'DocumentHandler'}; + $self->{Methods}->{'start_document'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'Handler'} and $method = $callbacks->{'Handler'}->can('start_document') ) { + my $handler = $callbacks->{'Handler'}; + $self->{Methods}->{'start_document'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'ContentHandler'} + and $callbacks->{'ContentHandler'}->can('AUTOLOAD') + and $callbacks->{'ContentHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'ContentHandler'}->start_document(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'ContentHandler'}; + $self->{Methods}->{'start_document'} = sub { $handler->start_document(@_) }; + } + return $res; + } + elsif (defined $callbacks->{'DocumentHandler'} + and $callbacks->{'DocumentHandler'}->can('AUTOLOAD') + and $callbacks->{'DocumentHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'DocumentHandler'}->start_document(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'DocumentHandler'}; + $self->{Methods}->{'start_document'} = sub { $handler->start_document(@_) }; + } + return $res; + } + elsif (defined $callbacks->{'Handler'} + and $callbacks->{'Handler'}->can('AUTOLOAD') + and $callbacks->{'Handler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'Handler'}->start_document(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'Handler'}; + $self->{Methods}->{'start_document'} = sub { $handler->start_document(@_) }; + } + return $res; + } + else { + $self->{Methods}->{'start_document'} = sub { }; + } + } + +} + +sub external_entity_decl { + my $self = shift; + if (defined $self->{Methods}->{'external_entity_decl'}) { + $self->{Methods}->{'external_entity_decl'}->(@_); + } + else { + my $method; + my $callbacks; + if (exists $self->{ParseOptions}) { + $callbacks = $self->{ParseOptions}; + } + else { + $callbacks = $self; + } + if (0) { # dummy to make elsif's below compile + } + elsif (defined $callbacks->{'DeclHandler'} and $method = $callbacks->{'DeclHandler'}->can('external_entity_decl') ) { + my $handler = $callbacks->{'DeclHandler'}; + $self->{Methods}->{'external_entity_decl'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'Handler'} and $method = $callbacks->{'Handler'}->can('external_entity_decl') ) { + my $handler = $callbacks->{'Handler'}; + $self->{Methods}->{'external_entity_decl'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'DeclHandler'} + and $callbacks->{'DeclHandler'}->can('AUTOLOAD') + and $callbacks->{'DeclHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'DeclHandler'}->external_entity_decl(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'DeclHandler'}; + $self->{Methods}->{'external_entity_decl'} = sub { $handler->external_entity_decl(@_) }; + } + return $res; + } + elsif (defined $callbacks->{'Handler'} + and $callbacks->{'Handler'}->can('AUTOLOAD') + and $callbacks->{'Handler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'Handler'}->external_entity_decl(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'Handler'}; + $self->{Methods}->{'external_entity_decl'} = sub { $handler->external_entity_decl(@_) }; + } + return $res; + } + else { + $self->{Methods}->{'external_entity_decl'} = sub { }; + } + } + +} + +sub warning { + my $self = shift; + if (defined $self->{Methods}->{'warning'}) { + $self->{Methods}->{'warning'}->(@_); + } + else { + my $method; + my $callbacks; + if (exists $self->{ParseOptions}) { + $callbacks = $self->{ParseOptions}; + } + else { + $callbacks = $self; + } + if (0) { # dummy to make elsif's below compile + } + elsif (defined $callbacks->{'ErrorHandler'} and $method = $callbacks->{'ErrorHandler'}->can('warning') ) { + my $handler = $callbacks->{'ErrorHandler'}; + $self->{Methods}->{'warning'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'Handler'} and $method = $callbacks->{'Handler'}->can('warning') ) { + my $handler = $callbacks->{'Handler'}; + $self->{Methods}->{'warning'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'ErrorHandler'} + and $callbacks->{'ErrorHandler'}->can('AUTOLOAD') + and $callbacks->{'ErrorHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'ErrorHandler'}->warning(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'ErrorHandler'}; + $self->{Methods}->{'warning'} = sub { $handler->warning(@_) }; + } + return $res; + } + elsif (defined $callbacks->{'Handler'} + and $callbacks->{'Handler'}->can('AUTOLOAD') + and $callbacks->{'Handler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'Handler'}->warning(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'Handler'}; + $self->{Methods}->{'warning'} = sub { $handler->warning(@_) }; + } + return $res; + } + else { + $self->{Methods}->{'warning'} = sub { }; + } + } + +} + +sub doctype_decl { + my $self = shift; + if (defined $self->{Methods}->{'doctype_decl'}) { + $self->{Methods}->{'doctype_decl'}->(@_); + } + else { + my $method; + my $callbacks; + if (exists $self->{ParseOptions}) { + $callbacks = $self->{ParseOptions}; + } + else { + $callbacks = $self; + } + if (0) { # dummy to make elsif's below compile + } + elsif (defined $callbacks->{'DTDHandler'} and $method = $callbacks->{'DTDHandler'}->can('doctype_decl') ) { + my $handler = $callbacks->{'DTDHandler'}; + $self->{Methods}->{'doctype_decl'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'Handler'} and $method = $callbacks->{'Handler'}->can('doctype_decl') ) { + my $handler = $callbacks->{'Handler'}; + $self->{Methods}->{'doctype_decl'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'DTDHandler'} + and $callbacks->{'DTDHandler'}->can('AUTOLOAD') + and $callbacks->{'DTDHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'DTDHandler'}->doctype_decl(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'DTDHandler'}; + $self->{Methods}->{'doctype_decl'} = sub { $handler->doctype_decl(@_) }; + } + return $res; + } + elsif (defined $callbacks->{'Handler'} + and $callbacks->{'Handler'}->can('AUTOLOAD') + and $callbacks->{'Handler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'Handler'}->doctype_decl(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'Handler'}; + $self->{Methods}->{'doctype_decl'} = sub { $handler->doctype_decl(@_) }; + } + return $res; + } + else { + $self->{Methods}->{'doctype_decl'} = sub { }; + } + } + +} + +sub entity_decl { + my $self = shift; + if (defined $self->{Methods}->{'entity_decl'}) { + $self->{Methods}->{'entity_decl'}->(@_); + } + else { + my $method; + my $callbacks; + if (exists $self->{ParseOptions}) { + $callbacks = $self->{ParseOptions}; + } + else { + $callbacks = $self; + } + if (0) { # dummy to make elsif's below compile + } + elsif (defined $callbacks->{'DTDHandler'} and $method = $callbacks->{'DTDHandler'}->can('entity_decl') ) { + my $handler = $callbacks->{'DTDHandler'}; + $self->{Methods}->{'entity_decl'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'Handler'} and $method = $callbacks->{'Handler'}->can('entity_decl') ) { + my $handler = $callbacks->{'Handler'}; + $self->{Methods}->{'entity_decl'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'DTDHandler'} + and $callbacks->{'DTDHandler'}->can('AUTOLOAD') + and $callbacks->{'DTDHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'DTDHandler'}->entity_decl(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'DTDHandler'}; + $self->{Methods}->{'entity_decl'} = sub { $handler->entity_decl(@_) }; + } + return $res; + } + elsif (defined $callbacks->{'Handler'} + and $callbacks->{'Handler'}->can('AUTOLOAD') + and $callbacks->{'Handler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'Handler'}->entity_decl(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'Handler'}; + $self->{Methods}->{'entity_decl'} = sub { $handler->entity_decl(@_) }; + } + return $res; + } + else { + $self->{Methods}->{'entity_decl'} = sub { }; + } + } + +} + +sub end_document { + my $self = shift; + if (defined $self->{Methods}->{'end_document'}) { + $self->{Methods}->{'end_document'}->(@_); + } + else { + my $method; + my $callbacks; + if (exists $self->{ParseOptions}) { + $callbacks = $self->{ParseOptions}; + } + else { + $callbacks = $self; + } + if (0) { # dummy to make elsif's below compile + } + elsif (defined $callbacks->{'ContentHandler'} and $method = $callbacks->{'ContentHandler'}->can('end_document') ) { + my $handler = $callbacks->{'ContentHandler'}; + $self->{Methods}->{'end_document'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'DocumentHandler'} and $method = $callbacks->{'DocumentHandler'}->can('end_document') ) { + my $handler = $callbacks->{'DocumentHandler'}; + $self->{Methods}->{'end_document'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'Handler'} and $method = $callbacks->{'Handler'}->can('end_document') ) { + my $handler = $callbacks->{'Handler'}; + $self->{Methods}->{'end_document'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'ContentHandler'} + and $callbacks->{'ContentHandler'}->can('AUTOLOAD') + and $callbacks->{'ContentHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'ContentHandler'}->end_document(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'ContentHandler'}; + $self->{Methods}->{'end_document'} = sub { $handler->end_document(@_) }; + } + return $res; + } + elsif (defined $callbacks->{'DocumentHandler'} + and $callbacks->{'DocumentHandler'}->can('AUTOLOAD') + and $callbacks->{'DocumentHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'DocumentHandler'}->end_document(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'DocumentHandler'}; + $self->{Methods}->{'end_document'} = sub { $handler->end_document(@_) }; + } + return $res; + } + elsif (defined $callbacks->{'Handler'} + and $callbacks->{'Handler'}->can('AUTOLOAD') + and $callbacks->{'Handler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'Handler'}->end_document(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'Handler'}; + $self->{Methods}->{'end_document'} = sub { $handler->end_document(@_) }; + } + return $res; + } + else { + $self->{Methods}->{'end_document'} = sub { }; + } + } + +} + +sub start_element { + my $self = shift; + if (defined $self->{Methods}->{'start_element'}) { + $self->{Methods}->{'start_element'}->(@_); + } + else { + my $method; + my $callbacks; + if (exists $self->{ParseOptions}) { + $callbacks = $self->{ParseOptions}; + } + else { + $callbacks = $self; + } + if (0) { # dummy to make elsif's below compile + } + elsif (defined $callbacks->{'ContentHandler'} and $method = $callbacks->{'ContentHandler'}->can('start_element') ) { + my $handler = $callbacks->{'ContentHandler'}; + $self->{Methods}->{'start_element'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'DocumentHandler'} and $method = $callbacks->{'DocumentHandler'}->can('start_element') ) { + my $handler = $callbacks->{'DocumentHandler'}; + $self->{Methods}->{'start_element'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'Handler'} and $method = $callbacks->{'Handler'}->can('start_element') ) { + my $handler = $callbacks->{'Handler'}; + $self->{Methods}->{'start_element'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'ContentHandler'} + and $callbacks->{'ContentHandler'}->can('AUTOLOAD') + and $callbacks->{'ContentHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'ContentHandler'}->start_element(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'ContentHandler'}; + $self->{Methods}->{'start_element'} = sub { $handler->start_element(@_) }; + } + return $res; + } + elsif (defined $callbacks->{'DocumentHandler'} + and $callbacks->{'DocumentHandler'}->can('AUTOLOAD') + and $callbacks->{'DocumentHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'DocumentHandler'}->start_element(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'DocumentHandler'}; + $self->{Methods}->{'start_element'} = sub { $handler->start_element(@_) }; + } + return $res; + } + elsif (defined $callbacks->{'Handler'} + and $callbacks->{'Handler'}->can('AUTOLOAD') + and $callbacks->{'Handler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'Handler'}->start_element(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'Handler'}; + $self->{Methods}->{'start_element'} = sub { $handler->start_element(@_) }; + } + return $res; + } + else { + $self->{Methods}->{'start_element'} = sub { }; + } + } + +} + +sub start_dtd { + my $self = shift; + if (defined $self->{Methods}->{'start_dtd'}) { + $self->{Methods}->{'start_dtd'}->(@_); + } + else { + my $method; + my $callbacks; + if (exists $self->{ParseOptions}) { + $callbacks = $self->{ParseOptions}; + } + else { + $callbacks = $self; + } + if (0) { # dummy to make elsif's below compile + } + elsif (defined $callbacks->{'LexicalHandler'} and $method = $callbacks->{'LexicalHandler'}->can('start_dtd') ) { + my $handler = $callbacks->{'LexicalHandler'}; + $self->{Methods}->{'start_dtd'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'Handler'} and $method = $callbacks->{'Handler'}->can('start_dtd') ) { + my $handler = $callbacks->{'Handler'}; + $self->{Methods}->{'start_dtd'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'LexicalHandler'} + and $callbacks->{'LexicalHandler'}->can('AUTOLOAD') + and $callbacks->{'LexicalHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'LexicalHandler'}->start_dtd(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'LexicalHandler'}; + $self->{Methods}->{'start_dtd'} = sub { $handler->start_dtd(@_) }; + } + return $res; + } + elsif (defined $callbacks->{'Handler'} + and $callbacks->{'Handler'}->can('AUTOLOAD') + and $callbacks->{'Handler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'Handler'}->start_dtd(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'Handler'}; + $self->{Methods}->{'start_dtd'} = sub { $handler->start_dtd(@_) }; + } + return $res; + } + else { + $self->{Methods}->{'start_dtd'} = sub { }; + } + } + +} + +sub end_prefix_mapping { + my $self = shift; + if (defined $self->{Methods}->{'end_prefix_mapping'}) { + $self->{Methods}->{'end_prefix_mapping'}->(@_); + } + else { + my $method; + my $callbacks; + if (exists $self->{ParseOptions}) { + $callbacks = $self->{ParseOptions}; + } + else { + $callbacks = $self; + } + if (0) { # dummy to make elsif's below compile + } + elsif (defined $callbacks->{'ContentHandler'} and $method = $callbacks->{'ContentHandler'}->can('end_prefix_mapping') ) { + my $handler = $callbacks->{'ContentHandler'}; + $self->{Methods}->{'end_prefix_mapping'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'Handler'} and $method = $callbacks->{'Handler'}->can('end_prefix_mapping') ) { + my $handler = $callbacks->{'Handler'}; + $self->{Methods}->{'end_prefix_mapping'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'ContentHandler'} + and $callbacks->{'ContentHandler'}->can('AUTOLOAD') + and $callbacks->{'ContentHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'ContentHandler'}->end_prefix_mapping(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'ContentHandler'}; + $self->{Methods}->{'end_prefix_mapping'} = sub { $handler->end_prefix_mapping(@_) }; + } + return $res; + } + elsif (defined $callbacks->{'Handler'} + and $callbacks->{'Handler'}->can('AUTOLOAD') + and $callbacks->{'Handler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'Handler'}->end_prefix_mapping(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'Handler'}; + $self->{Methods}->{'end_prefix_mapping'} = sub { $handler->end_prefix_mapping(@_) }; + } + return $res; + } + else { + $self->{Methods}->{'end_prefix_mapping'} = sub { }; + } + } + +} + +sub end_dtd { + my $self = shift; + if (defined $self->{Methods}->{'end_dtd'}) { + $self->{Methods}->{'end_dtd'}->(@_); + } + else { + my $method; + my $callbacks; + if (exists $self->{ParseOptions}) { + $callbacks = $self->{ParseOptions}; + } + else { + $callbacks = $self; + } + if (0) { # dummy to make elsif's below compile + } + elsif (defined $callbacks->{'LexicalHandler'} and $method = $callbacks->{'LexicalHandler'}->can('end_dtd') ) { + my $handler = $callbacks->{'LexicalHandler'}; + $self->{Methods}->{'end_dtd'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'Handler'} and $method = $callbacks->{'Handler'}->can('end_dtd') ) { + my $handler = $callbacks->{'Handler'}; + $self->{Methods}->{'end_dtd'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'LexicalHandler'} + and $callbacks->{'LexicalHandler'}->can('AUTOLOAD') + and $callbacks->{'LexicalHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'LexicalHandler'}->end_dtd(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'LexicalHandler'}; + $self->{Methods}->{'end_dtd'} = sub { $handler->end_dtd(@_) }; + } + return $res; + } + elsif (defined $callbacks->{'Handler'} + and $callbacks->{'Handler'}->can('AUTOLOAD') + and $callbacks->{'Handler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'Handler'}->end_dtd(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'Handler'}; + $self->{Methods}->{'end_dtd'} = sub { $handler->end_dtd(@_) }; + } + return $res; + } + else { + $self->{Methods}->{'end_dtd'} = sub { }; + } + } + +} + +sub characters { + my $self = shift; + if (defined $self->{Methods}->{'characters'}) { + $self->{Methods}->{'characters'}->(@_); + } + else { + my $method; + my $callbacks; + if (exists $self->{ParseOptions}) { + $callbacks = $self->{ParseOptions}; + } + else { + $callbacks = $self; + } + if (0) { # dummy to make elsif's below compile + } + elsif (defined $callbacks->{'ContentHandler'} and $method = $callbacks->{'ContentHandler'}->can('characters') ) { + my $handler = $callbacks->{'ContentHandler'}; + $self->{Methods}->{'characters'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'DocumentHandler'} and $method = $callbacks->{'DocumentHandler'}->can('characters') ) { + my $handler = $callbacks->{'DocumentHandler'}; + $self->{Methods}->{'characters'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'Handler'} and $method = $callbacks->{'Handler'}->can('characters') ) { + my $handler = $callbacks->{'Handler'}; + $self->{Methods}->{'characters'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'ContentHandler'} + and $callbacks->{'ContentHandler'}->can('AUTOLOAD') + and $callbacks->{'ContentHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'ContentHandler'}->characters(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'ContentHandler'}; + $self->{Methods}->{'characters'} = sub { $handler->characters(@_) }; + } + return $res; + } + elsif (defined $callbacks->{'DocumentHandler'} + and $callbacks->{'DocumentHandler'}->can('AUTOLOAD') + and $callbacks->{'DocumentHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'DocumentHandler'}->characters(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'DocumentHandler'}; + $self->{Methods}->{'characters'} = sub { $handler->characters(@_) }; + } + return $res; + } + elsif (defined $callbacks->{'Handler'} + and $callbacks->{'Handler'}->can('AUTOLOAD') + and $callbacks->{'Handler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'Handler'}->characters(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'Handler'}; + $self->{Methods}->{'characters'} = sub { $handler->characters(@_) }; + } + return $res; + } + else { + $self->{Methods}->{'characters'} = sub { }; + } + } + +} + +sub end_cdata { + my $self = shift; + if (defined $self->{Methods}->{'end_cdata'}) { + $self->{Methods}->{'end_cdata'}->(@_); + } + else { + my $method; + my $callbacks; + if (exists $self->{ParseOptions}) { + $callbacks = $self->{ParseOptions}; + } + else { + $callbacks = $self; + } + if (0) { # dummy to make elsif's below compile + } + elsif (defined $callbacks->{'DocumentHandler'} and $method = $callbacks->{'DocumentHandler'}->can('end_cdata') ) { + my $handler = $callbacks->{'DocumentHandler'}; + $self->{Methods}->{'end_cdata'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'LexicalHandler'} and $method = $callbacks->{'LexicalHandler'}->can('end_cdata') ) { + my $handler = $callbacks->{'LexicalHandler'}; + $self->{Methods}->{'end_cdata'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'Handler'} and $method = $callbacks->{'Handler'}->can('end_cdata') ) { + my $handler = $callbacks->{'Handler'}; + $self->{Methods}->{'end_cdata'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'DocumentHandler'} + and $callbacks->{'DocumentHandler'}->can('AUTOLOAD') + and $callbacks->{'DocumentHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'DocumentHandler'}->end_cdata(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'DocumentHandler'}; + $self->{Methods}->{'end_cdata'} = sub { $handler->end_cdata(@_) }; + } + return $res; + } + elsif (defined $callbacks->{'LexicalHandler'} + and $callbacks->{'LexicalHandler'}->can('AUTOLOAD') + and $callbacks->{'LexicalHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'LexicalHandler'}->end_cdata(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'LexicalHandler'}; + $self->{Methods}->{'end_cdata'} = sub { $handler->end_cdata(@_) }; + } + return $res; + } + elsif (defined $callbacks->{'Handler'} + and $callbacks->{'Handler'}->can('AUTOLOAD') + and $callbacks->{'Handler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'Handler'}->end_cdata(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'Handler'}; + $self->{Methods}->{'end_cdata'} = sub { $handler->end_cdata(@_) }; + } + return $res; + } + else { + $self->{Methods}->{'end_cdata'} = sub { }; + } + } + +} + +sub skipped_entity { + my $self = shift; + if (defined $self->{Methods}->{'skipped_entity'}) { + $self->{Methods}->{'skipped_entity'}->(@_); + } + else { + my $method; + my $callbacks; + if (exists $self->{ParseOptions}) { + $callbacks = $self->{ParseOptions}; + } + else { + $callbacks = $self; + } + if (0) { # dummy to make elsif's below compile + } + elsif (defined $callbacks->{'ContentHandler'} and $method = $callbacks->{'ContentHandler'}->can('skipped_entity') ) { + my $handler = $callbacks->{'ContentHandler'}; + $self->{Methods}->{'skipped_entity'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'Handler'} and $method = $callbacks->{'Handler'}->can('skipped_entity') ) { + my $handler = $callbacks->{'Handler'}; + $self->{Methods}->{'skipped_entity'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'ContentHandler'} + and $callbacks->{'ContentHandler'}->can('AUTOLOAD') + and $callbacks->{'ContentHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'ContentHandler'}->skipped_entity(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'ContentHandler'}; + $self->{Methods}->{'skipped_entity'} = sub { $handler->skipped_entity(@_) }; + } + return $res; + } + elsif (defined $callbacks->{'Handler'} + and $callbacks->{'Handler'}->can('AUTOLOAD') + and $callbacks->{'Handler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'Handler'}->skipped_entity(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'Handler'}; + $self->{Methods}->{'skipped_entity'} = sub { $handler->skipped_entity(@_) }; + } + return $res; + } + else { + $self->{Methods}->{'skipped_entity'} = sub { }; + } + } + +} + +sub ignorable_whitespace { + my $self = shift; + if (defined $self->{Methods}->{'ignorable_whitespace'}) { + $self->{Methods}->{'ignorable_whitespace'}->(@_); + } + else { + my $method; + my $callbacks; + if (exists $self->{ParseOptions}) { + $callbacks = $self->{ParseOptions}; + } + else { + $callbacks = $self; + } + if (0) { # dummy to make elsif's below compile + } + elsif (defined $callbacks->{'ContentHandler'} and $method = $callbacks->{'ContentHandler'}->can('ignorable_whitespace') ) { + my $handler = $callbacks->{'ContentHandler'}; + $self->{Methods}->{'ignorable_whitespace'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'DocumentHandler'} and $method = $callbacks->{'DocumentHandler'}->can('ignorable_whitespace') ) { + my $handler = $callbacks->{'DocumentHandler'}; + $self->{Methods}->{'ignorable_whitespace'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'Handler'} and $method = $callbacks->{'Handler'}->can('ignorable_whitespace') ) { + my $handler = $callbacks->{'Handler'}; + $self->{Methods}->{'ignorable_whitespace'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'ContentHandler'} + and $callbacks->{'ContentHandler'}->can('AUTOLOAD') + and $callbacks->{'ContentHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'ContentHandler'}->ignorable_whitespace(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'ContentHandler'}; + $self->{Methods}->{'ignorable_whitespace'} = sub { $handler->ignorable_whitespace(@_) }; + } + return $res; + } + elsif (defined $callbacks->{'DocumentHandler'} + and $callbacks->{'DocumentHandler'}->can('AUTOLOAD') + and $callbacks->{'DocumentHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'DocumentHandler'}->ignorable_whitespace(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'DocumentHandler'}; + $self->{Methods}->{'ignorable_whitespace'} = sub { $handler->ignorable_whitespace(@_) }; + } + return $res; + } + elsif (defined $callbacks->{'Handler'} + and $callbacks->{'Handler'}->can('AUTOLOAD') + and $callbacks->{'Handler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'Handler'}->ignorable_whitespace(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'Handler'}; + $self->{Methods}->{'ignorable_whitespace'} = sub { $handler->ignorable_whitespace(@_) }; + } + return $res; + } + else { + $self->{Methods}->{'ignorable_whitespace'} = sub { }; + } + } + +} + +sub internal_entity_decl { + my $self = shift; + if (defined $self->{Methods}->{'internal_entity_decl'}) { + $self->{Methods}->{'internal_entity_decl'}->(@_); + } + else { + my $method; + my $callbacks; + if (exists $self->{ParseOptions}) { + $callbacks = $self->{ParseOptions}; + } + else { + $callbacks = $self; + } + if (0) { # dummy to make elsif's below compile + } + elsif (defined $callbacks->{'DeclHandler'} and $method = $callbacks->{'DeclHandler'}->can('internal_entity_decl') ) { + my $handler = $callbacks->{'DeclHandler'}; + $self->{Methods}->{'internal_entity_decl'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'Handler'} and $method = $callbacks->{'Handler'}->can('internal_entity_decl') ) { + my $handler = $callbacks->{'Handler'}; + $self->{Methods}->{'internal_entity_decl'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'DeclHandler'} + and $callbacks->{'DeclHandler'}->can('AUTOLOAD') + and $callbacks->{'DeclHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'DeclHandler'}->internal_entity_decl(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'DeclHandler'}; + $self->{Methods}->{'internal_entity_decl'} = sub { $handler->internal_entity_decl(@_) }; + } + return $res; + } + elsif (defined $callbacks->{'Handler'} + and $callbacks->{'Handler'}->can('AUTOLOAD') + and $callbacks->{'Handler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'Handler'}->internal_entity_decl(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'Handler'}; + $self->{Methods}->{'internal_entity_decl'} = sub { $handler->internal_entity_decl(@_) }; + } + return $res; + } + else { + $self->{Methods}->{'internal_entity_decl'} = sub { }; + } + } + +} + +sub start_entity { + my $self = shift; + if (defined $self->{Methods}->{'start_entity'}) { + $self->{Methods}->{'start_entity'}->(@_); + } + else { + my $method; + my $callbacks; + if (exists $self->{ParseOptions}) { + $callbacks = $self->{ParseOptions}; + } + else { + $callbacks = $self; + } + if (0) { # dummy to make elsif's below compile + } + elsif (defined $callbacks->{'LexicalHandler'} and $method = $callbacks->{'LexicalHandler'}->can('start_entity') ) { + my $handler = $callbacks->{'LexicalHandler'}; + $self->{Methods}->{'start_entity'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'Handler'} and $method = $callbacks->{'Handler'}->can('start_entity') ) { + my $handler = $callbacks->{'Handler'}; + $self->{Methods}->{'start_entity'} = sub { $method->($handler, @_) }; + return $method->($handler, @_); + } + elsif (defined $callbacks->{'LexicalHandler'} + and $callbacks->{'LexicalHandler'}->can('AUTOLOAD') + and $callbacks->{'LexicalHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'LexicalHandler'}->start_entity(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'LexicalHandler'}; + $self->{Methods}->{'start_entity'} = sub { $handler->start_entity(@_) }; + } + return $res; + } + elsif (defined $callbacks->{'Handler'} + and $callbacks->{'Handler'}->can('AUTOLOAD') + and $callbacks->{'Handler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') + ) + { + my $res = eval { $callbacks->{'Handler'}->start_entity(@_) }; + if ($@) { + die $@; + } + else { + # I think there's a buggette here... + # if the first call throws an exception, we don't set it up right. + # Not fatal, but we might want to address it. + my $handler = $callbacks->{'Handler'}; + $self->{Methods}->{'start_entity'} = sub { $handler->start_entity(@_) }; + } + return $res; + } + else { + $self->{Methods}->{'start_entity'} = sub { }; + } + } + +} + +#-------------------------------------------------------------------# +# Class->new(%options) +#-------------------------------------------------------------------# +sub new { + my $proto = shift; + my $class = ref($proto) || $proto; + my $options = ($#_ == 0) ? shift : { @_ }; + + unless ( defined( $options->{Handler} ) or + defined( $options->{ContentHandler} ) or + defined( $options->{DTDHandler} ) or + defined( $options->{DocumentHandler} ) or + defined( $options->{LexicalHandler} ) or + defined( $options->{ErrorHandler} ) or + defined( $options->{DeclHandler} ) ) { + + $options->{Handler} = XML::SAX::Base::NoHandler->new; + } + + my $self = bless $options, $class; + # turn NS processing on by default + $self->set_feature('http://xml.org/sax/features/namespaces', 1); + return $self; +} +#-------------------------------------------------------------------# + +#-------------------------------------------------------------------# +# $p->parse(%options) +#-------------------------------------------------------------------# +sub parse { + my $self = shift; + my $parse_options = $self->get_options(@_); + local $self->{ParseOptions} = $parse_options; + if ($self->{Parent}) { # calling parse on a filter for some reason + return $self->{Parent}->parse($parse_options); + } + else { + my $method; + if (defined $parse_options->{Source}{CharacterStream} and $method = $self->can('_parse_characterstream')) { + warn("parse charstream???\n"); + return $method->($self, $parse_options->{Source}{CharacterStream}); + } + elsif (defined $parse_options->{Source}{ByteStream} and $method = $self->can('_parse_bytestream')) { + return $method->($self, $parse_options->{Source}{ByteStream}); + } + elsif (defined $parse_options->{Source}{String} and $method = $self->can('_parse_string')) { + return $method->($self, $parse_options->{Source}{String}); + } + elsif (defined $parse_options->{Source}{SystemId} and $method = $self->can('_parse_systemid')) { + return $method->($self, $parse_options->{Source}{SystemId}); + } + else { + die "No _parse_* routine defined on this driver (If it is a filter, remember to set the Parent property. If you call the parse() method, make sure to set a Source. You may want to call parse_uri, parse_string or parse_file instead.) [$self]"; + } + } +} +#-------------------------------------------------------------------# + +#-------------------------------------------------------------------# +# $p->parse_file(%options) +#-------------------------------------------------------------------# +sub parse_file { + my $self = shift; + my $file = shift; + return $self->parse_uri($file, @_) if ref(\$file) eq 'SCALAR'; + my $parse_options = $self->get_options(@_); + $parse_options->{Source}{ByteStream} = $file; + return $self->parse($parse_options); +} +#-------------------------------------------------------------------# + +#-------------------------------------------------------------------# +# $p->parse_uri(%options) +#-------------------------------------------------------------------# +sub parse_uri { + my $self = shift; + my $file = shift; + my $parse_options = $self->get_options(@_); + $parse_options->{Source}{SystemId} = $file; + return $self->parse($parse_options); +} +#-------------------------------------------------------------------# + +#-------------------------------------------------------------------# +# $p->parse_string(%options) +#-------------------------------------------------------------------# +sub parse_string { + my $self = shift; + my $string = shift; + my $parse_options = $self->get_options(@_); + $parse_options->{Source}{String} = $string; + return $self->parse($parse_options); +} +#-------------------------------------------------------------------# + +#-------------------------------------------------------------------# +# get_options +#-------------------------------------------------------------------# +sub get_options { + my $self = shift; + + if (@_ == 1) { + return { %$self, %{$_[0]} }; + } else { + return { %$self, @_ }; + } +} +#-------------------------------------------------------------------# + +#-------------------------------------------------------------------# +# get_features +#-------------------------------------------------------------------# +sub get_features { + return ( + 'http://xml.org/sax/features/external-general-entities' => undef, + 'http://xml.org/sax/features/external-parameter-entities' => undef, + 'http://xml.org/sax/features/is-standalone' => undef, + 'http://xml.org/sax/features/lexical-handler' => undef, + 'http://xml.org/sax/features/parameter-entities' => undef, + 'http://xml.org/sax/features/namespaces' => 1, + 'http://xml.org/sax/features/namespace-prefixes' => 0, + 'http://xml.org/sax/features/string-interning' => undef, + 'http://xml.org/sax/features/use-attributes2' => undef, + 'http://xml.org/sax/features/use-locator2' => undef, + 'http://xml.org/sax/features/validation' => undef, + + 'http://xml.org/sax/properties/dom-node' => undef, + 'http://xml.org/sax/properties/xml-string' => undef, + ); +} +#-------------------------------------------------------------------# + +#-------------------------------------------------------------------# +# get_feature +#-------------------------------------------------------------------# +sub get_feature { + my $self = shift; + my $feat = shift; + + # check %FEATURES to see if it's there, and return it if so + # throw XML::SAX::Exception::NotRecognized if it's not there + # throw XML::SAX::Exception::NotSupported if it's there but we + # don't support it + + my %features = $self->get_features(); + if (exists $features{$feat}) { + my %supported = map { $_ => 1 } $self->supported_features(); + if ($supported{$feat}) { + return $self->{__PACKAGE__ . "::Features"}{$feat}; + } + throw XML::SAX::Exception::NotSupported( + Message => "The feature '$feat' is not supported by " . ref($self), + Exception => undef, + ); + } + throw XML::SAX::Exception::NotRecognized( + Message => "The feature '$feat' is not recognized by " . ref($self), + Exception => undef, + ); +} +#-------------------------------------------------------------------# + +#-------------------------------------------------------------------# +# set_feature +#-------------------------------------------------------------------# +sub set_feature { + my $self = shift; + my $feat = shift; + my $value = shift; + # check %FEATURES to see if it's there, and set it if so + # throw XML::SAX::Exception::NotRecognized if it's not there + # throw XML::SAX::Exception::NotSupported if it's there but we + # don't support it + + my %features = $self->get_features(); + if (exists $features{$feat}) { + my %supported = map { $_ => 1 } $self->supported_features(); + if ($supported{$feat}) { + return $self->{__PACKAGE__ . "::Features"}{$feat} = $value; + } + throw XML::SAX::Exception::NotSupported( + Message => "The feature '$feat' is not supported by " . ref($self), + Exception => undef, + ); + } + throw XML::SAX::Exception::NotRecognized( + Message => "The feature '$feat' is not recognized by " . ref($self), + Exception => undef, + ); +} +#-------------------------------------------------------------------# + +#-------------------------------------------------------------------# +# get_handler and friends +#-------------------------------------------------------------------# +sub get_handler { + my $self = shift; + my $handler_type = shift; + $handler_type ||= 'Handler'; + return defined( $self->{$handler_type} ) ? $self->{$handler_type} : undef; +} + +sub get_document_handler { + my $self = shift; + return $self->get_handler('DocumentHandler', @_); +} + +sub get_content_handler { + my $self = shift; + return $self->get_handler('ContentHandler', @_); +} + +sub get_dtd_handler { + my $self = shift; + return $self->get_handler('DTDHandler', @_); +} + +sub get_lexical_handler { + my $self = shift; + return $self->get_handler('LexicalHandler', @_); +} + +sub get_decl_handler { + my $self = shift; + return $self->get_handler('DeclHandler', @_); +} + +sub get_error_handler { + my $self = shift; + return $self->get_handler('ErrorHandler', @_); +} + +sub get_entity_resolver { + my $self = shift; + return $self->get_handler('EntityResolver', @_); +} +#-------------------------------------------------------------------# + +#-------------------------------------------------------------------# +# set_handler and friends +#-------------------------------------------------------------------# +sub set_handler { + my $self = shift; + my ($new_handler, $handler_type) = reverse @_; + $handler_type ||= 'Handler'; + $self->{Methods} = {} if $self->{Methods}; + $self->{$handler_type} = $new_handler; + $self->{ParseOptions}->{$handler_type} = $new_handler; + return 1; +} + +sub set_document_handler { + my $self = shift; + return $self->set_handler('DocumentHandler', @_); +} + +sub set_content_handler { + my $self = shift; + return $self->set_handler('ContentHandler', @_); +} +sub set_dtd_handler { + my $self = shift; + return $self->set_handler('DTDHandler', @_); +} +sub set_lexical_handler { + my $self = shift; + return $self->set_handler('LexicalHandler', @_); +} +sub set_decl_handler { + my $self = shift; + return $self->set_handler('DeclHandler', @_); +} +sub set_error_handler { + my $self = shift; + return $self->set_handler('ErrorHandler', @_); +} +sub set_entity_resolver { + my $self = shift; + return $self->set_handler('EntityResolver', @_); +} + +#-------------------------------------------------------------------# + +#-------------------------------------------------------------------# +# supported_features +#-------------------------------------------------------------------# +sub supported_features { + my $self = shift; + # Only namespaces are required by all parsers + return ( + 'http://xml.org/sax/features/namespaces', + ); +} +#-------------------------------------------------------------------# + +sub no_op { + # this space intentionally blank +} + + +package XML::SAX::Base::NoHandler; + +# we need a fake handler that doesn't implement anything, this +# simplifies the code a lot (though given the recent changes, +# it may be better to do without) +sub new { + #warn "no handler called\n"; + return bless {}; +} + +1; + +__END__ + +=head1 NAME + +XML::SAX::Base - Base class SAX Drivers and Filters + +=head1 SYNOPSIS + + package MyFilter; + use XML::SAX::Base; + @ISA = ('XML::SAX::Base'); + +=head1 DESCRIPTION + +This module has a very simple task - to be a base class for PerlSAX +drivers and filters. It's default behaviour is to pass the input directly +to the output unchanged. It can be useful to use this module as a base class +so you don't have to, for example, implement the characters() callback. + +The main advantages that it provides are easy dispatching of events the right +way (ie it takes care for you of checking that the handler has implemented +that method, or has defined an AUTOLOAD), and the guarantee that filters +will pass along events that they aren't implementing to handlers downstream +that might nevertheless be interested in them. + +=head1 WRITING SAX DRIVERS AND FILTERS + +Writing SAX Filters is tremendously easy: all you need to do is +inherit from this module, and define the events you want to handle. A +more detailed explanation can be found at +http://www.xml.com/pub/a/2001/10/10/sax-filters.html. + +Writing Drivers is equally simple. The one thing you need to pay +attention to is B to call events yourself (this applies to Filters +as well). For instance: + + package MyFilter; + use base qw(XML::SAX::Base); + + sub start_element { + my $self = shift; + my $data = shift; + # do something + $self->{Handler}->start_element($data); # BAD + } + +The above example works well as precisely that: an example. But it has +several faults: 1) it doesn't test to see whether the handler defines +start_element. Perhaps it doesn't want to see that event, in which +case you shouldn't throw it (otherwise it'll die). 2) it doesn't check +ContentHandler and then Handler (ie it doesn't look to see that the +user hasn't requested events on a specific handler, and if not on the +default one), 3) if it did check all that, not only would the code be +cumbersome (see this module's source to get an idea) but it would also +probably have to check for a DocumentHandler (in case this were SAX1) +and for AUTOLOADs potentially defined in all these packages. As you can +tell, that would be fairly painful. Instead of going through that, +simply remember to use code similar to the following instead: + + package MyFilter; + use base qw(XML::SAX::Base); + + sub start_element { + my $self = shift; + my $data = shift; + # do something to filter + $self->SUPER::start_element($data); # GOOD (and easy) ! + } + +This way, once you've done your job you hand the ball back to +XML::SAX::Base and it takes care of all those problems for you! + +Note that the above example doesn't apply to filters only, drivers +will benefit from the exact same feature. + +=head1 METHODS + +A number of methods are defined within this class for the purpose of +inheritance. Some probably don't need to be overridden (eg parse_file) +but some clearly should be (eg parse). Options for these methods are +described in the PerlSAX2 specification available from +http://cvs.sourceforge.net/cgi-bin/viewcvs.cgi/~checkout~/perl-xml/libxml-perl/doc/sax-2.0.html?rev=HEAD&content-type=text/html. + +=over 4 + +=item * parse + +The parse method is the main entry point to parsing documents. Internally +the parse method will detect what type of "thing" you are parsing, and +call the appropriate method in your implementation class. Here is the +mapping table of what is in the Source options (see the Perl SAX 2.0 +specification for the meaning of these values): + + Source Contains parse() calls + =============== ============= + CharacterStream (*) _parse_characterstream($stream, $options) + ByteStream _parse_bytestream($stream, $options) + String _parse_string($string, $options) + SystemId _parse_systemid($string, $options) + +However note that these methods may not be sensible if your driver class +is not for parsing XML. An example might be a DBI driver that generates +XML/SAX from a database table. If that is the case, you likely want to +write your own parse() method. + +Also note that the Source may contain both a PublicId entry, and an +Encoding entry. To get at these, examine $options->{Source} as passed +to your method. + +(*) A CharacterStream is a filehandle that does not need any encoding +translation done on it. This is implemented as a regular filehandle +and only works under Perl 5.7.2 or higher using PerlIO. To get a single +character, or number of characters from it, use the perl core read() +function. To get a single byte from it (or number of bytes), you can +use sysread(). The encoding of the stream should be in the Encoding +entry for the Source. + +=item * parse_file, parse_uri, parse_string + +These are all convenience variations on parse(), and in fact simply +set up the options before calling it. You probably don't need to +override these. + +=item * get_options + +This is a convenience method to get options in SAX2 style, or more +generically either as hashes or as hashrefs (it returns a hashref). +You will probably want to use this method in your own implementations +of parse() and of new(). + +=item * get_feature, set_feature + +These simply get and set features, and throw the +appropriate exceptions defined in the specification if need be. + +If your subclass defines features not defined in this one, +then you should override these methods in such a way that they check for +your features first, and then call the base class's methods +for features not defined by your class. An example would be: + + sub get_feature { + my $self = shift; + my $feat = shift; + if (exists $MY_FEATURES{$feat}) { + # handle the feature in various ways + } + else { + return $self->SUPER::get_feature($feat); + } + } + +Currently this part is unimplemented. + + +=item * set_handler + +This method takes a handler type (Handler, ContentHandler, etc.) and a +handler object as arguments, and changes the current handler for that +handler type, while taking care of resetting the internal state that +needs to be reset. This allows one to change a handler during parse +without running into problems (changing it on the parser object +directly will most likely cause trouble). + +=item * set_document_handler, set_content_handler, set_dtd_handler, set_lexical_handler, set_decl_handler, set_error_handler, set_entity_resolver + +These are just simple wrappers around the former method, and take a +handler object as their argument. Internally they simply call +set_handler with the correct arguments. + +=item * get_handler + +The inverse of set_handler, this method takes a an optional string containing a handler type (DTDHandler, +ContentHandler, etc. 'Handler' is used if no type is passed). It returns a reference to the object that implements +that that class, or undef if that handler type is not set for the current driver/filter. + +=item * get_document_handler, get_content_handler, get_dtd_handler, get_lexical_handler, get_decl_handler, +get_error_handler, get_entity_resolver + +These are just simple wrappers around the get_handler() method, and take no arguments. Internally +they simply call get_handler with the correct handler type name. + +=back + +It would be rather useless to describe all the methods that this +module implements here. They are all the methods supported in SAX1 and +SAX2. In case your memory is a little short, here is a list. The +apparent duplicates are there so that both versions of SAX can be +supported. + +=over 4 + +=item * start_document + +=item * end_document + +=item * start_element + +=item * start_document + +=item * end_document + +=item * start_element + +=item * end_element + +=item * characters + +=item * processing_instruction + +=item * ignorable_whitespace + +=item * set_document_locator + +=item * start_prefix_mapping + +=item * end_prefix_mapping + +=item * skipped_entity + +=item * start_cdata + +=item * end_cdata + +=item * comment + +=item * entity_reference + +=item * notation_decl + +=item * unparsed_entity_decl + +=item * element_decl + +=item * attlist_decl + +=item * doctype_decl + +=item * xml_decl + +=item * entity_decl + +=item * attribute_decl + +=item * internal_entity_decl + +=item * external_entity_decl + +=item * resolve_entity + +=item * start_dtd + +=item * end_dtd + +=item * start_entity + +=item * end_entity + +=item * warning + +=item * error + +=item * fatal_error + +=back + +=head1 TODO + + - more tests + - conform to the "SAX Filters" and "Java and DOM compatibility" + sections of the SAX2 document. + +=head1 AUTHOR + +Kip Hampton (khampton@totalcinema.com) did most of the work, after porting +it from XML::Filter::Base. + +Robin Berjon (robin@knowscape.com) pitched in with patches to make it +usable as a base for drivers as well as filters, along with other patches. + +Matt Sergeant (matt@sergeant.org) wrote the original XML::Filter::Base, +and patched a few things here and there, and imported it into +the XML::SAX distribution. + +=head1 SEE ALSO + +L + +=cut + diff -r 57a2cac6870f -r 0c558d696e7a common/tools/raptor/XML/SAX/DocumentLocator.pm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/common/tools/raptor/XML/SAX/DocumentLocator.pm Mon Aug 24 11:01:37 2009 +0100 @@ -0,0 +1,134 @@ +# $Id: DocumentLocator.pm,v 1.3 2005/10/14 20:31:20 matt Exp $ + +package XML::SAX::DocumentLocator; +use strict; + +sub new { + my $class = shift; + my %object; + tie %object, $class, @_; + + return bless \%object, $class; +} + +sub TIEHASH { + my $class = shift; + my ($pubmeth, $sysmeth, $linemeth, $colmeth, $encmeth, $xmlvmeth) = @_; + return bless { + pubmeth => $pubmeth, + sysmeth => $sysmeth, + linemeth => $linemeth, + colmeth => $colmeth, + encmeth => $encmeth, + xmlvmeth => $xmlvmeth, + }, $class; +} + +sub FETCH { + my ($self, $key) = @_; + my $method; + if ($key eq 'PublicId') { + $method = $self->{pubmeth}; + } + elsif ($key eq 'SystemId') { + $method = $self->{sysmeth}; + } + elsif ($key eq 'LineNumber') { + $method = $self->{linemeth}; + } + elsif ($key eq 'ColumnNumber') { + $method = $self->{colmeth}; + } + elsif ($key eq 'Encoding') { + $method = $self->{encmeth}; + } + elsif ($key eq 'XMLVersion') { + $method = $self->{xmlvmeth}; + } + if ($method) { + my $value = $method->($key); + return $value; + } + return undef; +} + +sub EXISTS { + my ($self, $key) = @_; + if ($key =~ /^(PublicId|SystemId|LineNumber|ColumnNumber|Encoding|XMLVersion)$/) { + return 1; + } + return 0; +} + +sub STORE { + my ($self, $key, $value) = @_; +} + +sub DELETE { + my ($self, $key) = @_; +} + +sub CLEAR { + my ($self) = @_; +} + +sub FIRSTKEY { + my ($self) = @_; + # assignment resets. + $self->{keys} = { + PublicId => 1, + SystemId => 1, + LineNumber => 1, + ColumnNumber => 1, + Encoding => 1, + XMLVersion => 1, + }; + return each %{$self->{keys}}; +} + +sub NEXTKEY { + my ($self, $lastkey) = @_; + return each %{$self->{keys}}; +} + +1; +__END__ + +=head1 NAME + +XML::SAX::DocumentLocator - Helper class for document locators + +=head1 SYNOPSIS + + my $locator = XML::SAX::DocumentLocator->new( + sub { $object->get_public_id }, + sub { $object->get_system_id }, + sub { $reader->current_line }, + sub { $reader->current_column }, + sub { $reader->get_encoding }, + sub { $reader->get_xml_version }, + ); + +=head1 DESCRIPTION + +This module gives you a tied hash reference that calls the +specified closures when asked for PublicId, SystemId, +LineNumber and ColumnNumber. + +It is useful for writing SAX Parsers so that you don't have +to constantly update the line numbers in a hash reference on +the object you pass to set_document_locator(). See the source +code for XML::SAX::PurePerl for a usage example. + +=head1 API + +There is only 1 method: C. Simply pass it a list of +closures that when called will return the PublicId, the +SystemId, the LineNumber, the ColumnNumber, the Encoding +and the XMLVersion respectively. + +The closures are passed a single parameter, the key being +requested. But you're free to ignore that. + +=cut + diff -r 57a2cac6870f -r 0c558d696e7a common/tools/raptor/XML/SAX/Exception.pm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/common/tools/raptor/XML/SAX/Exception.pm Mon Aug 24 11:01:37 2009 +0100 @@ -0,0 +1,126 @@ +package XML::SAX::Exception; + +use strict; + +use overload '""' => "stringify", + 'fallback' => 1; + +use vars qw/$StackTrace $VERSION/; +$VERSION = '1.01'; +use Carp; + +$StackTrace = $ENV{XML_DEBUG} || 0; + +# Other exception classes: + +@XML::SAX::Exception::NotRecognized::ISA = ('XML::SAX::Exception'); +@XML::SAX::Exception::NotSupported::ISA = ('XML::SAX::Exception'); +@XML::SAX::Exception::Parse::ISA = ('XML::SAX::Exception'); + + +sub throw { + my $class = shift; + if (ref($class)) { + die $class; + } + die $class->new(@_); +} + +sub new { + my $class = shift; + my %opts = @_; + confess "Invalid options: " . join(', ', keys %opts) unless exists $opts{Message}; + + bless { ($StackTrace ? (StackTrace => stacktrace()) : ()), %opts }, + $class; +} + +sub stringify { + my $self = shift; + local $^W; + my $error; + if (exists $self->{LineNumber}) { + $error = $self->{Message} . " [Ln: " . $self->{LineNumber} . + ", Col: " . $self->{ColumnNumber} . "]"; + } + else { + $error = $self->{Message}; + } + if ($StackTrace) { + $error .= stackstring($self->{StackTrace}); + } + $error .= "\n"; + return $error; +} + +sub stacktrace { + my $i = 2; + my @fulltrace; + while (my @trace = caller($i++)) { + my %hash; + @hash{qw(Package Filename Line)} = @trace[0..2]; + push @fulltrace, \%hash; + } + return \@fulltrace; +} + +sub stackstring { + my $stacktrace = shift; + my $string = "\nFrom:\n"; + foreach my $current (@$stacktrace) { + $string .= $current->{Filename} . " Line: " . $current->{Line} . "\n"; + } + return $string; +} + +1; + +__END__ + +=head1 NAME + +XML::SAX::Exception - Exception classes for XML::SAX + +=head1 SYNOPSIS + + throw XML::SAX::Exception::NotSupported( + Message => "The foo feature is not supported", + ); + +=head1 DESCRIPTION + +This module is the base class for all SAX Exceptions, those defined in +the spec as well as those that one may create for one's own SAX errors. + +There are three subclasses included, corresponding to those of the SAX +spec: + + XML::SAX::Exception::NotSupported + XML::SAX::Exception::NotRecognized + XML::SAX::Exception::Parse + +Use them wherever you want, and as much as possible when you encounter +such errors. SAX is meant to use exceptions as much as possible to +flag problems. + +=head1 CREATING NEW EXCEPTION CLASSES + +All you need to do to create a new exception class is: + + @XML::SAX::Exception::MyException::ISA = ('XML::SAX::Exception') + +The given package doesn't need to exist, it'll behave correctly this +way. If your exception refines an existing exception class, then you +may also inherit from that instead of from the base class. + +=head1 THROWING EXCEPTIONS + +This is as simple as exemplified in the SYNOPSIS. In fact, there's +nothing more to know. All you have to do is: + + throw XML::SAX::Exception::MyException( Message => 'Something went wrong' ); + +and voila, you've thrown an exception which can be caught in an eval block. + +=cut + diff -r 57a2cac6870f -r 0c558d696e7a common/tools/raptor/XML/SAX/Intro.pod --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/common/tools/raptor/XML/SAX/Intro.pod Mon Aug 24 11:01:37 2009 +0100 @@ -0,0 +1,407 @@ +=head1 NAME + +XML::SAX::Intro - An Introduction to SAX Parsing with Perl + +=head1 Introduction + +XML::SAX is a new way to work with XML Parsers in Perl. In this article +we'll discuss why you should be using SAX, why you should be using +XML::SAX, and we'll see some of the finer implementation details. The +text below assumes some familiarity with callback, or push based +parsing, but if you are unfamiliar with these techniques then a good +place to start is Kip Hampton's excellent series of articles on XML.com. + +=head1 Replacing XML::Parser + +The de-facto way of parsing XML under perl is to use Larry Wall and +Clark Cooper's XML::Parser. This module is a Perl and XS wrapper around +the expat XML parser library by James Clark. It has been a hugely +successful project, but suffers from a couple of rather major flaws. +Firstly it is a proprietary API, designed before the SAX API was +conceived, which means that it is not easily replaceable by other +streaming parsers. Secondly it's callbacks are subrefs. This doesn't +sound like much of an issue, but unfortunately leads to code like: + + sub handle_start { + my ($e, $el, %attrs) = @_; + if ($el eq 'foo') { + $e->{inside_foo}++; # BAD! $e is an XML::Parser::Expat object. + } + } + +As you can see, we're using the $e object to hold our state +information, which is a bad idea because we don't own that object - we +didn't create it. It's an internal object of XML::Parser, that happens +to be a hashref. We could all too easily overwrite XML::Parser internal +state variables by using this, or Clark could change it to an array ref +(not that he would, because it would break so much code, but he could). + +The only way currently with XML::Parser to safely maintain state is to +use a closure: + + my $state = MyState->new(); + $parser->setHandlers(Start => sub { handle_start($state, @_) }); + +This closure traps the $state variable, which now gets passed as the +first parameter to your callback. Unfortunately very few people use +this technique, as it is not documented in the XML::Parser POD files. + +Another reason you might not want to use XML::Parser is because you +need some feature that it doesn't provide (such as validation), or you +might need to use a library that doesn't use expat, due to it not being +installed on your system, or due to having a restrictive ISP. Using SAX +allows you to work around these restrictions. + +=head1 Introducing SAX + +SAX stands for the Simple API for XML. And simple it really is. +Constructing a SAX parser and passing events to handlers is done as +simply as: + + use XML::SAX; + use MySAXHandler; + + my $parser = XML::SAX::ParserFactory->parser( + Handler => MySAXHandler->new + ); + + $parser->parse_uri("foo.xml"); + +The important concept to grasp here is that SAX uses a factory class +called XML::SAX::ParserFactory to create a new parser instance. The +reason for this is so that you can support other underlying +parser implementations for different feature sets. This is one thing +that XML::Parser has always sorely lacked. + +In the code above we see the parse_uri method used, but we could +have equally well +called parse_file, parse_string, or parse(). Please see XML::SAX::Base +for what these methods take as parameters, but don't be fooled into +believing parse_file takes a filename. No, it takes a file handle, a +glob, or a subclass of IO::Handle. Beware. + +SAX works very similarly to XML::Parser's default callback method, +except it has one major difference: rather than setting individual +callbacks, you create a new class in which to recieve the callbacks. +Each callback is called as a method call on an instance of that handler +class. An example will best demonstrate this: + + package MySAXHandler; + use base qw(XML::SAX::Base); + + sub start_document { + my ($self, $doc) = @_; + # process document start event + } + + sub start_element { + my ($self, $el) = @_; + # process element start event + } + +Now, when we instantiate this as above, and parse some XML with this as +the handler, the methods start_document and start_element will be +called as method calls, so this would be the equivalent of directly +calling: + + $object->start_element($el); + +Notice how this is different to XML::Parser's calling style, which +calls: + + start_element($e, $name, %attribs); + +It's the difference between function calling and method calling which +allows you to subclass SAX handlers which contributes to SAX being a +powerful solution. + +As you can see, unlike XML::Parser, we have to define a new package in +which to do our processing (there are hacks you can do to make this +uneccessary, but I'll leave figuring those out to the experts). The +biggest benefit of this is that you maintain your own state variable +($self in the above example) thus freeing you of the concerns listed +above. It is also an improvement in maintainability - you can place the +code in a separate file if you wish to, and your callback methods are +always called the same thing, rather than having to choose a suitable +name for them as you had to with XML::Parser. This is an obvious win. + +SAX parsers are also very flexible in how you pass a handler to them. +You can use a constructor parameter as we saw above, or we can pass the +handler directly in the call to one of the parse methods: + + $parser->parse(Handler => $handler, + Source => { SystemId => "foo.xml" }); + # or... + $parser->parse_file($fh, Handler => $handler); + +This flexibility allows for one parser to be used in many different +scenarios throughout your script (though one shouldn't feel pressure to +use this method, as parser construction is generally not a time +consuming process). + +=head1 Callback Parameters + +The only other thing you need to know to understand basic SAX is the +structure of the parameters passed to each of the callbacks. In +XML::Parser, all parameters are passed as multiple options to the +callbacks, so for example the Start callback would be called as +my_start($e, $name, %attributes), and the PI callback would be called +as my_processing_instruction($e, $target, $data). In SAX, every +callback is passed a hash reference, containing entries that define our +"node". The key callbacks and the structures they receive are: + +=head2 start_element + +The start_element handler is called whenever a parser sees an opening +tag. It is passed an element structure consisting of: + +=over 4 + +=item LocalName + +The name of the element minus any namespace prefix it may +have come with in the document. + +=item NamespaceURI + +The URI of the namespace associated with this element, +or the empty string for none. + +=item Attributes + +A set of attributes as described below. + +=item Name + +The name of the element as it was seen in the document (i.e. +including any prefix associated with it) + +=item Prefix + +The prefix used to qualify this element's namespace, or the +empty string if none. + +=back + +The B are a hash reference, keyed by what we have called +"James Clark" notation. This means that the attribute name has been +expanded to include any associated namespace URI, and put together as +{ns}name, where "ns" is the expanded namespace URI of the attribute if +and only if the attribute had a prefix, and "name" is the LocalName of +the attribute. + +The value of each entry in the attributes hash is another hash +structure consisting of: + +=over 4 + +=item LocalName + +The name of the attribute minus any namespace prefix it may have +come with in the document. + +=item NamespaceURI + +The URI of the namespace associated with this attribute. If the +attribute had no prefix, then this consists of just the empty string. + +=item Name + +The attribute's name as it appeared in the document, including any +namespace prefix. + +=item Prefix + +The prefix used to qualify this attribute's namepace, or the +empty string if none. + +=item Value + +The value of the attribute. + +=back + +So a full example, as output by Data::Dumper might be: + + .... + +=head2 end_element + +The end_element handler is called either when a parser sees a closing +tag, or after start_element has been called for an empty element (do +note however that a parser may if it is so inclined call characters +with an empty string when it sees an empty element. There is no simple +way in SAX to determine if the parser in fact saw an empty element, a +start and end element with no content.. + +The end_element handler receives exactly the same structure as +start_element, minus the Attributes entry. One must note though that it +should not be a reference to the same data as start_element receives, +so you may change the values in start_element but this will not affect +the values later seen by end_element. + +=head2 characters + +The characters callback may be called in serveral circumstances. The +most obvious one is when seeing ordinary character data in the markup. +But it is also called for text in a CDATA section, and is also called +in other situations. A SAX parser has to make no guarantees whatsoever +about how many times it may call characters for a stretch of text in an +XML document - it may call once, or it may call once for every +character in the text. In order to work around this it is often +important for the SAX developer to use a bundling technique, where text +is gathered up and processed in one of the other callbacks. This is not +always necessary, but it is a worthwhile technique to learn, which we +will cover in XML::SAX::Advanced (when I get around to writing it). + +The characters handler is called with a very simple structure - a hash +reference consisting of just one entry: + +=over 4 + +=item Data + +The text data that was received. + +=back + +=head2 comment + +The comment callback is called for comment text. Unlike with +C, the comment callback *must* be invoked just once for an +entire comment string. It receives a single simple structure - a hash +reference containing just one entry: + +=over 4 + +=item Data + +The text of the comment. + +=back + +=head2 processing_instruction + +The processing instruction handler is called for all processing +instructions in the document. Note that these processing instructions +may appear before the document root element, or after it, or anywhere +where text and elements would normally appear within the document, +according to the XML specification. + +The handler is passed a structure containing just two entries: + +=over 4 + +=item Target + +The target of the processing instrcution + +=item Data + +The text data in the processing instruction. Can be an empty +string for a processing instruction that has no data element. +For example E?wiggle?E is a perfectly valid processing instruction. + +=back + +=head1 Tip of the iceberg + +What we have discussed above is really the tip of the SAX iceberg. And +so far it looks like there's not much of interest to SAX beyond what we +have seen with XML::Parser. But it does go much further than that, I +promise. + +People who hate Object Oriented code for the sake of it may be thinking +here that creating a new package just to parse something is a waste +when they've been parsing things just fine up to now using procedural +code. But there's reason to all this madness. And that reason is SAX +Filters. + +As you saw right at the very start, to let the parser know about our +class, we pass it an instance of our class as the Handler to the +parser. But now imagine what would happen if our class could also take +a Handler option, and simply do some processing and pass on our data +further down the line? That in a nutshell is how SAX filters work. It's +Unix pipes for the 21st century! + +There are two downsides to this. Number 1 - writing SAX filters can be +tricky. If you look into the future and read the advanced tutorial I'm +writing, you'll see that Handler can come in several shapes and sizes. +So making sure your filter does the right thing can be tricky. +Secondly, constructing complex filter chains can be difficult, and +simple thinking tells us that we only get one pass at our document, +when often we'll need more than that. + +Luckily though, those downsides have been fixed by the release of two +very cool modules. What's even better is that I didn't write either of +them! + +The first module is XML::SAX::Base. This is a VITAL SAX module that +acts as a base class for all SAX parsers and filters. It provides an +abstraction away from calling the handler methods, that makes sure your +filter or parser does the right thing, and it does it FAST. So, if you +ever need to write a SAX filter, which if you're processing XML -> XML, +or XML -> HTML, then you probably do, then you need to be writing it as +a subclass of XML::SAX::Base. Really - this is advice not to ignore +lightly. I will not go into the details of writing a SAX filter here. +Kip Hampton, the author of XML::SAX::Base has covered this nicely in +his article on XML.com here . + +To construct SAX pipelines, Barrie Slaymaker, a long time Perl hacker +who's modules you will probably have heard of or used, wrote a very +clever module called XML::SAX::Machines. This combines some really +clever SAX filter-type modules, with a construction toolkit for filters +that makes building pipelines easy. But before we see how it makes +things easy, first lets see how tricky it looks to build complex SAX +filter pipelines. + + use XML::SAX::ParserFactory; + use XML::Filter::Filter1; + use XML::Filter::Filter2; + use XML::SAX::Writer; + + my $output_string; + my $writer = XML::SAX::Writer->new(Output => \$output_string); + my $filter2 = XML::SAX::Filter2->new(Handler => $writer); + my $filter1 = XML::SAX::Filter1->new(Handler => $filter2); + my $parser = XML::SAX::ParserFactory->parser(Handler => $filter1); + + $parser->parse_uri("foo.xml"); + +This is a lot easier with XML::SAX::Machines: + + use XML::SAX::Machines qw(Pipeline); + + my $output_string; + my $parser = Pipeline( + XML::SAX::Filter1 => XML::SAX::Filter2 => \$output_string + ); + + $parser->parse_uri("foo.xml"); + +One of the main benefits of XML::SAX::Machines is that the pipelines +are constructed in natural order, rather than the reverse order we saw +with manual pipeline construction. XML::SAX::Machines takes care of all +the internals of pipe construction, providing you at the end with just +a parser you can use (and you can re-use the same parser as many times +as you need to). + +Just a final tip. If you ever get stuck and are confused about what is +being passed from one SAX filter or parser to the next, then +Devel::TraceSAX will come to your rescue. This perl debugger plugin +will allow you to dump the SAX stream of events as it goes by. Usage is +really very simple just call your perl script that uses SAX as follows: + + $ perl -d:TraceSAX + +And preferably pipe the output to a pager of some sort, such as more or +less. The output is extremely verbose, but should help clear some +issues up. + +=head1 AUTHOR + +Matt Sergeant, matt@sergeant.org + +$Id: Intro.pod,v 1.3 2002/04/30 07:16:00 matt Exp $ + +=cut diff -r 57a2cac6870f -r 0c558d696e7a common/tools/raptor/XML/SAX/ParserDetails.ini --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/common/tools/raptor/XML/SAX/ParserDetails.ini Mon Aug 24 11:01:37 2009 +0100 @@ -0,0 +1,4 @@ +[XML::SAX::PurePerl] +http://xml.org/sax/features/namespaces = 1 + + diff -r 57a2cac6870f -r 0c558d696e7a common/tools/raptor/XML/SAX/ParserFactory.pm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/common/tools/raptor/XML/SAX/ParserFactory.pm Mon Aug 24 11:01:37 2009 +0100 @@ -0,0 +1,232 @@ +# $Id: ParserFactory.pm,v 1.13 2002/11/19 18:25:47 matt Exp $ + +package XML::SAX::ParserFactory; + +use strict; +use vars qw($VERSION); + +$VERSION = '1.01'; + +use Symbol qw(gensym); +use XML::SAX; +use XML::SAX::Exception; + +sub new { + my $class = shift; + my %params = @_; # TODO : Fix this in spec. + my $self = bless \%params, $class; + $self->{KnownParsers} = XML::SAX->parsers(); + return $self; +} + +sub parser { + my $self = shift; + my @parser_params = @_; + if (!ref($self)) { + $self = $self->new(); + } + + my $parser_class = $self->_parser_class(); + + my $version = ''; + if ($parser_class =~ s/\s*$([\d\.]+)$\s*$//) { + $version = " $1"; + } + + { + no strict 'refs'; + if (!keys %{"${parser_class}::"}) { + eval "use $parser_class $version;"; + } + } + + return $parser_class->new(@parser_params); +} + +sub require_feature { + my $self = shift; + my ($feature) = @_; + $self->{RequiredFeatures}{$feature}++; + return $self; +} + +sub _parser_class { + my $self = shift; + + # First try ParserPackage + if ($XML::SAX::ParserPackage) { + return $XML::SAX::ParserPackage; + } + + # Now check if required/preferred is there + if ($self->{RequiredFeatures}) { + my %required = %{$self->{RequiredFeatures}}; + # note - we never go onto the next try (ParserDetails.ini), + # because if we can't provide the requested feature + # we need to throw an exception. + PARSER: + foreach my $parser (reverse @{$self->{KnownParsers}}) { + foreach my $feature (keys %required) { + if (!exists $parser->{Features}{$feature}) { + next PARSER; + } + } + # got here - all features must exist! + return $parser->{Name}; + } + # TODO : should this be NotSupported() ? + throw XML::SAX::Exception ( + Message => "Unable to provide required features", + ); + } + + # Next try SAX.ini + for my $dir (@INC) { + my $fh = gensym(); + if (open($fh, "$dir/SAX.ini")) { + my $param_list = XML::SAX->_parse_ini_file($fh); + my $params = $param_list->[0]->{Features}; + if ($params->{ParserPackage}) { + return $params->{ParserPackage}; + } + else { + # we have required features (or nothing?) + PARSER: + foreach my $parser (reverse @{$self->{KnownParsers}}) { + foreach my $feature (keys %$params) { + if (!exists $parser->{Features}{$feature}) { + next PARSER; + } + } + return $parser->{Name}; + } + XML::SAX->do_warn("Unable to provide SAX.ini required features. Using fallback\n"); + } + last; # stop after first INI found + } + } + + if (@{$self->{KnownParsers}}) { + return $self->{KnownParsers}[-1]{Name}; + } + else { + return "XML::SAX::PurePerl"; # backup plan! + } +} + +1; +__END__ + +=head1 NAME + +XML::SAX::ParserFactory - Obtain a SAX parser + +=head1 SYNOPSIS + + use XML::SAX::ParserFactory; + use XML::SAX::XYZHandler; + my $handler = XML::SAX::XYZHandler->new(); + my $p = XML::SAX::ParserFactory->parser(Handler => $handler); + $p->parse_uri("foo.xml"); + # or $p->parse_string("") or $p->parse_file($fh); + +=head1 DESCRIPTION + +XML::SAX::ParserFactory is a factory class for providing an application +with a Perl SAX2 XML parser. It is akin to DBI - a front end for other +parser classes. Each new SAX2 parser installed will register itself +with XML::SAX, and then it will become available to all applications +that use XML::SAX::ParserFactory to obtain a SAX parser. + +Unlike DBI however, XML/SAX parsers almost all work alike (especially +if they subclass XML::SAX::Base, as they should), so rather than +specifying the parser you want in the call to C, XML::SAX +has several ways to automatically choose which parser to use: + +=over 4 + +=item * $XML::SAX::ParserPackage + +If this package variable is set, then this package is Cd +and an instance of this package is returned by calling the C +class method in that package. If it cannot be loaded or there is +an error, an exception will be thrown. The variable can also contain +a version number: + + $XML::SAX::ParserPackage = "XML::SAX::Expat (0.72)"; + +And the number will be treated as a minimum version number. + +=item * Required features + +It is possible to require features from the parsers. For example, you +may wish for a parser that supports validation via a DTD. To do that, +use the following code: + + use XML::SAX::ParserFactory; + my $factory = XML::SAX::ParserFactory->new(); + $factory->require_feature('http://xml.org/sax/features/validation'); + my $parser = $factory->parser(...); + +Alternatively, specify the required features in the call to the +ParserFactory constructor: + + my $factory = XML::SAX::ParserFactory->new( + RequiredFeatures => { + 'http://xml.org/sax/features/validation' => 1, + } + ); + +If the features you have asked for are unavailable (for example the +user might not have a validating parser installed), then an +exception will be thrown. + +The list of known parsers is searched in reverse order, so it will +always return the last installed parser that supports all of your +requested features (Note: this is subject to change if someone +comes up with a better way of making this work). + +=item * SAX.ini + +ParserFactory will search @INC for a file called SAX.ini, which +is in a simple format: + + # a comment looks like this, + ; or like this, and are stripped anywhere in the file + key = value # SAX.in contains key/value pairs. + +All whitespace is non-significant. + +This file can contain either a line: + + ParserPackage = MyParserModule (1.02) + +Where MyParserModule is the module to load and use for the parser, +and the number in brackets is a minimum version to load. + +Or you can list required features: + + http://xml.org/sax/features/validation = 1 + +And each feature with a true value will be required. + +=item * Fallback + +If none of the above works, the last parser installed on the user's +system will be used. The XML::SAX package ships with a pure perl +XML parser, XML::SAX::PurePerl, so that there will always be a +fallback parser. + +=back + +=head1 AUTHOR + +Matt Sergeant, matt@sergeant.org + +=head1 LICENSE + +This is free software, you may use it and distribute it under the same +terms as Perl itself. + +=cut + diff -r 57a2cac6870f -r 0c558d696e7a common/tools/raptor/XML/SAX/PurePerl.pm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/common/tools/raptor/XML/SAX/PurePerl.pm Mon Aug 24 11:01:37 2009 +0100 @@ -0,0 +1,744 @@ +# $Id: PurePerl.pm,v 1.21 2007/02/07 09:33:50 grant Exp $ + +package XML::SAX::PurePerl; + +use strict; +use vars qw/$VERSION/; + +$VERSION = '0.91'; + +use XML::SAX::PurePerl::Productions qw($Any $CharMinusDash $SingleChar); +use XML::SAX::PurePerl::Reader; +use XML::SAX::PurePerl::EncodingDetect (); +use XML::SAX::Exception; +use XML::SAX::PurePerl::DocType (); +use XML::SAX::PurePerl::DTDDecls (); +use XML::SAX::PurePerl::XMLDecl (); +use XML::SAX::DocumentLocator (); +use XML::SAX::Base (); +use XML::SAX qw(Namespaces); +use XML::NamespaceSupport (); +use IO::File; + +if ($] < 5.006) { + require XML::SAX::PurePerl::NoUnicodeExt; +} +else { + require XML::SAX::PurePerl::UnicodeExt; +} + +use vars qw(@ISA); +@ISA = ('XML::SAX::Base'); + +my %int_ents = ( + amp => '&', + lt => '<', + gt => '>', + quot => '"', + apos => "'", + ); + +my $xmlns_ns = "http://www.w3.org/2000/xmlns/"; +my $xml_ns = "http://www.w3.org/XML/1998/namespace"; + +use Carp; +sub _parse_characterstream { + my $self = shift; + my ($fh) = @_; + confess("CharacterStream is not yet correctly implemented"); + my $reader = XML::SAX::PurePerl::Reader::Stream->new($fh); + return $self->_parse($reader); +} + +sub _parse_bytestream { + my $self = shift; + my ($fh) = @_; + my $reader = XML::SAX::PurePerl::Reader::Stream->new($fh); + return $self->_parse($reader); +} + +sub _parse_string { + my $self = shift; + my ($str) = @_; + my $reader = XML::SAX::PurePerl::Reader::String->new($str); + return $self->_parse($reader); +} + +sub _parse_systemid { + my $self = shift; + my ($uri) = @_; + my $reader = XML::SAX::PurePerl::Reader::URI->new($uri); + return $self->_parse($reader); +} + +sub _parse { + my ($self, $reader) = @_; + + $reader->public_id($self->{ParseOptions}{Source}{PublicId}); + $reader->system_id($self->{ParseOptions}{Source}{SystemId}); + + $self->{NSHelper} = XML::NamespaceSupport->new({xmlns => 1}); + + $self->set_document_locator( + XML::SAX::DocumentLocator->new( + sub { $reader->public_id }, + sub { $reader->system_id }, + sub { $reader->line }, + sub { $reader->column }, + sub { $reader->get_encoding }, + sub { $reader->get_xml_version }, + ), + ); + + $self->start_document({}); + + if (defined $self->{ParseOptions}{Source}{Encoding}) { + $reader->set_encoding($self->{ParseOptions}{Source}{Encoding}); + } + else { + $self->encoding_detect($reader); + } + + # parse a document + $self->document($reader); + + return $self->end_document({}); +} + +sub parser_error { + my $self = shift; + my ($error, $reader) = @_; + +# warn("parser error: $error from ", $reader->line, " : ", $reader->column, "\n"); + my $exception = XML::SAX::Exception::Parse->new( + Message => $error, + ColumnNumber => $reader->column, + LineNumber => $reader->line, + PublicId => $reader->public_id, + SystemId => $reader->system_id, + ); + + $self->fatal_error($exception); + $exception->throw; +} + +sub document { + my ($self, $reader) = @_; + + # document ::= prolog element Misc* + + $self->prolog($reader); + $self->element($reader) || + $self->parser_error("Document requires an element", $reader); + + while(length($reader->data)) { + $self->Misc($reader) || + $self->parser_error("Only Comments, PIs and whitespace allowed at end of document", $reader); + } +} + +sub prolog { + my ($self, $reader) = @_; + + $self->XMLDecl($reader); + + # consume all misc bits + 1 while($self->Misc($reader)); + + if ($self->doctypedecl($reader)) { + while (length($reader->data)) { + $self->Misc($reader) || last; + } + } +} + +sub element { + my ($self, $reader) = @_; + + return 0 unless $reader->match('<'); + + my $name = $self->Name($reader) || $self->parser_error("Invalid element name", $reader); + + my %attribs; + + while( my ($k, $v) = $self->Attribute($reader) ) { + $attribs{$k} = $v; + } + + my $have_namespaces = $self->get_feature(Namespaces); + + # Namespace processing + $self->{NSHelper}->push_context; + my @new_ns; +# my %attrs = @attribs; +# while (my ($k,$v) = each %attrs) { + if ($have_namespaces) { + while ( my ($k, $v) = each %attribs ) { + if ($k =~ m/^xmlns(:(.*))?$/) { + my $prefix = $2 || ''; + $self->{NSHelper}->declare_prefix($prefix, $v); + my $ns = + { + Prefix => $prefix, + NamespaceURI => $v, + }; + push @new_ns, $ns; + $self->SUPER::start_prefix_mapping($ns); + } + } + } + + # Create element object and fire event + my %attrib_hash; + while (my ($name, $value) = each %attribs ) { + # TODO normalise value here + my ($ns, $prefix, $lname); + if ($have_namespaces) { + ($ns, $prefix, $lname) = $self->{NSHelper}->process_attribute_name($name); + } + $ns ||= ''; $prefix ||= ''; $lname ||= ''; + $attrib_hash{"{$ns}$lname"} = { + Name => $name, + LocalName => $lname, + Prefix => $prefix, + NamespaceURI => $ns, + Value => $value, + }; + } + + %attribs = (); # lose the memory since we recurse deep + + my ($ns, $prefix, $lname); + if ($self->get_feature(Namespaces)) { + ($ns, $prefix, $lname) = $self->{NSHelper}->process_element_name($name); + } + else { + $lname = $name; + } + $ns ||= ''; $prefix ||= ''; $lname ||= ''; + + # Process remainder of start_element + $self->skip_whitespace($reader); + my $have_content; + my $data = $reader->data(2); + if ($data =~ /^\/>/) { + $reader->move_along(2); + } + else { + $data =~ /^>/ or $self->parser_error("No close element tag", $reader); + $reader->move_along(1); + $have_content++; + } + + my $el = + { + Name => $name, + LocalName => $lname, + Prefix => $prefix, + NamespaceURI => $ns, + Attributes => \%attrib_hash, + }; + $self->start_element($el); + + # warn("($name\n"); + + if ($have_content) { + $self->content($reader); + + my $data = $reader->data(2); + $data =~ /^<\// or $self->parser_error("No close tag marker", $reader); + $reader->move_along(2); + my $end_name = $self->Name($reader); + $end_name eq $name || $self->parser_error("End tag mismatch ($end_name != $name)", $reader); + $self->skip_whitespace($reader); + $reader->match('>') or $self->parser_error("No close '>' on end tag", $reader); + } + + my %end_el = %$el; + delete $end_el{Attributes}; + $self->end_element(\%end_el); + + for my $ns (@new_ns) { + $self->end_prefix_mapping($ns); + } + $self->{NSHelper}->pop_context; + + return 1; +} + +sub content { + my ($self, $reader) = @_; + + while (1) { + $self->CharData($reader); + + my $data = $reader->data(2); + + if ($data =~ /^<\//) { + return 1; + } + elsif ($data =~ /^&/) { + $self->Reference($reader) or $self->parser_error("bare & not allowed in content", $reader); + next; + } + elsif ($data =~ /^CDSect($reader) + or + $self->Comment($reader)) + and next; + } + elsif ($data =~ /^<\?/) { + $self->PI($reader) and next; + } + elsif ($data =~ /^element($reader) and next; + } + last; + } + + return 1; +} + +sub CDSect { + my ($self, $reader) = @_; + + my $data = $reader->data(9); + return 0 unless $data =~ /^move_along(9); + + $self->start_cdata({}); + + $data = $reader->data; + while (1) { + $self->parser_error("EOF looking for CDATA section end", $reader) + unless length($data); + + if ($data =~ /^(.*?)\]\]>/s) { + my $chars = $1; + $reader->move_along(length($chars) + 3); + $self->characters({Data => $chars}); + last; + } + else { + $self->characters({Data => $data}); + $reader->move_along(length($data)); + $data = $reader->data; + } + } + $self->end_cdata({}); + return 1; +} + +sub CharData { + my ($self, $reader) = @_; + + my $data = $reader->data; + + while (1) { + return unless length($data); + + if ($data =~ /^([^<&]*)[<&]/s) { + my $chars = $1; + $self->parser_error("String ']]>' not allowed in character data", $reader) + if $chars =~ /\]\]>/; + $reader->move_along(length($chars)); + $self->characters({Data => $chars}) if length($chars); + last; + } + else { + $self->characters({Data => $data}); + $reader->move_along(length($data)); + $data = $reader->data; + } + } +} + +sub Misc { + my ($self, $reader) = @_; + if ($self->Comment($reader)) { + return 1; + } + elsif ($self->PI($reader)) { + return 1; + } + elsif ($self->skip_whitespace($reader)) { + return 1; + } + + return 0; +} + +sub Reference { + my ($self, $reader) = @_; + + return 0 unless $reader->match('&'); + + my $data = $reader->data; + + if ($data =~ /^#x([0-9a-fA-F]+);/) { + my $ref = $1; + $reader->move_along(length($ref) + 3); + my $char = chr_ref(hex($ref)); + $self->parser_error("Character reference &#$ref; refers to an illegal XML character ($char)", $reader) + unless $char =~ /$SingleChar/o; + $self->characters({ Data => $char }); + return 1; + } + elsif ($data =~ /^#([0-9]+);/) { + my $ref = $1; + $reader->move_along(length($ref) + 2); + my $char = chr_ref($ref); + $self->parser_error("Character reference &#$ref; refers to an illegal XML character ($char)", $reader) + unless $char =~ /$SingleChar/o; + $self->characters({ Data => $char }); + return 1; + } + else { + # EntityRef + my $name = $self->Name($reader) + || $self->parser_error("Invalid name in entity", $reader); + $reader->match(';') or $self->parser_error("No semi-colon found after entity name", $reader); + + # warn("got entity: \&$name;\n"); + + # expand it + if ($self->_is_entity($name)) { + + if ($self->_is_external($name)) { + my $value = $self->_get_entity($name); + my $ent_reader = XML::SAX::PurePerl::Reader::URI->new($value); + $self->encoding_detect($ent_reader); + $self->extParsedEnt($ent_reader); + } + else { + my $value = $self->_stringify_entity($name); + my $ent_reader = XML::SAX::PurePerl::Reader::String->new($value); + $self->content($ent_reader); + } + return 1; + } + elsif ($name =~ /^(?:amp|gt|lt|quot|apos)$/) { + $self->characters({ Data => $int_ents{$name} }); + return 1; + } + else { + $self->parser_error("Undeclared entity", $reader); + } + } +} + +sub AttReference { + my ($self, $name, $reader) = @_; + if ($name =~ /^#x([0-9a-fA-F]+)$/) { + my $chr = chr_ref(hex($1)); + $chr =~ /$SingleChar/o or $self->parser_error("Character reference '&$name;' refers to an illegal XML character", $reader); + return $chr; + } + elsif ($name =~ /^#([0-9]+)$/) { + my $chr = chr_ref($1); + $chr =~ /$SingleChar/o or $self->parser_error("Character reference '&$name;' refers to an illegal XML character", $reader); + return $chr; + } + else { + if ($self->_is_entity($name)) { + if ($self->_is_external($name)) { + $self->parser_error("No external entity references allowed in attribute values", $reader); + } + else { + my $value = $self->_stringify_entity($name); + return $value; + } + } + elsif ($name =~ /^(?:amp|lt|gt|quot|apos)$/) { + return $int_ents{$name}; + } + else { + $self->parser_error("Undeclared entity '$name'", $reader); + } + } +} + +sub extParsedEnt { + my ($self, $reader) = @_; + + $self->TextDecl($reader); + $self->content($reader); +} + +sub _is_external { + my ($self, $name) = @_; +# TODO: Fix this to use $reader to store the entities perhaps. + if ($self->{ParseOptions}{external_entities}{$name}) { + return 1; + } + return ; +} + +sub _is_entity { + my ($self, $name) = @_; +# TODO: ditto above + if (exists $self->{ParseOptions}{entities}{$name}) { + return 1; + } + return 0; +} + +sub _stringify_entity { + my ($self, $name) = @_; +# TODO: ditto above + if (exists $self->{ParseOptions}{expanded_entity}{$name}) { + return $self->{ParseOptions}{expanded_entity}{$name}; + } + # expand + my $reader = XML::SAX::PurePerl::Reader::URI->new($self->{ParseOptions}{entities}{$name}); + my $ent = ''; + while(1) { + my $data = $reader->data; + $ent .= $data; + $reader->move_along(length($data)) or last; + } + return $self->{ParseOptions}{expanded_entity}{$name} = $ent; +} + +sub _get_entity { + my ($self, $name) = @_; +# TODO: ditto above + return $self->{ParseOptions}{entities}{$name}; +} + +sub skip_whitespace { + my ($self, $reader) = @_; + + my $data = $reader->data; + + my $found = 0; + while ($data =~ s/^([\x20\x0A\x0D\x09]*)//) { + last unless length($1); + $found++; + $reader->move_along(length($1)); + $data = $reader->data; + } + + return $found; +} + +sub Attribute { + my ($self, $reader) = @_; + + $self->skip_whitespace($reader) || return; + + my $data = $reader->data(2); + return if $data =~ /^\/?>/; + + if (my $name = $self->Name($reader)) { + $self->skip_whitespace($reader); + $reader->match('=') or $self->parser_error("No '=' in Attribute", $reader); + $self->skip_whitespace($reader); + my $value = $self->AttValue($reader); + + if (!$self->cdata_attrib($name)) { + $value =~ s/^\x20*//; # discard leading spaces + $value =~ s/\x20*$//; # discard trailing spaces + $value =~ s/ {1,}/ /g; # all >1 space to single space + } + + return $name, $value; + } + + return; +} + +sub cdata_attrib { + # TODO implement this! + return 1; +} + +sub AttValue { + my ($self, $reader) = @_; + + my $quote = $self->quote($reader); + + my $value = ''; + + while (1) { + my $data = $reader->data; + $self->parser_error("EOF found while looking for the end of attribute value", $reader) + unless length($data); + if ($data =~ /^([^$quote]*)$quote/) { + $reader->move_along(length($1) + 1); + $value .= $1; + last; + } + else { + $value .= $data; + $reader->move_along(length($data)); + } + } + + if ($value =~ /parser_error("< character not allowed in attribute values", $reader); + } + + $value =~ s/[\x09\x0A\x0D]/\x20/g; + $value =~ s/&(#(x[0-9a-fA-F]+)|([0-9]+)|\w+);/$self->AttReference($1, $reader)/geo; + + return $value; +} + +sub Comment { + my ($self, $reader) = @_; + + my $data = $reader->data(4); + if ($data =~ /^/s) { + $comment_str .= $1; + $self->parser_error("Invalid comment (dash)", $reader) if $comment_str =~ /-$/; + $reader->move_along(length($1) + 3); + last; + } + else { + $comment_str .= $data; + $reader->move_along(length($data)); + } + } + + $self->comment({ Data => $comment_str }); + + return 1; + } + return 0; +} + +sub PI { + my ($self, $reader) = @_; + + my $data = $reader->data(2); + + if ($data =~ /^<\?/) { + $reader->move_along(2); + my ($target, $data); + $target = $self->Name($reader) || + $self->parser_error("PI has no target", $reader); + if ($self->skip_whitespace($reader)) { + $target = ''; + while (1) { + my $data = $reader->data; + $self->parser_error("End of data seen while looking for close PI marker", $reader) + unless length($data); + if ($data =~ /^(.*?)\?>/s) { + $target .= $1; + $reader->move_along(length($1) + 2); + last; + } + else { + $target .= $data; + $reader->move_along(length($data)); + } + } + } + else { + my $data = $reader->data(2); + $data =~ /^\?>/ or $self->parser_error("PI closing sequence not found", $reader); + $reader->move_along(2); + } + $self->processing_instruction({ Target => $target, Data => $data }); + + return 1; + } + return 0; +} + +sub Name { + my ($self, $reader) = @_; + + my $name = ''; + while(1) { + my $data = $reader->data; + return unless length($data); + $data =~ /^([^\s>\/&\?;=<\)\(\[\],\%\#\!\*]*)/ or return; + $name .= $1; + my $len = length($1); + $reader->move_along($len); + last if ($len != length($data)); + } + + return unless length($name); + + $name =~ /$NameChar/o or $self->parser_error("Name <$name> does not match NameChar production", $reader); + + return $name; +} + +sub quote { + my ($self, $reader) = @_; + + my $data = $reader->data; + + $data =~ /^(['"])/ or $self->parser_error("Invalid quote token", $reader); + $reader->move_along(1); + return $1; +} + +1; +__END__ + +=head1 NAME + +XML::SAX::PurePerl - Pure Perl XML Parser with SAX2 interface + +=head1 SYNOPSIS + + use XML::Handler::Foo; + use XML::SAX::PurePerl; + my $handler = XML::Handler::Foo->new(); + my $parser = XML::SAX::PurePerl->new(Handler => $handler); + $parser->parse_uri("myfile.xml"); + +=head1 DESCRIPTION + +This module implements an XML parser in pure perl. It is written around the +upcoming perl 5.8's unicode support and support for multiple document +encodings (using the PerlIO layer), however it has been ported to work with +ASCII/UTF8 documents under lower perl versions. + +The SAX2 API is described in detail at http://sourceforge.net/projects/perl-xml/, in +the CVS archive, under libxml-perl/docs. Hopefully those documents will be in a +better location soon. + +Please refer to the SAX2 documentation for how to use this module - it is merely a +front end to SAX2, and implements nothing that is not in that spec (or at least tries +not to - please email me if you find errors in this implementation). + +=head1 BUGS + +XML::SAX::PurePerl is B. Very slow. I suggest you use something else +in fact. However it is great as a fallback parser for XML::SAX, where the +user might not be able to install an XS based parser or C library. + +Currently lots, probably. At the moment the weakest area is parsing DOCTYPE declarations, +though the code is in place to start doing this. Also parsing parameter entity +references is causing me much confusion, since it's not exactly what I would call +trivial, or well documented in the XML grammar. XML documents with internal subsets +are likely to fail. + +I am however trying to work towards full conformance using the Oasis test suite. + +=head1 AUTHOR + +Matt Sergeant, matt@sergeant.org. Copyright 2001. + +Please report all bugs to the Perl-XML mailing list at perl-xml@listserv.activestate.com. + +=head1 LICENSE + +This is free software. You may use it or redistribute it under the same terms as +Perl 5.7.2 itself. + +=cut + diff -r 57a2cac6870f -r 0c558d696e7a common/tools/raptor/XML/SAX/PurePerl/DTDDecls.pm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/common/tools/raptor/XML/SAX/PurePerl/DTDDecls.pm Mon Aug 24 11:01:37 2009 +0100 @@ -0,0 +1,603 @@ +# $Id: DTDDecls.pm,v 1.7 2005/10/14 20:31:20 matt Exp $ + +package XML::SAX::PurePerl; + +use strict; +use XML::SAX::PurePerl::Productions qw($NameChar $SingleChar); + +sub elementdecl { + my ($self, $reader) = @_; + + my $data = $reader->data(9); + return 0 unless $data =~ /^move_along(9); + + $self->skip_whitespace($reader) || + $self->parser_error("No whitespace after ELEMENT declaration", $reader); + + my $name = $self->Name($reader); + + $self->skip_whitespace($reader) || + $self->parser_error("No whitespace after ELEMENT's name", $reader); + + $self->contentspec($reader, $name); + + $self->skip_whitespace($reader); + + $reader->match('>') or $self->parser_error("Closing angle bracket not found on ELEMENT declaration", $reader); + + return 1; +} + +sub contentspec { + my ($self, $reader, $name) = @_; + + my $data = $reader->data(5); + + my $model; + if ($data =~ /^EMPTY/) { + $reader->move_along(5); + $model = 'EMPTY'; + } + elsif ($data =~ /^ANY/) { + $reader->move_along(3); + $model = 'ANY'; + } + else { + $model = $self->Mixed_or_children($reader); + } + + if ($model) { + # call SAX callback now. + $self->element_decl({Name => $name, Model => $model}); + return 1; + } + + $self->parser_error("contentspec not found in ELEMENT declaration", $reader); +} + +sub Mixed_or_children { + my ($self, $reader) = @_; + + my $data = $reader->data(8); + $data =~ /^\(/ or return; # $self->parser_error("No opening bracket in Mixed or children", $reader); + + if ($data =~ /^\(\s*\#PCDATA/) { + $reader->match('('); + $self->skip_whitespace($reader); + $reader->move_along(7); + my $model = $self->Mixed($reader); + return $model; + } + + # not matched - must be Children + return $self->children($reader); +} + +# Mixed ::= ( '(' S* PCDATA ( S* '|' S* QName )* S* ')' '*' ) +# | ( '(' S* PCDATA S* ')' ) +sub Mixed { + my ($self, $reader) = @_; + + # Mixed_or_children already matched '(' S* '#PCDATA' + + my $model = '(#PCDATA'; + + $self->skip_whitespace($reader); + + my %seen; + + while (1) { + last unless $reader->match('|'); + $self->skip_whitespace($reader); + + my $name = $self->Name($reader) || + $self->parser_error("No 'Name' after Mixed content '|'", $reader); + + if ($seen{$name}) { + $self->parser_error("Element '$name' has already appeared in this group", $reader); + } + $seen{$name}++; + + $model .= "|$name"; + + $self->skip_whitespace($reader); + } + + $reader->match(')') || $self->parser_error("no closing bracket on mixed content", $reader); + + $model .= ")"; + + if ($reader->match('*')) { + $model .= "*"; + } + + return $model; +} + +# [[47]] Children ::= ChoiceOrSeq Cardinality? +# [[48]] Cp ::= ( QName | ChoiceOrSeq ) Cardinality? +# ChoiceOrSeq ::= '(' S* Cp ( Choice | Seq )? S* ')' +# [[49]] Choice ::= ( S* '|' S* Cp )+ +# [[50]] Seq ::= ( S* ',' S* Cp )+ +# // Children ::= (Choice | Seq) Cardinality? +# // Cp ::= ( QName | Choice | Seq) Cardinality? +# // Choice ::= '(' S* Cp ( S* '|' S* Cp )+ S* ')' +# // Seq ::= '(' S* Cp ( S* ',' S* Cp )* S* ')' +# [[51]] Mixed ::= ( '(' S* PCDATA ( S* '|' S* QName )* S* ')' MixedCardinality ) +# | ( '(' S* PCDATA S* ')' ) +# Cardinality ::= '?' | '+' | '*' +# MixedCardinality ::= '*' +sub children { + my ($self, $reader) = @_; + + return $self->ChoiceOrSeq($reader) . $self->Cardinality($reader); +} + +sub ChoiceOrSeq { + my ($self, $reader) = @_; + + $reader->match('(') or $self->parser_error("choice/seq contains no opening bracket", $reader); + + my $model = '('; + + $self->skip_whitespace($reader); + + $model .= $self->Cp($reader); + + if (my $choice = $self->Choice($reader)) { + $model .= $choice; + } + else { + $model .= $self->Seq($reader); + } + + $self->skip_whitespace($reader); + + $reader->match(')') or $self->parser_error("choice/seq contains no closing bracket", $reader); + + $model .= ')'; + + return $model; +} + +sub Cardinality { + my ($self, $reader) = @_; + # cardinality is always optional + my $data = $reader->data; + if ($data =~ /^([\?\+\*])/) { + $reader->move_along(1); + return $1; + } + return ''; +} + +sub Cp { + my ($self, $reader) = @_; + + my $model; + my $name = eval + { + if (my $name = $self->Name($reader)) { + return $name . $self->Cardinality($reader); + } + }; + return $name if defined $name; + return $self->ChoiceOrSeq($reader) . $self->Cardinality($reader); +} + +sub Choice { + my ($self, $reader) = @_; + + my $model = ''; + $self->skip_whitespace($reader); + + while ($reader->match('|')) { + $self->skip_whitespace($reader); + $model .= '|'; + $model .= $self->Cp($reader); + $self->skip_whitespace($reader); + } + + return $model; +} + +sub Seq { + my ($self, $reader) = @_; + + my $model = ''; + $self->skip_whitespace($reader); + + while ($reader->match(',')) { + $self->skip_whitespace($reader); + my $cp = $self->Cp($reader); + if ($cp) { + $model .= ','; + $model .= $cp; + } + $self->skip_whitespace($reader); + } + + return $model; +} + +sub AttlistDecl { + my ($self, $reader) = @_; + + my $data = $reader->data(9); + if ($data =~ /^move_along(9); + + $self->skip_whitespace($reader) || + $self->parser_error("No whitespace after ATTLIST declaration", $reader); + my $name = $self->Name($reader); + + $self->AttDefList($reader, $name); + + $self->skip_whitespace($reader); + + $reader->match('>') or $self->parser_error("Closing angle bracket not found on ATTLIST declaration", $reader); + + return 1; + } + + return 0; +} + +sub AttDefList { + my ($self, $reader, $name) = @_; + + 1 while $self->AttDef($reader, $name); +} + +sub AttDef { + my ($self, $reader, $el_name) = @_; + + $self->skip_whitespace($reader) || return 0; + my $att_name = $self->Name($reader) || return 0; + $self->skip_whitespace($reader) || + $self->parser_error("No whitespace after Name in attribute definition", $reader); + my $att_type = $self->AttType($reader); + + $self->skip_whitespace($reader) || + $self->parser_error("No whitespace after AttType in attribute definition", $reader); + my ($mode, $value) = $self->DefaultDecl($reader); + + # fire SAX event here! + $self->attribute_decl({ + eName => $el_name, + aName => $att_name, + Type => $att_type, + Mode => $mode, + Value => $value, + }); + return 1; +} + +sub AttType { + my ($self, $reader) = @_; + + return $self->StringType($reader) || + $self->TokenizedType($reader) || + $self->EnumeratedType($reader) || + $self->parser_error("Can't match AttType", $reader); +} + +sub StringType { + my ($self, $reader) = @_; + + my $data = $reader->data(5); + return unless $data =~ /^CDATA/; + $reader->move_along(5); + return 'CDATA'; +} + +sub TokenizedType { + my ($self, $reader) = @_; + + my $data = $reader->data(8); + if ($data =~ /^(IDREFS?|ID|ENTITIES|ENTITY|NMTOKENS?)/) { + $reader->move_along(length($1)); + return $1; + } + return; +} + +sub EnumeratedType { + my ($self, $reader) = @_; + return $self->NotationType($reader) || $self->Enumeration($reader); +} + +sub NotationType { + my ($self, $reader) = @_; + + my $data = $reader->data(8); + return unless $data =~ /^NOTATION/; + $reader->move_along(8); + + $self->skip_whitespace($reader) || + $self->parser_error("No whitespace after NOTATION", $reader); + $reader->match('(') or $self->parser_error("No opening bracket in notation section", $reader); + + $self->skip_whitespace($reader); + my $model = 'NOTATION ('; + my $name = $self->Name($reader) || + $self->parser_error("No name in notation section", $reader); + $model .= $name; + $self->skip_whitespace($reader); + $data = $reader->data; + while ($data =~ /^\|/) { + $reader->move_along(1); + $model .= '|'; + $self->skip_whitespace($reader); + my $name = $self->Name($reader) || + $self->parser_error("No name in notation section", $reader); + $model .= $name; + $self->skip_whitespace($reader); + $data = $reader->data; + } + $data =~ /^\)/ or $self->parser_error("No closing bracket in notation section", $reader); + $reader->move_along(1); + + $model .= ')'; + + return $model; +} + +sub Enumeration { + my ($self, $reader) = @_; + + return unless $reader->match('('); + + $self->skip_whitespace($reader); + my $model = '('; + my $nmtoken = $self->Nmtoken($reader) || + $self->parser_error("No Nmtoken in enumerated declaration", $reader); + $model .= $nmtoken; + $self->skip_whitespace($reader); + my $data = $reader->data; + while ($data =~ /^\|/) { + $model .= '|'; + $reader->move_along(1); + $self->skip_whitespace($reader); + my $nmtoken = $self->Nmtoken($reader) || + $self->parser_error("No Nmtoken in enumerated declaration", $reader); + $model .= $nmtoken; + $self->skip_whitespace($reader); + $data = $reader->data; + } + $data =~ /^\)/ or $self->parser_error("No closing bracket in enumerated declaration", $reader); + $reader->move_along(1); + + $model .= ')'; + + return $model; +} + +sub Nmtoken { + my ($self, $reader) = @_; + return $self->Name($reader); +} + +sub DefaultDecl { + my ($self, $reader) = @_; + + my $data = $reader->data(9); + if ($data =~ /^(\#REQUIRED|\#IMPLIED)/) { + $reader->move_along(length($1)); + return $1; + } + my $model = ''; + if ($data =~ /^\#FIXED/) { + $reader->move_along(6); + $self->skip_whitespace($reader) || $self->parser_error( + "no whitespace after FIXED specifier", $reader); + my $value = $self->AttValue($reader); + return "#FIXED", $value; + } + my $value = $self->AttValue($reader); + return undef, $value; +} + +sub EntityDecl { + my ($self, $reader) = @_; + + my $data = $reader->data(8); + return 0 unless $data =~ /^move_along(8); + + $self->skip_whitespace($reader) || $self->parser_error( + "No whitespace after ENTITY declaration", $reader); + + $self->PEDecl($reader) || $self->GEDecl($reader); + + $self->skip_whitespace($reader); + + $reader->match('>') or $self->parser_error("No closing '>' in entity definition", $reader); + + return 1; +} + +sub GEDecl { + my ($self, $reader) = @_; + + my $name = $self->Name($reader) || $self->parser_error("No entity name given", $reader); + $self->skip_whitespace($reader) || $self->parser_error("No whitespace after entity name", $reader); + + # TODO: ExternalID calls lexhandler method. Wrong place for it. + my $value; + if ($value = $self->ExternalID($reader)) { + $value .= $self->NDataDecl($reader); + } + else { + $value = $self->EntityValue($reader); + } + + if ($self->{ParseOptions}{entities}{$name}) { + warn("entity $name already exists\n"); + } else { + $self->{ParseOptions}{entities}{$name} = 1; + $self->{ParseOptions}{expanded_entity}{$name} = $value; # ??? + } + # do callback? + return 1; +} + +sub PEDecl { + my ($self, $reader) = @_; + + return 0 unless $reader->match('%'); + + $self->skip_whitespace($reader) || $self->parser_error("No whitespace after parameter entity marker", $reader); + my $name = $self->Name($reader) || $self->parser_error("No parameter entity name given", $reader); + $self->skip_whitespace($reader) || $self->parser_error("No whitespace after parameter entity name", $reader); + my $value = $self->ExternalID($reader) || + $self->EntityValue($reader) || + $self->parser_error("PE is not a value or an external resource", $reader); + # do callback? + return 1; +} + +my $quotre = qr/[^%&\"]/; +my $aposre = qr/[^%&\']/; + +sub EntityValue { + my ($self, $reader) = @_; + + my $data = $reader->data; + my $quote = '"'; + my $re = $quotre; + if (!$data =~ /^"/) { + $data =~ /^'/ or $self->parser_error("Not a quote character", $reader); + $quote = "'"; + $re = $aposre; + } + $reader->move_along(1); + + my $value = ''; + + while (1) { + my $data = $reader->data; + + $self->parser_error("EOF found while reading entity value", $reader) + unless length($data); + + if ($data =~ /^($re+)/) { + my $match = $1; + $value .= $match; + $reader->move_along(length($match)); + } + elsif ($reader->match('&')) { + # if it's a char ref, expand now: + if ($reader->match('#')) { + my $char; + my $ref = ''; + if ($reader->match('x')) { + my $data = $reader->data; + while (1) { + $self->parser_error("EOF looking for reference end", $reader) + unless length($data); + if ($data !~ /^([0-9a-fA-F]*)/) { + last; + } + $ref .= $1; + $reader->move_along(length($1)); + if (length($1) == length($data)) { + $data = $reader->data; + } + else { + last; + } + } + $char = chr_ref(hex($ref)); + $ref = "x$ref"; + } + else { + my $data = $reader->data; + while (1) { + $self->parser_error("EOF looking for reference end", $reader) + unless length($data); + if ($data !~ /^([0-9]*)/) { + last; + } + $ref .= $1; + $reader->move_along(length($1)); + if (length($1) == length($data)) { + $data = $reader->data; + } + else { + last; + } + } + $char = chr($ref); + } + $reader->match(';') || + $self->parser_error("No semi-colon found after character reference", $reader); + if ($char !~ $SingleChar) { # match a single character + $self->parser_error("Character reference '&#$ref;' refers to an illegal XML character ($char)", $reader); + } + $value .= $char; + } + else { + # entity refs in entities get expanded later, so don't parse now. + $value .= '&'; + } + } + elsif ($reader->match('%')) { + $value .= $self->PEReference($reader); + } + elsif ($reader->match($quote)) { + # end of attrib + last; + } + else { + $self->parser_error("Invalid character in attribute value: " . substr($reader->data, 0, 1), $reader); + } + } + + return $value; +} + +sub NDataDecl { + my ($self, $reader) = @_; + $self->skip_whitespace($reader) || return ''; + my $data = $reader->data(5); + return '' unless $data =~ /^NDATA/; + $reader->move_along(5); + $self->skip_whitespace($reader) || $self->parser_error("No whitespace after NDATA declaration", $reader); + my $name = $self->Name($reader) || $self->parser_error("NDATA declaration lacks a proper Name", $reader); + return " NDATA $name"; +} + +sub NotationDecl { + my ($self, $reader) = @_; + + my $data = $reader->data(10); + return 0 unless $data =~ /^move_along(10); + $self->skip_whitespace($reader) || + $self->parser_error("No whitespace after NOTATION declaration", $reader); + $data = $reader->data; + my $value = ''; + while(1) { + $self->parser_error("EOF found while looking for end of NotationDecl", $reader) + unless length($data); + + if ($data =~ /^([^>]*)>/) { + $value .= $1; + $reader->move_along(length($1) + 1); + $self->notation_decl({Name => "FIXME", SystemId => "FIXME", PublicId => "FIXME" }); + last; + } + else { + $value .= $data; + $reader->move_along(length($data)); + $data = $reader->data; + } + } + return 1; +} + +1; diff -r 57a2cac6870f -r 0c558d696e7a common/tools/raptor/XML/SAX/PurePerl/DebugHandler.pm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/common/tools/raptor/XML/SAX/PurePerl/DebugHandler.pm Mon Aug 24 11:01:37 2009 +0100 @@ -0,0 +1,95 @@ +# $Id: DebugHandler.pm,v 1.3 2001/11/24 17:47:53 matt Exp $ + +package XML::SAX::PurePerl::DebugHandler; + +use strict; + +sub new { + my $class = shift; + my %opts = @_; + return bless \%opts, $class; +} + +# DocumentHandler + +sub set_document_locator { + my $self = shift; + print "set_document_locator\n" if $ENV{DEBUG_XML}; + $self->{seen}{set_document_locator}++; +} + +sub start_document { + my $self = shift; + print "start_document\n" if $ENV{DEBUG_XML}; + $self->{seen}{start_document}++; +} + +sub end_document { + my $self = shift; + print "end_document\n" if $ENV{DEBUG_XML}; + $self->{seen}{end_document}++; +} + +sub start_element { + my $self = shift; + print "start_element\n" if $ENV{DEBUG_XML}; + $self->{seen}{start_element}++; +} + +sub end_element { + my $self = shift; + print "end_element\n" if $ENV{DEBUG_XML}; + $self->{seen}{end_element}++; +} + +sub characters { + my $self = shift; + print "characters\n" if $ENV{DEBUG_XML}; +# warn "Char: ", $_[0]->{Data}, "\n"; + $self->{seen}{characters}++; +} + +sub processing_instruction { + my $self = shift; + print "processing_instruction\n" if $ENV{DEBUG_XML}; + $self->{seen}{processing_instruction}++; +} + +sub ignorable_whitespace { + my $self = shift; + print "ignorable_whitespace\n" if $ENV{DEBUG_XML}; + $self->{seen}{ignorable_whitespace}++; +} + +# LexHandler + +sub comment { + my $self = shift; + print "comment\n" if $ENV{DEBUG_XML}; + $self->{seen}{comment}++; +} + +# DTDHandler + +sub notation_decl { + my $self = shift; + print "notation_decl\n" if $ENV{DEBUG_XML}; + $self->{seen}{notation_decl}++; +} + +sub unparsed_entity_decl { + my $self = shift; + print "unparsed_entity_decl\n" if $ENV{DEBUG_XML}; + $self->{seen}{entity_decl}++; +} + +# EntityResolver + +sub resolve_entity { + my $self = shift; + print "resolve_entity\n" if $ENV{DEBUG_XML}; + $self->{seen}{resolve_entity}++; + return ''; +} + +1; diff -r 57a2cac6870f -r 0c558d696e7a common/tools/raptor/XML/SAX/PurePerl/DocType.pm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/common/tools/raptor/XML/SAX/PurePerl/DocType.pm Mon Aug 24 11:01:37 2009 +0100 @@ -0,0 +1,180 @@ +# $Id: DocType.pm,v 1.3 2003/07/30 13:39:22 matt Exp $ + +package XML::SAX::PurePerl; + +use strict; +use XML::SAX::PurePerl::Productions qw($PubidChar); + +sub doctypedecl { + my ($self, $reader) = @_; + + my $data = $reader->data(9); + if ($data =~ /^move_along(9); + $self->skip_whitespace($reader) || + $self->parser_error("No whitespace after doctype declaration", $reader); + + my $root_name = $self->Name($reader) || + $self->parser_error("Doctype declaration has no root element name", $reader); + + if ($self->skip_whitespace($reader)) { + # might be externalid... + my %dtd = $self->ExternalID($reader); + # TODO: Call SAX event + } + + $self->skip_whitespace($reader); + + $self->InternalSubset($reader); + + $reader->match('>') or $self->parser_error("Doctype not closed", $reader); + + return 1; + } + + return 0; +} + +sub ExternalID { + my ($self, $reader) = @_; + + my $data = $reader->data(6); + + if ($data =~ /^SYSTEM/) { + $reader->move_along(6); + $self->skip_whitespace($reader) || + $self->parser_error("No whitespace after SYSTEM identifier", $reader); + return (SYSTEM => $self->SystemLiteral($reader)); + } + elsif ($data =~ /^PUBLIC/) { + $reader->move_along(6); + $self->skip_whitespace($reader) || + $self->parser_error("No whitespace after PUBLIC identifier", $reader); + + my $quote = $self->quote($reader) || + $self->parser_error("Not a quote character in PUBLIC identifier", $reader); + + my $data = $reader->data; + my $pubid = ''; + while(1) { + $self->parser_error("EOF while looking for end of PUBLIC identifiier", $reader) + unless length($data); + + if ($data =~ /^([^$quote]*)$quote/) { + $pubid .= $1; + $reader->move_along(length($1) + 1); + last; + } + else { + $pubid .= $data; + $reader->move_along(length($data)); + $data = $reader->data; + } + } + + if ($pubid !~ /^($PubidChar)+$/) { + $self->parser_error("Invalid characters in PUBLIC identifier", $reader); + } + + $self->skip_whitespace($reader) || + $self->parser_error("Not whitespace after PUBLIC ID in DOCTYPE", $reader); + + return (PUBLIC => $pubid, + SYSTEM => $self->SystemLiteral($reader)); + } + else { + return; + } + + return 1; +} + +sub SystemLiteral { + my ($self, $reader) = @_; + + my $quote = $self->quote($reader); + + my $data = $reader->data; + my $systemid = ''; + while (1) { + $self->parser_error("EOF found while looking for end of Sytem Literal", $reader) + unless length($data); + if ($data =~ /^([^$quote]*)$quote/) { + $systemid .= $1; + $reader->move_along(length($1) + 1); + return $systemid; + } + else { + $systemid .= $data; + $reader->move_along(length($data)); + $data = $reader->data; + } + } +} + +sub InternalSubset { + my ($self, $reader) = @_; + + return 0 unless $reader->match('['); + + 1 while $self->IntSubsetDecl($reader); + + $reader->match(']') or $self->parser_error("No close bracket on internal subset (found: " . $reader->data, $reader); + $self->skip_whitespace($reader); + return 1; +} + +sub IntSubsetDecl { + my ($self, $reader) = @_; + + return $self->DeclSep($reader) || $self->markupdecl($reader); +} + +sub DeclSep { + my ($self, $reader) = @_; + + if ($self->skip_whitespace($reader)) { + return 1; + } + + if ($self->PEReference($reader)) { + return 1; + } + +# if ($self->ParsedExtSubset($reader)) { +# return 1; +# } + + return 0; +} + +sub PEReference { + my ($self, $reader) = @_; + + return 0 unless $reader->match('%'); + + my $peref = $self->Name($reader) || + $self->parser_error("PEReference did not find a Name", $reader); + # TODO - load/parse the peref + + $reader->match(';') or $self->parser_error("Invalid token in PEReference", $reader); + return 1; +} + +sub markupdecl { + my ($self, $reader) = @_; + + if ($self->elementdecl($reader) || + $self->AttlistDecl($reader) || + $self->EntityDecl($reader) || + $self->NotationDecl($reader) || + $self->PI($reader) || + $self->Comment($reader)) + { + return 1; + } + + return 0; +} + +1; diff -r 57a2cac6870f -r 0c558d696e7a common/tools/raptor/XML/SAX/PurePerl/EncodingDetect.pm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/common/tools/raptor/XML/SAX/PurePerl/EncodingDetect.pm Mon Aug 24 11:01:37 2009 +0100 @@ -0,0 +1,105 @@ +# $Id: EncodingDetect.pm,v 1.6 2007/02/07 09:33:50 grant Exp $ + +package XML::SAX::PurePerl; # NB, not ::EncodingDetect! + +use strict; + +sub encoding_detect { + my ($parser, $reader) = @_; + + my $error = "Invalid byte sequence at start of file"; + + my $data = $reader->data; + if ($data =~ /^\x00\x00\xFE\xFF/) { + # BO-UCS4-be + $reader->move_along(4); + $reader->set_encoding('UCS-4BE'); + return; + } + elsif ($data =~ /^\x00\x00\xFF\xFE/) { + # BO-UCS-4-2143 + $reader->move_along(4); + $reader->set_encoding('UCS-4-2143'); + return; + } + elsif ($data =~ /^\x00\x00\x00\x3C/) { + $reader->set_encoding('UCS-4BE'); + return; + } + elsif ($data =~ /^\x00\x00\x3C\x00/) { + $reader->set_encoding('UCS-4-2143'); + return; + } + elsif ($data =~ /^\x00\x3C\x00\x00/) { + $reader->set_encoding('UCS-4-3412'); + return; + } + elsif ($data =~ /^\x00\x3C\x00\x3F/) { + $reader->set_encoding('UTF-16BE'); + return; + } + elsif ($data =~ /^\xFF\xFE\x00\x00/) { + # BO-UCS-4LE + $reader->move_along(4); + $reader->set_encoding('UCS-4LE'); + return; + } + elsif ($data =~ /^\xFF\xFE/) { + $reader->move_along(2); + $reader->set_encoding('UTF-16LE'); + return; + } + elsif ($data =~ /^\xFE\xFF\x00\x00/) { + $reader->move_along(4); + $reader->set_encoding('UCS-4-3412'); + return; + } + elsif ($data =~ /^\xFE\xFF/) { + $reader->move_along(2); + $reader->set_encoding('UTF-16BE'); + return; + } + elsif ($data =~ /^\xEF\xBB\xBF/) { # UTF-8 BOM + $reader->move_along(3); + $reader->set_encoding('UTF-8'); + return; + } + elsif ($data =~ /^\x3C\x00\x00\x00/) { + $reader->set_encoding('UCS-4LE'); + return; + } + elsif ($data =~ /^\x3C\x00\x3F\x00/) { + $reader->set_encoding('UTF-16LE'); + return; + } + elsif ($data =~ /^\x3C\x3F\x78\x6D/) { + # $reader->set_encoding('UTF-8'); + return; + } + elsif ($data =~ /^\x3C\x3F\x78/) { + # $reader->set_encoding('UTF-8'); + return; + } + elsif ($data =~ /^\x3C\x3F/) { + # $reader->set_encoding('UTF-8'); + return; + } + elsif ($data =~ /^\x3C/) { + # $reader->set_encoding('UTF-8'); + return; + } + elsif ($data =~ /^[\x20\x09\x0A\x0D]+\x3C[^\x3F]/) { + # $reader->set_encoding('UTF-8'); + return; + } + elsif ($data =~ /^\x4C\x6F\xA7\x94/) { + $reader->set_encoding('EBCDIC'); + return; + } + + warn("Unable to recognise encoding of this document"); + return; +} + +1; + diff -r 57a2cac6870f -r 0c558d696e7a common/tools/raptor/XML/SAX/PurePerl/Exception.pm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/common/tools/raptor/XML/SAX/PurePerl/Exception.pm Mon Aug 24 11:01:37 2009 +0100 @@ -0,0 +1,67 @@ +# $Id: Exception.pm,v 1.2 2001/11/14 11:07:25 matt Exp $ + +package XML::SAX::PurePerl::Exception; + +use strict; + +use overload '""' => "stringify"; + +use vars qw/$StackTrace/; + +$StackTrace = $ENV{XML_DEBUG} || 0; + +sub throw { + my $class = shift; + die $class->new(@_); +} + +sub new { + my $class = shift; + my %opts = @_; + die "Invalid options" unless exists $opts{Message}; + + if ($opts{reader}) { + return bless { Message => $opts{Message}, + Exception => undef, # not sure what this is for!!! + ColumnNumber => $opts{reader}->column, + LineNumber => $opts{reader}->line, + PublicId => $opts{reader}->public_id, + SystemId => $opts{reader}->system_id, + $StackTrace ? (StackTrace => stacktrace()) : (), + }, $class; + } + return bless { Message => $opts{Message}, + Exception => undef, # not sure what this is for!!! + }, $class; +} + +sub stringify { + my $self = shift; + local $^W; + return $self->{Message} . " [Ln: " . $self->{LineNumber} . + ", Col: " . $self->{ColumnNumber} . "]" . + ($StackTrace ? stackstring($self->{StackTrace}) : "") . "\n"; +} + +sub stacktrace { + my $i = 2; + my @fulltrace; + while (my @trace = caller($i++)) { + my %hash; + @hash{qw(Package Filename Line)} = @trace[0..2]; + push @fulltrace, \%hash; + } + return \@fulltrace; +} + +sub stackstring { + my $stacktrace = shift; + my $string = "\nFrom:\n"; + foreach my $current (@$stacktrace) { + $string .= $current->{Filename} . " Line: " . $current->{Line} . "\n"; + } + return $string; +} + +1; + diff -r 57a2cac6870f -r 0c558d696e7a common/tools/raptor/XML/SAX/PurePerl/NoUnicodeExt.pm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/common/tools/raptor/XML/SAX/PurePerl/NoUnicodeExt.pm Mon Aug 24 11:01:37 2009 +0100 @@ -0,0 +1,28 @@ +# $Id: NoUnicodeExt.pm,v 1.1 2002/01/30 17:35:21 matt Exp $ + +package XML::SAX::PurePerl; +use strict; + +sub chr_ref { + my $n = shift; + if ($n < 0x80) { + return chr ($n); + } + elsif ($n < 0x800) { + return pack ("CC", (($n >> 6) | 0xc0), (($n & 0x3f) | 0x80)); + } + elsif ($n < 0x10000) { + return pack ("CCC", (($n >> 12) | 0xe0), ((($n >> 6) & 0x3f) | 0x80), + (($n & 0x3f) | 0x80)); + } + elsif ($n < 0x110000) + { + return pack ("CCCC", (($n >> 18) | 0xf0), ((($n >> 12) & 0x3f) | 0x80), + ((($n >> 6) & 0x3f) | 0x80), (($n & 0x3f) | 0x80)); + } + else { + return undef; + } +} + +1; diff -r 57a2cac6870f -r 0c558d696e7a common/tools/raptor/XML/SAX/PurePerl/Productions.pm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/common/tools/raptor/XML/SAX/PurePerl/Productions.pm Mon Aug 24 11:01:37 2009 +0100 @@ -0,0 +1,151 @@ +# $Id: Productions.pm,v 1.11 2003/07/30 13:39:22 matt Exp $ + +package XML::SAX::PurePerl::Productions; + +use Exporter; +@ISA = ('Exporter'); +@EXPORT_OK = qw($S $Char $VersionNum $BaseChar $Letter $Ideographic + $Extender $Digit $CombiningChar $EncNameStart $EncNameEnd $NameChar $CharMinusDash + $PubidChar $Any $SingleChar); + +### WARNING!!! All productions here must *only* match a *single* character!!! ### + +BEGIN { +$S = qr/[\x20\x09\x0D\x0A]/; + +$CharMinusDash = qr/[^-]/x; + +$Any = qr/ . /xms; + +$VersionNum = qr/ [a-zA-Z0-9_.:-]+ /x; + +$EncNameStart = qr/ [A-Za-z] /x; +$EncNameEnd = qr/ [A-Za-z0-9\._-] /x; + +$PubidChar = qr/ [\x20\x0D\x0Aa-zA-Z0-9'()\+,.\/:=\?;!*\#@\$_\%-] /x; + +if ($] < 5.006) { + eval <<' PERL'; + $Char = qr/^ [\x09\x0A\x0D\x20-\x7F]|([\xC0-\xFD][\x80-\xBF]+) $/x; + + $SingleChar = qr/^$Char$/; + + $BaseChar = qr/ [\x41-\x5A\x61-\x7A]|([\xC0-\xFD][\x80-\xBF]+) /x; + + $Extender = qr/ \xB7 /x; + + $Digit = qr/ [\x30-\x39] /x; + + $Letter = qr/^ $BaseChar $/x; + + # can't do this one without unicode + # $CombiningChar = qr/^$/msx; + + $NameChar = qr/^ $BaseChar | $Digit | [._:-] | $Extender $/x; + PERL + die $@ if $@; +} +else { + eval <<' PERL'; + + use utf8; # for 5.6 + + $Char = qr/^ [\x09\x0A\x0D\x{0020}-\x{D7FF}\x{E000}-\x{FFFD}\x{10000}-\x{10FFFF}] $/x; + + $SingleChar = qr/^$Char$/; + + $BaseChar = qr/ +[\x{0041}-\x{005A}\x{0061}-\x{007A}\x{00C0}-\x{00D6}\x{00D8}-\x{00F6}] | +[\x{00F8}-\x{00FF}\x{0100}-\x{0131}\x{0134}-\x{013E}\x{0141}-\x{0148}] | +[\x{014A}-\x{017E}\x{0180}-\x{01C3}\x{01CD}-\x{01F0}\x{01F4}-\x{01F5}] | +[\x{01FA}-\x{0217}\x{0250}-\x{02A8}\x{02BB}-\x{02C1}\x{0386}\x{0388}-\x{038A}] | +[\x{038C}\x{038E}-\x{03A1}\x{03A3}-\x{03CE}\x{03D0}-\x{03D6}\x{03DA}] | +[\x{03DC}\x{03DE}\x{03E0}\x{03E2}-\x{03F3}\x{0401}-\x{040C}\x{040E}-\x{044F}] | +[\x{0451}-\x{045C}\x{045E}-\x{0481}\x{0490}-\x{04C4}\x{04C7}-\x{04C8}] | +[\x{04CB}-\x{04CC}\x{04D0}-\x{04EB}\x{04EE}-\x{04F5}\x{04F8}-\x{04F9}] | +[\x{0531}-\x{0556}\x{0559}\x{0561}-\x{0586}\x{05D0}-\x{05EA}\x{05F0}-\x{05F2}] | +[\x{0621}-\x{063A}\x{0641}-\x{064A}\x{0671}-\x{06B7}\x{06BA}-\x{06BE}] | +[\x{06C0}-\x{06CE}\x{06D0}-\x{06D3}\x{06D5}\x{06E5}-\x{06E6}\x{0905}-\x{0939}] | +[\x{093D}\x{0958}-\x{0961}\x{0985}-\x{098C}\x{098F}-\x{0990}] | +[\x{0993}-\x{09A8}\x{09AA}-\x{09B0}\x{09B2}\x{09B6}-\x{09B9}\x{09DC}-\x{09DD}] | +[\x{09DF}-\x{09E1}\x{09F0}-\x{09F1}\x{0A05}-\x{0A0A}\x{0A0F}-\x{0A10}] | +[\x{0A13}-\x{0A28}\x{0A2A}-\x{0A30}\x{0A32}-\x{0A33}\x{0A35}-\x{0A36}] | +[\x{0A38}-\x{0A39}\x{0A59}-\x{0A5C}\x{0A5E}\x{0A72}-\x{0A74}\x{0A85}-\x{0A8B}] | +[\x{0A8D}\x{0A8F}-\x{0A91}\x{0A93}-\x{0AA8}\x{0AAA}-\x{0AB0}] | +[\x{0AB2}-\x{0AB3}\x{0AB5}-\x{0AB9}\x{0ABD}\x{0AE0}\x{0B05}-\x{0B0C}] | +[\x{0B0F}-\x{0B10}\x{0B13}-\x{0B28}\x{0B2A}-\x{0B30}\x{0B32}-\x{0B33}] | +[\x{0B36}-\x{0B39}\x{0B3D}\x{0B5C}-\x{0B5D}\x{0B5F}-\x{0B61}\x{0B85}-\x{0B8A}] | +[\x{0B8E}-\x{0B90}\x{0B92}-\x{0B95}\x{0B99}-\x{0B9A}\x{0B9C}] | +[\x{0B9E}-\x{0B9F}\x{0BA3}-\x{0BA4}\x{0BA8}-\x{0BAA}\x{0BAE}-\x{0BB5}] | +[\x{0BB7}-\x{0BB9}\x{0C05}-\x{0C0C}\x{0C0E}-\x{0C10}\x{0C12}-\x{0C28}] | +[\x{0C2A}-\x{0C33}\x{0C35}-\x{0C39}\x{0C60}-\x{0C61}\x{0C85}-\x{0C8C}] | +[\x{0C8E}-\x{0C90}\x{0C92}-\x{0CA8}\x{0CAA}-\x{0CB3}\x{0CB5}-\x{0CB9}\x{0CDE}] | +[\x{0CE0}-\x{0CE1}\x{0D05}-\x{0D0C}\x{0D0E}-\x{0D10}\x{0D12}-\x{0D28}] | +[\x{0D2A}-\x{0D39}\x{0D60}-\x{0D61}\x{0E01}-\x{0E2E}\x{0E30}\x{0E32}-\x{0E33}] | +[\x{0E40}-\x{0E45}\x{0E81}-\x{0E82}\x{0E84}\x{0E87}-\x{0E88}\x{0E8A}] | +[\x{0E8D}\x{0E94}-\x{0E97}\x{0E99}-\x{0E9F}\x{0EA1}-\x{0EA3}\x{0EA5}\x{0EA7}] | +[\x{0EAA}-\x{0EAB}\x{0EAD}-\x{0EAE}\x{0EB0}\x{0EB2}-\x{0EB3}\x{0EBD}] | +[\x{0EC0}-\x{0EC4}\x{0F40}-\x{0F47}\x{0F49}-\x{0F69}\x{10A0}-\x{10C5}] | +[\x{10D0}-\x{10F6}\x{1100}\x{1102}-\x{1103}\x{1105}-\x{1107}\x{1109}] | +[\x{110B}-\x{110C}\x{110E}-\x{1112}\x{113C}\x{113E}\x{1140}\x{114C}\x{114E}] | +[\x{1150}\x{1154}-\x{1155}\x{1159}\x{115F}-\x{1161}\x{1163}\x{1165}] | +[\x{1167}\x{1169}\x{116D}-\x{116E}\x{1172}-\x{1173}\x{1175}\x{119E}\x{11A8}] | +[\x{11AB}\x{11AE}-\x{11AF}\x{11B7}-\x{11B8}\x{11BA}\x{11BC}-\x{11C2}] | +[\x{11EB}\x{11F0}\x{11F9}\x{1E00}-\x{1E9B}\x{1EA0}-\x{1EF9}\x{1F00}-\x{1F15}] | +[\x{1F18}-\x{1F1D}\x{1F20}-\x{1F45}\x{1F48}-\x{1F4D}\x{1F50}-\x{1F57}] | +[\x{1F59}\x{1F5B}\x{1F5D}\x{1F5F}-\x{1F7D}\x{1F80}-\x{1FB4}\x{1FB6}-\x{1FBC}] | +[\x{1FBE}\x{1FC2}-\x{1FC4}\x{1FC6}-\x{1FCC}\x{1FD0}-\x{1FD3}] | +[\x{1FD6}-\x{1FDB}\x{1FE0}-\x{1FEC}\x{1FF2}-\x{1FF4}\x{1FF6}-\x{1FFC}] | +[\x{2126}\x{212A}-\x{212B}\x{212E}\x{2180}-\x{2182}\x{3041}-\x{3094}] | +[\x{30A1}-\x{30FA}\x{3105}-\x{312C}\x{AC00}-\x{D7A3}] + /x; + + $Extender = qr/ +[\x{00B7}\x{02D0}\x{02D1}\x{0387}\x{0640}\x{0E46}\x{0EC6}\x{3005}\x{3031}-\x{3035}\x{309D}-\x{309E}\x{30FC}-\x{30FE}] +/x; + + $Digit = qr/ +[\x{0030}-\x{0039}\x{0660}-\x{0669}\x{06F0}-\x{06F9}\x{0966}-\x{096F}] | +[\x{09E6}-\x{09EF}\x{0A66}-\x{0A6F}\x{0AE6}-\x{0AEF}\x{0B66}-\x{0B6F}] | +[\x{0BE7}-\x{0BEF}\x{0C66}-\x{0C6F}\x{0CE6}-\x{0CEF}\x{0D66}-\x{0D6F}] | +[\x{0E50}-\x{0E59}\x{0ED0}-\x{0ED9}\x{0F20}-\x{0F29}] +/x; + + $CombiningChar = qr/ +[\x{0300}-\x{0345}\x{0360}-\x{0361}\x{0483}-\x{0486}\x{0591}-\x{05A1}] | +[\x{05A3}-\x{05B9}\x{05BB}-\x{05BD}\x{05BF}\x{05C1}-\x{05C2}\x{05C4}] | +[\x{064B}-\x{0652}\x{0670}\x{06D6}-\x{06DC}\x{06DD}-\x{06DF}\x{06E0}-\x{06E4}] | +[\x{06E7}-\x{06E8}\x{06EA}-\x{06ED}\x{0901}-\x{0903}\x{093C}] | +[\x{093E}-\x{094C}\x{094D}\x{0951}-\x{0954}\x{0962}-\x{0963}\x{0981}-\x{0983}] | +[\x{09BC}\x{09BE}\x{09BF}\x{09C0}-\x{09C4}\x{09C7}-\x{09C8}] | +[\x{09CB}-\x{09CD}\x{09D7}\x{09E2}-\x{09E3}\x{0A02}\x{0A3C}\x{0A3E}\x{0A3F}] | +[\x{0A40}-\x{0A42}\x{0A47}-\x{0A48}\x{0A4B}-\x{0A4D}\x{0A70}-\x{0A71}] | +[\x{0A81}-\x{0A83}\x{0ABC}\x{0ABE}-\x{0AC5}\x{0AC7}-\x{0AC9}\x{0ACB}-\x{0ACD}] | +[\x{0B01}-\x{0B03}\x{0B3C}\x{0B3E}-\x{0B43}\x{0B47}-\x{0B48}] | +[\x{0B4B}-\x{0B4D}\x{0B56}-\x{0B57}\x{0B82}-\x{0B83}\x{0BBE}-\x{0BC2}] | +[\x{0BC6}-\x{0BC8}\x{0BCA}-\x{0BCD}\x{0BD7}\x{0C01}-\x{0C03}\x{0C3E}-\x{0C44}] | +[\x{0C46}-\x{0C48}\x{0C4A}-\x{0C4D}\x{0C55}-\x{0C56}\x{0C82}-\x{0C83}] | +[\x{0CBE}-\x{0CC4}\x{0CC6}-\x{0CC8}\x{0CCA}-\x{0CCD}\x{0CD5}-\x{0CD6}] | +[\x{0D02}-\x{0D03}\x{0D3E}-\x{0D43}\x{0D46}-\x{0D48}\x{0D4A}-\x{0D4D}\x{0D57}] | +[\x{0E31}\x{0E34}-\x{0E3A}\x{0E47}-\x{0E4E}\x{0EB1}\x{0EB4}-\x{0EB9}] | +[\x{0EBB}-\x{0EBC}\x{0EC8}-\x{0ECD}\x{0F18}-\x{0F19}\x{0F35}\x{0F37}\x{0F39}] | +[\x{0F3E}\x{0F3F}\x{0F71}-\x{0F84}\x{0F86}-\x{0F8B}\x{0F90}-\x{0F95}] | +[\x{0F97}\x{0F99}-\x{0FAD}\x{0FB1}-\x{0FB7}\x{0FB9}\x{20D0}-\x{20DC}\x{20E1}] | +[\x{302A}-\x{302F}\x{3099}\x{309A}] +/x; + + $Ideographic = qr/ +[\x{4E00}-\x{9FA5}\x{3007}\x{3021}-\x{3029}] +/x; + + $Letter = qr/^ $BaseChar | $Ideographic $/x; + + $NameChar = qr/^ $Letter | $Digit | [._:-] | $CombiningChar | $Extender $/x; + PERL + + die $@ if $@; +} + +} + +1; diff -r 57a2cac6870f -r 0c558d696e7a common/tools/raptor/XML/SAX/PurePerl/Reader.pm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/common/tools/raptor/XML/SAX/PurePerl/Reader.pm Mon Aug 24 11:01:37 2009 +0100 @@ -0,0 +1,137 @@ +# $Id: Reader.pm,v 1.11 2005/10/14 20:31:20 matt Exp $ + +package XML::SAX::PurePerl::Reader; + +use strict; +use XML::SAX::PurePerl::Reader::URI; +use XML::SAX::PurePerl::Productions qw( $SingleChar $Letter $NameChar ); +use Exporter (); + +use vars qw(@ISA @EXPORT_OK); +@ISA = qw(Exporter); +@EXPORT_OK = qw( + EOF + BUFFER + LINE + COLUMN + ENCODING + XML_VERSION +); + +use constant EOF => 0; +use constant BUFFER => 1; +use constant LINE => 2; +use constant COLUMN => 3; +use constant ENCODING => 4; +use constant SYSTEM_ID => 5; +use constant PUBLIC_ID => 6; +use constant XML_VERSION => 7; + +require XML::SAX::PurePerl::Reader::Stream; +require XML::SAX::PurePerl::Reader::String; + +if ($] >= 5.007002) { + require XML::SAX::PurePerl::Reader::UnicodeExt; +} +else { + require XML::SAX::PurePerl::Reader::NoUnicodeExt; +} + +sub new { + my $class = shift; + my $thing = shift; + + # try to figure if this $thing is a handle of some sort + if (ref($thing) && UNIVERSAL::isa($thing, 'IO::Handle')) { + return XML::SAX::PurePerl::Reader::Stream->new($thing)->init; + } + my $ioref; + if (tied($thing)) { + my $class = ref($thing); + no strict 'refs'; + $ioref = $thing if defined &{"${class}::TIEHANDLE"}; + } + else { + eval { + $ioref = *{$thing}{IO}; + }; + undef $@; + } + if ($ioref) { + return XML::SAX::PurePerl::Reader::Stream->new($thing)->init; + } + + if ($thing =~ /new($thing)->init; + } + + # assume it is a uri + return XML::SAX::PurePerl::Reader::URI->new($thing)->init; +} + +sub init { + my $self = shift; + $self->[LINE] = 1; + $self->[COLUMN] = 1; + $self->read_more; + return $self; +} + +sub data { + my ($self, $min_length) = (@_, 1); + if (length($self->[BUFFER]) < $min_length) { + $self->read_more; + } + return $self->[BUFFER]; +} + +sub match { + my ($self, $char) = @_; + my $data = $self->data; + if (substr($data, 0, 1) eq $char) { + $self->move_along(1); + return 1; + } + return 0; +} + +sub public_id { + my $self = shift; + @_ and $self->[PUBLIC_ID] = shift; + $self->[PUBLIC_ID]; +} + +sub system_id { + my $self = shift; + @_ and $self->[SYSTEM_ID] = shift; + $self->[SYSTEM_ID]; +} + +sub line { + shift->[LINE]; +} + +sub column { + shift->[COLUMN]; +} + +sub get_encoding { + my $self = shift; + return $self->[ENCODING]; +} + +sub get_xml_version { + my $self = shift; + return $self->[XML_VERSION]; +} + +1; + +__END__ + +=head1 NAME + +XML::Parser::PurePerl::Reader - Abstract Reader factory class + +=cut diff -r 57a2cac6870f -r 0c558d696e7a common/tools/raptor/XML/SAX/PurePerl/Reader/NoUnicodeExt.pm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/common/tools/raptor/XML/SAX/PurePerl/Reader/NoUnicodeExt.pm Mon Aug 24 11:01:37 2009 +0100 @@ -0,0 +1,25 @@ +# $Id: NoUnicodeExt.pm,v 1.3 2003/07/30 13:39:23 matt Exp $ + +package XML::SAX::PurePerl::Reader; +use strict; + +sub set_raw_stream { + # no-op +} + +sub switch_encoding_stream { + my ($fh, $encoding) = @_; + throw XML::SAX::Exception::Parse ( + Message => "Only ASCII encoding allowed without perl 5.7.2 or higher. You tried: $encoding", + ) if $encoding !~ /(ASCII|UTF\-?8)/i; +} + +sub switch_encoding_string { + my (undef, $encoding) = @_; + throw XML::SAX::Exception::Parse ( + Message => "Only ASCII encoding allowed without perl 5.7.2 or higher. You tried: $encoding", + ) if $encoding !~ /(ASCII|UTF\-?8)/i; +} + +1; + diff -r 57a2cac6870f -r 0c558d696e7a common/tools/raptor/XML/SAX/PurePerl/Reader/Stream.pm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/common/tools/raptor/XML/SAX/PurePerl/Reader/Stream.pm Mon Aug 24 11:01:37 2009 +0100 @@ -0,0 +1,84 @@ +# $Id: Stream.pm,v 1.7 2005/10/14 20:31:20 matt Exp $ + +package XML::SAX::PurePerl::Reader::Stream; + +use strict; +use vars qw(@ISA); + +use XML::SAX::PurePerl::Reader qw( + EOF + BUFFER + LINE + COLUMN + ENCODING + XML_VERSION +); +use XML::SAX::Exception; + +@ISA = ('XML::SAX::PurePerl::Reader'); + +# subclassed by adding 1 to last element +use constant FH => 8; +use constant BUFFER_SIZE => 4096; + +sub new { + my $class = shift; + my $ioref = shift; + XML::SAX::PurePerl::Reader::set_raw_stream($ioref); + my @parts; + @parts[FH, LINE, COLUMN, BUFFER, EOF, XML_VERSION] = + ($ioref, 1, 0, '', 0, '1.0'); + return bless \@parts, $class; +} + +sub read_more { + my $self = shift; + my $buf; + my $bytesread = read($self->[FH], $buf, BUFFER_SIZE); + if ($bytesread) { + $self->[BUFFER] .= $buf; + return 1; + } + elsif (defined($bytesread)) { + $self->[EOF]++; + return 0; + } + else { + throw XML::SAX::Exception::Parse( + Message => "Error reading from filehandle: $!", + ); + } +} + +sub move_along { + my $self = shift; + my $discarded = substr($self->[BUFFER], 0, $_[0], ''); + + # Wish I could skip this lot - tells us where we are in the file + my $lines = $discarded =~ tr/\n//; + $self->[LINE] += $lines; + if ($lines) { + $discarded =~ /\n([^\n]*)$/; + $self->[COLUMN] = length($1); + } + else { + $self->[COLUMN] += $_[0]; + } +} + +sub set_encoding { + my $self = shift; + my ($encoding) = @_; + # warn("set encoding to: $encoding\n"); + XML::SAX::PurePerl::Reader::switch_encoding_stream($self->[FH], $encoding); + XML::SAX::PurePerl::Reader::switch_encoding_string($self->[BUFFER], $encoding); + $self->[ENCODING] = $encoding; +} + +sub bytepos { + my $self = shift; + tell($self->[FH]); +} + +1; + diff -r 57a2cac6870f -r 0c558d696e7a common/tools/raptor/XML/SAX/PurePerl/Reader/String.pm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/common/tools/raptor/XML/SAX/PurePerl/Reader/String.pm Mon Aug 24 11:01:37 2009 +0100 @@ -0,0 +1,61 @@ +# $Id: String.pm,v 1.5 2003/07/30 13:39:23 matt Exp $ + +package XML::SAX::PurePerl::Reader::String; + +use strict; +use vars qw(@ISA); + +use XML::SAX::PurePerl::Reader qw( + LINE + COLUMN + BUFFER + ENCODING + EOF +); + +@ISA = ('XML::SAX::PurePerl::Reader'); + +use constant DISCARDED => 7; + +sub new { + my $class = shift; + my $string = shift; + my @parts; + @parts[BUFFER, EOF, LINE, COLUMN, DISCARDED] = + ($string, 0, 1, 0, ''); + return bless \@parts, $class; +} + +sub read_more () { } + +sub move_along { + my $self = shift; + my $discarded = substr($self->[BUFFER], 0, $_[0], ''); + $self->[DISCARDED] .= $discarded; + + # Wish I could skip this lot - tells us where we are in the file + my $lines = $discarded =~ tr/\n//; + $self->[LINE] += $lines; + if ($lines) { + $discarded =~ /\n([^\n]*)$/; + $self->[COLUMN] = length($1); + } + else { + $self->[COLUMN] += $_[0]; + } +} + +sub set_encoding { + my $self = shift; + my ($encoding) = @_; + + XML::SAX::PurePerl::Reader::switch_encoding_string($self->[BUFFER], $encoding, "utf-8"); + $self->[ENCODING] = $encoding; +} + +sub bytepos { + my $self = shift; + length($self->[DISCARDED]); +} + +1; diff -r 57a2cac6870f -r 0c558d696e7a common/tools/raptor/XML/SAX/PurePerl/Reader/URI.pm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/common/tools/raptor/XML/SAX/PurePerl/Reader/URI.pm Mon Aug 24 11:01:37 2009 +0100 @@ -0,0 +1,57 @@ +# $Id: URI.pm,v 1.1 2001/11/11 18:41:51 matt Exp $ + +package XML::SAX::PurePerl::Reader::URI; + +use strict; + +use XML::SAX::PurePerl::Reader; +use File::Temp qw(tempfile); +use Symbol; + +## NOTE: This is *not* a subclass of Reader. It just returns Stream or String +## Reader objects depending on what it's capabilities are. + +sub new { + my $class = shift; + my $uri = shift; + # request the URI + if (-e $uri && -f _) { + my $fh = gensym; + open($fh, $uri) || die "Cannot open file $uri : $!"; + return XML::SAX::PurePerl::Reader::Stream->new($fh); + } + elsif ($uri =~ /^file:(.*)$/ && -e $1 && -f _) { + my $file = $1; + my $fh = gensym; + open($fh, $file) || die "Cannot open file $file : $!"; + return XML::SAX::PurePerl::Reader::Stream->new($fh); + } + else { + # request URI, return String reader + require LWP::UserAgent; + my $ua = LWP::UserAgent->new; + $ua->agent("Perl/XML/SAX/PurePerl/1.0 " . $ua->agent); + + my $req = HTTP::Request->new(GET => $uri); + + my $fh = tempfile(); + + my $callback = sub { + my ($data, $response, $protocol) = @_; + print $fh $data; + }; + + my $res = $ua->request($req, $callback, 4096); + + if ($res->is_success) { + seek($fh, 0, 0); + return XML::SAX::PurePerl::Reader::Stream->new($fh); + } + else { + die "LWP Request Failed"; + } + } +} + + +1; diff -r 57a2cac6870f -r 0c558d696e7a common/tools/raptor/XML/SAX/PurePerl/Reader/UnicodeExt.pm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/common/tools/raptor/XML/SAX/PurePerl/Reader/UnicodeExt.pm Mon Aug 24 11:01:37 2009 +0100 @@ -0,0 +1,23 @@ +# $Id: UnicodeExt.pm,v 1.4 2003/07/30 13:39:23 matt Exp $ + +package XML::SAX::PurePerl::Reader; +use strict; + +use Encode; + +sub set_raw_stream { + my ($fh) = @_; + binmode($fh, ":bytes"); +} + +sub switch_encoding_stream { + my ($fh, $encoding) = @_; + binmode($fh, ":encoding($encoding)"); +} + +sub switch_encoding_string { + Encode::from_to($_[0], $_[1], "utf-8"); +} + +1; + diff -r 57a2cac6870f -r 0c558d696e7a common/tools/raptor/XML/SAX/PurePerl/UnicodeExt.pm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/common/tools/raptor/XML/SAX/PurePerl/UnicodeExt.pm Mon Aug 24 11:01:37 2009 +0100 @@ -0,0 +1,22 @@ +# $Id: UnicodeExt.pm,v 1.1 2002/01/30 17:35:21 matt Exp $ + +package XML::SAX::PurePerl; +use strict; + +no warnings 'utf8'; + +sub chr_ref { + return chr(shift); +} + +if ($] >= 5.007002) { + require Encode; + + Encode::define_alias( "UTF-16" => "UCS-2" ); + Encode::define_alias( "UTF-16BE" => "UCS-2" ); + Encode::define_alias( "UTF-16LE" => "ucs-2le" ); + Encode::define_alias( "UTF16LE" => "ucs-2le" ); +} + +1; + diff -r 57a2cac6870f -r 0c558d696e7a common/tools/raptor/XML/SAX/PurePerl/XMLDecl.pm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/common/tools/raptor/XML/SAX/PurePerl/XMLDecl.pm Mon Aug 24 11:01:37 2009 +0100 @@ -0,0 +1,129 @@ +# $Id: XMLDecl.pm,v 1.3 2003/07/30 13:39:22 matt Exp $ + +package XML::SAX::PurePerl; + +use strict; +use XML::SAX::PurePerl::Productions qw($S $VersionNum $EncNameStart $EncNameEnd); + +sub XMLDecl { + my ($self, $reader) = @_; + + my $data = $reader->data(5); + # warn("Looking for xmldecl in: $data"); + if ($data =~ /^<\?xml$S/o) { + $reader->move_along(5); + $self->skip_whitespace($reader); + + # get version attribute + $self->VersionInfo($reader) || + $self->parser_error("XML Declaration lacks required version attribute, or version attribute does not match XML specification", $reader); + + if (!$self->skip_whitespace($reader)) { + my $data = $reader->data(2); + $data =~ /^\?>/ or $self->parser_error("Syntax error", $reader); + $reader->move_along(2); + return; + } + + if ($self->EncodingDecl($reader)) { + if (!$self->skip_whitespace($reader)) { + my $data = $reader->data(2); + $data =~ /^\?>/ or $self->parser_error("Syntax error", $reader); + $reader->move_along(2); + return; + } + } + + $self->SDDecl($reader); + + $self->skip_whitespace($reader); + + my $data = $reader->data(2); + $data =~ /^\?>/ or $self->parser_error("Syntax error", $reader); + $reader->move_along(2); + } + else { + # warn("first 5 bytes: ", join(',', unpack("CCCCC", $data)), "\n"); + # no xml decl + if (!$reader->get_encoding) { + $reader->set_encoding("UTF-8"); + } + } +} + +sub VersionInfo { + my ($self, $reader) = @_; + + my $data = $reader->data(11); + + # warn("Looking for version in $data"); + + $data =~ /^(version$S*=$S*(["'])($VersionNum)\2)/o or return 0; + $reader->move_along(length($1)); + my $vernum = $3; + + if ($vernum ne "1.0") { + $self->parser_error("Only XML version 1.0 supported. Saw: '$vernum'", $reader); + } + + return 1; +} + +sub SDDecl { + my ($self, $reader) = @_; + + my $data = $reader->data(15); + + $data =~ /^(standalone$S*=$S*(["'])(yes|no)\2)/o or return 0; + $reader->move_along(length($1)); + my $yesno = $3; + + if ($yesno eq 'yes') { + $self->{standalone} = 1; + } + else { + $self->{standalone} = 0; + } + + return 1; +} + +sub EncodingDecl { + my ($self, $reader) = @_; + + my $data = $reader->data(12); + + $data =~ /^(encoding$S*=$S*(["'])($EncNameStart$EncNameEnd*)\2)/o or return 0; + $reader->move_along(length($1)); + my $encoding = $3; + + $reader->set_encoding($encoding); + + return 1; +} + +sub TextDecl { + my ($self, $reader) = @_; + + my $data = $reader->data(6); + $data =~ /^<\?xml$S+/ or return; + $reader->move_along(5); + $self->skip_whitespace($reader); + + if ($self->VersionInfo($reader)) { + $self->skip_whitespace($reader) || + $self->parser_error("Lack of whitespace after version attribute in text declaration", $reader); + } + + $self->EncodingDecl($reader) || + $self->parser_error("Encoding declaration missing from external entity text declaration", $reader); + + $self->skip_whitespace($reader); + + $data = $reader->data(2); + $data =~ /^\?>/ or $self->parser_error("Syntax error", $reader); + + return 1; +} + +1; diff -r 57a2cac6870f -r 0c558d696e7a common/tools/raptor/XML/SAX/placeholder.pl --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/common/tools/raptor/XML/SAX/placeholder.pl Mon Aug 24 11:01:37 2009 +0100 @@ -0,0 +1,1 @@ +# ignore me diff -r 57a2cac6870f -r 0c558d696e7a common/tools/summary/brag_script.pl --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/common/tools/summary/brag_script.pl Mon Aug 24 11:01:37 2009 +0100 @@ -0,0 +1,57 @@ +# 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: +# Generate build summary with BRAG status + +use Getopt::Long; + +my $buildid = ''; +my $basedir = ''; +my $help = 0; +GetOptions(( + 'buildid=s' => \$buildid, + 'basedir=s' => \$basedir, + 'help!' => \$help +)); + +$help = 1 if (!$buildid or !$basedir); + +if ($help) +{ + print "Generate build summary with BRAG status\n"; + print "Usage: perl brag_script.pl --buildid=ID --basedir=DIR\n"; + exit(0); +} + +$buildid =~ /^([^_]*)_([^.]*)\./; +my $project = $1; +my $codeline = $2; + +my $logdir = "$basedir\\$buildid\\output\\logs"; + +opendir(DIR, $logdir); +my @dir_content = readdir(DIR); +close(DIR); +#my @asSimilarDirs = grep(/^$sBaseName(\.|$)/, @asDirs); + +my $nfiles = scalar(@dir_content); + + +open(FILE, ">$logdir\\build_summary.html"); +print FILE "build summary
build id: $buildid
log files: $nfiles"; +close(FILE); + +my $copy_cmd = "copy $logdir\\build_summary.html \\\\bishare\\sf_builds\\$project\\builds\\$codeline\\$buildid"; +print "Exec: $copy_cmd\n"; +system($copy_cmd); + + diff -r 57a2cac6870f -r 0c558d696e7a sf-package/build.xml --- a/sf-package/build.xml Tue Aug 18 13:48:35 2009 +0100 +++ b/sf-package/build.xml Mon Aug 24 11:01:37 2009 +0100 @@ -13,6 +13,15 @@ + + + + + + + + + @@ -21,72 +30,127 @@ - - - + + + + + + - - - - - + + - - - - + + + + + - - + + --> - - - - + + + + + + - - - - + + - - - + + + + + + - - - + - + diff -r 57a2cac6870f -r 0c558d696e7a sf-package/package_props.ant.xml --- a/sf-package/package_props.ant.xml Tue Aug 18 13:48:35 2009 +0100 +++ b/sf-package/package_props.ant.xml Mon Aug 24 11:01:37 2009 +0100 @@ -2,19 +2,28 @@ + + - + + + + + + + + diff -r 57a2cac6870f -r 0c558d696e7a sf-package/package_refs.ant.xml --- a/sf-package/package_refs.ant.xml Tue Aug 18 13:48:35 2009 +0100 +++ b/sf-package/package_refs.ant.xml Mon Aug 24 11:01:37 2009 +0100 @@ -4,8 +4,8 @@ - + - - \ No newline at end of file + + \ No newline at end of file diff -r 57a2cac6870f -r 0c558d696e7a sf-platform/build.xml --- a/sf-platform/build.xml Tue Aug 18 13:48:35 2009 +0100 +++ b/sf-platform/build.xml Mon Aug 24 11:01:37 2009 +0100 @@ -3,86 +3,67 @@ + + + + + + + + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + [SF-BUILD-NOPREP] (platform) + [SF-BUILD-NOPREP] WARNING: Not generating model from packages + - - - - - + This target is effectively a callback, called from compile-main. + Its responsibility is to convert the set of peices in ref "system.definition.files" into one sys def with absolute paths + + However, in our builds, we know that there will only be one sysdef peice passed in, so that makes things a lot simpler + --> + + + + + + - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + @@ -278,7 +281,8 @@ - + + @@ -453,8 +457,5 @@ - - - diff -r 57a2cac6870f -r 0c558d696e7a sf-platform/platform_props.ant.xml --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sf-platform/platform_props.ant.xml Mon Aug 24 11:01:37 2009 +0100 @@ -0,0 +1,7 @@ + + + + + + + diff -r 57a2cac6870f -r 0c558d696e7a sf-platform/platform_refs.ant.xml --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sf-platform/platform_refs.ant.xml Mon Aug 24 11:01:37 2009 +0100 @@ -0,0 +1,5 @@ + + + + +