#!/usr/bin/perl

# Copyright (C) 2007 王亮 <netcasper AT gmail DOT com>

# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public Licence as published by
# the Free Software Foundation; either version 2, or (at your option)
# any later version.

# 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 Licence for more details.

use strict;
use warnings;

use XML::OPML;
use XML::Feed;
use Encode;
use YAML::Syck;
use File::HomeDir;
use File::Spec::Functions;
use Getopt::Long;

my $overwrite_old_subscriptions;
my $result = GetOptions
    (
     "scratch" => \$overwrite_old_subscriptions,
    );

die "Usage: perl cache.pl [--scratch]\n"
    unless $result;

my $cache_dir = catdir(File::HomeDir->my_home, ".feedman");
unless (-e $cache_dir and -d _) {
    mkdir $cache_dir, 0700
	or can_not_open_file_or_create_dir('create', $cache_dir, $!);
}

my $cachefile = catfile($cache_dir, "feed.yaml");

my %subscription;

if (!$overwrite_old_subscriptions and -e $cachefile and -f _) {
    local $YAML::Syck::ImplicitUnicode = 1;
    my $cache = LoadFile($cachefile);
    %subscription = %$cache;
}

for my $opml_file (@ARGV) {
    my $opml = XML::OPML->new;
    $opml->parse($opml_file);
    print $opml->head->{title}, "\n";
    for my $outline (@{$opml->outline}) {
	if (exists $outline->{opmlvalue} and $outline->{opmlvalue} eq 'embed') {
	    for my $key (keys %$outline) {
		if (ref $outline->{$key} eq "HASH") {
		    my $embedded_outline = $outline->{$key};
		    $embedded_outline->{xmlUrl} =~ s!^feed://!http://!;
		    if (exists $embedded_outline->{htmlUrl}
			and $embedded_outline->{htmlUrl} ne "") {
			my $htmlUrl = lc $embedded_outline->{htmlUrl};
			unless (exists $subscription{$htmlUrl}
				and exists $subscription{$htmlUrl}->{feeds}) {
			    my @feeds = XML::Feed->find_feeds($embedded_outline->{htmlUrl});
			    $_ =~ s!^feed://!http://! for @feeds;
			    @feeds = grep { $_ !~ m/\Q$embedded_outline->{xmlUrl}\E/i } @feeds;
			    $embedded_outline->{feeds} = \@feeds;
			    $subscription{$htmlUrl} = $embedded_outline;
			    print "  ", encode_utf8($embedded_outline->{title})
				, "\n";
			}
		    }
		    else {
			warn "htmlUrl not found.  $embedded_outline->{title} skipped.\n";
		    }
		}
	    }
	}
	elsif (exists $outline->{htmlUrl}
	       and $outline->{htmlUrl} ne "") {
	    $outline->{xmlUrl} =~ s!^feed://!http://!;
	    my $htmlUrl = lc $outline->{htmlUrl};
	    unless (exists $subscription{$htmlUrl}
		    and exists $subscription{$htmlUrl}->{feeds}) {
		my @feeds = XML::Feed->find_feeds($outline->{htmlUrl});
		$_ =~ s!^feed://!http://! for @feeds;
		@feeds = grep { $_ !~ m/\Q$outline->{xmlUrl}\E/i } @feeds;
		$outline->{feeds} = \@feeds;
		$subscription{$htmlUrl} = $outline;
		print "  ", encode_utf8($outline->{title}), "\n";
	    }
	}
	else {
	    warn "htmlUrl not found.  $outline->{title} skipped.\n";
	}
    }
}

DumpFile($cachefile, \%subscription);

sub can_not_open_file_or_create_dir {
    my ($operation, $name, $message) = @_;

    "can not $operation $name: $message\n";
}