-
Notifications
You must be signed in to change notification settings - Fork 0
/
json2storable_db.pl
52 lines (36 loc) · 1.2 KB
/
json2storable_db.pl
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
#!/usr/bin/perl
# Convert the JSON encoded values to Storable values.
# Usage:
# perl zstd_db.pl [old.db] [new.db]
use 5.014;
use strict;
use warnings;
use JSON::XS qw(decode_json);
use IO::Compress::Zstd qw(zstd);
use IO::Uncompress::UnZstd qw(unzstd);
use Storable qw(freeze);
my $old_db = $ARGV[0];
my $new_db = $ARGV[1] // 'new-with-storable.db';
if (not defined($old_db) or not -f $old_db) {
die "usage: $0 [old db] [new db]\n";
}
if (not defined($new_db) or -e $new_db) {
die "File <<$new_db>> already exists!\n";
}
use GDBM_File;
tie(my %OLD_DB, 'GDBM_File', $old_db, &GDBM_READER, 0777)
or die "Can't access database <<$old_db>>: $!";
tie(my %NEW_DB, 'GDBM_File', $new_db, &GDBM_WRCREAT, 0777)
or die "Can't create database <<$new_db>>: $!";
while (my ($key, $value) = each %OLD_DB) {
if (defined($value)) {
unzstd(\$value, \my $json_data)
or die "unzstd failed: $IO::Uncompress::UnZstd::UnZstdError\n";
my $serialized = freeze(eval { decode_json($json_data) } // next);
zstd(\$serialized, \my $zstd_data)
or die "zstd failed: $IO::Compress::Zstd::ZstdError\n";
$NEW_DB{$key} = $zstd_data;
}
}
untie(%OLD_DB);
untie(%NEW_DB);