1#!/usr/local/bin/perl -w
2# -*- perl -*-
3
4#
5# Author: Slaven Rezic
6#
7# Copyright (C) 2009,2012 Slaven Rezic. All rights reserved.
8# This program is free software; you can redistribute it and/or
9# modify it under the same terms as Perl itself.
10#
11# Mail: slaven@rezic.de
12# WWW:  http://www.rezic.de/eserte/
13#
14
15use strict;
16use warnings;
17use FindBin;
18use lib (
19	 "$FindBin::RealBin/..",
20	 "$FindBin::RealBin/../lib",
21	 $FindBin::RealBin,
22	);
23
24use Cwd qw(realpath);
25use File::Basename qw(basename);
26use File::Glob qw(bsd_glob);
27use File::Spec qw();
28use Getopt::Long;
29use Tk;
30use Tk::Balloon;
31use Tk::Pane;
32
33BEGIN {
34    eval q{ use YAML::Syck qw(LoadFile); 1 } ||
35	eval q{ use YAML qw(LoadFile); 1 } ||
36	    eval q{ use Safe; 1 } ||
37		die "ERROR: Can't load any YAML parser (tried YAML::Syck and YAML) and also no success loading Safe.pm: $@";
38}
39
40use BBBikeDir qw(get_data_osm_directory);
41use Msg qw(M Mfmt noautosetup);
42
43my $lang = Msg::get_lang() || 'en';
44if ($lang !~ m{^(en|de)$}) {
45    $lang = 'en';
46}
47
48$Msg::messages =
49    { en => {}, # default language
50      de => {
51	     'Sorry, no data directories found in %s' => 'Sorry, keine Datenverzeichnisse in %s gefunden',
52	     'Exit' => 'Beenden',
53	     'Close' => 'Schlie�en',
54	     'Lazy drawing (experimental, faster startup)' => 'Verz�gertes Zeichnen (experimentell, schnellerer Start)',
55	     'Warnings in a window' => 'Warnungen in ein eigenes Fenster',
56	     'Advanced mode' => 'Fortgeschrittener Modus',
57	     'Choose city/region:' => 'Stadt/Region ausw�hlen:',
58	     '(original BBBike data)' => '(originale BBBike-Daten)',
59	     'Options' => 'Optionen',
60	     'More cities/regions @ bbbike.org' => 'Weitere St�dte/Regionen bei bbbike.org',
61	     'Problem: cannot find more data at bbbike.org.' => 'Problem: es konnten keine weiteren Daten bei bbbike.org gefunden werden.',
62	     "The download of '%s' was successful." => "Der Download von '%s' war erfolgreich.",
63	     "An error occurred while downloading '%s'." => "Ein Fehler beim Downloaden von '%s' ist aufgetreten.",
64	    },
65    }->{$lang};
66
67sub usage ();
68sub guess_dataset_title_from_dir ($);
69
70my $rootdir = my $this_rootdir = realpath(File::Spec->catfile($FindBin::RealBin, File::Spec->updir));
71
72Getopt::Long::Configure("pass_through");
73GetOptions("rootdir=s" => \$rootdir);
74
75my $mw = tkinit;
76
77$mw->optionAdd('*advOpts*font', '{sans serif} 7');
78
79#$mw->optionAdd('*font', '{sans serif} 10');
80#{ my $bg = '#dfdbd7'; $mw->configure(-background => $bg); $mw->optionAdd('*background', $bg) }
81
82@ARGV and usage;
83
84my $download_script = "$rootdir/miscsrc/bbbike.org_download.pl";
85if (!-e $download_script) {
86    warn "Das Download-Skript $download_script ist nicht verf�gbar.\n";
87}
88
89my @bbbike_datadirs = find_all_datadirs();
90
91if (!@bbbike_datadirs) {
92    $mw->messageBox(-message => Mfmt('Sorry, no data directories found in %s', $rootdir));
93    exit;
94}
95
96uniquify_titles();
97
98my $xb = $mw->Button(-text => M"Exit",
99		     -command => sub { $mw->destroy },
100		    )->pack(-side => 'bottom');
101$mw->bind('<Escape>' => sub { $xb->invoke });
102
103my %opt;
104$mw->Menubutton(Name => 'advOpts',
105		-text => M"Options",
106		-menuitems => [[Checkbutton => M"Lazy drawing (experimental, faster startup)",
107				-variable => \$opt{'-lazy'},
108			       ],
109			       [Checkbutton => M"Warnings in a window",
110				-variable => \$opt{'-stderrwindow'},
111			       ],
112			       [Checkbutton => M"Advanced mode",
113				-variable => \$opt{'-advanced'},
114			       ],
115			      ]
116	       )->pack(-side => 'bottom', -anchor => 'e');
117
118my $bln = $mw->Balloon;
119$mw->Label(-text => M"Choose city/region:")->pack;
120my $p = $mw->Scrolled("Pane", -sticky => 'nw', -scrollbars => 'ose')->pack(qw(-fill both));
121fill_chooser();
122
123#$mw->WidgetDump;
124MainLoop;
125
126sub fill_chooser {
127    # clean pane (for the refresh case)
128    $_->destroy for $p->Subwidget('scrolled')->Subwidget("frame")->children;
129
130    my $last_b;
131    for my $bbbike_datadir (sort { $a->{dataset_title} cmp $b->{dataset_title} } @bbbike_datadirs) {
132	my($dataset_title, $datadir) = @{$bbbike_datadir}{qw(dataset_title datadir)};
133	Tk::grid(my $b = $p->Button(-text => $dataset_title,
134				    -anchor => 'w',
135				    -command => sub {
136					my @cmd = ($^X, File::Spec->catfile($this_rootdir, 'bbbike'), '-datadir', $datadir,
137						   (grep { $opt{$_} } keys %opt),
138						  );
139					if ($^O eq 'MSWin32') {
140					    # Sigh. Windows braindamage
141					    @cmd = ($cmd[0], (map { qq{"$_"} } @cmd[1..$#cmd]));
142					    # no forking here
143					    { exec @cmd }
144					    $mw->messageBox(-message => "Can't execute @cmd: $!",
145							    -icon => 'error');
146					} else {
147					    if (fork == 0) {
148						exec @cmd;
149						warn "Cannot start @cmd: $!";
150						CORE::exit(1);
151					    }
152					    $mw->destroy;
153					}
154				    },
155				   ), -sticky => 'ew');
156	$bln->attach($b, -msg => $datadir);
157	$last_b = $b;
158    }
159    if ($download_script) {
160	Tk::grid($p->Button(-text => M('More cities/regions @ bbbike.org'),
161			    -anchor => 'w',
162			    -command => \&download_more,
163			   ), -sticky => 'ew');
164    }
165    if ($last_b) {
166	create_adjust_geometry_cb($p, $last_b);
167    }
168}
169
170sub create_adjust_geometry_cb {
171    my($p, $b) = @_;
172    my $height = 400; $height = $p->screenheight - 40 if $height > $p->screenheight;
173    $p->after(50, sub { $p->GeometryRequest($b->Width+20, $height) });
174}
175
176sub find_all_datadirs {
177    my @dirs;
178    {
179	my $data_osm_directory = get_data_osm_directory();
180	if (-d $data_osm_directory) {
181	    push @dirs, find_datadirs($data_osm_directory);
182	}
183    }
184    push @dirs, find_datadirs($rootdir);
185    @dirs;
186}
187
188sub find_datadirs {
189    my($startdir) = @_;
190    my @dirs;
191    for my $dir (bsd_glob(File::Spec->catfile($startdir, '*'))) {
192	if (-d $dir) {
193	    my $meta = load_meta($dir);
194	    if ($meta) {
195		$meta->{datadir} = $dir;
196		$meta->{dataset_title} = guess_dataset_title_from_dir($dir)
197		    if !$meta->{dataset_title};
198		push @dirs, $meta;
199	    } else {
200		my $base_dir = basename($dir);
201		if ($base_dir eq 'data-osm') { # Wolfram's convention
202		    push @dirs, find_datadirs($dir); # XXX no recursion detection (possible with recursive symlinks...)
203		} elsif ($base_dir =~ m{^data}) {
204		    push @dirs, { datadir => $dir,
205				  dataset_title => guess_dataset_title_from_dir($dir),
206				};
207		}
208	    }
209	}
210    }
211    @dirs;
212}
213
214sub guess_dataset_title_from_dir ($) {
215    my $dir = shift;
216    $dir = basename $dir;
217    if ($dir eq 'data') {
218	'Berlin ' . M"(original BBBike data)";
219    } else {
220	my $city = $dir;
221	$city =~ s{^data}{};
222	$city =~ s{^[^A-Za-z]*}{}; # search for the alphabetic part
223	$city = ucfirst $city;
224	$city;
225    }
226}
227
228sub uniquify_titles {
229    my %seen_title;
230    for my $def (@bbbike_datadirs) {
231	push @{ $seen_title{$def->{dataset_title}} }, $def;
232    }
233    while(my($title, $v) = each %seen_title) {
234	if (@$v > 1) {
235	    for my $rec (@$v) {
236		$rec->{dataset_title} .= " (" . basename($rec->{datadir}) . ")"; # XXX should try harder if the basenames are also same
237	    }
238	}
239    }
240}
241
242sub load_meta {
243    my $dir = shift;
244
245    my $meta_yml = File::Spec->catfile($dir, 'meta.yml');
246    if (-f $meta_yml && defined &LoadFile) {
247	my $meta = eval { LoadFile $meta_yml };
248	if (!$meta) {
249	    warn "WARN: Cannot load $meta_yml: $!, will try another fallback...\n";
250	} else {
251	    return $meta;
252	}
253    }
254
255    my $meta_dd = File::Spec->catfile($dir, 'meta.dd');
256    if (-f $meta_dd) {
257	my $c = Safe->new;
258	my $meta = $c->rdo($meta_dd);
259	if (!$meta) {
260	    warn "WARN: Also cannot load $meta_dd: $!, skipping this possible data directory...\n";
261	    return;
262	} else {
263	    return $meta;
264	}
265    }
266
267    # Don't warn, we're usually trying every directory under
268    # $bbbike_root...
269    undef;
270}
271
272sub download_more {
273    chomp(my(@cities) = `$^X $download_script`);
274    if (!@cities) {
275	$mw->messageBox(-message => M('Problem: cannot find more data at bbbike.org.'));
276	return;
277    }
278    my $t = $mw->Toplevel;
279    $t->Label(-text => M"Choose city/region:")->pack;
280    my $p = $t->Scrolled("Pane", -sticky => 'nw', -scrollbars => 'ose')->pack(qw(-fill both));
281    my $last_b;
282    for my $city (@cities) {
283	Tk::grid(my $b = $p->Button(-text => $city,
284				    -anchor => 'w',
285				    -command => [\&download_city, $city, $t],
286				   ), -sticky => 'ew');
287	$bln->attach($b, -msg => "Download $city");
288	$last_b = $b;
289    }
290    if ($last_b) {
291	create_adjust_geometry_cb($p, $last_b);
292    }
293    $t->Button(-text => M"Close",
294	       -command => sub { $t->destroy },
295	      )->pack(-side => 'bottom');
296}
297
298sub download_city {
299    my($city, $t) = @_;
300    $t->Busy;
301    system($^X, $download_script, '-city', $city);
302    my $st = $?;
303    $t->Unbusy;
304    if ($st == 0) {
305	$mw->messageBox(-message => Mfmt("The download of '%s' was successful.", $city));
306    } else {
307	$mw->messageBox(-message => Mfmt("An error occurred while downloading '%s'.", $city));
308    }
309    $t->destroy;
310
311    # refresh:
312    @bbbike_datadirs = find_all_datadirs();
313    uniquify_titles();
314    fill_chooser();
315}
316
317sub usage () {
318    die <<EOF;
319usage: $0 [-rootdir directory] [Tk options]
320EOF
321}
322
323__END__
324
325=head2 TODO
326
327 * store list of lru items into a config file
328 * store options into a config file
329 * get path to config file (~/.bbbike/bbbike_chooser_options) from a yet-to-written BBBikeUtil function
330 * reorder the list to display the list of lru items at the top, with a separator to the other items
331 * get a list of further directories from a Web address
332 * download and unpack from Web
333 * update data from Web
334
335=cut
336