Skip to content

HTTPS clone URL

Subversion checkout URL

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