1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
|
# /=====================================================================\ #
# | LaTeXML::Util::ObjectDB::Entry | #
# | Database of Objects for crossreferencing, etc | #
# |=====================================================================| #
# | Part of LaTeXML: | #
# | Public domain software, produced as part of work done by the | #
# | United States Government & not subject to copyright in the US. | #
# |---------------------------------------------------------------------| #
# | Bruce Miller <bruce.miller@nist.gov> #_# | #
# | http://dlmf.nist.gov/LaTeXML/ (o o) | #
# \=========================================================ooo==U==ooo=/ #
package LaTeXML::Util::ObjectDB::Entry;
use strict;
use warnings;
use LaTeXML::Common::XML;
my $XMLParser = LaTeXML::Common::XML::Parser->new(); # [CONSTANT]
sub new {
my ($class, $key, %data) = @_;
return bless { key => $key, %data }, $class; }
sub key {
my ($entry) = @_;
return $$entry{key}; }
sub getAttributes {
my ($self) = @_;
return keys %$self; }
# Get/Set a value (column) in the DBRow entry, noting whether it modifies the entry.
# Note that XML data is stored in it's serialized form, prefixed by "XML::".
sub hasValue {
my ($self, $attr) = @_;
return exists $$self{$attr}; }
sub getValue {
my ($self, $attr) = @_;
return decodeValue($$self{$attr}); }
sub setValues {
my ($self, %avpairs) = @_;
foreach my $attr (keys %avpairs) {
my $value = encodeValue($avpairs{$attr});
if (!defined $value) {
if (defined $$self{$attr}) {
delete $$self{$attr}; } }
elsif ((!defined $$self{$attr}) || ($$self{$attr} ne $value)) {
$$self{$attr} = $value; } }
return; }
sub pushValues {
my ($self, $attr, @values) = @_;
my $list = $$self{$attr};
foreach my $value (@values) {
push(@$list, encodeValue($value)) if defined $value; }
return; }
sub pushNew {
my ($self, $attr, @values) = @_;
my $list = $$self{$attr};
foreach my $value (@values) {
my $value = encodeValue($value);
push(@$list, $value) if (defined $value) && !grep { $_ eq $value } @$list; }
return; }
# Note an association with this entry
# Roughly equivalent to $$entry{key1}{key2}{...}=1,
# but keeps track of modification timestamps. --- not any more!
sub noteAssociation {
my ($self, @keys) = @_;
my $hash = $self;
while (@keys) {
my $key = shift(@keys);
if (defined $$hash{$key}) {
$hash = $$hash{$key}; }
else {
$hash = $$hash{$key} = (@keys ? {} : 1); } }
return; }
# Debugging aid
use Text::Wrap;
sub show {
my ($self) = @_;
my $string = "ObjectDB Entry for: $$self{key}\n";
foreach my $attr (grep { $_ ne 'key' } keys %{$self}) {
my $label = sprintf(' %16s : ', $attr);
my $value = showvalue($self->getValue($attr));
# hack around bug in Text::Wrap 2012.0818
my $line;
eval {
local $LaTeXML::IGNORE_ERRORS = 1;
$line = wrap($label, (' ' x 20), $value); };
$string .= (defined $line ? $line : $label . $value) . "\n"; }
return $string; }
sub showvalue {
my ($value) = @_;
if ((ref $value) =~ /^XML::/) {
return $value->toString(1); }
elsif (ref $value eq 'HASH') {
return "{" . join(', ', map { "$_=>" . showvalue($$value{$_}) } keys %$value) . "}"; }
elsif (ref $value eq 'ARRAY') {
return "[" . join(', ', map { showvalue($_) } @$value) . "]"; }
else {
return "$value"; } }
#======================================================================
# Internal methods to encode/decode values; primarily to serialize/deserialize XML.
# Yikes, this ultimately needs to be recursive!
sub encodeValue {
my ($value) = @_;
my $ref = ref $value;
if (!defined $value) {
return $value; }
elsif (!$ref) {
return $value; }
# The node is cloned so as to copy any inherited namespace nodes.
elsif ($ref =~ /^XML::/) {
if ($ref eq 'XML::LibXML::DocumentFragment') {
my @c = $value->childNodes;
if (scalar(@c) > 1) {
warn "Encoding XML Document fragment; dropping all except 1st node!"; }
$value = $c[0]; }
return "XML::" . $value->cloneNode(1)->toString; }
elsif ($ref eq 'ARRAY') {
return [map { encodeValue($_) } @$value]; }
elsif ($ref eq 'HASH') {
my %h = map { ($_ => encodeValue($$value{$_})) } keys %$value;
return \%h; }
else {
return $value; } }
sub decodeValue {
my ($value) = @_;
my $ref = ref $value;
if (!defined $value) {
return $value; }
elsif ($value =~ /^XML::/) {
return $XMLParser->parseChunk(substr($value, 5)); }
elsif (!$ref) {
return $value; }
elsif ($ref eq 'ARRAY') {
return [map { decodeValue($_) } @$value]; }
elsif ($ref eq 'HASH') {
my %h = map { ($_ => decodeValue($$value{$_})) } keys %$value;
return \%h; }
else {
return $value; } }
#======================================================================
1;
|
