Trying to pop context without push context at /usr/local/lib/perl5/site_perl/5.8.0/XML/NamespaceSupport.pm line 76.
####
#
# SAX Filter to follow XLinks and basically
# transform them into XIncludes.
#
# code by Brad Lhotsky
#
package XML::Expander::Filter::XLink;
use 5.006;
use strict;
use warnings;
use base qw(XML::SAX::Base);
use XML::Expander;
use LWP::Simple;
use Data::Dumper;
our $VERSION = 0.01;
our $DEBUG = 1;
#our $AUTOLOAD;
XML::Expander::Filter::XLink->_debug("USED ME");
sub start_element {
my ($self,$el) = @_;
$self->_debug("starting an element $el->{LocalName}");
my $attrs = $el->{Attributes};
my $xlink = undef;
my %link = ();
foreach my $a (keys %$attrs) {
next unless $attrs->{$a}{NamespaceURI} eq 'http://www.w3.org/1999/xlink';
$link{$attrs->{$a}{LocalName}} = $attrs->{$a}{Value};
$xlink ||= $el->{LocalName};
}
return $self->SUPER::start_element($el) unless $xlink;
$self->_debug("* found an xlink");
print Dumper ( \%link );
#
# this where we incorporate the rest of the document if its
# an xlink and stuff
$self->{xlink_linked} = 1;
my @lnx = qw/simple locator/;
if($link{href}) {
delete $self->{xlink_linked};
my $parser = XML::SAX::ParserFactory->parser( { Handler => $self} );
my $content = $self->retrieve($link{href});
print $content;
$parser->parse_string( $content );
$self->{xlink_linked} = 1;
return;
}
#
# we should only get here if we have an xlinked we don't
# understand, so lets make this safe
delete $self->{xlink_linked};
return $self->SUPER::start_element($el);
}
sub end_element {
my $self = shift;
if($self->{xlink_linked}) {
delete $self->{xlink_linked};
return;
}
$self->SUPER::end_element(@_);
}
sub characters {
my $self = shift;
return if $self->{xlink_linked};
$self->SUPER::characters(@_);
}
sub retrieve {
my ($self,$uri) = @_;
return get($uri);
}
#sub AUTOLOAD {
# my ($self) = shift;
# $self->_debug("Attempting to AUTOLOAD $AUTOLOAD");
# my $func = 'SUPER::' . (split /\:\:/, $AUTOLOAD)[-1];
# $self->_debug("fucntion: $func");
# #no strict 'refs';
# #$self->$func(@_);
#}
sub _debug {
return unless $DEBUG;
my ($self,@msgs) = @_;
my $time = join ':', map { unless( /^\d\d$/ ) { s/^/0/; } $_; } (localtime)[2,1,0];
for(@msgs) {
chomp;
print STDERR "$time DEBUG> $_\n";
}
}
1;
####
package XML::Expander;
use 5.008;
use strict;
use warnings;
use Carp;
use base qw(Exporter);
use XML::SAX;
use XML::SAX::Machines qw(Pipeline);
use XML::SAX::Writer;
use LWP::Simple;
our $VERSION = '0.01';
our @EXPORT = qw(Expand);
sub new {
#
# pretty much a no-op,
# but lets set it up to function
my $proto = shift;
my $class = ref $proto || $proto;
return bless {}, $class;
}
sub Expand {
#
# we take a document and follow the XLinks
# and embed them in the document, and then return
# the document beautifully formatted with the
# XLink'd stuff included.
my $self = bless {}, __PACKAGE__;
$self = shift if ref $_[0] eq __PACKAGE__;
my $doc = $self->get_xml( @_ );
my $data = undef;
print $doc;
my $writer = new XML::SAX::Writer( Output => \$data );
#
# All the hard stuff gets taken care of thanks
# to our pipeline, leaving us to just return the data.
#XML::SAX->add_parser(q(XML::Expander::Filter::XLink));
my $pipeline = Pipeline(
'XML::Expander::Filter::XLink' =>
$writer
);
$pipeline->parse_string( $doc );
#XML::SAX->remove_parser(q(XML::Expander::Filter::XLink));
return $data;
}
sub get_xml {
my $self = shift;
if(scalar @_ == 1) {
if(/^\<\?xml/i) {
#
# valid xml ?
return $_[0];
}
elsif(-f $_[0]) {
return $self->fetch_file($_[0]);
}
elsif($_[0] =~ m/^\w+\:\/\//) {
# uri ?
return $self->fetch_uri( $_[0] )
}
}
return;
}
sub fetch_file {
my $self = shift;
my $filename = shift;
return unless -f $filename;
open FILE, "< $filename" or
croak "cannot open file: $filename\n";
local $/ = undef;
my $str = ;
close FILE;
return $str;
}
sub fetch_uri {
my $self = shift;
my $uri = shift;
if(is_success(head($uri))) {
return get($uri);
}
carp "unable to retrieve uri $uri!\n";
return undef;
}
1;
__END__
=head1 NAME
XML::Expander - Perl extension for expanding XML documents
=head1 SYNOPSIS
use XML::Expander;
my $xmlfile = 'file.xml';
my $expanded = Expand $xmlfile;
print $expanded;
=head1 ABSTRACT
This module exports one method "Expand" which takes a string
of data or a URI or a file handle and expands any remote element
in the document into the full document to store locally.
=head1 DESCRIPTION
This module exports one method "Expand" which takes a string
of data or a URI or a file handle and expands any remote element
in the document into the full document to store locally.
=head1 AUTHOR
Brad Lhotsky, Ebrad@divsionbyzero.netE
=head1 COPYRIGHT AND LICENSE
Copyright 2002 by Brad Lhotsky
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
=cut