~ubuntu-branches/ubuntu/oneiric/latexml/oneiric

« back to all changes in this revision

Viewing changes to lib/LaTeXML/Util/ObjectDB.pm

  • Committer: Bazaar Package Importer
  • Author(s): Atsuhito KOHDA
  • Date: 2010-06-09 08:15:06 UTC
  • Revision ID: james.westby@ubuntu.com-20100609081506-1asj0n4u3w4q6jem
Tags: upstream-0.7.0
ImportĀ upstreamĀ versionĀ 0.7.0

Show diffs side-by-side

added added

removed removed

Lines of Context:
 
1
# /=====================================================================\ #
 
2
# |  LaTeXML::Util::ObjectDB                                            | #
 
3
# | Database of Objects for crossreferencing, etc                       | #
 
4
# |=====================================================================| #
 
5
# | Part of LaTeXML:                                                    | #
 
6
# |  Public domain software, produced as part of work done by the       | #
 
7
# |  United States Government & not subject to copyright in the US.     | #
 
8
# |---------------------------------------------------------------------| #
 
9
# | Bruce Miller <bruce.miller@nist.gov>                        #_#     | #
 
10
# | http://dlmf.nist.gov/LaTeXML/                              (o o)    | #
 
11
# \=========================================================ooo==U==ooo=/ #
 
12
 
 
13
package LaTeXML::Util::ObjectDB;
 
14
use strict;
 
15
use LaTeXML::Util::Pathname;
 
16
use DB_File;
 
17
use Storable qw(nfreeze thaw);
 
18
use strict;
 
19
use Encode;
 
20
use Carp;
 
21
our @ISA=qw(Storable);
 
22
 
 
23
#======================================================================
 
24
# NOTES:
 
25
#  (1) If we can do make-like processing, when an entry is marked as
 
26
#       modified, any referrers to it also need processing.
 
27
#      (and we could defer a save if nothing was dirty)
 
28
#======================================================================
 
29
# Some Definitions:
 
30
#  * Object: places a link will take you to.  Several types
 
31
#    * chunk: any significant document object with a reference
 
32
#       number: sectional chunks, equations, ...
 
33
#    * index : the target is the entry in the index itself.
 
34
#         a back reference can take you to where the \index was invoked.
 
35
#    * bib   : the target is the entry in the bibliography.
 
36
#         a back reference can take you to the \cite.
 
37
#
 
38
#======================================================================
 
39
 
 
40
our @DBS=();
 
41
END {
 
42
  map($_->finish, @DBS);
 
43
}
 
44
 
 
45
#======================================================================
 
46
# Creating an ObjectDB object, hooking up initial database.
 
47
sub new {
 
48
  my($class, %options)=@_;
 
49
  my $dbfile = $options{dbfile};
 
50
  if($dbfile && $options{clean}){
 
51
    warn "\nWARN: Removing Object database file $dbfile!!!\n";
 
52
    unlink($dbfile); }
 
53
 
 
54
  my $self = bless {dbfile=>$dbfile,
 
55
                    objects=>{}, externaldb=>{},
 
56
                    verbosity => $options{verbosity}||0,
 
57
                    read_write => $options{read_write},
 
58
                   }, $class;
 
59
  if($dbfile){
 
60
##    my $flags = ($options{read_write} ? O_RDWR|O_CREAT : O_RDONLY);
 
61
    my $flags = O_RDWR|O_CREAT;
 
62
    tie %{$$self{externaldb}}, 'DB_File', $dbfile,$flags
 
63
      or die "Couldn't attach DB $dbfile for object table"; 
 
64
  }
 
65
  push(@DBS,$self);
 
66
  $self; }
 
67
 
 
68
sub status {
 
69
  my($self)=@_;
 
70
  my $status = scalar(keys %{$$self{objects}})." objects";
 
71
#  if($$self{dbfile}){ ...
 
72
  $status; }
 
73
    
 
74
#======================================================================
 
75
# This saves the db
 
76
 
 
77
sub XXXfinish {
 
78
  my($self)=@_;
 
79
  if($$self{externaldb} && $$self{dbfile}){
 
80
    my $n=0;
 
81
    my %types=();
 
82
    my $opened = $$self{opened_timestamp};
 
83
    foreach my $key (keys %{$$self{objects}}){
 
84
      my $row = $$self{objects}{$key};
 
85
      next if $$row{timestamp} < $opened;
 
86
      $n++;
 
87
      my %item = %$row;
 
88
      delete $item{key};                # Don't store these
 
89
      #    $$row{timestamp}=$opened;
 
90
##print STDERR "Saving: ".$row->show."\n";
 
91
      $$self{externaldb}{Encode::encode('utf8',$key)} = nfreeze({%item}); }
 
92
 
 
93
    print STDERR "ObjectDB Stored $n objects (".scalar(keys %{$$self{externaldb}})." total)\n"
 
94
      if $$self{verbosity} > 0; 
 
95
    untie %{$$self{externaldb}};  }
 
96
 
 
97
 $$self{externaldb}=undef;
 
98
 $$self{objects}=undef;
 
99
}
 
100
 
 
101
 
 
102
sub finish {
 
103
  my($self)=@_;
 
104
  if($$self{externaldb} && $$self{dbfile}){
 
105
    my $n=0;
 
106
    my %types=();
 
107
    foreach my $key (keys %{$$self{objects}}){
 
108
      my $row = $$self{objects}{$key};
 
109
      # Skip saving, unless there's some difference between stored value
 
110
      if(my $stored = $$self{externaldb}{Encode::encode('utf8',$key)}){ # Get the external object
 
111
        next if compare_hash($row,thaw($stored)); }
 
112
      $n++;
 
113
      my %item = %$row;
 
114
##print STDERR "Saving: ".$row->show."\n";
 
115
      $$self{externaldb}{Encode::encode('utf8',$key)} = nfreeze({%item}); }
 
116
 
 
117
    print STDERR "ObjectDB Stored $n objects (".scalar(keys %{$$self{externaldb}})." total)\n"
 
118
      if $$self{verbosity} > 0; 
 
119
    untie %{$$self{externaldb}};  }
 
120
 
 
121
 $$self{externaldb}=undef;
 
122
 $$self{objects}=undef;
 
123
}
 
124
 
 
125
sub compare {
 
126
  my($a,$b)=@_;
 
127
  my $ra = ref $a;
 
128
  if(! $ra){
 
129
    if(ref $b){ 0; }
 
130
    else { $a eq $b; }}
 
131
  elsif($ra ne ref $b){ 0; }
 
132
  elsif($ra eq 'HASH'){ compare_hash($a,$b); }
 
133
  elsif($ra eq 'ARRAY'){ compare_array($a,$b); }
 
134
  else { $a eq $b;}}
 
135
 
 
136
sub compare_hash {
 
137
  my($a,$b)=@_;
 
138
  my %attr = ();
 
139
  map($attr{$_}=1, keys %$a);
 
140
  map($attr{$_}=1, keys %$b);
 
141
  (grep( !( (defined $$a{$_}) && (defined $$b{$_})
 
142
            && compare($$a{$_}, $$b{$_}) ), keys %attr) ? 0 : 1); }
 
143
 
 
144
sub compare_array {
 
145
  my($a,$b)=@_;
 
146
  my @a = @$a;
 
147
  my @b = @$b;
 
148
  while(@a && @b){
 
149
    return 0 unless compare(shift(@a),shift(@b)); }
 
150
  (@a || @b ? 0 : 1); }
 
151
 
 
152
#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 
153
sub getKeys {
 
154
  my($self)=@_;
 
155
  # Get union of all keys in externaldb & local objects.
 
156
  my %keys = ();
 
157
  map($keys{$_}=1, keys %{$$self{objects}});
 
158
  map($keys{Encode::decode('utf8',$_)}=1, keys %{$$self{externaldb}}); 
 
159
  keys %keys; }
 
160
 
 
161
#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 
162
# Lookup of various kinds of things in the DB.
 
163
#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 
164
 
 
165
# Lookup the Object associated with label
 
166
# If it is not already fetched from the external db (if any), fetch it now.
 
167
 
 
168
sub lookup {
 
169
  my($self,$key)=@_;
 
170
  return undef unless defined $key;
 
171
  my $entry = $$self{objects}{$key}; # Get the local copy.
 
172
  return $entry if $entry;
 
173
  $entry = $$self{externaldb}{Encode::encode('utf8',$key)}; # Get the external object
 
174
  if($entry){
 
175
    $entry = thaw($entry);
 
176
    $$entry{key} = $key;
 
177
    bless $entry, 'LaTeXML::Util::ObjectDB::Entry';
 
178
    $$self{objects}{$key} = $entry; }
 
179
  $entry; }
 
180
 
 
181
#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 
182
# Register various interesting document nodes.
 
183
#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 
184
# Register the labeled object $node, creating, or filling in, and
 
185
# returning a Chunk entry.
 
186
sub register {
 
187
  my($self,$key,%props)=@_;
 
188
  carp("Missing key for object!") unless $key;
 
189
  my $entry = $self->lookup($key);
 
190
  if(!$entry){
 
191
    $entry = {key=>$key};
 
192
    bless $entry, 'LaTeXML::Util::ObjectDB::Entry';
 
193
    $$self{objects}{$key}=$entry; }
 
194
  $entry->setValues(%props);
 
195
 
 
196
  $entry; }
 
197
 
 
198
#********************************************************************************
 
199
# DB Entries
 
200
#********************************************************************************
 
201
package LaTeXML::Util::ObjectDB::Entry;
 
202
use strict;
 
203
use LaTeXML::Common::XML;
 
204
 
 
205
our $XMLParser = LaTeXML::Common::XML::Parser->new();
 
206
 
 
207
sub new {
 
208
  my($class,$key,%data)=@_;
 
209
  bless {key=>$key,%data},$class; }
 
210
 
 
211
sub key { $_[0]->{key}; }
 
212
 
 
213
# Get/Set a value (column) in the DBRow entry, noting whether it modifies the entry.
 
214
# Note that XML data is stored in it's serialized form, prefixed by "XML::".
 
215
sub getValue {
 
216
  my($self,$attr)=@_;
 
217
  my $value = $$self{$attr}; 
 
218
  if($value && $value =~ /^XML::/){
 
219
    $value = $XMLParser->parseChunk(substr($value,5)); }
 
220
  $value; }
 
221
 
 
222
sub setValues {
 
223
  my($self,%avpairs)=@_;
 
224
  foreach my $attr (keys %avpairs){
 
225
    my $value = $avpairs{$attr};
 
226
    if(((ref $value) || '') =~ /^XML::/){
 
227
      # The node is cloned so as to copy any inherited namespace nodes.
 
228
      $value = "XML::".$value->cloneNode(1)->toString; }
 
229
    if(! defined $value){
 
230
      if(defined $$self{$attr}){
 
231
        delete $$self{$attr}; }}
 
232
    elsif((! defined $$self{$attr}) || ($$self{$attr} ne $value)){
 
233
      $$self{$attr}=$value; }}}
 
234
 
 
235
# Note an association with this entry
 
236
# Roughly equivalent to $$entry{key1}{key2}{...}=1,
 
237
# but keeps track of modification timestamps. --- not any more!
 
238
sub noteAssociation {
 
239
  my($self,@keys)=@_;
 
240
  my $hash = $self;
 
241
  while(@keys){
 
242
    my $key = shift(@keys);
 
243
    if(defined $$hash{$key}){
 
244
      $hash = $$hash{$key}; }
 
245
    else {
 
246
      $hash = $$hash{$key} = (@keys ? {} : 1); }}}
 
247
 
 
248
# Debugging aid
 
249
use Text::Wrap;
 
250
sub show {
 
251
  my($self)=@_;
 
252
  my $string = "ObjectDB Entry for: $$self{key}\n";
 
253
  foreach my $attr (grep($_ ne 'key', keys %{$self})){
 
254
    $string .= wrap(sprintf(' %16s : ',$attr),(' 'x20), showvalue($self->getValue($attr)))."\n"; }
 
255
  $string; }
 
256
 
 
257
sub showvalue {
 
258
  my($value)=@_;
 
259
  if((ref $value) =~ /^XML::/){ $value->toString; }
 
260
  elsif(ref $value eq 'HASH'){
 
261
    "{".join(', ',map("$_=>".showvalue($$value{$_}), keys %$value))."}"; }
 
262
  elsif(ref $value eq 'ARRAY'){
 
263
  "[".join(', ',map(showvalue($_),@$value))."]"; }
 
264
  else { "$value"; }}
 
265
 
 
266
#======================================================================
 
267
1;