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