Reads HTML and shifts its heading level

shift_heading_level.pl

#!/usr/bin/env perl

use 5.014;
use warnings;
use opts;
use HTML::TreeBuilder;
use HTML::TreeBuilder::XPath;
use Pod::Usage;

opts my $help => +{ isa => 'Bool', default => 0 },
  my $shift_level => +{ isa => 'Int' },
  my $body_only => +{ isa => 'Bool', default => 1 };

pod2usage(+{ -exitval => 0, -verbose => 2 }) if $help;

unless (defined $shift_level) {
  die 'Required parameter "shift-level" is missing.';
}

if (abs($shift_level) >= 6) {
  die 'Shift level must be grater than -5 <= level <= 5.';
}

my $tree = HTML::TreeBuilder->new_from_content(do { local $/; <> });

my @headers; $#headers = 6; # $headers[0] is undef.
for my $header_level (1 .. 6) {
  $headers[$header_level] = [ $tree->findnodes("//h$header_level") ];
}

SHIFT_LEVEL:
for my $header_level (1 .. 6) {
  my $shifted_level = $header_level + $shift_level;
  unless (1 <= $shifted_level and $shifted_level <= 6) {
    $shifted_level = $shifted_level < 1 ? 1 : 6;
  }
  $_->tag("h$shifted_level") for @{ $headers[$header_level] };
}

say $body_only
  ? map { $_->as_XML } $tree->findnodes('/html/body/node()')
  : $tree->as_XML;

$tree->delete;

=head1 NAME

shift_heading_level.pl

=head1 SYNOPSIS

  shift_heading_level.pl --shift-level 2 [--no-body-only] [file ...]

=head1 DESCRIPTION

This program reads HTML and shifts its heading level.

=head1 AUTHOR

Koichi SATOH E<lt>sekia@cpan.orgE<gt>

=cut