SWE/DB/IDDOM.pm

package SWE::DB::IDDOM;
use strict;

require SWE::DB::IDProps;
push our @ISA, 'SWE::DB::IDProps';

require Message::DOM::DOMImplementation;

sub new ($) {
  my $self = shift->SUPER::new (@_);
  $self->{leaf_suffix} = '.dom';
  return $self;
} # new

sub get_data ($$) {
  my $self = shift;
  my $file_name = $self->_get_file_name ($_[0]);

  unless (-f $file_name) {
    return undef;
  }

  open my $file, '<:encoding(utf8)', $file_name or die "$0: $file_name: $!";
  return _load_dom ($file);
} # get_data

sub set_data ($$$) {
  my $self = shift;
  my $file_name = $self->_get_file_name ($_[0], 1);
  my $dom = $_[1];
  
  my $has_file = -f $file_name;
  
  open my $file, '>:encoding(utf8)', $file_name or die "$0: $file_name: $!";
  _store_dom ($file, $dom);

## TODO: cvs
} # set_data

sub _load_dom ($) {
  my $handle = shift;

  my $dom = Message::DOM::DOMImplementation->new;
  my @node = ($dom->create_document);

  $node[0]->strict_error_checking (0);
  $node[0]->dom_config->set_parameter
    ('http://suika.fam.cx/www/2006/dom-config/strict-document-children' => 0);

  my $unescape = sub {
    my $s = shift;
    $s =~ s/\\([0-9A-Fa-f]{2})/pack 'C', hex $1/ge;
    return $s;
  }; # $unescape

  while (<$handle>) {
    tr/\x0D\x0A//d;
    if (s/^n(\d+);//) {
      $node[$1] = $unescape->($_);
    } elsif (s/^t(\d+);//) {
      my $parent_id = $1;
      $node[$parent_id]->append_child
          ($node[0]->create_text_node ($unescape->($_)));
    } elsif (s/^e(\d+);(\d+);(\d+);//) {
      my ($this_id, $parent_id, $ns_id) = ($1, $2, $3);
      $node[$this_id] = $node[0]->create_element_ns
          ($node[$ns_id], [undef, $unescape->($_)]);
      $node[$parent_id]->append_child ($node[$this_id]);
    } elsif (s/^a(\d+);(\d+);([^;]+);//) {
      my ($parent_id, $ns_id, $ln) = ($1, $2, $3);
      $node[$parent_id]->set_attribute_ns
          ($node[$ns_id], [undef, $unescape->($ln)], $unescape->($_));
    }
  }

  return $node[0];
} # _load_dom

sub _store_dom ($$) {
  my $handle = shift;
  my @item = ([0, shift]);

  my $escape = sub {
    my $v = $_[0];
    $v =~ s/([;\\\x0D\x0A])/sprintf '\\%02X', ord $1/ge;
    return $v;
  }; # $escape

  my $ns;
  my $next_id = 1;
  while (@item) {
    my ($parent_id, $node) = @{shift @item};
    if ($node->node_type == $node->ELEMENT_NODE) {
      my $nsuri = $node->namespace_uri // '';
      my $nsid = $ns->{$nsuri};
      unless (defined $nsid) {
        $nsid = $next_id++;
        $ns->{$nsuri} = $nsid;
        print $handle "n", $nsid, ';', $escape->($nsuri), "\n";
      }
      my $el_id = $next_id++;
      print $handle "e", $el_id, ';', $parent_id, ';', $nsid, ';',
          $escape->($node->manakai_local_name), "\n";
      for my $attr (@{$node->attributes}) {
        my $nsuri = $attr->namespace_uri // '';
        my $nsid = $ns->{$nsuri};
        unless (defined $nsid) {
          $nsid = $next_id++;
          $ns->{$nsuri} = $nsid;
          print $handle "n", $nsid, ';', $escape->($nsuri), "\n";
        }
        print $handle "a", $el_id, ';', $nsid, ';', 
            $escape->($attr->manakai_local_name), ';',
            $escape->($attr->value), "\n";
      }
      unshift @item, map {[$el_id, $_]} @{$node->child_nodes}; 
    } elsif ($node->node_type == $node->TEXT_NODE or
             $node->node_type == $node->CDATA_SECTION_NODE) {
      print $handle "t", $parent_id, ';', $escape->($node->data), "\n";
    } elsif ($node->node_type == $node->DOCUMENT_NODE or
             $node->node_type == $node->DOCUMENT_FRAGMENT_NODE) {
      unshift @item, map {[0, $_]} @{$node->child_nodes}; 
    }
  }
} # _store_dom

1;
1	wakaba	1.1	package SWE::DB::IDDOM;
2			use strict;
3
4			require SWE::DB::IDProps;
5			push our @ISA, 'SWE::DB::IDProps';
6
7			require Message::DOM::DOMImplementation;
8
9			sub new ($) {
10			my $self = shift->SUPER::new (@_);
11			$self->{leaf_suffix} = '.dom';
12			return $self;
13			} # new
14
15			sub get_data ($$) {
16			my $self = shift;
17			my $file_name = $self->_get_file_name ($_[0]);
18
19			unless (-f $file_name) {
20			return undef;
21			}
22
23			open my $file, '<:encoding(utf8)', $file_name or die "$0: $file_name: $!";
24			return _load_dom ($file);
25			} # get_data
26
27			sub set_data ($$$) {
28			my $self = shift;
29			my $file_name = $self->_get_file_name ($_[0], 1);
30			my $dom = $_[1];
31
32			my $has_file = -f $file_name;
33
34			open my $file, '>:encoding(utf8)', $file_name or die "$0: $file_name: $!";
35			_store_dom ($file, $dom);
36
37			## TODO: cvs
38			} # set_data
39
40			sub _load_dom ($) {
41			my $handle = shift;
42
43			my $dom = Message::DOM::DOMImplementation->new;
44			my @node = ($dom->create_document);
45
46			$node[0]->strict_error_checking (0);
47			$node[0]->dom_config->set_parameter
48			('http://suika.fam.cx/www/2006/dom-config/strict-document-children' => 0);
49
50			my $unescape = sub {
51			my $s = shift;
52			$s =~ s/\\([0-9A-Fa-f]{2})/pack 'C', hex $1/ge;
53			return $s;
54			}; # $unescape
55
56			while (<$handle>) {
57			tr/\x0D\x0A//d;
58			if (s/^n(\d+);//) {
59			$node[$1] = $unescape->($_);
60			} elsif (s/^t(\d+);//) {
61			my $parent_id = $1;
62			$node[$parent_id]->append_child
63			($node[0]->create_text_node ($unescape->($_)));
64			} elsif (s/^e(\d+);(\d+);(\d+);//) {
65			my ($this_id, $parent_id, $ns_id) = ($1, $2, $3);
66			$node[$this_id] = $node[0]->create_element_ns
67			($node[$ns_id], [undef, $unescape->($_)]);
68			$node[$parent_id]->append_child ($node[$this_id]);
69			} elsif (s/^a(\d+);(\d+);([^;]+);//) {
70			my ($parent_id, $ns_id, $ln) = ($1, $2, $3);
71			$node[$parent_id]->set_attribute_ns
72			($node[$ns_id], [undef, $unescape->($ln)], $unescape->($_));
73			}
74			}
75
76			return $node[0];
77			} # _load_dom
78
79			sub _store_dom ($$) {
80			my $handle = shift;
81			my @item = ([0, shift]);
82
83			my $escape = sub {
84			my $v = $_[0];
85			$v =~ s/([;\\\x0D\x0A])/sprintf '\\%02X', ord $1/ge;
86			return $v;
87			}; # $escape
88
89			my $ns;
90			my $next_id = 1;
91			while (@item) {
92			my ($parent_id, $node) = @{shift @item};
93			if ($node->node_type == $node->ELEMENT_NODE) {
94			my $nsuri = $node->namespace_uri // '';
95			my $nsid = $ns->{$nsuri};
96			unless (defined $nsid) {
97			$nsid = $next_id++;
98			$ns->{$nsuri} = $nsid;
99			print $handle "n", $nsid, ';', $escape->($nsuri), "\n";
100			}
101			my $el_id = $next_id++;
102			print $handle "e", $el_id, ';', $parent_id, ';', $nsid, ';',
103			$escape->($node->manakai_local_name), "\n";
104			for my $attr (@{$node->attributes}) {
105			my $nsuri = $attr->namespace_uri // '';
106			my $nsid = $ns->{$nsuri};
107			unless (defined $nsid) {
108			$nsid = $next_id++;
109			$ns->{$nsuri} = $nsid;
110			print $handle "n", $nsid, ';', $escape->($nsuri), "\n";
111			}
112			print $handle "a", $el_id, ';', $nsid, ';',
113			$escape->($attr->manakai_local_name), ';',
114			$escape->($attr->value), "\n";
115			}
116			unshift @item, map {[$el_id, $_]} @{$node->child_nodes};
117			} elsif ($node->node_type == $node->TEXT_NODE or
118			$node->node_type == $node->CDATA_SECTION_NODE) {
119			print $handle "t", $parent_id, ';', $escape->($node->data), "\n";
120			} elsif ($node->node_type == $node->DOCUMENT_NODE or
121			$node->node_type == $node->DOCUMENT_FRAGMENT_NODE) {
122			unshift @item, map {[0, $_]} @{$node->child_nodes};
123			}
124			}
125			} # _store_dom
126
127			1;