Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Newer
Older
100755 453 lines (385 sloc) 16.247 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 i…
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 countr…
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 i…
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 i…
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()');
7537d69 @szabgab Experimental: add social networks
szabgab authored
132 my $linkedin = $g->findvalue('linkedin/text()');
133 my $googleplus = $g->findvalue('googleplus/text()');
134 my $facebook = $g->findvalue('facebook/text()');
135 my $twitter = $g->findvalue('twitter/text()');
474f762 @szabgab add meetup to NY.pm
szabgab authored
136 my $meetup = $g->findvalue('meetup/text()');
4a947ec @ranguard Perltidy bin/xml
ranguard authored
137
138 my @tsar;
139 foreach my $t ( $g->findnodes('tsar') ) {
140 my $tsar = $t->findvalue('name/text()');
141 my $tsaremail = $t->findvalue('email/user/text()');
142
143 #$tsaremail .= ' <' . int(rand(100)) . '> ';
144 $tsaremail .= ' <replace me by @> ';
145 $tsaremail .= $t->findvalue('email/domain/text()');
146 push @tsar, { name => $tsar, mail => $tsaremail };
147 }
148
149 my $mailing_lists_name = $g->findvalue('mailing_list/name/text()');
150
151 # if ($mailing_lists_name) { print STDERR "M $mailing_lists_name\n" }
152
153 die "Duplicate group id $id\n" if $ids{$id}++;
154
155 next unless $status eq 'active';
156 die "$name has no id\n" unless defined $id;
157
158 unless ($continent) {
159 warn "$name has no continent. Assuming Non-geographical.\n";
160 $continent = 'Non-geographical';
161 }
162 unless ($country) {
163 warn "$name has no country. Assuming Non-geographical.\n";
164 $country = 'Non-geographical';
165 }
166
167 # joined up city, state, region, country, continent
168 my $location = join ', ',
169 grep {$_} ( $city, $state, $region, $country, $continent );
170
171 my $linked_location = join ', ', grep {$_} ( $city, $state, $region );
172 if ( $country and $country ne 'Non-geographical' ) {
173 my $country_link = lc $country;
174 $country_link =~ s/\W/_/g;
175 $linked_location .= qq(, <a href="$country_link.html">$country</a>);
176 }
177 if ($continent) {
178 my $continent_link
179 = $continent eq 'Non-geographical'
180 ? 'non_geographical'
181 : lc($continent);
182 $continent_link =~ s/ /_/;
183 $linked_location
184 .= qq(, <a href="$continent_link.html">$continent</a>);
185 }
186
187 #$tsaremail =~ s/@/ at /g;
188
189 my $group = {
190 continent => $continent,
191 id => $id,
192 location => $location,
193 linked_location => $linked_location,
194 longitude => $longitude,
195 latitude => $latitude,
8d6bccc @ranguard Sort out the group pages (also don't need to zoom in quite so much)
ranguard authored
196 zoom => 11,
4a947ec @ranguard Perltidy bin/xml
ranguard authored
197 name => $name,
198 tsar => \@tsar,
199 state => $state,
200 status => $status,
201 web => $web,
202 mailing_list => { name => $mailing_lists_name, },
7537d69 @szabgab Experimental: add social networks
szabgab authored
203 linkedin => $linkedin,
204 googleplus => $googleplus,
205 facebook => $facebook,
206 twitter => $twitter,
474f762 @szabgab add meetup to NY.pm
szabgab authored
207 meetup => $meetup,
4a947ec @ranguard Perltidy bin/xml
ranguard authored
208 };
209 $allgroups{$name} = $group;
210
211 if ( $country eq 'United States of America' ) {
212 push @{ $groups{$continent}{$country}{$state} }, $group;
213 } else {
214 push @{ $groups{$continent}{$country} }, $group;
215 }
216
217 unless ( -f "www/groups/$id.html" ) {
218 $group->{description}
219 = "Perl Mongers $location is the Perl users group that organizes meetings";
220
221 #print "PROCESS group: www/groups/$id.html\n";
222 $tt->process(
223 'src/groups/group.html', $group,
224 "www/groups/$id.html", binmode => ':utf8'
225 ) || die $tt->error();
226 }
c95990b Initial revision
leon authored
227 }
228
4a947ec @ranguard Perltidy bin/xml
ranguard authored
229 copy( './perl_mongers.xml', 'www/groups/perl_mongers.xml' );
230 copy( './perl_mongers.dtd', 'www/groups/perl_mongers.dtd' );
0c8d262 Minor updates
leon authored
231
4a947ec @ranguard Perltidy bin/xml
ranguard authored
232 my @continents = (
233 'Africa', 'Asia',
234 'Europe', 'North America',
235 'Central America', 'South America',
236 'Oceania', 'Non-geographical'
237 );
442e909 New central america, cope with empty continents, lv update
leon authored
238
239 foreach my $continent (@continents) {
4a947ec @ranguard Perltidy bin/xml
ranguard authored
240 my $name = lc $continent;
241 $name =~ s/\W/_/g;
242 my $file = "www/groups/$name.html";
243 my $groups;
244 my %country_links;
245 my %states;
246 foreach my $country ( sort keys %{ $groups{$continent} } ) {
247 if ( $country eq 'United States of America' ) {
248 foreach my $state ( keys %{ $groups{$continent}{$country} } ) {
249 $groups->{$country}{$state}
250 = [ sort { lc $a->{name} cmp lc $b->{name} }
251 @{ $groups{$continent}{$country}{$state} } ];
252 $states{$state} = 'usa_' . lc $state;
253 $states{$state} =~ s/\W/_/g;
254 $states{$state} .= '.html';
255
256 #warn "WARN: Missing map_coordinates for $country" if not $map_coordinates{$country};
257 my $conf = {
258 groups => $groups->{$country}{$state},
259 country => $state,
260 continent => $continent,
261 continent_link => "$name.html",
262 longitude => $map_coordinates{$country}[0],
263 latitude => $map_coordinates{$country}[1],
264 zoom => $map_coordinates{$country}[2],
265
266 #states => \%states,
267 };
268 $conf->{description}
269 = "Perl Mongers in $state are the Perl users groups that organize meetings";
270
271 #print "PROCESS US state: www/groups/$states{$state}\n";
272 $tt->process(
273 'src/groups/country.html', $conf,
274 "www/groups/$states{$state}", binmode => ':utf8'
275 ) || die $tt->error();
276 }
277 } else {
278 $groups->{$country} = [ sort { lc $a->{name} cmp lc $b->{name} }
279 @{ $groups{$continent}{$country} } ];
280 }
281 my $country_file = lc $country;
282 $country_file =~ s/\W/_/g;
283 $country_links{$country} = "$country_file.html";
284 $country_file = "www/groups/$country_file.html";
285 warn "WARN: Missing map_coordinates for $country"
286 if not $map_coordinates{$country};
287 my $conf = {
288 groups => $groups->{$country},
289 country => $country,
290
291 #country_file => $country_file,
292 continent => $continent,
293 continent_link => "$name.html",
294 longitude => $map_coordinates{$country}[0],
295 latitude => $map_coordinates{$country}[1],
296 zoom => $map_coordinates{$country}[2],
297 states => \%states,
298 };
299 $conf->{description}
300 = "Perl Mongers in $country are the Perl users groups that organize meetings";
301
302 #print "PROCESS country: $country_file\n";
303 $tt->process( 'src/groups/country.html', $conf, $country_file,
304 binmode => ':utf8' )
305 || die $tt->error();
306 }
307
308 warn "WARN: Missing map_coordinates for $name"
309 if not $map_coordinates{$name};
310 my $conf = {
311 country_links => \%country_links,
312 groups => $groups,
313 continent => $continent,
314 longitude => $map_coordinates{$name}[0],
315 latitude => $map_coordinates{$name}[1],
316 zoom => $map_coordinates{$name}[2],
317 states => \%states,
318 };
319
320 $conf->{description}
321 = "Perl Mongers in $continent are the Perl users groups that organize meetings";
322
323 #print "PROCESS continent: $file\n";
324 $tt->process( 'src/groups/continent.html', $conf, $file,
325 binmode => ':utf8' )
326 || die $tt->error();
afe34ff Fill up groups
leon authored
327 }
0c8d262 Minor updates
leon authored
328
7951a9c list of all the active groups on the groups/index.html page
gabor authored
329 {
0631326 @ranguard Write out a JSON file for the map data (less faff)
ranguard authored
330 # just want a list
331 my @allgroups = values %allgroups;
332
333 # Get the perl_monger data as json, makes the map stuff easier
334 my $j = JSON->new->utf8;
335 my $json = $j->pretty->encode( \@allgroups );
336 write_file( 'www/groups/perl_mongers.json', $json );
337
338 }
339
340 {
4a947ec @ranguard Perltidy bin/xml
ranguard authored
341 my $source = 'src';
342 my $destination = 'www';
343 my $parms = {
344 allgroups => \%allgroups,
345 allgroupsnum => scalar( keys %allgroups ),
346 };
347
348 my $rule = File::Find::Rule->new;
349 $rule->or(
350 $rule->new->file->name(qr/.swp$/)->prune->discard,
351 $rule->new->directory->name('census')->prune->discard,
352 $rule->new
353 );
354 my @files = $rule->file()->name(qr/^.[^~]+$/)->in($source);
355
356 foreach my $file (@files) {
357 next if $file =~ /country.html$/;
358 next if $file =~ /group.html$/;
359 next if $file =~ /continent.html$/;
360
361 print STDERR $file, "\n";
362
363 my $destfile = $file;
364 $destfile =~ s/^$source/$destination/;
365 my ( $volume, $directories, $filepart ) = splitpath($destfile);
366 mkpath $directories;
367 warn "$file -> $destfile\n";
368
e91971d @ranguard Start implimenting in real src/
ranguard authored
369 if ( $file =~ /\.png$/ || $file =~ /\.jpg$/ ) {
4a947ec @ranguard Perltidy bin/xml
ranguard authored
370 copy( $file, $destfile );
371 } else {
372 $parms->{description}
373 = "Perl Mongers organise local Perl user groups and meetings";
374
375 #print "PROCESS: $destfile\n";
376 $tt->process( $file, $parms, $destfile, binmode => ':utf8' )
377 || die $tt->error;
378 }
379 }
7951a9c list of all the active groups on the groups/index.html page
gabor authored
380 }
94bb3e8 New world and continent maps, with colours
leon authored
381
c95990b Initial revision
leon authored
382 __END__
4a947ec @ranguard Perltidy bin/xml
ranguard authored
383
c95990b Initial revision
leon authored
384 =head1 NAME
385
386 draw.pl - draw the master copies of the Perl Monger World Maps
387
388 =head1 SYNOPSIS
389
390 draw.pl [-huge]
391
392 =head1 DESCRIPTION
393
394 This uses the two large earth.png, earth-small.png, and the Perl Monger
395 Group XML file, perl_mongers.xml. It takes the longitude and latitude
396 location information contained in the XML file and produces one of
397 two image files: mongers.png and mongers-small.png.
398
399 It also outputs a list of all the groups which do not current have
400 location information.
401
402 =head1 AUTHOR
403
404 Leon Brocard, leon@astray.com
405
406 =cut
407
408 __END__
409 Example data structure for a group:
410
411 $VAR1 = {
412 'location' => {
413 'state' => {},
414 'country' => 'Ireland',
415 'latitude' => '52.664',
416 'region' => {},
417 'city' => 'Limerick',
418 'longitude' => '-8.623',
419 'continent' => 'Europe'
420 },
421 'web' => {},
422 'tsar' => {
423 'email' => {
424 'content' => 'foranp@tinet.ie',
425 'type' => 'personal'
426 },
427 'name' => 'Paul Foran'
428 },
429 'date' => {
430 'content' => '19990214',
431 'type' => 'inception'
432 },
433 'id' => '134',
434 'mailing-list' => {
435 'subscribe' => 'subscribe limerick-pm-list email_address',
436 'unsubscribe' => 'unsubscribe limerick-pm-list email_address',
437 'email' => [
438 {
439 'content' => 'limerick-pm-list@pm.org',
440 'type' => 'list'
441 },
442 {
443 'content' => 'majordomo@pm.org',
444 'type' => 'list_admin'
445 }
446 ],
447 'name' => 'General Limerick.pm discussion'
448 },
449 'email' => {
450 'type' => 'group'
451 }
452 };
Something went wrong with that request. Please try again.