Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Newer
Older
100644 366 lines (309 sloc) 11.055 kB
74918ac Changed shebang
dave authored
1 #!/usr/bin/perl -w
c95990b Initial revision
leon authored
2
3 use strict;
7033e16 fix e-mail addresses of multiple tsars
gabor authored
4 use Data::Dumper qw(Dumper);
646eb55 move code from bin/build to bin/xml
gabor authored
5 use File::Copy qw(copy);
6 use File::Find::Rule;
7 use File::Path qw(mkpath);
8 use File::Spec::Functions qw(splitpath);
c95990b Initial revision
leon authored
9 use Template;
7b6dfbf Use XML::LibXML instead of XML::Simple so that entities work and it i…
leon authored
10 use XML::LibXML;
c95990b Initial revision
leon authored
11
93f798f Tidied bin/xml.
dave authored
12 my $src_file = shift || './perl_mongers.xml';
13
e813b83 Updates
leon authored
14 my %ids;
15
c95990b Initial revision
leon authored
16 $| = 1;
17
ee341a4 fix function name embedding, adding some unused coordinates
gabor authored
18
f70ec7b add coordinates to perl script and embed them in continent and countr…
gabor authored
19 # longitude, latitude, zoom
ee341a4 fix function name embedding, adding some unused coordinates
gabor authored
20 my %map_coordinates = (
f70ec7b add coordinates to perl script and embed them in continent and countr…
gabor authored
21 africa => [20, -1, 3],
22 asia => [95, 45, 2],
23 central_america => [-76, 9, 3],
24 europe => [15.029297, 49.61071, 3],
25 north_america => [-90, 40, 3],
26 oceania => [134.296875, -25.641526, 3],
27 south_america => [-63.63, -20.00, 3],
28 non_geographical => [0, 0, 1],
29
30 'South Africa' => [20, -1, 3],
31 Uganda => [20, -1, 3],
32
33 Armenia => [95, 45, 2],
34 China => [95, 45, 2],
35 India => [95, 45, 2],
36 Indonesia => [95, 45, 2],
37 Israel => [95, 45, 2],
38 Japan => [95, 45, 2],
39 'Korea (Republic of)' => [95, 45, 2],
40 Malaysia => [95, 45, 2],
41 Qatar => [95, 45, 2],
42 Russia => [95, 45, 2],
43 Singapore => [95, 45, 2],
44 Taiwan => [95, 45, 2],
45 Turkey => [95, 45, 2],
46
47 Austria => [15.029297, 49.61071, 3],
48 Belgium => [15.029297, 49.61071, 3],
49 Bulgaria => [15.029297, 49.61071, 3],
50 Denmark => [15.029297, 49.61071, 3],
51 Estonia => [15.029297, 49.61071, 3],
52 Finland => [15.029297, 49.61071, 3],
53 France => [15.029297, 49.61071, 3],
54 Germany => [15.029297, 49.61071, 3],
55 'Hrvatska (Croatia)' => [15.029297, 49.61071, 3],
56 Hungary => [15.029297, 49.61071, 3],
57 Ireland => [15.029297, 49.61071, 3],
58 Italy => [15.029297, 49.61071, 3],
59 'Moldova, Republic of' => [15.029297, 49.61071, 3],
60 Netherlands => [15.029297, 49.61071, 3],
61 Norway => [15.029297, 49.61071, 3],
62 Poland => [15.029297, 49.61071, 3],
63 Portugal => [15.029297, 49.61071, 3],
64 Romania => [15.029297, 49.61071, 3],
65 'Russian Federation' => [15.029297, 49.61071, 3],
66 'Slovak Republic' => [15.029297, 49.61071, 3],
67 Spain => [15.029297, 49.61071, 3],
68 Sweden => [15.029297, 49.61071, 3],
69 Switzerland => [15.029297, 49.61071, 3],
70 'The Republic of Belarus' => [15.029297, 49.61071, 3],
71 Ukraine => [15.029297, 49.61071, 3],
72 'United Kingdom' => [15.029297, 49.61071, 3],
73 Yugoslavia => [15.029297, 49.61071, 3],
74
75 Canada => [-90, 40, 3],
76 USA => [-90, 40, 3],
77 'United States of America' => [-90, 40, 3],
78
79 'Costa Rica' => [-76, 9, 3],
80
81 Argentina => [-63.63, -20.00, 3],
82 Brazil => [-63.63, -20.00, 3],
83 Chile => [-63.63, -20.00, 3],
84 Colombia => [-63.63, -20.00, 3],
85 Ecuador => [-63.63, -20.00, 3],
86 Paraguay => [-63.63, -20.00, 3],
87 Peru => [-63.63, -20.00, 3],
88 Venezuela => [-63.63, -20.00, 3],
89
90 'Australia' => [134.296875, -25.641526, 3],
91 'New Zealand' => [134.296875, -25.641526, 3],
92
93 'Non-geographical' => [0, 0, 1],
ee341a4 fix function name embedding, adding some unused coordinates
gabor authored
94 );
95
96
97
c95990b Initial revision
leon authored
98 my $tt = Template->new({
9e48f4f Added lib/macros to PRE_PROCESS option
davorg authored
99 PRE_PROCESS => [ 'lib/macros' ],
93f798f Tidied bin/xml.
dave authored
100 POST_CHOMP => 1,
101 PRE_CHOMP => 1,
102 TRIM => 1,
103 EVAL_PERL => 1 ,
104 INCLUDE_PATH => ['.', 'lib', 'src'],
733daef Using WRAPPER instead of PROCESS
davorg authored
105 # PROCESS => 'layout',
aa4b19c indentation change
gabor authored
106 });
c95990b Initial revision
leon authored
107
7b6dfbf Use XML::LibXML instead of XML::Simple so that entities work and it i…
leon authored
108 my %allgroups;
109
afe34ff Fill up groups
leon authored
110 # Array containing all the group names order by continent
111 my %groups;
59d03b2 List US groups by state.
dave authored
112 mkdir 'www/groups/graphics';
c95990b Initial revision
leon authored
113
7b6dfbf Use XML::LibXML instead of XML::Simple so that entities work and it i…
leon authored
114 my $xml = XML::LibXML->new();
93f798f Tidied bin/xml.
dave authored
115 my $doc = $xml->parse_file($src_file);
59d03b2 List US groups by state.
dave authored
116 foreach my $g ($doc->findnodes('//group')) {
aa4b19c indentation change
gabor authored
117 my $id = $g->getAttribute('id');
118 my $status = $g->getAttribute('status') || 'not-specified-in-xml-file';
119 my $name = $g->findvalue('name/text()');
120 my $city = $g->findvalue('location/city/text()');
121 my $state = $g->findvalue('location/state/text()');
122 my $region = $g->findvalue('location/region/text()');
123 my $country = $g->findvalue('location/country/text()');
124 my $continent = $g->findvalue('location/continent/text()');
125 my $longitude = $g->findvalue('location/longitude/text()');
126 my $latitude = $g->findvalue('location/latitude/text()');
127 my $web = $g->findvalue('web/text()');
128
129 my @tsar;
130 foreach my $t ($g->findnodes('tsar')) {
131 my $tsar = $t->findvalue('name/text()');
132 my $tsaremail = $t->findvalue('email/user/text()');
133 #$tsaremail .= ' <' . int(rand(100)) . '> ';
134 $tsaremail .= ' <replace me by @> ';
135 $tsaremail .= $t->findvalue('email/domain/text()');
136 push @tsar, { name => $tsar, mail => $tsaremail };
137 }
138
139
140 my $mailing_lists_name = $g->findvalue('mailing_list/name/text()');
141 # if ($mailing_lists_name) { print STDERR "M $mailing_lists_name\n" }
142
143 die "Duplicate group id $id\n" if $ids{$id}++;
144
145 next unless $status eq 'active';
146 die "$name has no id\n" unless defined $id;
a0258cf Hard coded-list of non-geographics removed.
jhannah authored
147
aa4b19c indentation change
gabor authored
148 unless ($continent) {
149 warn "$name has no continent. Assuming Non-geographical.\n";
150 $continent = 'Non-geographical';
151 }
152 unless ($country) {
153 warn "$name has no country. Assuming Non-geographical.\n";
154 $country = 'Non-geographical';
155 }
156
157 # joined up city, state, region, country, continent
158 my $location = join ', ', grep { $_ }
159 ($city, $state, $region, $country, $continent);
160
161 my $linked_location = join ', ', grep { $_ }
f4d09fd add pages for each country and add links to them
gabor authored
162 ($city, $state, $region);
163 if ($country and $country ne 'Non-geographical') {
164 my $country_link = lc $country;
165 $country_link =~ s/\W/_/g;
166 $linked_location .= qq(, <a href="$country_link.html">$country</a>);
167 }
aa4b19c indentation change
gabor authored
168 if ($continent) {
169 my $continent_link = $continent eq 'Non-geographical' ? 'non_geographical' : lc($continent);
170 $continent_link =~ s/ /_/;
171 $linked_location .= qq(, <a href="$continent_link.html">$continent</a>);
172 }
173 #$tsaremail =~ s/@/ at /g;
174
175 my $group = {
176 continent => $continent,
177 id => $id,
178 location => $location,
179 linked_location => $linked_location,
180 longitude => $longitude,
f70ec7b add coordinates to perl script and embed them in continent and countr…
gabor authored
181 latitude => $latitude,
182 zoom => 13,
aa4b19c indentation change
gabor authored
183 name => $name,
184 tsar => \@tsar,
185 state => $state,
186 status => $status,
187 web => $web,
188 mailing_list => {
189 name => $mailing_lists_name,
190 },
191 };
192 $allgroups{$name} = $group;
193
194 if ($country eq 'United States of America') {
195 push @{$groups{$continent}{$country}{$state}}, $group;
196 } else {
197 push @{$groups{$continent}{$country}}, $group;
198 }
199
200 unless (-f "www/groups/$id.html") {
201 $tt->process('src/groups/group.html', $group, "www/groups/$id.html")
202 || die $tt->error();
203 }
c95990b Initial revision
leon authored
204 }
205
59d03b2 List US groups by state.
dave authored
206 copy('./perl_mongers.xml', 'www/groups/perl_mongers.xml');
207 copy('./perl_mongers.dtd', 'www/groups/perl_mongers.dtd');
0c8d262 Minor updates
leon authored
208
93f798f Tidied bin/xml.
dave authored
209 my @continents = ('Africa', 'Asia', 'Europe', 'North America',
aa4b19c indentation change
gabor authored
210 'Central America', 'South America', 'Oceania',
211 'Non-geographical');
442e909 New central america, cope with empty continents, lv update
leon authored
212
213 foreach my $continent (@continents) {
aa4b19c indentation change
gabor authored
214 my $name = lc $continent;
215 $name =~ s/\W/_/g;
216 my $file = "www/groups/$name.html";
217 my $groups;
218 foreach my $country (sort keys %{$groups{$continent}}) {
219 if ($country eq 'United States of America') {
220 foreach my $state (keys %{$groups{$continent}{$country}}) {
221 $groups->{$country}{$state} = [
222 sort { lc $a->{name} cmp lc $b->{name} }
59d03b2 List US groups by state.
dave authored
223 @{$groups{$continent}{$country}{$state}} ];
aa4b19c indentation change
gabor authored
224 }
225 } else {
226 $groups->{$country} = [
227 sort { lc $a->{name} cmp lc $b->{name} }
228 @{$groups{$continent}{$country}} ];
229 }
f4d09fd add pages for each country and add links to them
gabor authored
230
231 my $country_file = lc $country;
232 $country_file =~ s/\W/_/g;
233 $country_file = "www/groups/$country_file.html";
f70ec7b add coordinates to perl script and embed them in continent and countr…
gabor authored
234 warn "WARN: Missing map_coordinates for $country" if not $map_coordinates{$country};
f4d09fd add pages for each country and add links to them
gabor authored
235 my $conf = {
236 groups => $groups->{$country},
237 country => $country,
238 #country_file => $country_file,
239 continent => $continent,
240 continent_link => "$name.html",
f70ec7b add coordinates to perl script and embed them in continent and countr…
gabor authored
241 longitude => $map_coordinates{$country}[0],
242 latitude => $map_coordinates{$country}[1],
243 zoom => $map_coordinates{$country}[2],
f4d09fd add pages for each country and add links to them
gabor authored
244 };
245 $tt->process('src/groups/country.html', $conf, $country_file) || die $tt->error();
aa4b19c indentation change
gabor authored
246 }
247
f70ec7b add coordinates to perl script and embed them in continent and countr…
gabor authored
248 warn "WARN: Missing map_coordinates for $name" if not $map_coordinates{$name};
aa4b19c indentation change
gabor authored
249 my $conf = {
250 groups => $groups,
251 continent => $continent,
f70ec7b add coordinates to perl script and embed them in continent and countr…
gabor authored
252 longitude => $map_coordinates{$name}[0],
253 latitude => $map_coordinates{$name}[1],
254 zoom => $map_coordinates{$name}[2],
aa4b19c indentation change
gabor authored
255 };
256
257 $tt->process('src/groups/continent.html', $conf, $file) || die $tt->error();
afe34ff Fill up groups
leon authored
258 }
0c8d262 Minor updates
leon authored
259
7951a9c list of all the active groups on the groups/index.html page
gabor authored
260 {
646eb55 move code from bin/build to bin/xml
gabor authored
261 my $source = 'src';
262 my $destination = 'www';
263 my $parms = {
264 allgroups => \%allgroups,
265 allgroupsnum => scalar(keys %allgroups),
266 };
267
268 my $rule = File::Find::Rule->new;
269 $rule->or(
270 $rule->new->directory->name('.svn')->prune->discard,
66e9382 include link from individual group pages to continent
gabor authored
271 $rule->new->file->name(qr/.swp$/)->prune->discard,
646eb55 move code from bin/build to bin/xml
gabor authored
272 $rule->new->directory->name('census')->prune->discard,
273 $rule->new
274 );
275 my @files = $rule->file()->name(qr/^.[^~]+$/)->in($source);
276
277 foreach my $file (@files) {
278 print STDERR $file, "\n";
279
280 my $destfile = $file;
281 $destfile =~ s/^$source/$destination/;
282 my($volume, $directories, $filepart) = splitpath($destfile);
283 mkpath $directories;
284 warn "$file -> $destfile\n";
285
286 if ($file =~ /\.png$/) {
287 copy($file, $destfile);
288 } else {
289 $tt->process($file, $parms, $destfile) || die $tt->error;
290 }
291 }
7951a9c list of all the active groups on the groups/index.html page
gabor authored
292 }
94bb3e8 New world and continent maps, with colours
leon authored
293
646eb55 move code from bin/build to bin/xml
gabor authored
294
295
c95990b Initial revision
leon authored
296 __END__
297 =head1 NAME
298
299 draw.pl - draw the master copies of the Perl Monger World Maps
300
301 =head1 SYNOPSIS
302
303 draw.pl [-huge]
304
305 =head1 DESCRIPTION
306
307 This uses the two large earth.png, earth-small.png, and the Perl Monger
308 Group XML file, perl_mongers.xml. It takes the longitude and latitude
309 location information contained in the XML file and produces one of
310 two image files: mongers.png and mongers-small.png.
311
312 It also outputs a list of all the groups which do not current have
313 location information.
314
315 =head1 AUTHOR
316
317 Leon Brocard, leon@astray.com
318
319 =cut
320
321 __END__
322 Example data structure for a group:
323
324 $VAR1 = {
325 'location' => {
326 'state' => {},
327 'country' => 'Ireland',
328 'latitude' => '52.664',
329 'region' => {},
330 'city' => 'Limerick',
331 'longitude' => '-8.623',
332 'continent' => 'Europe'
333 },
334 'web' => {},
335 'tsar' => {
336 'email' => {
337 'content' => 'foranp@tinet.ie',
338 'type' => 'personal'
339 },
340 'name' => 'Paul Foran'
341 },
342 'date' => {
343 'content' => '19990214',
344 'type' => 'inception'
345 },
346 'id' => '134',
347 'mailing-list' => {
348 'subscribe' => 'subscribe limerick-pm-list email_address',
349 'unsubscribe' => 'unsubscribe limerick-pm-list email_address',
350 'email' => [
351 {
352 'content' => 'limerick-pm-list@pm.org',
353 'type' => 'list'
354 },
355 {
356 'content' => 'majordomo@pm.org',
357 'type' => 'list_admin'
358 }
359 ],
360 'name' => 'General Limerick.pm discussion'
361 },
362 'email' => {
363 'type' => 'group'
364 }
365 };
Something went wrong with that request. Please try again.