File Coverage

bin/xpathify

Criterion	Covered	Total	%
statement	74	79	93.6
branch	30	34	88.2
condition	13	16	81.2
subroutine	12	12	100.0
pod			n/a
total	129	141	91.4

#!/usr/bin/env perl
# ABSTRACT: output HTML document as a flat XPath/content list
# PODNAME: xpathify
use 5.010;
use strict;
use utf8::all;
use warnings qw(all);

use Carp qw(croak);
use Encode;
use Getopt::Long;
use HTML::Linear;
use HTTP::Tiny;
use IO::Interactive qw(is_interactive);
use Pod::Usage;

## no critic (ProhibitPackageVars)

our $VERSION = '0.019'; # VERSION


GetOptions(
    q(help)         => \my $help,
    q(color!)       => \my $color,
    q(16)           => \my $sixteen,
    q(html!)        => \my $html,
    q(encoding=s)   => \my $encoding,
    q(shrink!)      => \my $shrink,
    q(strict!)      => \my $strict,
    q(weight!)      => \my $weight,
) or pod2usage(q(-verbose) => 1);
pod2usage(q(-verbose) => 1)
    if $help or $#ARGV != 0;

$color //= is_interactive(*STDOUT);
$weight //= 0;

if ($html) {
    (%HTML::Linear::Path::xpath_wrap) = (%{$HTML::Linear::Path::Colors::scheme{html}});
    $color = 0;
    print $HTML::Linear::Path::Colors::html[0];
} elsif ($color) {
    (%HTML::Linear::Path::xpath_wrap) = (%{$HTML::Linear::Path::Colors::scheme{($sixteen // 0) ? q(terminal) : q(terminal256)}});
    $html = 0;
}

my $hl = HTML::Linear->new;

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

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

my $encoding_layer = ':' . ($encoding ? "encoding($encoding)" : 'utf8');
if ($ARGV[0] =~ m{^https?://}x) {
    my $res = HTTP::Tiny->new->get($ARGV[0]);
    croak "Can't download $ARGV[0]: " . $res->{reason} unless $res->{success};
    $hl->parse_content(decode($encoding || 'utf8', $res->{content}));
} elsif ($ARGV[0] eq '-') {
    binmode(\*STDIN, $encoding_layer);
    $hl->parse_file(\*STDIN);
} else {
    open(my $fh, '<' . $encoding_layer, $ARGV[0])
        or croak "Can't open $ARGV[0]: $!";
    $hl->parse_file($fh);
    close $fh;
}

scan($hl);

print $HTML::Linear::Path::Colors::html[1]
    if $html;

sub scan {
    my ($tree) = @_;
    for my $el ($tree->as_list) {
        my $hash = $el->as_hash;
        for (sort keys %{$hash}) {
            my @line;
            if ($html) {
                push @line, HTML::Linear::Path::Colors::wrap_xpath($_);
                $hash->{$_} = HTML::Linear::Path::Colors::wrap_content($hash->{$_}, 1);
            } elsif ($color) {
                push @line, $_;
                $hash->{$_} = HTML::Linear::Path::Colors::wrap_content($hash->{$_});
            } else {
                push @line, $_;
            }

            push @line, $el->weight if $weight;
            push @line, $hash->{$_};
            if ($html) {
                say '
            } else {
                say join("\t", @line);
            }
        }
    }
    return;
}

__END__