#!/usr/bin/env perl
# ABSTRACT: analyze several HTML documents based on the same template
# PODNAME: untemplate
use strict;
use common::sense;
use feature 'say';

# workaround for the crappy Windows 'Cannot figure out an encoding to use' error
$ENV{LANG} = 'en_US.UTF-8' if $^O =~ /^win/i;
use open ':locale';

use File::Basename;
use File::Temp;
use Getopt::Long;
use HTML::Linear;
use IO::Interactive qw(is_interactive);
use Module::Load qw(load);
use Pod::Usage;
use Term::ANSIColor qw(:constants);
use Tie::IxHash;

our $VERSION = '0.010'; # VERSION


GetOptions(
    q(help)         => \my $help,
    q(color!)       => \my $color,
    q(encoding=s)   => \my $encoding,
    q(shrink!)      => \my $shrink,
    q(strict!)      => \my $strict,
    q(unmangle=s)   => \my @unmangle,
) or pod2usage(q(-verbose) => 1);
pod2usage(q(-verbose) => 1)
    if $help or $#ARGV < 1;

$color //= is_interactive(*STDOUT);

if ($color) {
    # ugly in the morning
    %HTML::Linear::Path::xpath_wrap = (
        array       => [BOLD . CYAN,            RESET],
        attribute   => [BOLD . BRIGHT_YELLOW,   RESET],
        equal       => [BOLD . YELLOW,          RESET],
        number      => [BOLD . BRIGHT_GREEN,    RESET],
        separator   => [BOLD . RED,             RESET],
        sigil       => [BOLD . MAGENTA,         RESET],
        tag         => [BOLD . BRIGHT_BLUE,     RESET],
        value       => [BOLD . BRIGHT_WHITE,    RESET],
    );
}

eval { load('YADA') };
fetch_documents() unless $@;

tie my %elem, 'Tie::IxHash';
for my $file (@ARGV) {
    my $hl = HTML::Linear->new;

    $hl->set_shrink
        if $shrink // 1;

    $hl->set_strict
        if $strict // 0;

    open(my $fh, '<:' . ($encoding ? "encoding($encoding)" : 'locale' ), $file)
        or die "Can't open $file: $!";
    $hl->parse_file($fh)
        or die "Can't parse $file: $!";
    close $fh;

    push @{$elem{$_}}, [ $_ => basename($file) ]
        for $hl->as_list;
}

tie my %xpath, 'Tie::IxHash';
while (my ($key, $list) = each %elem) {
    for (@{$list}) {
        my ($el, $file) = @{$_};

        if (@unmangle) {
            for my $path (@{$el->path}) {
                for my $attr (keys %{$path->attributes}) {
                    next unless HTML::Linear::Path::_isgroup($el->path->[-1], $attr);
                    for my $unmangle (@unmangle) {
                        $path->attributes->{$attr} =~ s/$unmangle//;
                    }
                }
            }
        }

        my $hash = $el->as_hash;
        $xpath{$_}->{$hash->{$_}} = $file
            for keys %{$hash};
    }
}

for my $xpath (keys %xpath) {
    next if 1 == scalar keys %{$xpath{$xpath}};

    my %file;
    push @{$file{$xpath{$xpath}->{$_}}}, $_
        for keys %{$xpath{$xpath}};

    if (1 < scalar keys %file) {
        say $xpath;
        for my $file (sort keys %file) {
            for (@{$file{$file}}) {
                if ($color) {
                    print GREEN . $file . RESET;
                } else {
                    print $file;
                }
                say "\t${_}";
            }
        }
        say '';
    }
}

sub fetch_documents {
    my (@local, @remote);
    for (@ARGV) {
        if (m{^https?://}) {
            push @remote, $_;
        } else {
            push @local, $_;
        }
    }
    return unless @remote;

    @ARGV = @local;

    my $q = YADA->new;
    for (@remote) {
        my $tmp = File::Temp->new(
            SUFFIX      => '.html',
            TEMPLATE    => 'doc-XXXX',
            TMPDIR      => 1,
        );
        $q->append(sub {
            YADA::Worker->new({
                initial_url => $_,
                on_init     => sub {
                    $_[0]->setopt(writedata => $tmp);
                },
                on_finish   => sub {
                    $tmp->flush;
                    push @ARGV, $tmp unless $_[0]->has_error;
                },
            })
        });
    }
    $q->wait;
}

__END__
=pod

=encoding utf8

=head1 NAME

untemplate - analyze several HTML documents based on the same template

=head1 VERSION

version 0.010

=head1 SYNOPSIS

    untemplate [options] HTML1 HTML2 [HTML3] [...]

=head1 DESCRIPTION

Takes multiple HTML documents generated using the same template and attempts to extract only the data inserted into original template.

Accepts URL if L<AnyEvent::Net::Curl::Queued> is present.

=head1 OPTIONS

=over 4

=item --help

This.

=item --encoding=name

Specify the HTML document encoding (C<latin1>, C<utf8>).
System locale is assumed by default.

=item --[no]color

Enable syntax highlight for XPath.
By default, enabled automatically on interactive terminals.

=item --[no]shrink

Shrink the XPath to the minimal unique identifier.
For example:

    /html/body[@id='cpansearch']/form[@class='searchbox']/input[@name='query']

Could be shortened as:

    //input[@name='query']

The shrinking is enabled by default.

=item --[no]strict

Strict mode disables grouping by C<id>, C<class> or C<name> attributes.
The grouping is enabled by default.

=item --unmangle=regex

Specify regex(es) to unmangle C<id>/C<class> attributes.
Some CMS (WordPress) insert unique identifiers into HTML elements, like:

    <body class="post-id-12345">

This tend to break HTML tree analysis.
To fix the above case, use C<--unmangle 'post-id-\d+'>.
Multiple unmanglers are accepted (C<--unmangle a --unmangle b>).

=back

=head1 EXAMPLES

    untemplate --color http://bash.org/?1839 http://bash.org/?2486 | less -R

=head1 CAVEATS

Trying to I<untemplate> HTML documents B<not> based on the same template, the results will be empty.

Unfortunately, employing any kind of document identifier as part of element class/id
(common practice in L<WordPress|http://wordpress.org/> themes)
is enough to constitute "not same template".

See the C<--unmangle> option for a work-around.

=head1 AUTHOR

Stanislaw Pusep <stas@sysd.org>

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2012 by Stanislaw Pusep.

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

=cut

