Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

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