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	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;