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
|
#!/usr/bin/perl
# load definitions.units.patched into the unit_prefixes and unit_units tables
# existing data is wiped!
use utf8;
use open ":std", ":encoding(UTF-8)";
use strict;
use warnings;
use DBD::Pg;
open F, "cat definitions.units.patched elements.units |";
my $dbh = DBI->connect("dbi:Pg:", '', '',
{AutoCommit => 1, PrintError => 0, RaiseError => 0}
) || die "PG connection failed";
$dbh->do("SET synchronous_commit = off");
$dbh->do("TRUNCATE unit_prefixes, unit_units");
$dbh->do("SET client_min_messages = 'error'");
$dbh->do("ALTER TABLE unit_prefixes ADD COLUMN IF NOT EXISTS ordering serial"); # add temp column to preserve load ordering for dumping
$dbh->do("ALTER TABLE unit_units ADD COLUMN IF NOT EXISTS ordering serial");
$dbh->do("RESET client_min_messages");
my $skip_british = 0;
my @todo;
my $continued = '';
while (<F>) {
# skip over locale specific parts
$skip_british = 1 if /^!var UNITS_ENGLISH GB/;
$skip_british = 0 if /^!endvar/;
next if ($skip_british);
if (/\s*(.*)\\$/) {
$continued .= $1;
next;
} elsif ($continued) {
s/^\s*//;
$_ = "$continued$_";
$continued = '';
}
s/#.*//;
s/\s+$//;
next if /^\s*$/; # skip emtpy lines
next if /^!/; # skip pragmas
next if /^\+/; # skip units from non-SI systems
#next if /^[0-9]/; # skip over table contents
#next if /^\s/; # skip over table contents/continued lines
unless (/^(\S+)\s+(.*)/) {
print "unknown line $_\n";
exit 1;
}
my ($unit, $def) = ($1, $2);
next if ($unit =~ /[(\[]/); # skip functions and table definitions
my $is_prefix = ($unit =~ s/-$//); # it's a prefix if it ends with '-'
$def = $unit if ($def eq '!'); # base unit
$def = 1 if ($def eq '!dimensionless');
my $u = { unit => $unit, def => $def, is_prefix => $is_prefix };
$u->{is_base} = ($u->{unit} eq $u->{def});
# shifted units
if ($unit =~ /^(℃|°C|degC|degcelsius)$/) {
$u->{shift} = '273.15'; # 0 °C in K
} elsif ($unit =~ /^(℉|°F|degF|degfahrenheit)$/) {
$u->{shift} = '255.3722222222222222'; # 0 °F in K
} elsif ($unit =~ /^(degreaumur)$/) {
$u->{shift} = '273.15'; # 0 °Ré in K
}
push @todo, $u;
}
# try repeatedly to insert units, unfortunately the input data contains some
# forward references
my ($n_todo, $new_n_todo);
do {
$n_todo = @todo;
print "$n_todo units left to try ...\n";
my @new_todo;
foreach my $u (@todo) {
my ($unit, $def, $shift, $is_prefix) = ($u->{unit}, $u->{def}, $u->{shift}, $u->{is_prefix});
if ($is_prefix) {
my $ret = $dbh->do("INSERT INTO unit_prefixes (prefix, factor, definition, dump) VALUES (?, value(?::unit), ?, NULL)",
undef,
$unit, $def, $def);
next if defined $ret;
# see if the prefix is defined in terms of another prefix
# (we can't simply inject all prefixes as units because conflicts exist, e.g. on 'T')
$ret = $dbh->do("INSERT INTO unit_prefixes (prefix, factor, definition, dump) SELECT ?, factor, ?, NULL FROM unit_prefixes WHERE prefix = ?",
undef,
$unit, $def, $def);
next if defined $ret and $ret > 0;
} else {
my ($is_hashed) = $dbh->selectrow_array("SELECT unit_is_hashed(?)", undef, $unit);
if ($is_hashed and not $u->{is_base}) {
# if the unit we are defining now was successfully used before,
# something went wrong. It indicates that the new unit could
# also be parsed as prefix-otherknownunit, e.g. "ft" vs "f-t"
print "Unit $unit has already been used before being defined. Bad.\n";
exit 1;
}
my $ret = $dbh->do("INSERT INTO unit_units (name, unit, shift, definition, dump) VALUES (?, ?, ?, ?, NULL)",
undef,
$unit, $def, $shift, $def);
next if defined $ret;
$u->{error} = $dbh->errstr;
}
push @new_todo, $u;
}
$new_n_todo = @new_todo;
@todo = @new_todo;
} while ($n_todo != $new_n_todo);
print "$new_n_todo units not inserted:\n";
open my $unres, '>', "definitions.unresolved";
foreach my $u (@todo) {
if ($u->{is_prefix}) {
print "Prefix $u->{unit}: $u->{def}\n";
} else {
print $unres "$u->{unit}\t$u->{def}\n";
next if ($u->{error} =~ /dollar|euro|pence|quid|shilling/); # skip currencies so we can see the rest better
print "$u->{unit}: $u->{def} ($u->{error})\n";
}
}
close $unres;
|
