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
|
#! /usr/bin/tclsh
#
# This file is part of SAUCE, a very picky anti-spam receiver-SMTP.
# SAUCE is Copyright (C) 1997-2003 Ian Jackson
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2, or (at your option)
# any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software Foundation,
# Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
#
# $Id: convertdb.in,v 1.3 2006/04/02 18:30:36 ian Exp $
load chiark_tcl_cdb-1.so
if {[llength $argv] < 2} {
error "usage .../convertdb outfile timeadj infiles..."
}
set outfn [lindex $argv 0]
set timeadj [lindex $argv 1]
proc on_info {args} {
puts [concat on_info $args]
}
if {[file exists $outfn]} { error "wrong argument order" }
cdb-wr create-empty $outfn
set out [cdb-wr open $outfn on_info]
cdb-wr compact-explicit $out
foreach infn [lrange $argv 2 end] {
set in [open $infn r]
puts "reading $infn"
fconfigure $in -translation lf -encoding binary
set lno 0
while {[gets $in l] >= 0} {
incr lno
if {![regexp {^\:.*\;$} $l]} {
puts stderr "warning: $infn:$l: incomplete record"
continue
}
if {![regexp {^\:([^ ]+) ([^{}\\]+)\;} $l dummy key value]} {
error "error: $infn:$l: bad record"
}
if {[string length $timeadj]} {
set newvalue {}
foreach {time eachvalue} $value {
incr time $timeadj
set time [format 0x%016x $time]
set newvalue [lreplace $newvalue 0 -1 $time $eachvalue]
}
set value $newvalue
}
cdb-wr update $out $key $value
}
}
puts "finalising"
cdb-wr compact-force $out
puts "closing"
cdb-wr close $out
|
