—package
PITA::XML;
# See POD at end for docs.
use
5.005;
use
strict;
use
Carp ();
use
IO::File ();
use
IO::String ();
BEGIN {
# Temporary Hack:
# IO::String looks like a duck and quacks liks a duck, but we need it
# to be a real duck. So lets make it a duck (if it didn't turn into a
# real duck while we weren't looking.)
unless
(
@IO::String::ISA
) {
@IO::String::ISA
=
qw{IO::Handle IO::Seekable}
;
}
}
use
File::Flock ();
use
File::ShareDir ();
use
XML::SAX::ParserFactory ();
use
XML::Validator::Schema ();
BEGIN {
$VERSION
=
'0.13'
;
}
# The XML Schema File
# Locate the Schema at use-time (instead of compile-time) and
# allow the specification of a custom schema.
$SCHEMA
||= File::ShareDir::dist_file(
'PITA-XML'
,
'pita-xml.xsd'
);
# While in development, use a version-specific namespace.
# In theory, this ensures documents are only truly valid with the
# version they were created with.
# The list of core schemes
BEGIN {
%SCHEMES
= (
'perl5'
=> 1,
'perl5.make'
=> 1,
'perl5.build'
=> 1,
'perl6'
=> 1,
);
}
# Load the various classes
use
PITA::XML::File ();
use
PITA::XML::Command ();
use
PITA::XML::Test ();
use
PITA::XML::Request ();
use
PITA::XML::Platform ();
use
PITA::XML::Guest ();
use
PITA::XML::Install ();
use
PITA::XML::Report ();
use
PITA::XML::SAXParser ();
use
PITA::XML::SAXDriver ();
#####################################################################
# Main Methods
sub
validate {
my
$class
=
shift
;
my
$fh
=
$class
->_FH(
shift
);
# Create the validator
my
$parser
= XML::SAX::ParserFactory->parser(
Handler
=> XML::Validator::Schema->new(
file
=>
$SCHEMA
,
),
);
# Validate the document
$parser
->parse_file(
$fh
);
1;
}
#####################################################################
# Support Methods
sub
_FH {
my
(
$class
,
$file
) =
@_
;
if
( _SCALAR(
$file
) ) {
$file
= IO::String->new(
$file
);
}
if
( _INSTANCE(
$file
,
'IO::Handle'
) ) {
if
(
$file
->can(
'seek'
) ) {
# Reset the file handle
$file
->
seek
( 0, 0 ) or Carp::croak(
'Failed to reset file handle (seek to 0)'
,
);
return
$file
;
}
Carp::croak(
'IO::Handle is not seekable'
);
}
unless
(
defined
$file
and !
ref
$file
and
length
$file
) {
Carp::croak(
'Did not provide a file name or handle'
);
}
unless
(
$file
and -f
$file
and -r _ ) {
Carp::croak(
'Did not provide a readable file name'
);
}
my
$fh
= IO::File->new(
$file
);
unless
(
$fh
) {
Carp::croak(
"Failed to open PITA::XML file '$file'"
);
}
$fh
;
}
sub
_OUTPUT {
my
(
$class
,
$object
,
$name
) =
@_
;
# If provided as a param, clean it up
if
(
exists
$object
->{
$name
} ) {
# Convert from array to scalar ref
if
( _ARRAY0(
$object
->{
$name
}) ) {
# Clean up newlines and merge into SCALAR
my
$param
=
$object
->{
$name
};
foreach
my
$i
( 0 ..
$#$param
) {
$param
->[
$i
] =~ s/[\012\015]+$/\n/;
}
$param
=
join
''
,
@$param
;
$object
->{
$name
} = \
$param
;
}
}
# Check for scalarness
_SCALAR0(
$object
->
$name
()) ? 1 :
undef
;
}
sub
_SCHEME {
my
$class
=
shift
;
my
$string
= _STRING(
shift
) or
return
undef
;
(
$SCHEMES
{
$string
} or
$string
=~ /x_/) ?
$string
:
undef
;
}
sub
_MD5SUM {
my
$class
=
shift
;
my
$md5sum
= _STRING(
shift
) or
return
undef
;
(
$md5sum
=~ /^[0-9a-f]{32}$/i) ?
lc
(
$md5sum
) :
undef
;
}
sub
_DISTNAME {
my
$class
=
shift
;
my
$distname
= _STRING(
shift
) or
return
undef
;
(
$distname
=~ /^[a-z]\w*(?:\-[a-z]\w*)+$/is) ?
$distname
:
undef
;
}
1;
__END__
=pod
=head1 NAME
PITA::XML - Create, load, save and manipulate PITA-XML files
=head1 STATUS
B<This is an experimental release for demonstration purposes only.>
B<Please note the .xsd schema file may not install correctly as yet.>
=head1 DESCRIPTION
The C<PITA::XML> package supports the various uses of XML throughout
the L<PITA> project.
=head1 SUPPORT
Bugs should be reported via the CPAN bug tracker at
For other issues, contact the author.
=head1 AUTHOR
Adam Kennedy E<lt>cpan@ali.asE<gt>, L<http://ali.as/>
=head1 SEE ALSO
L<PITA::XML::Report>
The Perl Image-based Testing Architecture (L<http://ali.as/pita/>)
=head1 COPYRIGHT
Copyright 2005, 2006 Adam Kennedy. All rights reserved.
This program is free software; you can redistribute
it and/or modify it under the same terms as Perl itself.
The full text of the license can be found in the
LICENSE file included with this module.
=cut