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

#
# Author: Slaven Rezic
#
# Copyright (C) 2009,2011 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 FindBin;
use lib "$FindBin::RealBin/..";

use vars qw($VERSION);
$VERSION = 0.01;

my $debug = 0;

use DB_File;
use Encode qw(decode encode);
use File::Spec;
use Getopt::Long;
use XML::LibXML;

use constant DEFAULT_CONTEXT_LINES => 30; # to be on the safe side...
use constant OSM_FILE_ENCODING => 'utf-8'; # assume all XML files are utf8

my $context_lines = DEFAULT_CONTEXT_LINES;

my $need_cache_osm_nodes_hint;

sub usage {
    die "usage: $0 [-coordsys bbbike] [-context nr_of_lines] [-debug 1] searchterm osmfile ...\n";
}

sub grep_osm_fh {
    my($search_term, $osm_file) = @_;
    my @common_opts = ('-i', -A => $context_lines, -B => $context_lines);
    $search_term = encode OSM_FILE_ENCODING, $search_term;
    my @cmd;
    if ($osm_file =~ m{\.bz2$}) {
	@cmd = ('bzegrep', @common_opts, $search_term, $osm_file);
    } elsif ($osm_file =~ m{\.gz$}) {
	@cmd = ('zegrep', @common_opts, $search_term, $osm_file);
    } else {
	@cmd = ('egrep', @common_opts, $search_term, $osm_file);
    }
    local $ENV{LANG}   = 'C';
    local $ENV{LC_ALL} = 'C';
    warn "Run '@cmd' using encoding '" . OSM_FILE_ENCODING . "'...\n" if $debug;
    open my $fh, '-|:encoding('.OSM_FILE_ENCODING.')', @cmd
	or die "Can't run '@cmd': $!";
    $fh;
}

sub set_info_handler {
    my($osm_file) = @_;
    no warnings 'signal'; # INFO is usually only available on BSD systems
    $SIG{INFO} = sub {
	my $msg = "File $osm_file";
	print STDERR $msg, "\n";
	require Carp; Carp::carp('Currently');
    };
}

my $coordsys;
my $outfile;
GetOptions("coordsys=s" => \$coordsys,
	   "context=i" => \$context_lines,
	   "debug=i" => \$debug,
	   "o=s" => \$outfile,
	  ) or usage;

my $codeset;
my $ofh;
if ($outfile) {
    $codeset = 'utf-8';
    open $ofh, ">", $outfile
	or die "Can't write to $outfile: $!";
} else {
    eval {
	require I18N::Langinfo;
	I18N::Langinfo->import(qw(langinfo CODESET));
	$codeset = langinfo(CODESET());
    };
    if ($@) {
	warn "langinfo and/or CODESET probably not available, assuming iso-8859-1.\n";
	$codeset = 'iso-8859-1';
    }
    $codeset = lc $codeset; # 'UTF-8' is not recognized by emacs, but 'utf-8' is
    $ofh = \*STDOUT;
}
binmode $ofh, ":encoding($codeset)";

my $out_conv;
my $coordsys_map = 'polar';
if ($coordsys) {
    if ($coordsys eq 'bbbike') {
	require Karte::Polar;
	require Karte::Standard;
	no warnings 'once';
	$out_conv = sub { join ",", $Karte::Standard::obj->trim_accuracy($Karte::Polar::obj->map2standard(split /,/, $_[0])) };
	$coordsys_map = 'standard'; # XXX can I use 'bbbike' instead?
    } else {
	die "Only -coordsys bbbike allowed";
    }
}

my $index_dir = "$ENV{HOME}/.bbbike/cache";
if (!-d $index_dir) {
    die "Please create directory '$index_dir' manually";
}
my $index_file = $index_dir . '/osm_nodes_lonlat.db' . ($DB_File::db_version eq '' || $DB_File::db_version <= 1 ? '' : int($DB_File::db_version));

my $search_term = shift @ARGV;
usage if !defined $search_term;
$search_term = decode $codeset, $search_term;

usage if (!@ARGV);

my @orig_osm_files = @ARGV;
my @osm_files;
for my $osm_file (@orig_osm_files) {
    if (-d $osm_file) {
	push @osm_files, grep { -f $_ && -s $_ } glob(File::Spec->catfile($osm_file,"*.{osm,osm.gz,osm.bz2}")); # XXX argh, duplicated functionality, see osm2bbd
    } else {
	push @osm_files, $osm_file;
    }
}

if (!@osm_files) {
    die "No usable osm files found in @ARGV.\n";
}

# do it after populating @orig_osm_files
tie my %nodes_lonlat, 'DB_File', $index_file, O_RDONLY, 0644
    or do {
	$need_cache_osm_nodes_hint = 1;
	die "Cannot tie '$index_file' ($!)\n";
    };

my $p = XML::LibXML->new;

my $needs_header = 1;

my @global_relation_defs;
# First pass: handle nodes and way
for my $osm_file (@osm_files) {
    handle_osm_file($osm_file,
		    do_relations => 1,
		    search_term  => $search_term,
		   );
}
# Second pass: handle relations, recorded in the first pass
for my $relation_def (@global_relation_defs) {
    my($rx, $osm_file, $relation_tags) = @$relation_def;
    handle_osm_file($osm_file,
		    do_relations  => 0,
		    search_term   => $rx,
		    relation_tags => $relation_tags,
		   );
}

sub handle_osm_file {
    my($osm_file, %args) = @_;
    my $do_relations  = delete $args{'do_relations'};
    my $search_term   = delete $args{'search_term'};
    my $relation_tags = delete $args{'relation_tags'};
    die "Unhandled parameters: " . join(" ", %args) if %args;

    my $fh = grep_osm_fh($search_term, $osm_file);
    set_info_handler($osm_file);

    my $buf = "";
    local $/ = 4096;
    while(<$fh>) {
	$buf .= $_;
    }

    my @relation_defs; # { name => name, way => {....}, node => {....} }

    # Hack to find way and node elements in XML. Ignores
    # empty-elements (because they cannot have "name" tags, anyway).
    my @bufs = split /^--$/m, $buf;
    for my $buf (@bufs) {
	while ($buf =~ m{(<(?:way|node|relation) [^>]+(?<!/)>.*?</(?:way|node|relation)>)}gs) {
	    my $xml_frag = $1;
	    if ($xml_frag =~ m{$search_term}i) {
		my $frag = eval { $p->parse_string($xml_frag) };
		if ($@) {
		    warn "Cannot parse\n$xml_frag\n$@";
		    next;
		}
		$frag = $frag->documentElement;
		my @coords; # for ways/nodes
		my $relation_def; # for relations
		if ($frag->nodeName eq 'way') {
		    for my $nd_ref (map { $_->getAttribute('ref') } $frag->findnodes('//nd')) {
			my $lonlat = $nodes_lonlat{$nd_ref};
			if (defined $lonlat) {
			    push @coords, $lonlat;
			} else {
			    warn "WARN: Node $nd_ref cannot be resolved.\n";
			    $need_cache_osm_nodes_hint = 1;
			}
		    }
		} elsif ($do_relations && $frag->nodeName eq 'relation') {
		    $relation_def = {};
		    for my $way_member ($frag->findnodes('./member[@type="way"]')) {
			$relation_def->{'way'}->{$way_member->getAttribute('ref')} = 1;
		    }
		    for my $node_member ($frag->findnodes('./member[@type="node"]')) {
			$relation_def->{'node'}->{$node_member->getAttribute('ref')} = 1;
		    }
		    push @relation_defs, $relation_def;
		} else {	# node
		    push @coords, join ',', $frag->getAttribute('lon'), $frag->getAttribute('lat');
		}
		if (!@coords) {
		    if ($relation_def) {
			$relation_def->{tags} = get_tags($frag);
		    } else {
			warn "No coords found in $xml_frag";
		    }
		    next;
		}

		my $tags_ref = get_tags($frag);

		if ($needs_header) {
		    print $ofh <<EOF;
#: #: -*- coding: $codeset -*-
#: encoding: $codeset
#: map: $coordsys_map
#: note: filtered '$search_term' in '@orig_osm_files'
#:
EOF
		    $needs_header = 0;
		}

		my $name = join(" ", @$tags_ref);
		if ($relation_tags) {
		    $name .= " [RELATION " . join(" ", @$relation_tags) . "]";
		}
		print $ofh $name . "\tX " . ($out_conv ? join(' ', map { $out_conv->($_) } @coords) : join(' ', @coords)), "\n";
	    }
	}
    }

    if (@relation_defs) {
	for my $relation_def (@relation_defs) {
	    my $relation_tags = $relation_def->{tags};
	    my @rx;
	    # XXX Hack. Should use XML::LibXML::Reader here.
	    for my $type (qw(node way)) {
		if ($relation_def->{$type}) {
		    push @rx, $type . ' id="(' . join('|', keys %{ $relation_def->{$type} }) . ')"';
		}
	    }
	    my $rx = '(' . join('|', @rx) . ')';
	    push @global_relation_defs, [$rx, $osm_file, $relation_tags];
	}
    }
}

sub get_tags {
    my $frag = shift;
    my @tags;
    for my $tag ($frag->findnodes('//tag')) {
	my $k = $tag->getAttribute('k');
	my $v = $tag->getAttribute('v');
	s{[\t\n]}{ }g for $k, $v;
	push @tags, "$k=$v";
    }
    for my $k (qw(user timestamp id)) {
	my $v = $frag->getAttribute($k);
	if (defined $v) {
	    s{[\t\n]}{ }g for $v;
	    push @tags, "$k=$v";
	}
    }
    
    # re-sort, name= first, created_by last
    @tags = map { $_->[1] } sort { $a->[0] <=> $b->[0] } map { [m{^name=} ? 0 : m{^created_by=} ? 2 : 1, $_] } @tags;
    \@tags;
}

END {
    run_cache_osm_nodes_hint() if $need_cache_osm_nodes_hint;
}

sub run_cache_osm_nodes_hint {
    print STDERR <<EOF;
Maybe you need to run cache_osm_nodes first? Try:

    $^X $FindBin::RealBin/cache_osm_nodes @orig_osm_files

EOF
}

__END__

=head1 NAME

grep_osm - find nodes and ways in osm data by name

=head1 SYNOPSIS

    ./grep_osm [-coordsys bbbike] [-context lines] [-o outfile] searchregexp osmfile ...

=head1 DESCRIPTION

Search one or more osmfiles for the specified search regexp. The
search regexp will be treated case-insensitive (but see L</BUGS>). The
extended regular expression syntax is used (like in L<egrep(1)>).

The result is written to stdout, unless an explicit output file using
the C<-o> option is given. The encoding of the result is either the
terminal encoding, or C<utf-8> if written to a file.

Before using the program the osm files should be indexed using
L<cache_osm_nodes>, otherwise no coordinate mapping is possible.

Output is in a bbd-like format, which can be loaded into L<bbbike>.

By default the coordinates are in WGS84 format (lon, lat), but by
specifying C<-coordsys bbbike> the old BBBike standard coordinates may
be returned.

If the feature is large, then the default number of context lines for
the internal 'grep' (default is 30) is not large enough. With the
C<-context> switch the number of context lines may be increased.

=head1 BUGS

Search is case-insensitive, but only for ASCII characters.

The search regexp is internally used by C<egrep> and C<perl>. Try to
use only regular expression constructs which are compatible with both
programs.

The usage of context lines is a hack. Especially for large features or
relations it is necessary to use a larger C<-context> value. You have
to experiment.

=head1 SEE ALSO

L<cache_osm_nodes>.

=cut

