1#!/usr/local/bin/perl -w
2# -*- perl -*-
3
4#
5# Author: Slaven Rezic
6#
7# Copyright (C) 2011,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 FindBin;
17use lib (
18	 "$FindBin::RealBin/..",
19	 "$FindBin::RealBin/../lib",
20	 $FindBin::RealBin,
21	);
22
23use File::Basename qw(basename);
24use File::Temp qw(tempdir);
25use Getopt::Long;
26use LWP::UserAgent;
27
28use BBBikeDir qw(get_data_osm_directory);
29use BBBikeVar ();
30
31sub usage ();
32
33our $VERSION = '0.02';
34
35my $rooturl = 'http://download.bbbike.org/bbbike/data-osm';
36my $city;
37my $o;
38my $agent_suffix;
39GetOptions(
40	   "url=s" => \$rooturl,
41	   "city=s" => \$city,
42	   "o=s" => \$o, # download directory, for tests only
43	   "agentsuffix=s" => \$agent_suffix, # for tests only
44	  )
45    or usage;
46@ARGV and usage;
47
48my $ua = LWP::UserAgent->new;
49$ua->agent("bbbike/$BBBike::VERSION (bbbike.org_download.pl/$VERSION) (LWP::UserAgent/$LWP::VERSION) ($^O)" . ($agent_suffix ? $agent_suffix : ""));
50
51if (!$city) {
52    listing();
53} else {
54    city($city);
55}
56
57sub listing {
58    my $url = $rooturl . '/';
59
60    require XML::LibXML;
61    my $p = XML::LibXML->new;
62
63    my $resp = $ua->get($url);
64    die "Can't get $url: " . $resp->status_line
65	if !$resp->is_success;
66
67    my $root = $p->parse_html_string($resp->decoded_content)->documentElement;
68
69    for my $a_node ($root->findnodes('//a')) {
70	my $href = $a_node->getAttribute('href');
71	next if ($href !~ m{\.tbz$});
72	$href =~ s{\.tbz$}{};
73	print $href, "\n";
74    }
75}
76
77sub city {
78    my $city = shift;
79    my $url = "$rooturl/$city.tbz";
80    my $data_osm_directory = $o || get_data_osm_directory(-create => 1);
81    my $tmpdir = tempdir(DIR => $data_osm_directory, CLEANUP => 1)
82	or die "Can't create temporary directory in $data_osm_directory: $!";
83    my $tmpfile = "$tmpdir/$city.tbz";
84    chdir $data_osm_directory
85	or die "Can't chdir to $data_osm_directory: $!";
86
87    print STDERR "Downloading data for $city...\n";
88
89    my $resp = $ua->mirror($url, $tmpfile);
90    die "Can't get $url to $tmpfile: " . $resp->status_line
91	if !$resp->is_success;
92
93    print STDERR "Extracting data to $data_osm_directory...\n";
94    if (eval { require Archive::Tar; Archive::Tar->has_bzip2_support }) {
95	my $success = Archive::Tar->extract_archive($tmpfile);
96	if (!$success) {
97	    die "Error while extracting $tmpfile with Archive::Tar: " . Archive::Tar->error;
98	}
99    } else {
100	my @cmd = ("tar", "xfj", $tmpfile);
101	system @cmd;
102	die "Error while extracting using @cmd" if $? != 0;
103    }
104
105    print STDERR "Finished.\n";
106}
107
108sub usage () {
109    die <<EOF;
110usage: $0 [-url ...] [-city ...]
111EOF
112}
113
114__END__
115
116=for org TODO
117
118* Download location
119  Where exactly to download? Maybe: if bbbike is uninstalled, then
120  under .../bbbike/data-osm. If bbbike is installed, then in a user
121  directory, e.g. ~/.bbbike/data-osm.
122  -> need a function which determines the install type.
123     Does something like this exist already?
124* How bbbike-chooser.pl and bbbike.org-download.pl should interact?
125  Probably this should be a proper module. Name? BBBikeOrgDownload? Or
126  BBBikeOrg::Download?
127* tar bzip2 under Windows
128  Probably done with a module. Is it already in Strawberry?
129  -> Archive::Tar & ...::Bzip is available, just try it out
130* LWP UserAgent operation: mask as a BBBike UA
131  Find my standard UA. Don't forget version, git id etc.
132  (BBBikeHeavy::get_user_agent is problematic, because it expects to be run within bbbike, see above)
133* Updating
134  Do I need to care about things? Or just overwrite existing stuff?
135
136