#!/usr/bin/perl
# -*- perl -*-

#
# Author: Slaven Rezic
#
# Copyright (C) 2013 Slaven Rezic. All rights reserved.
# This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.
#
# Mail: slaven@rezic.de
# WWW:  http://www.rezic.de/eserte/
#

use strict;
use warnings;

use Getopt::Long;
use XML::LibXML;

sub usage (;$) {
    my $msg = shift;
    warn "$msg\n" if $msg;
    die <<EOF;
usage: $0 osmfile
EOF
}

GetOptions()
    or usage;
my $file = shift
    or usage "Please specify .osm file";
@ARGV and usage "Please only one .osm file";

my %nodes;
my %ways;
my %relations;

my $p = XML::LibXML->new;
my $root = $p->parse_file($file)->documentElement;
for my $typedef (
		 ['node',     \%nodes],
		 ['way',      \%ways],
		 ['relation', \%relations],
		) {
    my($type, $hashref) = @$typedef;
    for my $element ($root->findnodes('/osm/' . $type)) {
	my $object = {};
	my $id = $element->getAttribute('id');
	if (!defined $id) {
	    warn "WARN: skip invalid $type without id\n";
	} else {
	    {
		my %attributes;
		for my $attrib ($element->attributes) {
		    $attributes{$attrib->nodeName} = $attrib->value;
		}
		$object->{attributes} = \%attributes;
	    }

	    {
		my %tags;
		for my $tag_element ($element->findnodes('./tag')) {
		    my $k = $tag_element->getAttribute('k');
		    my $v = $tag_element->getAttribute('v');
		    $tags{$k} = $v;
		}
		$object->{tags} = \%tags;
	    }

	    if ($type eq 'way') {
		my @nodes;
		for my $nd_element ($element->findnodes('./nd')) {
		    my $ref = $nd_element->getAttribute('ref');
		    push @nodes, { ref => $ref };
		}
		$object->{nodes} = \@nodes;
	    }

	    if ($type eq 'relation') {
		my @members;
		for my $member_element ($element->findnodes('./member')) {
		    my %member_attributes;
		    for my $attrib ($member_element->attributes) {
			$member_attributes{$attrib->nodeName} = $attrib->value;
		    }
		    push @members, \%member_attributes;
		}
		$object->{members} = \@members;
	    }
	}

	$hashref->{$id} = $object;
    }
}

my %relations_resolved;
my %ways_resolved;
while(my($id, $relation) = each %relations) {
    resolve_relation_members($relation);
}
while(my($id, $way) = each %ways) {
    resolve_way_nodes($way);
}

my %relations_done;
my %ways_done;
my %nodes_done;

binmode \*STDOUT, ':utf8';
print "#: map: polar\n";
print "#: encoding: utf-8\n";
print "#:\n";
for my $id (sort { $a <=> $b } keys %relations) {
    my $relation = $relations{$id};
    my $s = output_relation($relation, undef);
    print $s if defined $s;
}
for my $id (sort { $a <=> $b } keys %ways) {
    my $way = $ways{$id};
    my $s = output_way($way, undef);
    print $s if defined $s;
}
for my $id (sort { $a <=> $b } keys %nodes) {
    my $node = $nodes{$id};
    my $s = output_node($node, undef);
    print $s if defined $s;
}

sub output_relation {
    my($relation, $parent) = @_;
    return if !$parent && $relations_done{$relation};
    $relations_done{$relation}++;
    my $s = "#: section: relation " . tags_attribs_to_name($relation) . " vvv\n";
    for my $member (@{ $relation->{members} }) {
	my $member_object = $member->{__object};
	my $member_s;
	if (!$member_object) {
	    $member_s = "# relation member ref=$member->{ref} is missing\n";
	} else {
	    my $sub = "output_" . $member->{type};
	    no strict 'refs';
	    $member_s = &$sub($member_object, $relation);
	    if (!defined $member_s) {
		$member_s = "# member ref=$member->{ref} type=$member->{type} probably already dumped\n";
	    } else {
		my $role = $member->{role};
		if (defined $role && length $role) {
		    if ($member_s =~ m{\n.*\n}) {
			$member_s = "#: role $role vvv\n" . $member_s . "#: role ^^^\n";
		    } else {
			$member_s = "#: role $role\n" . $member_s;
		    }
		}
	    }
	}
	$s .= $member_s;
    }
    $s .= "#: section ^^^\n";
    $s .= "# \n";
    $s;
}

sub output_way {
    my($way, $parent) = @_;
    return if !$parent && $ways_done{$way};
    $ways_done{$way}++;
    my $s = tags_attribs_to_name($way) . "\tX";
    for my $node_container (@{ $way->{nodes} }) {
	my $node = $node_container->{__object};
	my $attributes = $node->{attributes};
	$s .= " " . $attributes->{lon}.",".$attributes->{lat};
	$nodes_done{$node}++;
    }
    $s .= "\n";
    $s;
}

sub output_node {
    my($node, $parent) = @_;
    return if !$parent && $nodes_done{$node};
    $nodes_done{$node}++;
    tags_attribs_to_name($node) . "\tX " . $node->{attributes}->{lon}.",".$node->{attributes}->{lat} . "\n";
}

sub tags_attribs_to_name {
    my $object = shift;
    my $tags = $object->{tags};
    my $attributes = $object->{attributes};
    my $name = $tags->{name};
    my $id = $attributes->{id};
    my $ret = join("|", grep { defined and length } ($name, "id=$id",
						     (map { "$_=$tags->{$_}" } grep { $_ ne 'name' } sort keys %$tags),
						     (map { "$_=$attributes->{$_}" } grep { $_ !~ m{^(id|lon|lat)$} } sort keys %$attributes)
						    )
		  );
    $ret;
}

sub resolve_relation_members {
    my $relation = shift;
    return if $relations_resolved{$relation}++;
    for my $member (@{ $relation->{members} }) {
	my $resolved_member;
	if ($member->{type} eq 'relation') {
	    $resolved_member = $relations{$member->{ref}};
	    next if !$resolved_member;
	    resolve_relation_members($resolved_member);
	} elsif ($member->{type} eq 'way') {
	    $resolved_member = $ways{$member->{ref}};
	    next if !$resolved_member;
	    resolve_way_nodes($resolved_member);
	} elsif ($member->{type} eq 'node') {
	    $resolved_member = $nodes{$member->{ref}};
	    next if !$resolved_member;
	} else {
	    warn "ERROR in osm file '$member->{type}'";
	    next;
	}
	$member->{__object} = $resolved_member;
    }
}

sub resolve_way_nodes {
    my $way = shift;
    return if $ways_resolved{$way}++;
    my @resolved_nodes;
    for my $node (@{ $way->{nodes} }) {
	my $resolved_node = $nodes{$node->{ref}};
	next if !$resolved_node;
	$node->{__object} = $resolved_node;
    }
}

__END__
