Menu
▾
▴
[Everydevel-opers] SF.net SVN: everydevel: [933] trunk/ebase
|
From: <pau...@us...> - 2007-01-03 19:48:00
|
Revision: 933
http://svn.sourceforge.net/everydevel/?rev=933&view=rev
Author: paul_the_nomad
Date: 2007-01-03 11:47:50 -0800 (Wed, 03 Jan 2007)
Log Message:
-----------
Remove node to XML code from Node/node.pm and subclasses to
Everything/XML/Node.pm. Remove all imports from XML.pm to Node/node.pm and
subclasses. Node.pm remains.
Modified Paths:
--------------
trunk/ebase/lib/Everything/Node/Test/node.pm
trunk/ebase/lib/Everything/Node/Test/nodeball.pm
trunk/ebase/lib/Everything/Node/Test/nodegroup.pm
trunk/ebase/lib/Everything/Node/Test/setting.pm
trunk/ebase/lib/Everything/Node/node.pm
trunk/ebase/lib/Everything/Node/nodeball.pm
trunk/ebase/lib/Everything/Node/nodegroup.pm
trunk/ebase/lib/Everything/Node/setting.pm
trunk/ebase/lib/Everything/Test/XML.pm
trunk/ebase/lib/Everything/XML.pm
Added Paths:
-----------
trunk/ebase/lib/Everything/XML/
trunk/ebase/lib/Everything/XML/Node.pm
trunk/ebase/lib/Everything/XML/Test/
trunk/ebase/lib/Everything/XML/Test/Node.pm
Property Changed:
----------------
trunk/ebase/
Property changes on: trunk/ebase
___________________________________________________________________
Name: svk:merge
- 16c2b9cb-492b-4d64-9535-64d4e875048d:/wip/ebase:935
a6810612-c0f9-0310-9d3e-a9e4af8c5745:/ebase/offline:17930
+ 16c2b9cb-492b-4d64-9535-64d4e875048d:/wip/ebase:936
a6810612-c0f9-0310-9d3e-a9e4af8c5745:/ebase/offline:17930
Modified: trunk/ebase/lib/Everything/Node/Test/node.pm
===================================================================
--- trunk/ebase/lib/Everything/Node/Test/node.pm 2007-01-03 19:47:06 UTC (rev 932)
+++ trunk/ebase/lib/Everything/Node/Test/node.pm 2007-01-03 19:47:50 UTC (rev 933)
@@ -62,10 +62,10 @@
sub setup_imports {
- return qw( DBI Everything Everything::XML);
+ return qw( DBI Everything );
}
-sub test_imports :Test(startup => 2) {
+sub test_imports :Test(startup => 1) {
my ( $self) = @_;
my $imports = $self->{imports};
is_deeply(
@@ -73,11 +73,6 @@
{ '$DB' => 1},
'...imports $DB from Everything'
);
- is_deeply(
- $$imports{'Everything::XML'},
- { genBasicTag => 1 },
- '...imports xml2node, genBasicTag, parseBasicTag from Everything::XML'
- );
}
@@ -448,31 +443,6 @@
'... and removing non-export keys as well' );
}
-sub test_field_to_XML :Test( 5 )
-{
- my $self = shift;
- my $node = $self->{node};
- my @gbt;
-
- local *Everything::Node::node::genBasicTag;
-
- *Everything::Node::node::genBasicTag = sub {
- push @gbt, [@_];
- return 'tag';
- };
-
- $node->{afield} = 'thisfield';
- is( $node->fieldToXML( $node, 'afield' ), 'tag',
- 'fieldToXML() should return an XML tag element' );
- is( @gbt, 1, '... and should call genBasicTag()' );
- is( join( ' ', @{ $gbt[0] } ), "$node field afield thisfield",
- '... with the correct arguments' );
-
- ok( ! $node->fieldToXML( $node, 'notafield' ),
- '... and should return false if field does not exist' );
- ok( ! exists $node->{notafield}, '... and should not create field' );
-}
-
sub test_get_identifying_fields :Test( 1 )
{
my $self = shift;
Modified: trunk/ebase/lib/Everything/Node/Test/nodeball.pm
===================================================================
--- trunk/ebase/lib/Everything/Node/Test/nodeball.pm 2007-01-03 19:47:06 UTC (rev 932)
+++ trunk/ebase/lib/Everything/Node/Test/nodeball.pm 2007-01-03 19:47:50 UTC (rev 933)
@@ -114,28 +114,4 @@
ok( $node->hasVars(), 'hasVars() should return true' );
}
-sub test_field_to_XML :Test( 4 )
-{
- my $self = shift;
- my $node = $self->{node};
-
- my @saveargs;
- local *Everything::Node::setting::fieldToXML;
- *Everything::Node::setting::fieldToXML = sub { @saveargs = @_ };
-
- my @args = ( 'doc', '', 1 );
- $node->set_always( SUPER => 4 );
-
- is( $node->fieldToXML(@args), 4,
- 'fieldToXML() should call SUPER() unless handling a "vars" field' );
-
- my ($method, $args) = $node->next_call();
- is_deeply( $args, [ $node, @args ], '... passing all arguments' );
-
- $args[1] = 'vars';
- is( $node->fieldToXML( @args ), 4,
- '... delegating to setting nodetype if handling "vars" field' );
- is( "@saveargs", "$node @args", '... passing along its arguments' );
-}
-
1;
Modified: trunk/ebase/lib/Everything/Node/Test/nodegroup.pm
===================================================================
--- trunk/ebase/lib/Everything/Node/Test/nodegroup.pm 2007-01-03 19:47:06 UTC (rev 932)
+++ trunk/ebase/lib/Everything/Node/Test/nodegroup.pm 2007-01-03 19:47:50 UTC (rev 933)
@@ -7,25 +7,6 @@
use Test::More;
-
-sub setup_imports {
-
- return qw( Everything::XML);
-}
-
-sub test_imports :Test(startup => 1) {
- my ( $self) = @_;
- my $imports = $self->{imports};
-
- is_deeply(
- $$imports{'Everything::XML'},
- { genBasicTag => 1 },
- '...imports genBasicTag from Everything::XML'
- );
-
-}
-
-
sub test_construct :Test( 1 )
{
my $self = shift;
@@ -483,64 +464,6 @@
ok( !exists $node->getNodeKeys()->{group}, '... excluding it otherwise' );
}
-sub test_field_to_XML :Test( +8 )
-{
- my $self = shift;
- my $node = $self->{node};
- $self->SUPER();
-
- $node->set_series( SUPER => ( 5, 6, 7 ) )
- ->set_true('appendChild');
-
- my $result = $node->fieldToXML( 'doc', 'field', 0 );
- my ($method, $args) = $node->next_call();
-
- is( $method, 'SUPER',
- 'fieldToXML() should call SUPER() unless handling a group field' );
- is( join( '-', @$args ), "$node-doc-field-0", '... passing args' );
-
- is( $result, 5, '... returning the results' );
- {
- local ( *XML::DOM::Element::new, *XML::DOM::Text::new,
- *Everything::Node::nodegroup::genBasicTag );
-
- my @xd;
- *XML::DOM::Text::new = sub {
- push @xd, [@_];
- return @_;
- };
- *XML::DOM::Element::new = sub {
- push @xd, [@_];
- return $node;
- };
-
- my @gbt;
- *Everything::Node::nodegroup::genBasicTag = sub {
- push @gbt, [@_];
- };
-
- $node->{group} = [ 3, 4, 5 ];
- $result = $node->fieldToXML( 'doc', 'group', "\r" );
-
- is( join( ' ', @{ $xd[0] } ), 'XML::DOM::Element doc group',
- '... otherwise, it should create a new DOM group element' );
-
- my $count;
- for ( 1 .. 6 )
- {
- ( $method, $args ) = $node->next_call();
- $count++ if $method eq 'appendChild';
- }
-
- is( $count, 6, '... appending each child as a Text node' );
- is( join( ' ', map { $_->[3] } @gbt ),
- '3 4 5', '... noted with their node_ids' );
- is( $method, 'appendChild', '... and appending the whole thing' );
- is( $result, $node, '... and should return the new element' );
- }
-
-}
-
sub test_clone :Test( 9 )
{
my $self = shift;
Modified: trunk/ebase/lib/Everything/Node/Test/setting.pm
===================================================================
--- trunk/ebase/lib/Everything/Node/Test/setting.pm 2007-01-03 19:47:06 UTC (rev 932)
+++ trunk/ebase/lib/Everything/Node/Test/setting.pm 2007-01-03 19:47:50 UTC (rev 933)
@@ -8,22 +8,6 @@
use Test::More;
-sub setup_imports {
-
- return ('Everything::XML');
-}
-
-sub test_imports :Test(startup => 1) {
- my ( $self) = @_;
- my $imports = $self->{imports};
- is_deeply(
- $$imports{'Everything::XML'},
- { genBasicTag => 1 },
- '...imports genBasicTag and parseBasicTag from Everything::XML'
- );
-}
-
-
sub test_extends :Test( +1 )
{
my $self = shift;
@@ -77,41 +61,6 @@
ok( $node->hasVars(), 'hasVars() should return true' );
}
-sub test_field_to_XML :Test( +5 )
-{
- my $self = shift;
- my $node = $self->{node};
-
- $self->SUPER();
-
- local ( *XML::DOM::Element::new, *XML::DOM::Text::new,
- *Everything::Node::setting::genBasicTag, *fieldToXML );
-
- my @dom;
- *XML::DOM::Element::new = *XML::DOM::Text::new = sub {
- push @dom, shift;
- return $node;
- };
-
- my @tags;
- *Everything::Node::setting::genBasicTag = sub {
- push @tags, join( ' ', @_[ 1 .. 3 ] );
- };
-
- $node->set_always( getVars => { a => 1, b => 1, c => 1 } )
- ->set_series( SUPER => 2, 10 )
- ->set_true( '-appendChild' );
-
- is( $node->fieldToXML( '', 'vars' ),
- $node, '... should return XML::DOM element for vars, if "vars" field' );
- is( @dom, 5, '... should make several DOM nodes:' );
- is( scalar grep( /Element/, @dom ), 1, '... one Element node' );
- is( scalar grep( /Text/, @dom ), 4, '... and several Text nodes' );
-
- is( join( '!', @tags ), 'var a 1!var b 1!var c 1',
- '... should call genBasicTag() on each var pair' );
-}
-
sub test_get_node_keep_keys :Test( +1 )
{
my $self = shift;
Modified: trunk/ebase/lib/Everything/Node/node.pm
===================================================================
--- trunk/ebase/lib/Everything/Node/node.pm 2007-01-03 19:47:06 UTC (rev 932)
+++ trunk/ebase/lib/Everything/Node/node.pm 2007-01-03 19:47:50 UTC (rev 933)
@@ -15,7 +15,6 @@
use DBI;
use Everything qw/$DB/;
-use Everything::XML qw/genBasicTag/;
use Everything::NodeBase;
use Scalar::Util 'reftype';
@@ -457,42 +456,6 @@
return 1;
}
-=head2 C<fieldToXML>
-
-Given a field of this node (ie title), convert that field into an XML tag.
-
-=over 4
-
-=item * $DOC
-
-the base XML::DOM::Document object that this tag belongs to
-
-=item * $field
-
-the field of the node to convert
-
-=item * $indent
-
-string that contains the amount this tag will be indented. node::fieldToXML
-does not use this. This is for more complicated structures that want to have a
-nice formatting. This lets them know how far they are going to be indented so
-they know how far to indent their children.
-
-=back
-
-Returns an XML::DOM::Element object that can be inserted into the parent
-structure.
-
-=cut
-
-sub fieldToXML
-{
- my ( $this, $DOC, $field, $indent ) = @_;
- return unless exists $this->{$field};
-
- return genBasicTag( $DOC, 'field', $field, $this->{$field} );
-}
-
=head2 C<getIdentifyingFields>
When we export nodes to XML any fields that are pointers to other nodes. A
Modified: trunk/ebase/lib/Everything/Node/nodeball.pm
===================================================================
--- trunk/ebase/lib/Everything/Node/nodeball.pm 2007-01-03 19:47:06 UTC (rev 932)
+++ trunk/ebase/lib/Everything/Node/nodeball.pm 2007-01-03 19:47:50 UTC (rev 933)
@@ -80,22 +80,4 @@
sub hasVars { 1 }
-=head2 C<fieldToXML>
-
-A nodeball has both setting and group type information. A nodeball derives
-from nodegroup, but we also need to handle our setting info. The base setting
-object will handle that and pass the rest to our parent.
-
-=cut
-
-sub fieldToXML
-{
- my ( $this, $DOC, $field, $indent ) = @_;
-
- return Everything::Node::setting::fieldToXML( $this, $DOC, $field, $indent )
- if $field eq 'vars';
-
- return $this->SUPER( $DOC, $field, $indent );
-}
-
1;
Modified: trunk/ebase/lib/Everything/Node/nodegroup.pm
===================================================================
--- trunk/ebase/lib/Everything/Node/nodegroup.pm 2007-01-03 19:47:06 UTC (rev 932)
+++ trunk/ebase/lib/Everything/Node/nodegroup.pm 2007-01-03 19:47:50 UTC (rev 933)
@@ -13,9 +13,6 @@
use base 'Everything::Node::node';
-use Everything::XML (qw/genBasicTag/);
-
-use XML::DOM;
use Scalar::Util 'reftype';
sub construct
@@ -633,52 +630,6 @@
return $keys;
}
-=head2 C<fieldToXML>
-
-Convert the field that contains the group structure to an XML format.
-
-=over 4
-
-=item * $DOC
-
-the base XML::DOM::Document object that contains this structure
-
-=item * $field
-
-the field of the node to convert (if it is not the group field, we just call
-SUPER())
-
-=item * $indent
-
-string that contains the spaces that this will be indented
-
-=back
-
-=cut
-
-sub fieldToXML
-{
- my ( $this, $DOC, $field, $indent ) = @_;
-
- return $this->SUPER( $DOC, $field, $indent ) unless $field eq 'group';
-
- my $GROUP = XML::DOM::Element->new( $DOC, 'group' );
- my $indentself = "\n" . $indent;
- my $indentchild = $indentself . " ";
-
- for my $member ( @{ $this->{group} } )
- {
- $GROUP->appendChild( XML::DOM::Text->new( $DOC, $indentchild ) );
-
- my $tag = genBasicTag( $DOC, 'member', 'group_node', $member );
- $GROUP->appendChild($tag);
- }
-
- $GROUP->appendChild( XML::DOM::Text->new( $DOC, $indentself ) );
-
- return $GROUP;
-}
-
=head2 C<clone>
Clone the node! The normal clone doesn't duplicate members of a nodegroup, so
Modified: trunk/ebase/lib/Everything/Node/setting.pm
===================================================================
--- trunk/ebase/lib/Everything/Node/setting.pm 2007-01-03 19:47:06 UTC (rev 932)
+++ trunk/ebase/lib/Everything/Node/setting.pm 2007-01-03 19:47:50 UTC (rev 933)
@@ -14,8 +14,6 @@
use base 'Everything::Node::node';
use Everything::Security;
-use Everything::XML (qw/genBasicTag/);
-use XML::DOM;
use Scalar::Util 'reftype';
=head2 C<dbtables()>
@@ -75,60 +73,6 @@
sub hasVars { 1 }
-=head2 C<fieldToXML>
-
-This is called when the node is being exported to XML. The base node knows how
-to export fields to XML, but if the node contains some more complex data
-structures, that nodetype needs to export that data structure itself. In this
-case, we have a settings field (hash) that needs to get exported.
-
-=over 4
-
-=item * $DOC
-
-an XML::DOM::Document object that this field belongs to
-
-=item * $field
-
-the field of this node that needs to be exported as XML
-
-=item * $indent
-
-string that contains the amount that this will be indented (used for formatting
-purposes)
-
-=back
-
-Returns the XML::DOM::Element that represents this field.
-
-=cut
-
-sub fieldToXML
-{
- my ( $this, $DOC, $field, $indent ) = @_;
- $indent ||= '';
-
- return $this->SUPER( $DOC, $field, $indent ) unless $field eq 'vars';
-
- my $VARS = XML::DOM::Element->new( $DOC, "vars" );
- my $vars = $this->getVars();
- my @raw = keys %$vars;
- my @vars = sort { $a cmp $b } @raw;
- my $indentself = "\n" . $indent;
- my $indentchild = $indentself . " ";
-
- foreach my $var (@vars)
- {
- $VARS->appendChild( XML::DOM::Text->new( $DOC, $indentchild ) );
- my $tag = genBasicTag( $DOC, "var", $var, $$vars{$var} );
- $VARS->appendChild($tag);
- }
-
- $VARS->appendChild( XML::DOM::Text->new( $DOC, $indentself ) );
-
- return $VARS;
-}
-
sub getNodeKeepKeys
{
my ($this) = @_;
Modified: trunk/ebase/lib/Everything/Test/XML.pm
===================================================================
--- trunk/ebase/lib/Everything/Test/XML.pm 2007-01-03 19:47:06 UTC (rev 932)
+++ trunk/ebase/lib/Everything/Test/XML.pm 2007-01-03 19:47:50 UTC (rev 933)
@@ -258,121 +258,6 @@
);
}
-### genBasicTag
-# is passed $doc, $tagname, $fieldname, $content
-#
-# $doc is a XML::DOM::Document object and here is a mock
-# $tagname is a string of what whe want to call the XML tag
-#
-# fieldname is the field of the node that we are encoding
-# content is the actual content that we are encoding
-#
-# if fieldname is preceded by an underscore it is assumed content is a
-# noderef pointing to a type
-
-sub test_gen_basic_tag : Test(15) {
- my $self = shift;
- my $package = $self->{class};
- can_ok( $package, 'genBasicTag' ) || return "Can't genBasicTag";
-
- my $mock = $self->{mock};
- $mock->clear;
-
- $mock->fake_module('XML::DOM::Element');
- $mock->fake_new('XML::DOM::Element');
- $mock->fake_module('XML::DOM::Text');
- $mock->fake_new('XML::DOM::Text');
-
- $mock->set_true( 'setAttribute', 'appendChild', '-isOfType' );
- $mock->set_always( 'getIdentifyingFields', ['identifyingfield'] );
- $mock->{type}->{title} = "a_type_title";
- my (@gn);
- no strict 'refs';
-
- local *genBasicTag = \&{ $self->{class} . '::genBasicTag' };
- local *{ $package . '::getNode' };
- *{ $package . '::getNode' } = sub {
- push @gn, [@_];
- return $mock;
- };
- local *{ $package . '::makeXmlSafe' };
- *{ $package . '::makeXmlSafe' } = sub {
- push @gn, [@_];
- return $_[0];
- };
-
- local *{ $package . '::getRef' };
- *{ $package . '::getRef' } = sub {
- $mock->{node_id} = $_[0];
- $_[0] = $mock;
- };
- use strict 'refs';
-
- my $result = genBasicTag(
- $mock,
- "amazing tag name",
- "node field name",
- "stupendous content"
- );
-
- my ( $method, $args ) = $mock->next_call;
- is( $method, 'setAttribute', '...sets tag attributes.' );
- is_deeply(
- $args,
- [ $mock, 'name', 'node field name' ],
- '...and set it properly.'
- );
-
- ( $method, $args ) = $mock->next_call;
- is( $method, 'setAttribute', '...sets next tag attributes.' );
- is_deeply(
- $args,
- [ $mock, 'type', 'literal_value' ],
- '...and sets it to literal value.'
- );
-
- ( $method, $args ) = $mock->next_call;
- is( $method, 'appendChild', '...adds it to the tag.' );
- is_deeply( $args, [ $mock, $mock ], '...with the correct content.' );
- is( $result, $mock, '...should return a tag' );
-
- $mock->{identifyingfield} = 111;
- $result = genBasicTag( $mock, "amazing tag name", "_nodefieldname", "112" );
-
- ( $method, $args ) = $mock->next_call;
- is( $method, 'getIdentifyingFields',
- '...checks identifying fields if node has some.' );
- ( $method, $args ) = $mock->next_call;
- is( $method, 'setAttribute', '...sets tag attributes.' );
- is_deeply(
- $args,
- [ $mock, 'identifyingfield', 111 ],
- '...with identifying fields'
- );
-
- $mock->clear;
- @gn = ();
- $mock->{_identifyingfield} = 222;
- $mock->{title} = 'a random title';
- $mock->{type}->{title} = 'a type name';
- $mock->set_always( 'getIdentifyingFields', ['_identifyingfield'] );
- $result = genBasicTag( $mock, "amazing tag name", "_nodefieldname", "112" );
-
- ( $method, $args ) = $mock->next_call;
- is( $method, 'getIdentifyingFields',
- '...checks identifying fields if noderef.' );
- ( $method, $args ) = $mock->next_call;
- is( $method, 'setAttribute', '...sets tag attributes with node ref.' );
- is_deeply(
- $args,
- [ $mock, '_identifyingfield', 'a random title,a type name' ],
- '...with fields by type and name.'
- );
-
- is_deeply( $gn[2], [222],
- '...and calls get node with the identifying field' );
-}
-
### parseBasicTag plan:
#
# arguments: $TAG, which is a XML::DOM::Element object here $mock
@@ -529,18 +414,6 @@
is_deeply( $result, { _akey => 'avalue' }, '...the hash is not amended.' );
}
-sub test_make_xml_safe : Test(2) {
- my $self = shift;
- my $package = $self->{class};
- can_ok( $package, 'makeXmlSafe' ) || return;
- *makeXmlSafe = \&{ $self->{class} . '::makeXmlSafe' };
- is(
- makeXmlSafe('& > <'),
- '& > <',
- '...encodes a few XML character entities.'
- );
-}
-
sub test_unmake_xml_safe : Test(2) {
my $self = shift;
my $package = $self->{class};
Added: trunk/ebase/lib/Everything/XML/Node.pm
===================================================================
--- trunk/ebase/lib/Everything/XML/Node.pm (rev 0)
+++ trunk/ebase/lib/Everything/XML/Node.pm 2007-01-03 19:47:50 UTC (rev 933)
@@ -0,0 +1,313 @@
+package Everything::XML::Node;
+
+{
+ use Object::InsideOut;
+
+ my @node
+ :Field
+ :Standard(node)
+ :Arg(node);
+
+ my @nodebase
+ :Field
+ :Standard(nodebase)
+ :Arg(nodebase);
+
+}
+
+
+=head2 C<fieldToXML_vars>
+
+This is called when the node is being exported to XML and the field we
+are creating is a var field. The base node knows how to export fields
+to XML, but if the node contains some more complex data structures,
+that nodetype needs to export that data structure itself. In this
+case, we have a settings field (hash) that needs to get exported.
+
+=over 4
+
+=item * $DOC
+
+an XML::DOM::Document object that this field belongs to
+
+=item * $field
+
+the field of this node that needs to be exported as XML
+
+=item * $indent
+
+string that contains the amount that this will be indented (used for formatting
+purposes)
+
+=back
+
+Returns the XML::DOM::Element that represents this field.
+
+=cut
+
+sub fieldToXML_vars
+{
+ my ( $this, $DOC, $field, $indent ) = @_;
+ $indent ||= '';
+
+ my $VARS = XML::DOM::Element->new( $DOC, "vars" );
+ my $vars = $this->get_node->getVars();
+ my @raw = keys %$vars;
+ my @vars = sort { $a cmp $b } @raw;
+ my $indentself = "\n" . $indent;
+ my $indentchild = $indentself . " ";
+
+ foreach my $var (@vars)
+ {
+ $VARS->appendChild( XML::DOM::Text->new( $DOC, $indentchild ) );
+ my $tag = genBasicTag( $DOC, "var", $var, $$vars{$var} );
+ $VARS->appendChild($tag);
+ }
+
+ $VARS->appendChild( XML::DOM::Text->new( $DOC, $indentself ) );
+
+ return $VARS;
+}
+
+
+=head2 C<fieldToXML_group>
+
+Convert the field that contains the group structure to an XML format.
+
+=over 4
+
+=item * $DOC
+
+the base XML::DOM::Document object that contains this structure
+
+=item * $field
+
+the field of the node to convert (if it is not the group field, we just call
+SUPER())
+
+=item * $indent
+
+string that contains the spaces that this will be indented
+
+=back
+
+=cut
+
+sub fieldToXML_group
+{
+ my ( $this, $DOC, $field, $indent ) = @_;
+
+ my $GROUP = XML::DOM::Element->new( $DOC, 'group' );
+ my $indentself = "\n" . $indent;
+ my $indentchild = $indentself . " ";
+
+ for my $member ( @{ $this->get_node->{group} } )
+ {
+ $GROUP->appendChild( XML::DOM::Text->new( $DOC, $indentchild ) );
+
+ my $tag = $this->genBasicTag( $DOC, 'member', 'group_node', $member );
+ $GROUP->appendChild($tag);
+ }
+
+ $GROUP->appendChild( XML::DOM::Text->new( $DOC, $indentself ) );
+
+ return $GROUP;
+}
+
+
+sub fieldToXML_field {
+
+ my ( $this, $DOC, $field, $indent ) = @_;
+ return $this->genBasicTag( $DOC, 'field', $field, $this->get_node->{$field} );
+}
+
+=head2 C<fieldToXML>
+
+Given a field of this node (ie title), convert that field into an XML tag.
+
+=over 4
+
+=item * $DOC
+
+the base XML::DOM::Document object that this tag belongs to
+
+=item * $field
+
+the field of the node to convert
+
+=item * $indent
+
+string that contains the amount this tag will be indented. node::fieldToXML
+does not use this. This is for more complicated structures that want to have a
+nice formatting. This lets them know how far they are going to be indented so
+they know how far to indent their children.
+
+=back
+
+Returns an XML::DOM::Element object that can be inserted into the parent
+structure.
+
+=cut
+
+sub fieldToXML
+{
+ my ( $this, $DOC, $field, $indent ) = @_;
+ return unless exists $this->get_node->{$field};
+
+ my %dispatches = ( field => \&fieldToXML_field,
+ group => \&fieldToXML_group,
+ vars => \&fieldToXML_vars,
+ );
+
+ my $sub = $dispatches{$field} || $dispatches{'field'};
+ return $sub->(@_);
+}
+
+
+=head2 C<genBasicTag>
+
+For most fields in a node, there are 2 types that the field could be. Either a
+literal value, or a reference to a node. This function will generate the tag
+based on the fieldname and the content.
+
+=over 4
+
+=item * $doc
+
+the root document node for which this new tag belongs
+
+=item * $tagname
+
+the name of the xml tag
+
+=item * $fieldname
+
+the name of the field
+
+=item * $content
+
+the content of the tag
+
+=back
+
+ E<lt>tagname name="fieldname" *generated params*E<gt>contentE<lt>/tagnameE<gt>
+
+Returns the generated XML tag.
+
+=cut
+
+sub genBasicTag
+{
+ my ( $this, $doc, $tagname, $fieldname, $content ) = @_;
+ my $db = $this->get_nodebase;
+ my $isRef = 0;
+ my $isNum = 0;
+ my $type;
+ my $xml;
+ my $PARAMS = { name => $fieldname };
+ my $data;
+
+ # Check to see if the field name ends with a "_typename"
+ if ( $fieldname =~ /_(\w+)$/ )
+ {
+ $type = $1;
+
+ # if the numeric value is not greater than zero, it is a literal value.
+ # Nodes cannot have an id of less than 1.
+ $isRef = 1 if $content !~ /\D/ && $content > 0 && $db->getRef($content);
+ }
+
+ if ($isRef)
+ {
+
+ # This field references a node
+ my $REF = $db->getNode($content);
+
+ unless ( $REF->isOfType( $type, 1 ) )
+ {
+ Everything::logErrors( "Field '$fieldname' needs a node of type "
+ . "'$type',\nbut it is pointing to a node of type "
+ . "'$REF->{type}{title}'!" );
+ }
+
+ $data = makeXmlSafe( $$REF{title} );
+ @$PARAMS{qw( type type_nodetype )} =
+ ( 'noderef', "$REF->{type}{title},nodetype" );
+
+ # Merge the standard title/type with any unique identifiers given
+ # by the node.
+ my $ID = $REF->getIdentifyingFields() || ();
+
+ foreach my $id (@$ID)
+ {
+ if ( $id =~ /_(\w*)$/ )
+ {
+ my $N = $db->getNode( $REF->{$id} );
+ $PARAMS->{$id} = "$N->{title},$N->{type}{title}";
+ }
+ else
+ {
+ $PARAMS->{$id} = $REF->{$id};
+ }
+ }
+ }
+ else
+ {
+
+ # This is just a literal value
+ $data = $content;
+ $PARAMS->{type} = 'literal_value';
+ }
+
+ # Now that we have gathered the attributes and data for this tag, we
+ # need to construct it.
+ my $tag = XML::DOM::Element->new( $doc, $tagname );
+ my $contents = XML::DOM::Text->new( $doc, $data );
+
+ # Set the attributes on the tag. We sort the keys so that the
+ # attributes come out in an ordered fashion. That way we won't
+ # get merge conflicts in CVS due to seemingly random order of
+ # the attributes
+ my @sortAttrs = sort { $a cmp $b } keys %$PARAMS;
+ foreach my $param (@sortAttrs)
+ {
+ $tag->setAttribute( $param, $PARAMS->{$param} );
+ }
+
+ # And insert the content into our tag
+ $tag->appendChild($contents);
+
+ return $tag;
+}
+
+
+
+=head2 C<makeXmlSafe>
+
+Make a string not interfere with the xml
+
+=over 4
+
+=item * $str
+
+the literal string
+
+=back
+
+Returns the encoded string.
+
+=cut
+
+sub makeXmlSafe
+{
+ my ($str) = @_;
+
+ #we use an HTML convention...
+ $str =~ s/\&/\&\;/g;
+ $str =~ s/\</\<\;/g;
+ $str =~ s/\>/\>\;/g;
+
+ return $str;
+}
+
+1;
Property changes on: trunk/ebase/lib/Everything/XML/Node.pm
___________________________________________________________________
Name: svn:mime-type
+ text/plain
Name: svn:eol-style
+ native
Added: trunk/ebase/lib/Everything/XML/Test/Node.pm
===================================================================
--- trunk/ebase/lib/Everything/XML/Test/Node.pm (rev 0)
+++ trunk/ebase/lib/Everything/XML/Test/Node.pm 2007-01-03 19:47:50 UTC (rev 933)
@@ -0,0 +1,293 @@
+package Everything::XML::Test::Node;
+
+use base 'Test::Class';
+use Test::More;
+use Test::MockObject;
+use Test::MockObject::Extends;
+use Scalar::Util qw/blessed/;
+use strict;
+use warnings;
+
+sub object_class {
+ my $self = shift;
+ my $name = blessed($self);
+ $name =~ s/Test:://;
+ return $name;
+}
+
+sub startup : Test(2) {
+ my $self = shift;
+ my $class = $self->object_class;
+ use_ok($class);
+ isa_ok( $class->new(), $class );
+ $self->{class} = $class;
+ $self->{instance} = $class->new;
+}
+
+sub test_field_to_XML : Test( 5 ) {
+ my $self = shift;
+ my $class = $self->{class};
+ my $instance = $self->{instance};
+
+ my $node = Test::MockObject->new;
+ $instance->set_node($node);
+ my @gbt;
+
+ no strict 'refs';
+ local *{ $class . '::genBasicTag' };
+ *{ $class . '::genBasicTag' } = sub {
+ push @gbt, [@_];
+ 'tag';
+ };
+ use strict 'refs';
+
+ $node->{afield} = 'thisfield';
+ is( $instance->fieldToXML( $node, 'afield' ),
+ 'tag', 'fieldToXML() should return an XML tag element' );
+ is( @gbt, 1, '... and should call genBasicTag()' );
+ is(
+ join( ' ', @{ $gbt[0] } ),
+ "$instance $node field afield thisfield",
+ '... with the correct arguments'
+ );
+
+ ok(
+ !$instance->fieldToXML( $instance, 'notafield' ),
+ '... and should return false if field does not exist'
+ );
+ ok( !exists $node->{notafield}, '... and should not create field' );
+}
+
+sub test_field_to_XML_vars : Test( 5 ) {
+ my $self = shift;
+ my $instance = $self->{instance};
+ my $mock = Test::MockObject->new;
+ $instance->set_node($mock);
+ $instance->set_nodebase($mock);
+
+ $mock->{vars} = 'a var';
+
+ local ( *XML::DOM::Element::new, *XML::DOM::Text::new,
+ *Everything::XML::Node::genBasicTag, *fieldToXML );
+
+ my @dom;
+ *XML::DOM::Element::new = *XML::DOM::Text::new = sub {
+ push @dom, shift;
+ return $mock;
+ };
+
+ my @tags;
+ *Everything::XML::Node::genBasicTag = sub {
+ push @tags, join( ' ', @_[ 1 .. 3 ] );
+ };
+
+ $mock->set_always( getVars => { a => 1, b => 1, c => 1 } )
+ ->set_true('-appendChild');
+
+ is( $instance->fieldToXML( '', 'vars' ),
+ $mock, '... should return XML::DOM element for vars, if "vars" field' );
+ is( @dom, 5, '... should make several DOM nodes:' );
+ is( scalar grep( /Element/, @dom ), 1, '... one Element node' );
+ is( scalar grep( /Text/, @dom ), 4, '... and several Text nodes' );
+
+ is(
+ join( '!', @tags ),
+ 'var a 1!var b 1!var c 1',
+ '... should call genBasicTag() on each var pair'
+ );
+}
+
+sub test_field_to_XML_group : Test( 5 ) {
+ my $self = shift;
+ my $instance = $self->{instance};
+ my $mock = Test::MockObject->new;
+ $mock->set_true('appendChild');
+ $instance->set_node($mock);
+ $instance->set_nodebase($mock);
+ $mock->set_true( 'getRef', 'setAttribute', 'isOfType' );
+ $mock->set_always( 'getNode', $mock );
+ $mock->set_always( 'getIdentifyingFields', ['identifyingfield'] );
+
+ my $result = $instance->fieldToXML( 'doc', 'field', 0 );
+ my ( $method, $args );
+
+ {
+ local ( *XML::DOM::Element::new, *XML::DOM::Text::new,
+ *Everything::XML::Node::genBasicTag );
+
+ my @xd;
+ *XML::DOM::Text::new = sub {
+ push @xd, [@_];
+ return @_;
+ };
+ *XML::DOM::Element::new = sub {
+ push @xd, [@_];
+ return $mock;
+ };
+
+ my @gbt;
+ *Everything::XML::Node::genBasicTag = sub {
+ push @gbt, [@_];
+ };
+
+ $mock->{group} = [ 3, 4, 5 ];
+ $result = $instance->fieldToXML( 'doc', 'group', "\r" );
+
+ is(
+ join( ' ', @{ $xd[0] } ),
+ 'XML::DOM::Element doc group',
+ '... it should create a new DOM group element'
+ );
+
+ my $count;
+ for ( 1 .. 6 ) {
+ ( $method, $args ) = $mock->next_call();
+ $count++ if $method eq 'appendChild';
+ }
+
+ is( $count, 6, '... appending each child as a Text node' );
+ is( join( ' ', map { $_->[4] } @gbt ),
+ '3 4 5', '... noted with their node_ids' );
+ is( $method, 'appendChild', '... and appending the whole thing' );
+ is( $result, $mock, '... and should return the new element' );
+ }
+
+}
+
+### genBasicTag
+# is passed $doc, $tagname, $fieldname, $content
+#
+# $doc is a XML::DOM::Document object and here is a mock
+# $tagname is a string of what whe want to call the XML tag
+#
+# fieldname is the field of the node that we are encoding
+# content is the actual content that we are encoding
+#
+# if fieldname is preceded by an underscore it is assumed content is a
+# noderef pointing to a type
+
+sub test_gen_basic_tag : Test(15) {
+ my $self = shift;
+ my $package = $self->{class};
+ my $instance = $self->{instance};
+ can_ok( $package, 'genBasicTag' ) || return "Can't genBasicTag";
+
+ my $mock = Test::MockObject->new;
+
+ $instance->set_node($mock);
+ $instance->set_nodebase($mock);
+
+ $mock->fake_module('XML::DOM::Element');
+ $mock->fake_new('XML::DOM::Element');
+ $mock->fake_module('XML::DOM::Text');
+ $mock->fake_new('XML::DOM::Text');
+
+ $mock->set_true( 'setAttribute', 'appendChild', '-isOfType', '-getRef' );
+ $mock->set_always( 'getIdentifyingFields', ['identifyingfield'] );
+ $mock->{type}->{title} = "a_type_title";
+ my (@gn);
+
+ $mock->mock(
+ -getNode => sub {
+ push @gn, [@_];
+ return $mock;
+ }
+ );
+ no strict 'refs';
+ local *{ $package . '::makeXmlSafe' };
+ *{ $package . '::makeXmlSafe' } = sub {
+ push @gn, [@_];
+ return $_[0];
+ };
+
+ local *{ $package . '::getRef' };
+ *{ $package . '::getRef' } = sub {
+ $mock->{node_id} = $_[0];
+ $_[0] = $mock;
+ };
+ use strict 'refs';
+
+ my $result = $instance->genBasicTag(
+ $mock,
+ "amazing tag name",
+ "node field name",
+ "stupendous content"
+ );
+
+ my ( $method, $args ) = $mock->next_call;
+ is( $method, 'setAttribute', '...sets tag attributes.' );
+ is_deeply(
+ $args,
+ [ $mock, 'name', 'node field name' ],
+ '...and set it properly.'
+ );
+
+ ( $method, $args ) = $mock->next_call;
+ is( $method, 'setAttribute', '...sets next tag attributes.' );
+ is_deeply(
+ $args,
+ [ $mock, 'type', 'literal_value' ],
+ '...and sets it to literal value.'
+ );
+
+ ( $method, $args ) = $mock->next_call;
+ is( $method, 'appendChild', '...adds it to the tag.' );
+ is_deeply( $args, [ $mock, $mock ], '...with the correct content.' );
+ is( $result, $mock, '...should return a tag' );
+
+ $mock->{identifyingfield} = 111;
+ $result = $instance->genBasicTag( $mock, "amazing tag name",
+ "_nodefieldname", "112" );
+
+ ( $method, $args ) = $mock->next_call;
+ is( $method, 'getIdentifyingFields',
+ '...checks identifying fields if node has some.' );
+ ( $method, $args ) = $mock->next_call;
+ is( $method, 'setAttribute', '...sets tag attributes.' );
+ is_deeply(
+ $args,
+ [ $mock, 'identifyingfield', 111 ],
+ '...with identifying fields'
+ );
+
+ $mock->clear;
+ @gn = ();
+ $mock->{_identifyingfield} = 222;
+ $mock->{title} = 'a random title';
+ $mock->{type}->{title} = 'a type name';
+ $mock->set_always( 'getIdentifyingFields', ['_identifyingfield'] );
+ $result = $instance->genBasicTag( $mock, "amazing tag name",
+ "_nodefieldname", "112" );
+
+ ( $method, $args ) = $mock->next_call;
+ is( $method, 'getIdentifyingFields',
+ '...checks identifying fields if noderef.' );
+ ( $method, $args ) = $mock->next_call;
+ is( $method, 'setAttribute', '...sets tag attributes with node ref.' );
+ is_deeply(
+ $args,
+ [ $mock, '_identifyingfield', 'a random title,a type name' ],
+ '...with fields by type and name.'
+ );
+
+ is_deeply(
+ $gn[-1],
+ [ $mock, 222 ],
+ '...and calls get node with the identifying field'
+ );
+}
+
+
+sub test_make_xml_safe : Test(2) {
+ my $self = shift;
+ my $package = $self->{class};
+ can_ok( $package, 'makeXmlSafe' ) || return;
+ *makeXmlSafe = \&{ $self->{class} . '::makeXmlSafe' };
+ is(
+ makeXmlSafe('& > <'),
+ '& > <',
+ '...encodes a few XML character entities.'
+ );
+}
+
+1;
Property changes on: trunk/ebase/lib/Everything/XML/Test/Node.pm
___________________________________________________________________
Name: svn:mime-type
+ text/plain
Name: svn:eol-style
+ native
Modified: trunk/ebase/lib/Everything/XML.pm
===================================================================
--- trunk/ebase/lib/Everything/XML.pm 2007-01-03 19:47:06 UTC (rev 932)
+++ trunk/ebase/lib/Everything/XML.pm 2007-01-03 19:47:50 UTC (rev 933)
@@ -496,123 +496,6 @@
=cut
-=head2 C<genBasicTag>
-
-For most fields in a node, there are 2 types that the field could be. Either a
-literal value, or a reference to a node. This function will generate the tag
-based on the fieldname and the content.
-
-=over 4
-
-=item * $doc
-
-the root document node for which this new tag belongs
-
-=item * $tagname
-
-the name of the xml tag
-
-=item * $fieldname
-
-the name of the field
-
-=item * $content
-
-the content of the tag
-
-=back
-
- E<lt>tagname name="fieldname" *generated params*E<gt>contentE<lt>/tagnameE<gt>
-
-Returns the generated XML tag.
-
-=cut
-
-sub genBasicTag
-{
- my ( $doc, $tagname, $fieldname, $content ) = @_;
- my $isRef = 0;
- my $isNum = 0;
- my $type;
- my $xml;
- my $PARAMS = { name => $fieldname };
- my $data;
-
- # Check to see if the field name ends with a "_typename"
- if ( $fieldname =~ /_(\w+)$/ )
- {
- $type = $1;
-
- # if the numeric value is not greater than zero, it is a literal value.
- # Nodes cannot have an id of less than 1.
- $isRef = 1 if $content !~ /\D/ && $content > 0 && getRef($content);
- }
-
- if ($isRef)
- {
-
- # This field references a node
- my $REF = getNode($content);
-
- unless ( $REF->isOfType( $type, 1 ) )
- {
- Everything::logErrors( "Field '$fieldname' needs a node of type "
- . "'$type',\nbut it is pointing to a node of type "
- . "'$REF->{type}{title}'!" );
- }
-
- $data = makeXmlSafe( $$REF{title} );
- @$PARAMS{qw( type type_nodetype )} =
- ( 'noderef', "$REF->{type}{title},nodetype" );
-
- # Merge the standard title/type with any unique identifiers given
- # by the node.
- my $ID = $REF->getIdentifyingFields() || ();
-
- foreach my $id (@$ID)
- {
- if ( $id =~ /_(\w*)$/ )
- {
- my $N = getNode( $REF->{$id} );
- $PARAMS->{$id} = "$N->{title},$N->{type}{title}";
- }
- else
- {
- $PARAMS->{$id} = $REF->{$id};
- }
- }
- }
- else
- {
-
- # This is just a literal value
- $data = $content;
- $PARAMS->{type} = 'literal_value';
- }
-
- # Now that we have gathered the attributes and data for this tag, we
- # need to construct it.
- my $tag = XML::DOM::Element->new( $doc, $tagname );
- my $contents = XML::DOM::Text->new( $doc, $data );
-
- # Set the attributes on the tag. We sort the keys so that the
- # attributes come out in an ordered fashion. That way we won't
- # get merge conflicts in CVS due to seemingly random order of
- # the attributes
- my @sortAttrs = sort { $a cmp $b } keys %$PARAMS;
- foreach my $param (@sortAttrs)
- {
- $tag->setAttribute( $param, $PARAMS->{$param} );
- }
-
- # And insert the content into our tag
- $tag->appendChild($contents);
-
- return $tag;
-}
-
-=cut
-
=head2 C<xmlFinal>
This is called when a node has finished being constructed from an XML import.
@@ -773,37 +656,9 @@
=cut
-=head2 C<makeXmlSafe>
-
-Make a string not interfere with the xml
-
-=over 4
-
-=item * $str
-
-the literal string
-
-=back
-
-Returns the encoded string.
-
=cut
-sub makeXmlSafe
-{
- my ($str) = @_;
- #we use an HTML convention...
- $str =~ s/\&/\&\;/g;
- $str =~ s/\</\<\;/g;
- $str =~ s/\>/\>\;/g;
-
- return $str;
-}
-
-=cut
-
-
=head2 C<unMakeXmlSafe>
Decode something encoded by makeXmlSafe
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
