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
|
#!/usr/bin/perl -w
#
# $Id$
#
# Script to generate JSON files with descriptions of each list and group.
#
# We generate two files:
# groups.json -- contains information about list groups
# lists.json -- contains information about lists
#
# NOTE: groups.json contains the groups indexed by sortkey. This is
# a kluge to support sorting in PHP with ksort(); apparently it's not
# possible to specify a comparison callback in PHP.
use warnings;
use strict;
use DBI;
use JSON;
my ($group, $list);
parse_config();
$group = "$ENV{'ARCHIVES_TEMPLATES'}/groups.json";
$list = "$ENV{'ARCHIVES_TEMPLATES'}/lists.json";
my ($conninfo, $conn);
$conninfo = sprintf("db=%s;host=%s;sslmode=require", $ENV{'DBNAME'}, $ENV{'DBHOST'});
$conn = DBI->connect("dbi:Pg:$conninfo", $ENV{'DBUSER'}, '', {AutoCommit => 0})
or die "cannot connect";
my (%groups, %lists);
my $query = "SELECT lg.id AS groupid, lg.groupname AS groupname, sortkey
FROM lists_mailinglistgroup lg";
my $sth = $conn->prepare($query);
$sth->execute;
while (my $h = $sth->fetchrow_hashref) {
$groups{$h->{'sortkey'}} = {
id => $h->{'groupid'},
name => $h->{'groupname'}
};
}
$query = "SELECT lg.id AS groupid, lg.sortkey, l.listname, l.shortdesc,
l.description
FROM lists_mailinglistgroup lg JOIN lists_mailinglist l ON (lg.id = l.group_id)
ORDER BY sortkey, l.listname";
$sth = $conn->prepare($query);
$sth->execute;
while (my $h = $sth->fetchrow_hashref) {
push @{$groups{$h->{'sortkey'}}->{'lists'}}, $h->{'listname'};
$lists{$h->{'listname'}} = {
description => $h->{'description'},
shortdesc => $h->{'shortdesc'},
group => $h->{'groupid'}
};
}
my $json = new JSON;
writefile($group, \%groups);
writefile($list, \%lists);
$conn->disconnect;
sub writefile {
my $filename = shift;
my $data = shift;
my $tmpfile = "$filename.new";
if (open TMPOUT, ">", $tmpfile) {
print TMPOUT $json->encode($data);
close TMPOUT;
rename $tmpfile, $filename;
}
}
# parse config file
sub parse_config {
open CONF, "<", "$ENV{'HOME'}/etc/archives.conf"
or die "cannot parse config file: $!";
while (<CONF>) {
$_ = $1 if m/(.*)#/; # strip comments
next if m/^$/; # skip empty lines
next if (!m/([A-Z_]+)=(.*)\s*$/); # only lines like FOO=bar
# poor man's shell variable evaluation
my $key = $1;
my $val = $2;
if ($val =~ /(.*)\$([[:alnum:]_]+)(.*)/) {
$val = "$1$ENV{$2}$3";
}
$ENV{$key} = $val;
}
close CONF;
}
|
