Mercurial > pub > Impl

--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/Lib/IMPL/DOM/XMLReader.pm	Fri Aug 28 16:26:20 2009 +0400
@@ -0,0 +1,47 @@
+package IMPL::DOM::XMLReader;
+use strict;
+use warnings;
+
+use base qw(IMPL::Object IMPL::Object::Autofill);
+use IMPL::Class::Property;
+use IMPL::Class::Property::Direct;
+use XML::Parser;
+
+BEGIN {
+    public _direct property Navigator => prop_get | owner_set;
+    private _direct property _current => prop_all;
+}
+
+sub Parse {
+    my ($this,$in) = @_;
+
+    my $parser = new XML::Parser(
+        Handlers => {
+            Start => sub {shift; goto &OnStart($this,@_)},
+            End => sub {shift; goto &OnEnd($this,@_)},
+            Char => sub {shift; goto &OnChar($this,@_)}
+        }
+    );
+
+    $parser->parse($in);
+}
+
+sub OnBegin {
+    my ($this,$element,%attrs) = @_;
+
+    $this->{$_current} = $this->Navigator->CreateAndNavigate($element,%attrs);
+}
+
+sub OnEnd {
+    my ($this,$element) = @_;
+
+    $this->{$_current} = $this->Back;
+}
+
+sub OnChar {
+    my ($this,$val) = @_;
+
+    $this->{$_current}->nodeValue($this->{$_current}->nodeValue . $val);
+}
+
+1;
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/_test/Resources/form.schema	Fri Aug 28 16:26:20 2009 +0400
@@ -0,0 +1,29 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<schema>
+    <Include src="forms.schema"/>
+    <Form
+        dataObject="App::Data::User"
+        dataPolicy="AddOrUpdate"
+        messageMin="Вы не заполнили %Node.formLabel.%"
+    >
+        <EditBox nodeName="Name"
+            formLabel="Имя"
+            formLabel.blame="имя"
+            formLabel.no="имени"
+        />
+        <EditBox nodeName="Nick"
+            formLabel="Прозвище"
+            formLabel.no="прозвища"
+            minOccur="0"
+        >
+            <RegExp>\w{4,10}</RegExp>
+        </EditBox>
+        <ListBox nodeName="Role"
+            dataObject="App::Data::Role"
+            dataSource="roles"
+            formLabel="Роль"
+            formLabel.blame="роль"
+        />
+    </Form>
+</schema>
+
--- a/_test/Resources/test.schema	Thu Aug 27 17:49:42 2009 +0400
+++ b/_test/Resources/test.schema	Fri Aug 28 16:26:20 2009 +0400
@@ -1,12 +1,8 @@
 <?xml version="1.0" encoding="utf-8"?>
 <schema>
+    <!-- Загрузка фрагмента схемы -->
     <Include src="basic.types.schema"/>
-    <TypeNodeMapping>
-        <ListBox type="IMPL::Web::Control::ListBox"/>
-        <RadioList type="IMPL::Web::Control::RadioList"/>
-        <EditBox type="IMPL::Web::Control::EditBox"/>
-        <DateTimeBox type="IMPL::Web::Control::EditBox"/>
-    </TypeNodeMapping>
+
     <ComplexNode nodeName="Form">
         <NodeSet>
             <SimpleNode nodeName="FirstName">
@@ -15,13 +11,13 @@
             <SimpleNode nodeName="LastName">
                 <Regexp>\w+</Regexp>
             </SimpleNode>
-            <TypeNode nodeName="BirthDate" type="DateTime" />
-            <TypeNode nodeName="Email" type="Email" minOccur="0" maxOccur="unbounded" />
+            <Node nodeName="BirthDate" type="DateTime" />
+            <Node nodeName="Email" type="Email" minOccur="0" maxOccur="unbounded" />
             <ComplexNode nodeName="AviaTicket" minOccur="0">
-                <TypeNode nodeName="From" type="Airport" control="ListBox" datasource="Airports"/>
-                <TypeNode nodeName="To" type="Airport" >
-                    <DiffersFrom query="From"/>
-                </TypeNode>
+                <Node nodeName="From" type="Airport" control="ListBox" datasource="Airports"/>
+                <Node nodeName="To" type="Airport" >
+                    <Check op='!=' LVal='nodeValue' RVal="From.nodeValue"/>
+                </Node>
             </ComplexNode>
         </NodeSet>
     </ComplexNode>
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/_test/any.t	Fri Aug 28 16:26:20 2009 +0400
@@ -0,0 +1,19 @@
+#!/usr/bin/perl -w
+#use strict;
+
+use HTML::Element;
+$a = HTML::Element->new('a', href => 'http://www.perl.com/');
+$a->push_content("The Perl Homepage");
+
+$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";
+
+$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;
+
+
--- a/impl.kpf	Thu Aug 27 17:49:42 2009 +0400
+++ b/impl.kpf	Fri Aug 28 16:26:20 2009 +0400
@@ -196,6 +196,32 @@
 </preference-set>
   <string id="lastInvocation">default</string>
 </preference-set>
+<preference-set idref="66c7d414-175f-45b6-92fe-dbda51c64843/_test/any.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/any.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/object.t">
 <preference-set id="Invocations">
 <preference-set id="default">