#
# SAX Filter to follow XLinks and basically
# transform them into XIncludes.
#
# code by Brad Lhotsky <brad@divisionbyzero.net>
#
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( { Handle
+r => $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;
[download]

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 = <FILE>;
        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, E<lt>brad@divsionbyzero.netE<gt>

=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
[download]