3 # xdump example program.
4 # Copyright (C) 2006-2009 Markus Armbruster
6 # This program is free software; you can redistribute it and/or modify
7 # it under the terms of the GNU General Public License as published by
8 # the Free Software Foundation; either version 2 of the License, or
9 # (at your option) any later version.
11 # This program is distributed in the hope that it will be useful,
12 # but WITHOUT ANY WARRANTY; without even the implied warranty of
13 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 # GNU General Public License for more details.
16 # You should have received a copy of the GNU General Public License
17 # along with this program; if not, write to the Free Software
18 # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
20 # Connect to server, xdump everything into tables, then print the
23 # A table is an array of records.
24 # A record is a hash mapping field names to values.
26 # This is just an example! Error handling is anemic. Tables and
27 # records just beg to be objects, but aren't.
34 # Map table name to meta table reference
35 my %meta_by_name = ();
36 # Map table uid to meta table reference
38 # Map table name to table reference
39 my %table_by_name = ();
40 # Map table uid to table reference
41 my @table_by_uid = ();
45 # The meta-type symbol table
48 my $empire = new Empire(-host => '127.0.0.1',
53 my $dumper = new Dumpvalue;
57 my $mmd = send_cmd('xdump meta meta');
59 $table_by_name{meta} = $meta_by_name{meta} = \@meta_meta;
61 parse_xdump($mmd, undef, \&store_meta_meta_record);
62 # parse for real (requires field names)
63 parse_xdump($mmd, undef);
69 $meta_by_name{table} = [];
70 parse_xdump(send_cmd('xdump meta table'), undef);
71 # table's first field is record uid, and its table field is the table uid:
72 my $tuid = $meta_by_name{table}->[0]->{table};
73 $meta_by_uid[$tuid] = $meta_by_name{table};
76 $table_by_uid[$tuid] = $table_by_name{table} = [];
77 parse_xdump(send_cmd('xdump table *'), $tuid);
80 # complete work for xdump meta meta
82 # find the meta table uid
83 my ($meta) = grep { defined $_ && $_->{name} eq 'meta' }
84 @{$table_by_name{table}};
85 my $tuid = $meta->{uid};
86 # enter it into @*_by_uid
87 $meta_by_uid[$tuid] = $meta_by_name{meta};
88 $table_by_uid[$tuid] = $table_by_name{meta};
93 # lookup record with name => 'type' in meta meta:
94 my ($mmt) = grep {$_->{name} eq 'type'} @meta_meta;
95 # its table field is uid of table meta-type:
96 my $tuid = $mmt->{table};
97 # lookup table meta-type's name:
98 my $name = $table_by_name{table}->[$tuid]->{name};
100 # xdump meta meta-type
101 $meta_by_uid[$tuid] = $meta_by_name{$name} = [];
102 parse_xdump(send_cmd("xdump meta $tuid"), $tuid);
106 $table_by_uid[$tuid] = $table_by_name{$name} = \@meta_type;
107 parse_xdump(send_cmd("xdump $tuid *"), $tuid);
111 for my $tab (@{$table_by_name{table}}) {
113 next unless exists $tab->{name};
114 # skip tables already dumped:
115 next if defined $meta_by_name{$tab->{name}};
118 $meta_by_uid[$tab->{uid}] = $meta_by_name{$tab->{name}} = [];
119 parse_xdump(send_cmd("xdump meta $tab->{uid}"), $tab->{uid});
122 $table_by_uid[$tab->{uid}] = $table_by_name{$tab->{name}} = [];
123 parse_xdump(send_cmd("xdump $tab->{uid} *"), $tab->{uid});
128 # pick an unused tuid:
129 my $tuid = $#meta_by_uid + 1;
130 # hack the table of tables:
131 push @{$table_by_name{table}}, {uid => $tuid, name => 'version'};
133 $meta_by_uid[$tuid] = $meta_by_name{version} = [];
134 parse_xdump(send_cmd('xdump meta ver'), $tuid);
136 $table_by_uid[$tuid] = $table_by_name{version} = [];
137 parse_xdump(send_cmd('xdump ver'), $tuid);
140 $dumper->dumpValue(\@table_by_uid);
145 $empire->empcmd($cmd);
146 my ($status, $data) = $empire->empreadline($cmd);
147 die unless ($status eq $Empire::C_PROMPT);
152 my ($data, $tuid, $store_record) = @_;
153 $store_record = \&store_record unless defined $store_record;
156 ($_, $data) = split(/\n/, $data, 2);
157 /^XDUMP (meta )?(\S+) ([0-9])+$/
159 my $meta = defined $1;
165 while ($data !~ /^\//) {
166 ($_, $data) = split(/\n/, $data, 2);
167 my @fld = split(/ /);
168 &$store_record($tuid, $meta, $name, $n, \@fld, $timestamp);
173 $data =~ /^\/([0-9]+)$/
180 my ($tuid, $meta, $name, $idx, $fld, $timestamp) = @_;
181 my ($meta_table, $table);
183 # find table to update and its meta table
185 $meta_table = \@meta_meta;
186 $table = $meta_by_name{$name};
188 $meta_table = $meta_by_name{$name};
189 $table = $table_by_name{$name};
191 if has_record_uid($tuid);
195 my $record = $table->[$idx] || {};
197 for (my $i = 0; $i <= $#{$meta_table}; $i++) {
198 my $n = is_array($meta_table->[$i]);
202 my $fldname = $meta_table->[$i]->{name};
203 die unless defined $fld->[$fldidx];
204 $record->{$fldname} = eval_fld($fld->[$fldidx++]);
207 $table->[$idx] = $record;
210 sub store_meta_meta_record {
211 my ($tuid, $meta, $name, $idx, $fld, $timestamp) = @_;
212 die unless $name eq 'meta';
213 my $val = eval_fld($fld->[0]);
214 die if $idx == 0 && $val ne 'name';
215 $meta_meta[$idx] = {name => $val, len => 0};
220 if ($fld =~ /\A[-+.0-9]/) {
221 # sloppy, doesn't flag malformed numbers
223 } elsif ($fld =~ /\A\"(.*)\"/) {
224 # sloppy, doesn't junk after string
226 $fld =~ s/\\([0-7][0-7][0-7])/ chr(oct($1)) /eg;
233 # a table has record uids if the first field's table is the table's uid
235 die unless defined $tuid;
236 die unless defined $meta_by_uid[$tuid];
237 die unless defined $meta_by_uid[$tuid]->[0];
238 die unless defined $meta_by_uid[$tuid]->[0]->{table};
239 return $meta_by_uid[$tuid]->[0]->{table} == $tuid;
243 my ($symtab, $value) = @_;
244 my ($sym) = grep { $_->{value} == $value } @{$symtab};
250 my $len = $meta->{len};
251 # non-zero $len means array, except for format 'c'
252 if ($len == 0 || sym_by_value(\@meta_type, $meta->{type}) eq 'c') {