#!/usr/bin/perl

# Copyright (C) 2012 Thorsten Kukuk
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# in Version 2 as published by the Free Software Foundation.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston,
# MA  02110-1301, USA.

=head1 NAME

geo-pictures - Download pictures for caches from GPX files

=head1 SYNOPSIS

geo-pictures [options] [<gpx-file> ...]

=head1 DESCRIPTION

geo-pictures goes through the GPX files, downloads the pictures
for the included geocaches and stores them in a layout for current
GARMIN GPS devices.

=head1 OPTIONS

  -d|--dir <directory>  Garmin directory for output files
  -r|--remove           Remove caches no longer listed in the input file
  -s|--spoiler-only     Only download pictures with 'spoil', 'cache',
                        'hint', 'cue', 'hinweis', 'versteck' in the name
  -q|--quiet            Be quiet and only print error messages
  --dump-config         Write arguments as default config and exit
  --version             Print version number and exit
  --man                 Display manual page
  --usage               Display usage
  -h|-?|--help          Help

=head1 COPYRIGHT

Copyright (c) 2012 by Thorsten Kukuk.  All rights reserved.

This package is free software; you can redistribute it and/or modify
it under the GPL version <http://gnu.org/licenses/gpl2.html>.
There is NO WARRANTY, to the extent permitted by law.

=cut

use strict;
use warnings;
use utf8;
use File::Path;
use File::Basename;
use XML::Twig;
use Pod::Usage;
use Config::IniFiles;
use GEO::GC;
use LWP::Simple;
use URI::URL;

my $Version = '(geo-tools) 1.23';

#
# process command line arguments
#
use Getopt::Long;
my $help = 0;
my $man = 0;
my $version = 0;
my $dump_config = 0;
my $homedir = '';
my $photodir = 'GeocachePhotos';
my $cachefile = 'caches.txt';

if ($ENV{HOME}) {
  $homedir = $ENV{HOME};
} elsif ($ENV{HOMEDRIVE} && $ENV{HOMEPATH}) {
  $homedir = $ENV{HOMEDRIVE}."/".$ENV{HOMEPATH};
}
my $cfgname = $homedir."/.geo-tools.cfg";

if (!-r $cfgname) {
  my $cfg = new Config::IniFiles(-default => "Global",
				 -nocase => 1);
  $cfg->AddSection("geo-pictures");
  #$cfg->newval("geo-pictures", "save_cookies", 0);
  $cfg->newval("geo-pictures", "spoiler-only", 0);
  $cfg->newval("geo-pictures", "garmin-dir", "");
  $cfg->WriteConfig($cfgname);
}

my $cfg = new Config::IniFiles(-file => $cfgname,
			       -default => "Global");
if (!$cfg->SectionExists("geo-pictures")) {
  $cfg->AddSection("geo-pictures");
  #$cfg->newval("geo-pictures", "save_cookies", 0);
  $cfg->newval("geo-pictures", "spoiler-only", 0);
  $cfg->newval("geo-pictures", "garmin-dir", "");
  $cfg->WriteConfig($cfgname);
}
#my $save_cookies = $cfg->val("geo-pictures", "save_cookies", 0);
my $garmindir = $cfg->val("geo-pictures", "garmin-dir", "");
my $remove = $cfg->val("geo-pictures", "remove", 0);
my $spoiler_only = $cfg->val("geo-pictures", "spoiler-only", 0);
my $quiet = $cfg->val("geo-pictures", "quiet", 0);

GetOptions('d|dir=s' => \$garmindir,
	   'r:1' => \$remove,
	   'remove!' => \$remove,
	   's:1' => \$spoiler_only,
	   'spoiler-only!' => \$spoiler_only,
	   'q:1' => \$quiet,
	   'quiet!' => \$quiet,
	   'dump-config' => \$dump_config,
	   'man' => \$man,
	   'version' => \$version,
	   'help|h|?' => \$help) or pod2usage(2);
pod2usage(0) if $help;
pod2usage(-exitstatus => 0, -verbose => 2) if $man;

if ($version) {
  print "geo-pictures $Version\n";
  exit 0;
}

if ($dump_config) {
  WriteConfig();
  exit 0;
}

my @InputFiles;
if ($#ARGV >= 0) {
  @InputFiles = (@ARGV);
} else {
  print "No input files given\n";
  pod2usage(2);
}

# 1=Cache was seen in run before
# 2=Cache was seen in this run
my %KnownCaches;

$photodir = $garmindir."/".$photodir if (length($garmindir) > 0);

print "Getting known caches...\n" unless $quiet;
LoadCacheList ($photodir."/".$cachefile, \%KnownCaches);

if (! -d $photodir) {
  print "Create directory '$photodir'\n" unless $quiet;
  die "Cannot create directory '$photodir'\n" unless mkdir($photodir);
}

my $gc = new GEO::GC(save_cookies => 0, sleep => 1, #XXX $sleep,
		     quiet => 1, #XXX $quiet,
		     nologin => 1);

foreach my $InputFileName (@InputFiles) {
  my $Parser =
    new XML::Twig(twig_handlers=>{'gpx/wpt' => \&GetWaypoint},
		  keep_encoding => 1);
  print "Processing input GPX file $InputFileName:\n" unless $quiet;
  $Parser->parsefile($InputFileName);
}

if ($remove) {
  my ($k, $v);
  my $removed = 0;

  print "\nCheck for obsolete entries...\n" unless $quiet;

  while (($k,$v) = each %KnownCaches) {
    if ($v == 1) {
      $removed = 1;
      print "Remove entry $k\n";

      my $path = $photodir."/".CachePath($k);

      if (-d $path) {
	rmtree($path, {verbose=>0, safe=>1});
      }
    }
  }

  if ($removed) {
    open(FILE, ">", $photodir."/".$cachefile.".tmp");
    while (($k,$v) = each %KnownCaches) {
      print FILE "$k\n" if ($v == 2);
    }
    close FILE;
    rename ($photodir."/".$cachefile.".tmp", $photodir."/".$cachefile);
  }
}

print "\nDone!\n" unless $quiet;
exit;

sub WriteConfig {
  $cfg->newval("geo-pictures", "garmin-dir", $garmindir);
  $cfg->newval("geo-pictures", "remove", $remove);
  $cfg->newval("geo-pictures", "spoiler-only", $spoiler_only);
  #$cfg->newval("geo-pictures", "save_cookies", $save_cookies);
  $cfg->newval("geo-pictures", "quiet", $quiet);
  $cfg->WriteConfig($cfgname);
}

sub GetWaypoint {
  my ($t, $wpt) = @_;
  my $ID = $wpt->first_child_text('name');
  my $cache = $wpt->first_child('groundspeak:cache');

  print "Parsing $ID       \r" unless $quiet;

  #
  # if this is no geocache, but only a waypoint, stop here
  #
  if (!$cache) {
    return;
  }

  # Check if we had the cache already
  if ($KnownCaches{$ID} && $KnownCaches{$ID} > 0) {
    $KnownCaches{$ID} = 2;
    print "Skip $ID        \r" unless $quiet;
    return;
  }

  # Fetch webpage, don't login.
  my $orig_content = $gc->webpage($ID, 0);
  my $content;
  my %pictures;
  my $found = 0;
  my $cachedir;

  # some often used descriptions.
  $content = $orig_content;
  if ($content =~ m|<body background=\"(http://.*?)\".*>|is) {
    $pictures{$1} = "Hintergrund";
  }

  if ($content =~ m|<div class=\"UserSuppliedContent\">(.*?)</div>.*<div class=\"UserSuppliedContent\">(.*?)</div>|is) {
    $content = $1.$2;
    while ($content =~ m|<img src=\"(http://.*?)\"(.*?)/>(.*)$|is) {
      my $url=$1;
      $content = $3;

      $url =~ m|.*/(.*?)$|is;
      my $pic=$1;

      $pictures{$url} = $1;
      $found = 1;
    }
  }

  $content = $orig_content;
  while ($content =~ m|<a href=\"(http://img.geocaching.com/cache/large/.*?)\".*?images.gif\".*?/>.*?<span>(.*?)</span></a><br />(.*)$|is) {
    $pictures{$1} = $2;
    $content = $3;
    $found = 1;
  }

  if ($found) {
    # create directory and set $cachedir
    $cachedir = $photodir."/".CachePath($ID);
    if (! -d $cachedir) {
      print "Create directory '$cachedir'\n" unless $quiet;
      die "Cannot create directory '$cachedir'\n" unless mkpath($cachedir, {mode => 0755});
    }

    my ($k, $v);
    while (($k,$v) = each %pictures) {
      my $result;
      my $url = url($k);
      my $picname = clean ($v).".jpg";
      print "Download $url as $cachedir/$picname\n" unless $quiet;

      if ($picname =~ /(spoil|cue|hint|cache|hinweis|versteck|station|stage|hilfe)/i &&
	  $picname !~ /hintergrund/i) {
	if (! -d $cachedir."/Spoilers") {
	  print "Create directory '$cachedir/Spoilers'\n" unless $quiet;
	  die "Cannot create directory '$cachedir/Spoilers'\n" unless mkpath($cachedir."/Spoilers", {mode => 0755});
	}
	$result = getstore($url, $cachedir."/Spoilers/".$picname);
	print STDERR "Error $result on $url" unless is_success($result);
      } elsif (!$spoiler_only) {
	$result = getstore($url, $cachedir."/".$picname);
	print STDERR "Error $result on $url" unless is_success($result);
      }
    }
  }

  # Create a list of known Geocaches.
  add_cache($ID);
  $KnownCaches{$ID} = 2;
}

sub CachePath {
  my $ID = $_[0];
  my $second_last_char;
  my $last_char = substr($ID, length($ID)-1, 1);

  # If $ID has only three letters or less, second last char
  # will be '0' (zero).
  if (length($ID) <= 3) {
    $second_last_char = "0";
  } else {
    $second_last_char = substr($ID, length($ID)-2, 1);
  }
  return $last_char."/".$second_last_char."/".$ID;
}

sub LoadCacheList {
  my $filename = $_[0];
  my $Caches = $_[1];

  return if (!$filename || $filename eq '');

  if (-r $filename) {
    open(FILE, "<", $filename);
    while (<FILE>) {
      chomp;
      $$Caches{$_} = 1;
    }
    close FILE;
  }
}

sub add_cache {
  my $cache = $_[0];
  die "Cannot open cache file '$cachefile' in dir '$photodir' in append mode\n"
    unless open(CACHE, ">> $photodir/$cachefile");
  print CACHE "$cache\n";
  close(CACHE);
}


sub trim($) {
  my $string = shift;
  $string =~ s/^\s+//;
  $string =~ s/^\_+//;
  $string =~ s/\s+$//;
  $string =~ s/\_jpg$//;
  $string =~ s/\_$//;
  return $string;
}

sub beautify_name {
  my($name) = @_;
  $name = Encode::encode("iso-8859-15",$name);
  $name =~ s/\x{2019}/\'/gs;
  $name =~ s/&quot;/\"/gs;
  $name =~ s/&amp;/&/gs;
  $name =~ s/&lt;/</gs;
  $name =~ s/&gt;/>/gs;
  $name =~ s/&#161;/¡/gs;
  $name =~ s/&#162;/¢/gs;
  $name =~ s/&#163;/£/gs;
  $name =~ s/&#164;/¤/gs;
  $name =~ s/&#165;/¥/gs;
  $name =~ s/&#166;/¦/gs;
  $name =~ s/&#167;/§/gs;
  $name =~ s/&#168;/¨/gs;
  $name =~ s/&#169;/©/gs;
  $name =~ s/&#170;/ª/gs;
  $name =~ s/&#171;/\«/gs;
  $name =~ s/&#172;//gs;
  #  $name =~ s/SHY/&#173;/g;
  $name =~ s/&#174;/®/gs;
  $name =~ s/&#175;/¯/gs;
  $name =~ s/&#176;/°/gs;
  $name =~ s/&#177;/±/gs;
  $name =~ s/&#178;/²/gs;
  $name =~ s/&#179;/³/gs;
  $name =~ s/&#180;/´/gs;
  $name =~ s/&#181;/µ/gs;
  $name =~ s/&#182;//gs;
  $name =~ s/&#183;/·/gs;
  $name =~ s/&#184;/¸/gs;
  $name =~ s/&#185;/¹/gs;
  $name =~ s/&#186;/º/gs;
  $name =~ s/&#187;/\»/sg;
  $name =~ s/&#188;/¼/gs;
  $name =~ s/&#189;/½/gs;
  $name =~ s/&#190;/¾/gs;
  $name =~ s/&#191;/¿/gs;
  $name =~ s/&#192;/À/gs;
  $name =~ s/&#193;/Á/gs;
  $name =~ s/&#194;/Â/gs;
  $name =~ s/&#195;/Ã/gs;
  $name =~ s/&#196;/Ä/gs;
  $name =~ s/&#197;/Å/gs;
  $name =~ s/&#198;/Æ/gs;
  $name =~ s/&#199;/Ç/gs;
  $name =~ s/&#200;/È/gs;
  $name =~ s/&#201;/É/gs;
  $name =~ s/&#202;/Ê/gs;
  $name =~ s/&#203;/Ë/gs;
  $name =~ s/&#204;/Ì/gs;
  $name =~ s/&#205;/Í/gs;
  $name =~ s/&#206;/Î/gs;
  $name =~ s/&#207;/Ï/gs;
  $name =~ s/&#208;/Ð/gs;
  $name =~ s/&#209;/Ñ/gs;
  $name =~ s/&#210;/Ò/gs;
  $name =~ s/&#211;/Ó/gs;
  $name =~ s/&#212;/Ô/gs;
  $name =~ s/&#213;/Õ/gs;
  $name =~ s/&#214;/Ö/gs;
  $name =~ s/&#215;/×/gs;
  $name =~ s/&#216;/Ø/gs;
  $name =~ s/&#217;/Ù/gs;
  $name =~ s/&#218;/Ú/gs;
  $name =~ s/&#219;/Û/gs;
  $name =~ s/&#220;/Ü/gs;
  $name =~ s/&#221;/Ý/gs;
  $name =~ s/&#222;/Þ/gs;
  $name =~ s/&#223;/ß/gs;
  $name =~ s/&#224;/à/gs;
  $name =~ s/&#225;/á/gs;
  $name =~ s/&#226;/â/gs;
  $name =~ s/&#227;/ã/gs;
  $name =~ s/&#228;/ä/gs;
  $name =~ s/&#229;/å/gs;
  $name =~ s/&#230;/æ/gs;
  $name =~ s/&#231;/ç/gs;
  $name =~ s/&#232;/è/gs;
  $name =~ s/&#233;/é/gs;
  $name =~ s/&#234;/ê/gs;
  $name =~ s/&#235;/ë/gs;
  $name =~ s/&#236;/ì/gs;
  $name =~ s/&#237;/í/gs;
  $name =~ s/&#238;/î/gs;
  $name =~ s/&#239;/ï/gs;
  $name =~ s/&#240;/ð/gs;
  $name =~ s/&#241;/ñ/gs;
  $name =~ s/&#242;/ò/gs;
  $name =~ s/&#243;/ó/gs;
  $name =~ s/&#244;/ô/gs;
  $name =~ s/&#245;/õ/gs;
  $name =~ s/&#246;/ö/gs;
  $name =~ s/&#247;/÷/gs;
  $name =~ s/&#248;/ø/gs;
  $name =~ s/&#249;/ù/gs;
  $name =~ s/&#250;/ú/gs;
  $name =~ s/&#251;/û/gs;
  $name =~ s/&#252;/ü/gs;
  $name =~ s/&#253;/ý/gs;
  $name =~ s/&#254;/þ/gs;
  $name =~ s/&#255;/ÿ/gs;
  $name =~ s/&#[0-9][0-9][0-9];/_/gs;
  return(trim($name));
}

sub clean {
  my($name) = @_;
  $name = beautify_name($name);
  #    utf8::decode($name);
  # we really do not want any umlauts and special chars in file and link names!
  $name =~ s/[ÄÆ]/Ae/gs;
  $name =~ s/[ÀÁÂÃÅ]/A/gs;
  $name =~ s/Ç/C/gs;
  $name =~ s/[ÈÉÊË]/E/gs;
  $name =~ s/[ÌÍÎÏ]/I/gs;
  $name =~ s/Ð/D/gs;
  $name =~ s/Ñ/N/gs;
  $name =~ s/[ÒÓÔÕ]/O/gs;
  $name =~ s/[ÖØ]/Oe/gs;
  $name =~ s/×/x/gs;
  $name =~ s/Ü/Ue/gs;
  $name =~ s/[ÙÚÛ]/U/gs;
  $name =~ s/Ý/Y/gs;
  $name =~ s/Þ/p/gs;
  $name =~ s/ß/ss/gs;
  $name =~ s/[àáâãå]/a/gs;
  $name =~ s/[äæ]/ae/gs;
  $name =~ s/ç/c/gs;
  $name =~ s/[èéêë]/e/gs;
  $name =~ s/[ìíîï]/i/gs;
  $name =~ s/ñ/n/gs;
  $name =~ s/[òóôõ]/o/gs;
  $name =~ s/[öø]/oe/gs;
  $name =~ s/[ùúû]/u/gs;
  $name =~ s/ü/ue/gs;
  $name =~ s/[ýÿ]/y/gs;
  $name =~ s/þ/p/gs;
  $name =~ s/[^0-9a-zA-Z_\-\+]/_/gs;
  return(trim($name));
}
