xml

#!/usr/bin/perl -w

use strict;
use Data::Dumper          qw(Dumper);
use File::Copy            qw(copy);
use File::Find::Rule;
use File::Path            qw(mkpath);
use File::Spec::Functions qw(splitpath);
use Template;
use XML::LibXML;

my $src_file = shift || './perl_mongers.xml';

my %ids;

$| = 1;

my $tt = Template->new({
			PRE_PROCESS => [ 'lib/macros' ],
			POST_CHOMP => 1,
			PRE_CHOMP => 1,
			TRIM => 1,
			EVAL_PERL => 1 ,
			INCLUDE_PATH => ['.', 'lib', 'src'],
			# PROCESS => 'layout',
		       });

my %allgroups;

# Array containing all the group names order by continent
my %groups;
mkdir 'www/groups/graphics';

my $xml = XML::LibXML->new();
my $doc = $xml->parse_file($src_file);
foreach my $g ($doc->findnodes('//group')) {
  my $id = $g->getAttribute('id');
  my $status = $g->getAttribute('status') || 'not-specified-in-xml-file';
  my $name = $g->findvalue('name/text()');
  my $city = $g->findvalue('location/city/text()');
  my $state = $g->findvalue('location/state/text()');
  my $region = $g->findvalue('location/region/text()');
  my $country = $g->findvalue('location/country/text()');
  my $continent = $g->findvalue('location/continent/text()');
  my $longitude = $g->findvalue('location/longitude/text()');
  my $latitude = $g->findvalue('location/latitude/text()');
  my $web = $g->findvalue('web/text()');

  my @tsar;
  foreach my $t ($g->findnodes('tsar')) {
    my $tsar = $t->findvalue('name/text()');
    my $tsaremail = $t->findvalue('email/user/text()');
    #$tsaremail .= ' <' . int(rand(100)) . '> ';
    $tsaremail .= ' <replace me by @> ';
    $tsaremail .= $t->findvalue('email/domain/text()');
    push @tsar, { name => $tsar, mail => $tsaremail };
  }


  my $mailing_lists_name = $g->findvalue('mailing_list/name/text()');
#  if ($mailing_lists_name) { print STDERR "M $mailing_lists_name\n" }

  die "Duplicate group id $id\n" if $ids{$id}++;

  next unless $status eq 'active';
  die "$name has no id\n" unless defined $id;
  
  unless ($continent) {
     warn "$name has no continent. Assuming Non-geographical.\n";
     $continent = 'Non-geographical';
  }
  unless ($country) {
     warn "$name has no country. Assuming Non-geographical.\n";
     $country = 'Non-geographical';
  }

  # joined up city, state, region, country, continent
  my $location = join ', ', grep { $_ }
    ($city, $state, $region, $country, $continent);

  #$tsaremail =~ s/@/ at /g;

  my $group = {
	       continent => $continent,
	       id => $id,
	       latitude => $latitude,
	       location => $location,
	       longitude => $longitude,
	       name => $name,
	       tsar => \@tsar,
	       state => $state,
	       status => $status,
	       web => $web,
	       mailing_list => {
	         name => $mailing_lists_name,
	       },
	      };
  $allgroups{$name} = $group;

  if ($country eq 'United States of America') {
    push @{$groups{$continent}{$country}{$state}}, $group;
  } else {
    push @{$groups{$continent}{$country}}, $group;
  }

  unless (-f "www/groups/$id.html") {
    $tt->process('src/groups/group.html', $group, "www/groups/$id.html")
      || die $tt->error();
  }
}

copy('./perl_mongers.xml', 'www/groups/perl_mongers.xml');
copy('./perl_mongers.dtd', 'www/groups/perl_mongers.dtd');

my @continents = ('Africa', 'Asia', 'Europe', 'North America',
		  'Central America', 'South America', 'Oceania',
		  'Non-geographical');

foreach my $continent (@continents) {
  my $name = lc $continent;
  $name =~ s/\W/_/g;
  my $file = "www/groups/$name.html";
  my $groups;
  foreach my $country (sort keys %{$groups{$continent}}) {
    if ($country eq 'United States of America') {
      foreach my $state (keys %{$groups{$continent}{$country}}) {
	$groups->{$country}{$state} = [ sort  { lc $a->{name} cmp
						  lc $b->{name} }
					@{$groups{$continent}{$country}{$state}} ];
      }
    } else {
      $groups->{$country} = [ sort { lc $a->{name} cmp lc $b->{name} }
			      @{$groups{$continent}{$country}} ];
    }
  }

  my $conf = {
	      groups => $groups,
	      continent => $continent,
	     };

  $tt->process('src/groups/continent.html', $conf, $file)
    || die $tt->error();
}

{
	my $source = 'src';
	my $destination = 'www';
	my $parms = {
		allgroups => \%allgroups,
		allgroupsnum => scalar(keys %allgroups),
	};

	my $rule = File::Find::Rule->new;
	$rule->or(
		$rule->new->directory->name('.svn')->prune->discard,
		$rule->new->directory->name('census')->prune->discard,
		$rule->new
	);
	my @files = $rule->file()->name(qr/^.[^~]+$/)->in($source);

	foreach my $file (@files) {
		#next if $file eq 'src/groups/index.html'; # processed by bin/xml
  
		print STDERR $file, "\n";

		my $destfile = $file;
		$destfile =~ s/^$source/$destination/;
		my($volume, $directories, $filepart) = splitpath($destfile);
		mkpath $directories;
		warn "$file -> $destfile\n";

		if ($file =~ /\.png$/) {
			copy($file, $destfile);
		} else {
			$tt->process($file, $parms, $destfile) || die $tt->error;
		}
	}
}



__END__
=head1 NAME

draw.pl - draw the master copies of the Perl Monger World Maps

=head1 SYNOPSIS

draw.pl [-huge]

=head1 DESCRIPTION

This uses the two large earth.png, earth-small.png, and the Perl Monger
Group XML file, perl_mongers.xml. It takes the longitude and latitude 
location information contained in the XML file and produces one of
two image files: mongers.png and mongers-small.png.

It also outputs a list of all the groups which do not current have
location information.

=head1 AUTHOR

Leon Brocard, leon@astray.com

=cut

__END__
Example data structure for a group:

$VAR1 = {
          'location' => {
                          'state' => {},
                          'country' => 'Ireland',
                          'latitude' => '52.664',
                          'region' => {},
                          'city' => 'Limerick',
                          'longitude' => '-8.623',
                          'continent' => 'Europe'
                        },
          'web' => {},
          'tsar' => {
                      'email' => {
                                   'content' => 'foranp@tinet.ie',
                                   'type' => 'personal'
                                 },
                      'name' => 'Paul Foran'
                    },
          'date' => {
                      'content' => '19990214',
                      'type' => 'inception'
                    },
          'id' => '134',
          'mailing-list' => {
                              'subscribe' => 'subscribe limerick-pm-list email_address',
                              'unsubscribe' => 'unsubscribe limerick-pm-list email_address',
                              'email' => [
                                           {
                                             'content' => 'limerick-pm-list@pm.org',
                                             'type' => 'list'
                                           },
                                           {
                                             'content' => 'majordomo@pm.org',
                                             'type' => 'list_admin'
                                           }
                                         ],
                              'name' => 'General Limerick.pm discussion'
                            },
          'email' => {
                       'type' => 'group'
                     }
        };