# HG changeset patch
# User Sergey
# Date 1252590167 -14400
# Node ID 818c74b038ae539755ad55f336d56e59527d2cac
# Parent  7f88e01b58f860f0e54b1a6704daa34d067ec20f
DOM Schema + tests

diff -r 7f88e01b58f8 -r 818c74b038ae Lib/IMPL/DOM/Document.pm
--- a/Lib/IMPL/DOM/Document.pm	Wed Sep 09 17:43:31 2009 +0400
+++ b/Lib/IMPL/DOM/Document.pm	Thu Sep 10 17:42:47 2009 +0400
@@ -24,6 +24,14 @@
 
 =head1 DESCRIPTION
 
+=head1 METHODS
+
+=over
+
+=item C<<$doc->Create>>
+
 Создает узел определеннго типа с определенным именем и свойствами.
 
+=back
+
 =cut
\ No newline at end of file
diff -r 7f88e01b58f8 -r 818c74b038ae Lib/IMPL/DOM/Navigator.pm
--- a/Lib/IMPL/DOM/Navigator.pm	Wed Sep 09 17:43:31 2009 +0400
+++ b/Lib/IMPL/DOM/Navigator.pm	Thu Sep 10 17:42:47 2009 +0400
@@ -27,6 +27,20 @@
     }
 }
 
+sub _NavigateNode {
+    my ($this,$newNode) = @_;
+    push @{$this->{$Path}}, $this->{$Current};
+    return $this->{$Current} = $newNode;
+}
+
+sub _NavigateNodeStirct {
+    my ($this,$newNode) = @_;
+    
+    die new IMPL::InvalidOperationException("A newNode doesn't belongs to the current") unless $newNode->parentNode == $this->{$Current};
+    push @{$this->{$Path}}, $this->{$Current};
+    return $this->{$Current} = $newNode;
+}
+
 sub Back {
     my ($this) = @_;
     
diff -r 7f88e01b58f8 -r 818c74b038ae Lib/IMPL/DOM/Navigator/SchemaNavigator.pm
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/Lib/IMPL/DOM/Navigator/SchemaNavigator.pm	Thu Sep 10 17:42:47 2009 +0400
@@ -0,0 +1,46 @@
+package IMPL::DOM::Navigator::SchemaNavigator;
+use strict;
+use warnings;
+
+use base qw(IMPL::DOM::Navigator);
+use IMPL::Class::Property;
+use IMPL::Class::Property::Direct;
+
+__PACKAGE__->PassThroughArgs;
+
+BEGIN {
+    public _direct property Schema => prop_get;
+}
+
+sub CTOR {
+    my ($this,$schema) = @_;
+    
+    $this->{$Schema} = $schema;
+    
+    die new IMPL::InvalidArgumentException("A schema object is required") unless $schema->isa('IMPL::DOM::Schema');
+}
+
+sub Navigate {
+    my ($this,$query) = @_;
+    
+    if (my ($newNode) = $this->Current->selectNodes($query)) {
+        if (ref $newNode eq 'IMPL::DOM::Schema::Node') {
+            $newNode = $this->{$Schema}->ResolveType($newNode->type) || $newNode;
+        }
+        return $this->_NavigateNode($newNode);
+    } else {
+        return undef;
+    }
+}
+
+1;
+__END__
+
+=pod
+
+=head1 DESCRIPTION
+
+Навигатор для схемы, отличается от стандартного тем, что переходит по ссылкам вида <Node nodeName="SomeName" type="ReferencedType"/>.
+При этом имя узла в который перешли будет отличаться от указанного в поисковом критерии.
+
+=cut
\ No newline at end of file
diff -r 7f88e01b58f8 -r 818c74b038ae Lib/IMPL/DOM/Node.pm
--- a/Lib/IMPL/DOM/Node.pm	Wed Sep 09 17:43:31 2009 +0400
+++ b/Lib/IMPL/DOM/Node.pm	Thu Sep 10 17:42:47 2009 +0400
@@ -17,13 +17,15 @@
     public _direct property nodeValue => prop_all;
     public _direct property childNodes => { get => \&_getChildNodes };
     public _direct property parentNode => prop_get ;
-    private _direct property _propertyMap => prop_get ;
+    public _direct property rootNode => { get => \&_getRootNode};
+    private _direct property _propertyMap => prop_all ;
 }
 
 sub CTOR {
     my ($this,%args) = @_;
     
     $this->nodeName($args{nodeName}) or die new IMPL::InvalidArgumentException("A name is required");
+    $this->nodeValue($args{nodeValue});
 }
 
 sub insertNode {
@@ -47,7 +49,8 @@
     
     $node->{$parentNode}->removeNode($node) if ($node->{$parentNode});
     
-    $this->childNodes->Append($node);
+    my $children = $this->childNodes;
+    $children->Append($node);
     
     $node->_setParent( $this );
     
@@ -73,7 +76,7 @@
     my ($this) = @_;
     
     $this->{$childNodes} = new IMPL::Object::List() unless $this->{$childNodes};
-    $this->{$childNodes};
+    return $this->{$childNodes};
 }
 
 sub removeNode {
@@ -81,8 +84,8 @@
     
     if ($this == $node->{$parentNode}) {
         $this->childNodes->RemoveItem($node);
-        $node->{$parentNode} = undef;
-        return $this;
+        $node->_setParent(undef);
+        return $node;
     } else {
         die new IMPL::InvalidOperationException("The specified node isn't belong to this node");
     }
@@ -101,11 +104,11 @@
     # replace (or set) old node
     $this->childNodes->[$index] = $node;
         
-    # save new parent
+    # set new parent
     $node->_setParent( $this );
         
     # unlink old node if we have one
-    $nodeOld->{$parentNode} = undef if $nodeOld;
+    $nodeOld->_setParent(undef) if $nodeOld;
         
     # return old node
     return $nodeOld;
@@ -115,21 +118,64 @@
     my ($this,$pos) = @_;
     
     if ( my $node = $this->childNodes->RemoveAt($pos) ) {
-        $node->{$parentNode} = undef;
+        $node->_setParent(undef);
+        return $node;
+    } else {
+        return undef;
+    }
+}
+
+sub removeLast {
+    my ($this) = @_;
+    
+    if ( my $node = $this->{$childNodes} ? $this->{$childNodes}->RemoveLast() : undef) {
+        $node->_setParent(undef);
         return $node;
     } else {
         return undef;
     }
 }
 
+sub removeSelected {
+    my ($this,$query) = @_;
+    
+    my @newSet;
+    my @result;
+    
+    if (ref $query eq 'CODE') {
+        &$query($_) ? push @result, $_ : push @newSet, $_ foreach @{$this->childNodes};
+    } elsif (defined $query) {
+        $_->nodeName eq $query ? push @result, $_ : push @newSet, $_ foreach @{$this->childNodes};
+    } else {
+        my $children = $this->childNodes;
+        $_->_setParent(undef) foreach @$children;
+        delete $this->{$childNodes};
+        return wantarray ? @$children : $children;
+    }
+    
+    $_->_setParent(undef) foreach @result;
+    
+    $this->{$childNodes} = @newSet ? bless \@newSet ,'IMPL::Object::List' : undef;
+    
+    return wantarray ? @result : \@result;
+}
+
 sub selectNodes {
     my ($this,$query) = @_;
+    
     my @result;
     
     if (ref $query eq 'CODE') {
         @result = grep &$query($_), @{$this->childNodes};
+    } elsif (defined $query) {
+        @result = grep $_->nodeName eq $query, @{$this->childNodes};
     } else {
-        @result = grep $_->nodeName eq $query, @{$this->childNodes};
+        if (wantarray) {
+            return @{$this->childNodes};
+        } else {
+            @result = $this->childNodes;
+            return \@result;
+        }
     }
     
     return wantarray ? @result : \@result;
@@ -143,18 +189,49 @@
     $_[0]->childNodes->Count ? 1 : 0;
 }
 
+sub _getRootNode {
+    $_[0]->{$rootNode} || $_[0];
+}
+
+sub _updateRootRefs {
+    my ($this) = @_;
+    
+    if ( my $newRoot = $this->{$parentNode} ? $this->{$parentNode}->rootNode : undef) {
+        if ($this->{$rootNode} ? $this->{$rootNode} != $newRoot : 1 ) {
+            $this->{$rootNode} = $newRoot;
+            weaken($this->{$rootNode});
+            if ($this->{$childNodes}) {
+                $_->_updateRootRefs foreach @{$this->{$childNodes}};
+            }
+        }
+    } elsif($this->{$rootNode}) {
+        delete $this->{$rootNode};
+        if ($this->{$childNodes}) {
+            $_->_updateRootRefs foreach @{$this->{$childNodes}};
+        }
+    }
+}
+
 sub _setParent {
     my ($this,$node) = @_;
     
-    $this->{$parentNode} = $node;
-    # prevent from creating cyclicreferences
-    weaken($this->{$parentNode});
+   
+    if (($node || 0) != ($this->{$parentNode} || 0)) {
+        if ($node) {
+            $this->{$parentNode} = $node;
+            # prevent from creating cyclicreferences
+            weaken($this->{$parentNode});
+        } else {
+            delete $this->{$parentNode};
+        }
+        $this->_updateRootRefs;
+    }
 }
 
 sub text {
     my ($this) = @_;
     
-    join '', $this->nodeValue, map $_->nodeValue, @{$this->childNodes};
+    join '', $this->nodeValue || '', map $_->nodeValue || '', @{$this->childNodes};
 }
 
 sub Property {
diff -r 7f88e01b58f8 -r 818c74b038ae Lib/IMPL/DOM/Schema.pm
--- a/Lib/IMPL/DOM/Schema.pm	Wed Sep 09 17:43:31 2009 +0400
+++ b/Lib/IMPL/DOM/Schema.pm	Thu Sep 10 17:42:47 2009 +0400
@@ -16,6 +16,12 @@
     $_[0]->{$_TypesMap}->{$_[1]};
 }
 
+sub Process {
+    my ($this) = @_;
+    
+    $this->{$_TypesMap} = { map { $_->type, $_ } grep {$_->isa('IMPL::DOM::Schema::Type')} @{$this->childNodes} };
+}
+
 sub MetaSchema {
     my $schema = new IMPL::DOM::Schema(nodeName => 'schema');
     
@@ -70,6 +76,8 @@
         )
     );
     
+    $schema->Process;
+    
     return $schema;
 }
 
@@ -79,6 +87,24 @@
 
 =pod
 
+=head1 DESCRIPTION
+
+Схема документа. Наследует C<IMPL::DOM::Document>
+
+=head1 METHODS
+
+=over
+
+=item C<< $obj->Process() >>
+
+Обновляет таблицу типов из содержимого.
+
+=item C<< $obj->ResolveType($typeName) >>
+
+Возвращает схему типа c именем C<$typeName>.
+
+=back
+
 =head1 META SCHEMA
 
 Схема для описания схемы, эта схема используется для постороения других схем
diff -r 7f88e01b58f8 -r 818c74b038ae Lib/IMPL/DOM/Schema/ComplexNode.pm
--- a/Lib/IMPL/DOM/Schema/ComplexNode.pm	Wed Sep 09 17:43:31 2009 +0400
+++ b/Lib/IMPL/DOM/Schema/ComplexNode.pm	Thu Sep 10 17:42:47 2009 +0400
@@ -2,7 +2,7 @@
 use strict;
 use warnings;
 
-use base qw(IMPL::DOM::Schema::Item);
+use base qw(IMPL::DOM::Schema::Node);
 use IMPL::Class::Property;
 
 BEGIN {
diff -r 7f88e01b58f8 -r 818c74b038ae Lib/IMPL/DOM/Schema/Item.pm
--- a/Lib/IMPL/DOM/Schema/Item.pm	Wed Sep 09 17:43:31 2009 +0400
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,44 +0,0 @@
-package IMPL::DOM::Schema::Item;
-use strict;
-use warnings;
-
-use base qw(IMPL::DOM::Node);
-use IMPL::Class::Property;
-use IMPL::DOM::Property qw(_dom);
-use IMPL::Class::Property::Direct;
-
-BEGIN {
-    public _dom property minOccur => prop_all;
-    public _dom property maxOccur => prop_all;
-    public _direct property Schema => prop_get;
-}
-
-__PACKAGE__->PassThroughArgs;
-
-sub CTOR {
-    my ($this,%args) = @_;
-    
-    $this->minOccur($args{minOcuur});
-    $this->maxOccur($args{maxOccur});
-    $this->{$Schema} = $args{Schema} or die new IMPL::InvalidArgumentException("A schema should be specified");
-}
-
-1;
-
-__END__
-=pod
-
-=head1 SYNOPSIS
-
-package Restriction;
-use base qw(IMPL::DOM::Schema::Item);
-
-sub Validate {
-    my ($this,$node) = @_;
-}
-
-=head1 DESCRIPTION
-
-Базовый класс для элементов схемы. Содержит в себе базовые методы 
-
-=cut
diff -r 7f88e01b58f8 -r 818c74b038ae Lib/IMPL/DOM/Schema/Node.pm
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/Lib/IMPL/DOM/Schema/Node.pm	Thu Sep 10 17:42:47 2009 +0400
@@ -0,0 +1,44 @@
+package IMPL::DOM::Schema::Node;
+use strict;
+use warnings;
+
+use base qw(IMPL::DOM::Node);
+use IMPL::Class::Property;
+use IMPL::DOM::Property qw(_dom);
+use IMPL::Class::Property::Direct;
+
+BEGIN {
+    public _dom property minOccur => prop_all;
+    public _dom property maxOccur => prop_all;
+    public _dom property type => prop_all
+}
+
+__PACKAGE__->PassThroughArgs;
+
+sub CTOR {
+    my ($this,%args) = @_;
+    
+    $this->minOccur($args{minOcuur});
+    $this->maxOccur($args{maxOccur});
+    $this->type($args{type});
+}
+
+1;
+
+__END__
+=pod
+
+=head1 SYNOPSIS
+
+package Restriction;
+use base qw(IMPL::DOM::Schema::Item);
+
+sub Validate {
+    my ($this,$node) = @_;
+}
+
+=head1 DESCRIPTION
+
+Базовый класс для элементов схемы. Содержит в себе базовые методы 
+
+=cut
diff -r 7f88e01b58f8 -r 818c74b038ae Lib/IMPL/Object/List.pm
--- a/Lib/IMPL/Object/List.pm	Wed Sep 09 17:43:31 2009 +0400
+++ b/Lib/IMPL/Object/List.pm	Thu Sep 10 17:42:47 2009 +0400
@@ -19,7 +19,7 @@
 }
 
 sub Append {
-    push @{$_[0]}, @_{1 .. @$_-1};
+    push @{$_[0]}, @_[1 .. $#_];
 }
 
 sub RemoveLast {
diff -r 7f88e01b58f8 -r 818c74b038ae Lib/IMPL/Resources/Format.pm
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/Lib/IMPL/Resources/Format.pm	Thu Sep 10 17:42:47 2009 +0400
@@ -0,0 +1,32 @@
+package IMPL::Resources::Format;
+use strict;
+use warnings;
+
+require Exporter;
+our @ISA = qw(Exporter);
+our @EXPORT_OK = qw(&FormatMessage);
+
+sub FormatMessage {
+    my ($string,$args) = @_;
+    
+    $string =~ s/%(\w+(?:\.\w+)*)%/_getvalue($args,$1,"\[$1\]")/ge;
+    
+    return $string;
+}
+
+sub _getvalue {
+    my ($obj,$path,$default) = @_;
+    
+    foreach my $chunk (split /\./,$path) {
+        if (eval { $obj->can( $chunk ) } ) {
+            $obj = $obj->$chunk();
+        } elsif (UNIVERSAL::isa($obj,'HASH')) {
+            $obj = $obj->{$chunk};
+        } else {
+            return $default;
+        }
+    }
+    return $obj;
+}
+
+1;
diff -r 7f88e01b58f8 -r 818c74b038ae _test/DOM.t
--- a/_test/DOM.t	Wed Sep 09 17:43:31 2009 +0400
+++ b/_test/DOM.t	Thu Sep 10 17:42:47 2009 +0400
@@ -7,8 +7,8 @@
 use IMPL::Test::TAPListener;
 
 my $plan = new IMPL::Test::Plan qw(
+    Test::DOM::Node
     Test::DOM::Navigator
-    Test::DOM::Node
 );
 
 $plan->AddListener(new IMPL::Test::TAPListener);
diff -r 7f88e01b58f8 -r 818c74b038ae _test/Resources.t
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/_test/Resources.t	Thu Sep 10 17:42:47 2009 +0400
@@ -0,0 +1,15 @@
+#!/usr/bin/perl -w
+use strict;
+use lib '../Lib';
+use lib '.';
+
+use IMPL::Test::Plan;
+use IMPL::Test::TAPListener;
+
+my $plan = new IMPL::Test::Plan qw(
+    Test::Resources::Format
+);
+
+$plan->AddListener(new IMPL::Test::TAPListener);
+$plan->Prepare();
+$plan->Run();
\ No newline at end of file
diff -r 7f88e01b58f8 -r 818c74b038ae _test/Test/DOM/Node.pm
--- a/_test/Test/DOM/Node.pm	Wed Sep 09 17:43:31 2009 +0400
+++ b/_test/Test/DOM/Node.pm	Thu Sep 10 17:42:47 2009 +0400
@@ -3,7 +3,7 @@
 use warnings;
 
 use base qw(IMPL::Test::Unit);
-use IMPL::Test qw(test shared failed);
+use IMPL::Test qw(test shared failed cmparray);
 use IMPL::Class::Property;
 
 require IMPL::DOM::Node;
@@ -20,14 +20,105 @@
     $this->Root(new IMPL::DOM::Node(nodeName => 'Root')) or failed "Failed to create a node";
 };
 
+test InsertNode => sub {
+    my ($this) = @_;
+    my $child = $this->Root->insertNode(new IMPL::DOM::Node(nodeName => 'Child')) or failed "Failed to insert a child node";
+    failed "fiestChild returned incorrect results" unless ($this->Root->firstChild || 0) == $child;
+};
+
 test AppendNode => sub {
     my ($this) = @_;
     
     my $child = $this->Root->appendNode(new IMPL::DOM::Node(nodeName => 'Child')) or failed "Failed to append a child node";
     
-    my $firstChild = $this->Root->firstChild;
+    my $lastChild = $this->Root->removeLast;
+    
+    failed "removeLast returned incorrect results" unless $lastChild == $child;
+};
+
+test GetRootNode => sub {
+    my ($this) = @_;
+    
+    my $child = $this->Root->firstChild->appendNode(new IMPL::DOM::Node(nodeName => 'GrandChild')) or failed "Failed to append a child node";
+    
+    failed "rootNode is undef" unless $child->rootNode;
+    failed "rootNode returned incorrect value" unless $child->rootNode == $this->Root;
+};
+
+test MoveNode => sub {
+    my ($this) = @_;
+    
+    my $grandChild = $this->Root->firstChild->firstChild;
+    $this->Root->appendNode($grandChild);
+    
+    failed "incorrect new parentNode value" unless ($grandChild->parentNode || 0) == $this->Root;
+    failed "incorrect new rootNode value" unless ($grandChild->rootNode || 0) == $this->Root;
+};
+
+test AppendRange => sub {
+    my ($this) = @_;
+    
+    my $count = $this->Root->childNodes->Count;
+    
+    $this->Root->appendRange(
+        map IMPL::DOM::Node->new(nodeName => "Item", nodeValue => $_),1..10
+    );
+    
+    failed
+        "Wrong number of a child nodes",
+        "Expected: ".($count+10),
+        "Actual: ".$this->Root->childNodes->Count
+    unless $count + 10 == $this->Root->childNodes->Count;
+};
+
+test SelectNodes => sub {
+    my ($this) = @_;
     
-    failed "firstChild returned incorrect results" unless $firstChild == $child;
+    my @result = $this->Root->selectNodes("Item");
+    
+    failed
+        "Wrong number of a selected nodes",
+        "Expected: 10",
+        "Actual: ".scalar(@result)
+    unless @result == 10;
+};
+
+test SelectNodesByQuery => sub {
+    my ($this) = @_;
+    
+    my @result = $this->Root->selectNodes(sub { $_[0]->nodeName =~ /child/i } );
+    failed
+        "Wrong number of a selected nodes",
+        "Expected: 2",
+        "Actual: ".scalar(@result)
+    unless @result == 2;
+};
+
+test CheckNodesValues => sub {
+    my ($this) = @_;
+    
+    my @expected = (1..10);
+    
+    my @result = map $_->nodeValue, grep $_->nodeValue, $this->Root->selectNodes("Item");
+    
+    failed
+        "Some nodes returned wrong node values or in a wrong order",
+        "Expected: ".join(', ',@expected),
+        "Recieved: ".join(', ',@result)
+    unless cmparray(\@expected,\@result);
+    
+    failed
+        "a text property of a root node returned a wrong value",
+        "Expected: @expected",
+        "Recieved: ". $this->Root->text
+    unless $this->Root->text eq join '',@expected;
+};
+
+test isComplex => sub {
+    my ($this) = @_;
+    
+    failed "property isComplex returned false for the root node" unless $this->Root->isComplex;
+    failed "property isComplex returned true for a simple node", $this->Root->firstChild->nodeName if $this->Root->firstChild->isComplex;
 };
 
 1;
diff -r 7f88e01b58f8 -r 818c74b038ae _test/Test/Resources/Format.pm
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/_test/Test/Resources/Format.pm	Thu Sep 10 17:42:47 2009 +0400
@@ -0,0 +1,39 @@
+package Test::Resources::Format;
+use strict;
+use warnings;
+
+use base qw(IMPL::Test::Unit);
+use IMPL::Test qw(test failed);
+use IMPL::Resources::Format qw(FormatMessage);
+
+__PACKAGE__->PassThroughArgs;
+
+{
+    package Args;
+    use base qw(IMPL::Object);
+    
+    sub foo {
+        return { name => 'Args::foo', value => 'some value'}
+    }
+}
+
+test FormatMessage => sub {
+    my $format = 'This is a %name% message. %args.foo.name% has %args.foo.value% and %some.unknown.param%';
+    
+    my $args = {
+        name => 'Test',
+        args => new Args()
+    };
+    
+    my $result = FormatMessage($format,$args);
+    my $expected = 'This is a Test message. Args::foo has some value and [some.unknown.param]';
+    
+    failed
+        "Format message returned unexpected results",
+        "Expected: $expected",
+        "Recieved: $result"
+    unless $result eq $expected;
+};
+
+
+1;
diff -r 7f88e01b58f8 -r 818c74b038ae _test/any.pl
--- a/_test/any.pl	Wed Sep 09 17:43:31 2009 +0400
+++ b/_test/any.pl	Thu Sep 10 17:42:47 2009 +0400
@@ -1,19 +1,10 @@
 #!/usr/bin/perl -w
-#use strict;
+use strict;
 
-use HTML::Element;
-$a = HTML::Element->new('a', href => 'http://www.perl.com/');
-$a->push_content("The Perl Homepage");
+my @data = (1,2,3,4);
 
-$tag = $a->tag;
-print "$tag starts out as:",  $a->starttag, "\n";
-print "$tag ends as:",  $a->endtag, "\n";
-print "$tag\'s href attribute is: ", $a->attr('href'), "\n";
+sub func {
+    return \@data;
+}
 
-$links_r = $a->extract_links();
-print "Hey, I found ", scalar(@$links_r), " links.\n";
-
-print "And that, as HTML, is: ", $a->as_HTML, "\n";
-$a = $a->delete;
-
-
+print "$_\n" and $data[3]=0 foreach @{func()};
diff -r 7f88e01b58f8 -r 818c74b038ae _test/run_tests.pl
--- a/_test/run_tests.pl	Wed Sep 09 17:43:31 2009 +0400
+++ b/_test/run_tests.pl	Thu Sep 10 17:42:47 2009 +0400
@@ -2,6 +2,9 @@
 use strict;
 use warnings;
 
+use lib '../Lib';
+use lib '.';
+
 use IMPL::Test::HarnessRunner;
 use IMPL::Test::Straps;
 
diff -r 7f88e01b58f8 -r 818c74b038ae impl.kpf
--- a/impl.kpf	Wed Sep 09 17:43:31 2009 +0400
+++ b/impl.kpf	Thu Sep 10 17:42:47 2009 +0400
@@ -248,6 +248,32 @@
 </preference-set>
   <string id="lastInvocation">default</string>
 </preference-set>
+<preference-set idref="66c7d414-175f-45b6-92fe-dbda51c64843/_test/Resources.t">
+<preference-set id="Invocations">
+<preference-set id="default">
+  <string id="cookieparams"></string>
+  <string id="cwd"></string>
+  <long id="debugger.io-port">9011</long>
+  <string id="documentRoot"></string>
+  <string id="executable-params"></string>
+  <string relative="path" id="filename">_test/Resources.t</string>
+  <string id="getparams"></string>
+  <string id="language">Perl</string>
+  <string id="mpostparams"></string>
+  <string id="params"></string>
+  <string id="postparams"></string>
+  <string id="posttype">application/x-www-form-urlencoded</string>
+  <string id="request-method">GET</string>
+  <boolean id="show-dialog">1</boolean>
+  <boolean id="sim-cgi">0</boolean>
+  <boolean id="use-console">0</boolean>
+  <string id="userCGIEnvironment"></string>
+  <string id="userEnvironment"></string>
+  <string id="warnings">enabled</string>
+</preference-set>
+</preference-set>
+  <string id="lastInvocation">default</string>
+</preference-set>
 <preference-set idref="66c7d414-175f-45b6-92fe-dbda51c64843/_test/Test/DOM/Node.pm">
 <preference-set id="Invocations">
 <preference-set id="default">
@@ -300,6 +326,32 @@
 </preference-set>
   <string id="lastInvocation">default</string>
 </preference-set>
+<preference-set idref="66c7d414-175f-45b6-92fe-dbda51c64843/_test/any.pl">
+<preference-set id="Invocations">
+<preference-set id="default">
+  <string id="cookieparams"></string>
+  <string id="cwd"></string>
+  <long id="debugger.io-port">9011</long>
+  <string id="documentRoot"></string>
+  <string id="executable-params"></string>
+  <string relative="path" id="filename">_test/any.pl</string>
+  <string id="getparams"></string>
+  <string id="language">Perl</string>
+  <string id="mpostparams"></string>
+  <string id="params"></string>
+  <string id="postparams"></string>
+  <string id="posttype">application/x-www-form-urlencoded</string>
+  <string id="request-method">GET</string>
+  <boolean id="show-dialog">1</boolean>
+  <boolean id="sim-cgi">0</boolean>
+  <boolean id="use-console">0</boolean>
+  <string id="userCGIEnvironment"></string>
+  <string id="userEnvironment"></string>
+  <string id="warnings">enabled</string>
+</preference-set>
+</preference-set>
+  <string id="lastInvocation">default</string>
+</preference-set>
 <preference-set idref="66c7d414-175f-45b6-92fe-dbda51c64843/_test/object.t">
 <preference-set id="Invocations">
 <preference-set id="default">