usr bin perl -------------------- -------- Скрипт работы tbl файлами D

  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
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
#!/usr/bin/perl
#----------------------------
# Скрипт работы с tbl файлами Diablo II
#
#----------------------------
use utf8;
use Encode;
use open IN => ":utf8", OUT => ":utf8";
binmode STDOUT, ":utf8";
# Структуры данных
# Заголовочная часть файла, содержит общую информацию.
my %header = (
CRC => 0, # 2 байта: CRC сумма $data + numStr + numHash
numStr => 0, # 2 байта: Количество строк данных
numHash => 0, # 4 байта: Количество строк в хеш-таблице
hdrB => 1, # 1 байт: Смысл туманен, должен быть единицей
stOffset => 0, # 4 байта: Начальное смещение данных
maxMisses => 0, # 4 байта: Максимальное количество 'промахов' хеша
endOffset => 0 # 4 байта: Конечное смещение данных (размер файла)
);
# Таблица индексов хеша (по 2 байта на число), которая ставит в соответствие номеру строки данных номер строки хеша
@hashIndexes = (
0, # 2 байта: номер строки в хеш-таблице
);
# Сам хеш
@hash = (
{
isUse => 0, # 1 байт: 0 - если не используется, 1 - если используется
indexNum => 0, # 2
hashVal => 0, # 4
keyOffset => 0, # 4
strOffset => 0, # 4
strLen => 0, # 2
}
);
# Данные
@data = (
{
key => "", # Ключ
string => "", # Строка
}
);
# Процедурки, используемые в программе
sub LoadTbl {
@_ == 1 or die "LoadTbl: должен быть ровно 1 аргумент\n";
open INPUT, "<${_[0]}" or die "LoadTbl: ошибка загрузки файла ${_[0]}\n";
binmode INPUT;
my $input;
# Читаем заголовочный блок
read (INPUT, $input, 2); # Читаем CRC
$header{CRC} = unpack ("S", $input);
read (INPUT, $input, 2); # Читаем количество элементов
$header{numStr} = unpack ("S", $input);
read (INPUT, $input, 4); # Читаем количество строк в хеш-таблице
$header{numHash} = unpack ("L", $input);
read (INPUT, $input, 1); # Читаем промежуточный байт, должен быть единицей
$header{hdrB} = unpack ("C", $input);
read (INPUT, $input, 4); # Читаем смещение блока данных
$header{stOffset} = unpack ("L", $input);
read (INPUT, $input, 4); # Читаем максимальное количество 'промахов' хеш-ключа
$header{maxMisses} = unpack ("L", $input);
read (INPUT, $input, 4); # Читаем конечное смещение блока данных (оно же размер файла)
$header{endOffset} = unpack ("L", $input);
# Читаем блок индексов хеша
foreach (0 .. $header{numStr}-1) {
read (INPUT, $input, 2); # Читаем очередной индекс
$hashIndexes[$_] = unpack ("S", $input); # Сохраняем в массив
}
# Читаем сам хеш
foreach (0 .. $header{numHash}-1) {
read (INPUT, $input, 1); # Читаем флаг использования
$hash[$_]{isUse} = unpack ("C", $input);
read (INPUT, $input, 2); # Читаем индекс строки
$hash[$_]{indexNum} = unpack ("S", $input);
read (INPUT, $input, 4); # Читаем значение хеша
$hash[$_]{hashVal} = unpack ("L", $input);
read (INPUT, $input, 4); # Читаем смещение ключа
$hash[$_]{keyOffset} = unpack ("L", $input);
read (INPUT, $input, 4); # Читаем смещение строки
$hash[$_]{strOffset} = unpack ("L", $input);
read (INPUT, $input, 2); # Читаем длину строки
$hash[$_]{strLen} = unpack ("S", $input);
}
tell(INPUT) eq $header{stOffset} or die "LoadTbl: заявленное смещение данных не соответствует фактическому\n";
# Читаем блок данных (какие-то хаки с позициями, почему-то иначе не работает)
$/=v0; # Ставим разделителем строк для <> и chomp символ '\0'
seek INPUT, $header{stOffset}, 0;
foreach (0 .. $header{numStr}-1) {
my $pos = tell INPUT;
my $k = <INPUT> or die "LoadTbl: фактическое количество строк данных не соответствует заявленному\n";
seek (INPUT, $pos+length($k), 0);
my $s = <INPUT> or die "LoadTbl: фактическое количество строк данных не соответствует заявленному\n";
seek (INPUT, $pos+length($k)+length($s), 0);
chomp $s;
chomp $k;
$data[$_]{key}=$k;
$data[$_]{string}=$s;
}
$/="\n"; # Не забываем вернуть обычный разделитель
tell(INPUT) eq $header{endOffset} or die "LoadTbl: заявленное конечное смещение не соответствует фактическому размеру файла\n";
<INPUT> and die "LoadTbl: за блоком данных есть ещё информация\n";
close INPUT;
}
sub Import {
}
# В уже полностью загруженный файл грузятся только строчки из текстового
# Текстовый файл должен быть в кодировке UTF-8 без BOM!!
sub ImportLite {
@_ == 1 or die "ImportLite: должен быть ровно 1 аргумент\n";
open INFILE, "<${_[0]}" or die "ImportLite: ошибка открытия файла ${_[0]}\n";
binmode INFILE;
$/="\n";
my $str;
foreach (<INFILE>) { $str .= $_ }
close INFILE;
my $i=0;
foreach (split /\n/,$str) {
chomp $_;
($k,$s) = /^(.*)\t(.*)$/;
$k =~ s/\\n/\n/g;
$s =~ s/\\n/\n/g;
$k == $data[$i]{key} or die "ImportLite: ключ в строчке $i не соответствует исходному\n";
if ($k ne "colorcode") { $data[$i]{string}=$s }
$i++;
}
}
sub Rebuild {
}
# Предпологается, что изменились только строки данных, а сумарное количество и ключи сохранились
sub RebuildLite {
my $dataOffset = $header{stOffset}; # Начальное смещение строк
my $allStrings = ''; # Строка для склейки всех текстовых данных (нужна для пересчёта CRC)
foreach (0 .. @data-1) {
$hash[$hashIndexes[$_]]{keyOffset} = $dataOffset;
$allStrings .= $data[$_]{key} . v0;
$dataOffset += length($data[$_]{key}) + 1;
$hash[$hashIndexes[$_]]{strOffset} = $dataOffset;
$allStrings .= $data[$_]{string} . v0;
$dataOffset += length($data[$_]{string}) + 1;
$hash[$hashIndexes[$_]]{strLen} = length($data[$_]{string}) + 1;
}
$header{CRC} = CRC($allStrings);
$header{endOffset} = $dataOffset;
}
sub Save {
@_ == 1 or die "Save: должен быть ровно 1 аргумент\n";
open OUTFILE, ">${_[0]}" or die "Save: ошибка записи в файл ${_[0]}\n";
binmode OUTFILE;
# Пишем заголовок
print OUTFILE pack("SSLCLLL", $header{CRC}, $header{numStr}, $header{numHash}, $header{hdrB}, $header{stOffset}, $header{maxMisses}, $header{endOffset});
# Пишем таблицу индексов хеша
foreach (@hashIndexes) { print OUTFILE pack("S",$_) }
# Пишем саму хеш-таблицу
foreach (0 .. $header{numHash}-1) {
print OUTFILE pack("CSL", $hash[$_]{isUse}, $hash[$_]{indexNum}, $hash[$_]{hashVal});
print OUTFILE pack("LLS",$hash[$_]{keyOffset}, $hash[$_]{strOffset}, $hash[$_]{strLen});
}
# Пишем данные
foreach (0 .. $header{numStr}-1) { print OUTFILE $data[$_]{key} . v0 . $data[$_]{string} . v0 }
close OUTFILE;
}
sub Export {
@_ == 1 or die "Export: должен быть ровно 1 аргумент\n";
open OUTFILE, ">${_[0]}" or die "Export: ошибка записи в файл ${_[0]}\n";
binmode OUTFILE;
foreach (0..@data-1) {
$k = $data[$_]{key};
$k =~ s/\n/\\n/g;
$s = $data[$_]{string};
$s =~ s/\n/\\n/g;
print OUTFILE "$k\t$s\n";
}
close OUTFILE;
}
sub CheckData {
print "Проверка данных...\n";
$header{hdrB} eq 1 or print "Байт в заголовке равен ${header{hdrB}}, а не 1.\n";
$header{numHash} eq ($temp=@hash) or print "Фактическое количество строк хеш-таблицы $temp не соответствует объявленному в заголовке $header{numHash}.\n";
$header{numStr} eq ($temp=@data) or print "Фактическое количество строк данных $temp не соответствует объявленному в заголовке $header{numStr}.\n";
my $dataOffset = (21 + ($header{numStr} * 2) + ($header{numHash} * 17)); # Начальное смещение строк
$header{stOffset} eq $dataOffset or print "Рассчитанное смещение блока данных не соответствует записанному в заголовке\n";
my $allStrings = ''; # Строка для склейки всех текстовых данных
my $highestNumberOfMisses = 0; # Максимальное количество 'промахов' хеша
foreach (0 .. $header{numStr} - 1) # Проходим по всему массиву данных
{
my $hashValue = Hash ($data[$_]{key}, $header{numHash}); # Вычисляем значение хеша
my $numberOfMisses = 0; # количество промахов данного хеша
my $hashOffset = $hashValue; # смещение в таблице
while ($hash[$hashOffset]{indexNum}<$_) # We would like to store this entry at $hashValue, so that we can find it by running the hash function on the key again and then looking at that entry. However, this entry may already be taken, so we check if it is. If so, we increment $numberOfMisses and $hashOffset (setting $hashOffset back to 0 if it goes above the hash table's size), and try the next entry until we find one that hasn't been taken yet.
{
$numberOfMisses++;
$hashOffset++;
$hashOffset %= $header{numHash};
}
$hash[$hashOffset]{indexNum} eq $_ or print "Расчитанное положение записи элемента $_ в хеш-таблице не совпало с фактическим\n";
$highestNumberOfMisses = $numberOfMisses if ($numberOfMisses > $highestNumberOfMisses); # Ищем максимальный промах
$hashIndexes[$_] eq $hashOffset or print "Ссылка на запись хеша для элемента $_ не совпала с рассчитанным положением\n";
$hashOffset = $hashIndexes[$_]; # На всякий случай, чтоб аварийно не завершаться в случае ошибок
$hash[$hashOffset]{isUse} eq 1 or print "Флаг использование стоит на ${hash[$hashOffset]{isUse}}\n";
$hash[$hashOffset]{hashVal} eq $hashValue or print "Рассчитанное значение хеша для элемента $_ не совпало с записанным\n";
$hash[$hashOffset]{keyOffset} eq $dataOffset or print "Смещение ключа для записи не совпало с фактическим\n";
$allStrings .= $data[$_]{key} . v0; # Прибавляем ключ к блоку данных
$dataOffset += length($data[$_]{key}) + 1;
$hash[$hashOffset]{strOffset} eq $dataOffset or print "Смещение строки для записи не совпало с фактическим\n";
$allStrings .= $data[$_]{string} . v0; # Прибавляем ключ к блоку данных
$dataOffset += length($data[$_]{string}) + 1;
$hash[$hashOffset]{strLen} eq length($data[$_]{string})+1 or print "Длина строки записи $_ не совпала с заявленной\n";
}
$header{endOffset} eq $dataOffset or print "Рассчитанное конечное смещение блока данных не соответствует записанному в заголовке\n";
$header{maxMisses} eq $highestNumberOfMisses+1 or print "Рассчитанное максимальное количество промахов не совпало с записанным\n";
$header{CRC} eq CRC($allStrings) or print "Не совпала CRC сумма.\n";
print "...Ok!\n";
}
# Целиком сворована из Enquettar.pl
sub Hash ($$) # Hash takes two arguments, the key to hash, and the number of different results that can be returned.
{
my $string = $_[0]; # Sets the variable $string to the first arg
my $hashSize = $_[1]; # Sets the variable $hashSize to the second arg
my $value = 0; # Sets the value to initially be 0.
foreach my $character (split (//, $string)) # Sets $character to be each byte in $string, starting with the first and ending with the last.
{
my $charValue = unpack ("c", $character); # this sets $charValue to be equal to character, interpreted as a signed byte
$value <<= 4; # Shift $value left by 4.
$value += $charValue; # Add $charValue to $value
if ($value & 0xF0000000)
{
my $temp = $value & 0xF0000000;
$temp >>= 24; # shift $temp right by 24
$value &= 0x0FFFFFFF;
$value ^= $temp; # $value = $value XOR $temp
}
}
$value %= $hashSize; # $value = $value modulo $hashSize
return $value; # return $value
}
# Целиком сворована из Enquettar.pl
sub CRC ($) # The CRC function, this is called on a string that contains all the keys and values in the file, seperated by null bytes. Not that this must be all the stuff between dwIndexStart (inclusive) and dwIndexEnd (exclusive).
{
my @multiplyTable = (0x0000, 0x1021, 0x2042, 0x3063, 0x4084, 0x50A5, 0x60C6, 0x70E7, 0x8108, 0x9129, 0xA14A, 0xB16B, 0xC18C, 0xD1AD, 0xE1CE, 0xF1EF, 0x1231, 0x0210, 0x3273, 0x2252, 0x52B5, 0x4294, 0x72F7, 0x62D6, 0x9339, 0x8318, 0xB37B, 0xA35A, 0xD3BD, 0xC39C, 0xF3FF, 0xE3DE, 0x2462, 0x3443, 0x0420, 0x1401, 0x64E6, 0x74C7, 0x44A4, 0x5485, 0xA56A, 0xB54B, 0x8528, 0x9509, 0xE5EE, 0xF5CF, 0xC5AC, 0xD58D, 0x3653, 0x2672, 0x1611, 0x0630, 0x76D7, 0x66F6, 0x5695, 0x46B4, 0xB75B, 0xA77A, 0x9719, 0x8738, 0xF7DF, 0xE7FE, 0xD79D, 0xC7BC, 0x48C4, 0x58E5, 0x6886, 0x78A7, 0x0840, 0x1861, 0x2802, 0x3823, 0xC9CC, 0xD9ED, 0xE98E, 0xF9AF, 0x8948, 0x9969, 0xA90A, 0xB92B, 0x5AF5, 0x4AD4, 0x7AB7, 0x6A96, 0x1A71, 0x0A50, 0x3A33, 0x2A12, 0xDBFD, 0xCBDC, 0xFBBF, 0xEB9E, 0x9B79, 0x8B58, 0xBB3B, 0xAB1A, 0x6CA6, 0x7C87, 0x4CE4, 0x5CC5, 0x2C22, 0x3C03, 0x0C60, 0x1C41, 0xEDAE, 0xFD8F, 0xCDEC, 0xDDCD, 0xAD2A, 0xBD0B, 0x8D68, 0x9D49, 0x7E97, 0x6EB6, 0x5ED5, 0x4EF4, 0x3E13, 0x2E32, 0x1E51, 0x0E70, 0xFF9F, 0xEFBE, 0xDFDD, 0xCFFC, 0xBF1B, 0xAF3A, 0x9F59, 0x8F78, 0x9188, 0x81A9, 0xB1CA, 0xA1EB, 0xD10C, 0xC12D, 0xF14E, 0xE16F, 0x1080, 0x00A1, 0x30C2, 0x20E3, 0x5004, 0x4025, 0x7046, 0x6067, 0x83B9, 0x9398, 0xA3FB, 0xB3DA, 0xC33D, 0xD31C, 0xE37F, 0xF35E, 0x02B1, 0x1290, 0x22F3, 0x32D2, 0x4235, 0x5214, 0x6277, 0x7256, 0xB5EA, 0xA5CB, 0x95A8, 0x8589, 0xF56E, 0xE54F, 0xD52C, 0xC50D, 0x34E2, 0x24C3, 0x14A0, 0x0481, 0x7466, 0x6447, 0x5424, 0x4405, 0xA7DB, 0xB7FA, 0x8799, 0x97B8, 0xE75F, 0xF77E, 0xC71D, 0xD73C, 0x26D3, 0x36F2, 0x0691, 0x16B0, 0x6657, 0x7676, 0x4615, 0x5634, 0xD94C, 0xC96D, 0xF90E, 0xE92F, 0x99C8, 0x89E9, 0xB98A, 0xA9AB, 0x5844, 0x4865, 0x7806, 0x6827, 0x18C0, 0x08E1, 0x3882, 0x28A3, 0xCB7D, 0xDB5C, 0xEB3F, 0xFB1E, 0x8BF9, 0x9BD8, 0xABBB, 0xBB9A, 0x4A75, 0x5A54, 0x6A37, 0x7A16, 0x0AF1, 0x1AD0, 0x2AB3, 0x3A92, 0xFD2E, 0xED0F, 0xDD6C, 0xCD4D, 0xBDAA, 0xAD8B, 0x9DE8, 0x8DC9, 0x7C26, 0x6C07, 0x5C64, 0x4C45, 0x3CA2, 0x2C83, 0x1CE0, 0x0CC1, 0xEF1F, 0xFF3E, 0xCF5D, 0xDF7C, 0xAF9B, 0xBFBA, 0x8FD9, 0x9FF8, 0x6E17, 0x7E36, 0x4E55, 0x5E74, 0x2E93, 0x3EB2, 0x0ED1, 0x1EF0); # This defines an array used in the CRC.
my $string = $_[0]; # Sets $string to the first argument.
my $value = 0xFFFF; # Initializes $value to 0xFFFF;
foreach my $character (split (//, $string)) # Sets it to go through each byte in $string in order.
{
my $charValue = unpack ("C", $character); # $charValue equals the bytes value, interpreted as as unsigned byte.
$charValue ^= ($value & 0xFFFF) >> 8; # ^= is like +=, but doing XOR instead of addition.
my $temp = ($value & 0xFF) << 8;
$value = $multiplyTable[$charValue]; # $value equals entry $charValue in array @multiplyTable, defined at the start of this function
$value ^= $temp;
}
return $value; # hope that that is clear.
}
#------------------------------------------------------------
# Сама программа
@ARGV > 1 or die "Необходимо ввести как минимум 2 аргумента!\n";
%args = (
o => '', # Открыть
i => '', # Импорт (только значения)
I => '', # Импорт (полный)
e => '', # Экспорт
c => 0, # Проверять?
s => '', # === # переглюк gedit, Сохранить в tbl
);
my $i=0;
foreach (@ARGV) {
my $t=join '',keys(%args);
if (/^-([$t])$/) {
if (/^-c$/) { $args{c}=1 }
elsif (defined ($ARGV[$i+1])) { $args{$1}=$ARGV[$i+1] }
}
$i++;
}
if ($args{o}) { LoadTbl $args{o} }
if ($args{I}) {
if (not $args{o}) {
Import $args{I};
Rebuild;
}
else { die "Нельзя использовать одновременно создание из файла и открытие\n" }
}
if ($args{i}) {
if ($args{o} or $args{I}) {
ImportLite $args{i};
RebuildLite;
}
else { die "Невозможно подгрузить строки, если не задан основной файл, используйте -o или -I\n" }
}
if ($args{o} or $args{I}) {
if ($args{c}) { CheckData }
if ($args{e}) { Export $args{e} }
if ($args{s}) { Save $args{s} }
}