package UR::Object::View::Default::Xml;
use strict;
use warnings;
require UR;
our $VERSION = "0.392"; # UR $VERSION;
use IO::File;
use XML::Dumper;
use XML::LibXML;
class UR::Object::View::Default::Xml {
is => 'UR::Object::View::Default::Text',
has_constant => [
toolkit => { value => 'xml' },
],
has => [
_xml_doc => { is => 'XML::LibXML::Document', doc => 'The LibXML document used to create the content for this view', is_transient => 1 }
],
};
sub xsl_template_files {
my $self = shift; #usually this is a view without a subject attached
my $output_format = shift;
my $root_path = shift;
my $perspective = shift || lc($self->perspective);
my @xsl_names = map {
$_ =~ s/::/_/g;
my $pf = "/$output_format/$perspective/" . lc($_) . '.xsl';
my $df = "/$output_format/default/" . lc($_) . '.xsl';
-e $root_path . $pf ? $pf : (-e $root_path . $df ? $df : undef)
} $self->all_subject_classes_ancestry;
my @found_xsl_names = grep {
defined
} @xsl_names;
return @found_xsl_names;
}
sub _generate_xml_doc {
my $self = shift;
my $subject = $self->subject();
return unless $subject;
my $xml_doc = XML::LibXML->createDocument();
$self->_xml_doc($xml_doc);
# the header line is the class followed by the id
my $object = $xml_doc->createElement('object');
$xml_doc->setDocumentElement($object);
$object->addChild( $xml_doc->createAttribute('type', $self->subject_class_name) );
$object->addChild( $xml_doc->createAttribute('id', $subject->id ) );
my $display_name = $object->addChild( $xml_doc->createElement('display_name') );
$display_name->addChild( $xml_doc->createTextNode($subject->__display_name__) );
my $label_name = $object->addChild( $xml_doc->createElement('label_name' ));
$label_name->addChild( $xml_doc->createTextNode($subject->__label_name__) );
my $types = $object->addChild( $xml_doc->createElement('types') );
foreach my $c ($self->subject_class_name,$subject->__meta__->ancestry_class_names) {
my $isa = $types->addChild( $xml_doc->createElement('isa') );
$isa->addChild( $xml_doc->createAttribute('type', $c) );
}
unless ($self->_subject_is_used_in_an_encompassing_view()) {
# the content for any given aspect is handled separately
my @aspects = $self->aspects;
if (@aspects) {
my @sorted_aspects = map { $_->[1] }
sort { $a->[0] <=> $b->[0] }
map { [ $_->number, $_ ] }
@aspects;
for my $aspect (@sorted_aspects) {
next if $aspect->name eq 'id';
my $aspect_node = $self->_generate_content_for_aspect($aspect);
$object->addChild( $aspect_node ) if $aspect_node; #If aspect has no values, it won't be included
}
}
}
#From the XML::LibXML documentation:
#If $format is 1, libxml2 will add ignorable white spaces, so the nodes content is easier to read. Existing text nodes will not be altered
#If $format is 2 (or higher), libxml2 will act as $format == 1 but it add a leading and a trailing line break to each text node.
return $xml_doc;
}
sub _generate_content {
my $self = shift;
my $xml_doc = $self->_generate_xml_doc;
return '' unless $xml_doc;
my $doc_string = $xml_doc->toString(1);
# remove invalid XML entities
$doc_string =~ s/[^\x09\x0A\x0D\x20-\x{D7FF}\x{E000}-\x{FFFD}\x{10000}-\x{10FFFF}]//go;
return $doc_string;
}
sub _add_perl_data_to_node {
my $self = shift;
my $perlref = shift;
my $node = shift;
my $xml_doc = $self->_xml_doc;
$node ||= $xml_doc->documentElement;
my $d = XML::Dumper->new;
my $perldata = $d->pl2xml($perlref);
my $parser = XML::LibXML->new;
my $ref_xml_doc = $parser->parse_string($perldata);
my $ref_root = $ref_xml_doc->documentElement;
$xml_doc->adoptNode( $ref_root );
$node->addChild( $ref_root );
return 1;
}
sub _generate_content_for_aspect {
# This does two odd things:
# 1. It gets the value(s) for an aspect, then expects to just print them
# unless there is a delegate view. In which case, it replaces them
# with the delegate's content.
# 2. In cases where more than one value is returned, it recycles the same
# view and keeps the content.
#
# These shortcuts make it hard to abstract out logic from toolkit-specifics
my $self = shift;
my $aspect = shift;
my $subject = $self->subject;
my $xml_doc = $self->_xml_doc;
my $aspect_name = $aspect->name;
my $aspect_node = $xml_doc->createElement('aspect');
$aspect_node->addChild( $xml_doc->createAttribute('name', $aspect_name) );
my @value;
eval {
@value = $subject->$aspect_name;
};
if ($@) {
my ($file,$line) = ($@ =~ /at (.*?) line (\d+)$/m);
my $exception = $aspect_node->addChild( $xml_doc->createElement('exception') );
$exception->addChild( $xml_doc->createAttribute('file', $file) );
$exception->addChild( $xml_doc->createAttribute('line', $line) );
$exception->addChild( $xml_doc->createCDATASection($@) );
return $aspect_node;
}
if (not Scalar::Util::blessed($value[0])) {
# shortcut to optimize for simple scalar values without delegate views
for my $value ( @value ) {
my $value_node = $aspect_node->addChild( $xml_doc->createElement('value') );
$value = '' if not defined $value;
$value_node->addChild( $xml_doc->createTextNode($value) );
}
return $aspect_node;
}
unless ($aspect->delegate_view) {
$aspect->generate_delegate_view;
}
# Delegate to a subordinate view if needed.
# This means we replace the value(s) with their
# subordinate widget content.
my $delegate_view = $aspect->delegate_view;
unless ($delegate_view) {
Carp::confess("No delegate view???");
}
foreach my $value ( @value ) {
if (Scalar::Util::blessed($value)) {
$delegate_view->subject($value);
} else {
$delegate_view->subject_id($value);
}
$delegate_view->_update_view_from_subject();
# merge the delegate view's XML into this one
if ($delegate_view->can('_xml_doc') and $delegate_view->_xml_doc) {
# the delegate has XML
my $delegate_xml_doc = $delegate_view->_xml_doc;
my $delegate_root = $delegate_xml_doc->documentElement;
#cloneNode($deep = 1)
$aspect_node->addChild( $delegate_root->cloneNode(1) );
}
elsif (ref($value) and not $value->isa("UR::Value")) {
# Note: Let UR::Values display content below
# Otherwise, the delegate view has no XML object, and the value is a reference
$self->_add_perl_data_to_node($value, $aspect_node);
}
elsif (ref($value) and $value->isa("UR::Value")) {
# For a UR::Value return both a formatted value and a raw value.
my $display_value_node = $aspect_node->addChild( $xml_doc->createElement('display_value') );
my $content = $delegate_view->content;
$content = '' if not defined $content;
$display_value_node->addChild( $xml_doc->createTextNode($content) );
my $value_node = $aspect_node->addChild( $xml_doc->createElement('value') );
$content = $value->id;
$value_node->addChild( $xml_doc->createTextNode($content) );
}
else {
# no delegate view has no XML object, and the value is a non-reference
# (this is the old logic for non-delegate views when we didn't have delegate views for primitives)
my $value_node = $aspect_node->addChild( $xml_doc->createElement('value') );
unless(defined $value) {
$value = '';
}
my $content = $delegate_view->content;
$content = '' if not defined $content;
$value_node->addChild( $xml_doc->createTextNode($content) );
## old logic for delegate views with no xml doc (unused now)
## the delegate view may not be XML at all--wrap it in our aspect tag so that it parses
## (assuming that whatever delegate was selected properly escapes anything that needs escaping)
# my $delegate_text = $delegate_view->content() ? $delegate_view->content() : '';
# my $aspect_text = "<aspect name=\"$aspect_name\">\n$delegate_text\n</aspect>";
# my $parser = XML::LibXML->new;
# my $delegate_xml_doc = $parser->parse_string($aspect_text);
# $aspect_node = $delegate_xml_doc->documentElement;
# $xml_doc->adoptNode( $aspect_node );
}
}
return $aspect_node;
}
# Do not return any aspects by default if we're embedded in another view
# The creator of the view will have to specify them manually
sub _resolve_default_aspects {
my $self = shift;
unless ($self->parent_view) {
return $self->SUPER::_resolve_default_aspects;
}
return;
}
1;
=pod
=head1 NAME
UR::Object::View::Default::Xml - represent object state in XML format
=head1 SYNOPSIS
$o = Acme::Product->get(1234);
$v = $o->create_view(
toolkit => 'xml',
aspects => [
'id',
'name',
'qty_on_hand',
'outstanding_orders' => [
'id',
'status',
'customer' => [
'id',
'name',
]
],
],
);
$xml1 = $v->content;
$o->qty_on_hand(200);
$xml2 = $v->content;
=head1 DESCRIPTION
This class implements basic XML views of objects. It has standard behavior for all text views.
=head1 SEE ALSO
UR::Object::View::Default::Text, UR::Object::View, UR::Object::View::Toolkit::XML, UR::Object::View::Toolkit::Text, UR::Object
=cut