Парсинг XML - I

xml-libxml.pl

#!/usr/bin/perl

# ------------------------------------------------------------------------------
# Напишите скрипт, получающий в качестве параметра путь к XML-файлу и выдающий
# на STDOUT следующее:
# * суммарное число букв внутри тегов, не включая пробельные символы 
#   (<aaa dd="ddd">text</aaa> - четыре буквы)
# * суммарное число букв нормализованного текста внутри тегов, включая пробелы
# * число внутренних ссылок (теги <a href="#id">)
# * число битых внутренних ссылок (ссылки на несуществующие ID элементов)
# ------------------------------------------------------------------------------
use Modern::Perl;
use Number::Format qw/format_number/;
use XML::LibXML;
use utf8;
use open qw/:std :utf8/;

# ------------------------------------------------------------------------------
my @nodes = XML::LibXML->load_xml( 
    location => @ARGV ? $ARGV[0] : 'test.xml' 
)->nonBlankChildNodes;

my ( $chars, $all_chars, %id, @href ) = ( 0, 0 );

walk_nodes( \@nodes );

say 'All characters            : ' . format_number($all_chars);
say 'Non-whitespace characters : ' . format_number($chars);
say 'Internal links            : ' . format_number( scalar @href );
my $errors = 0;
for (@href) {
    ++$errors unless exists $id{$_};
}
say 'Broken links              : ' . format_number($errors) if $errors;

# ------------------------------------------------------------------------------
sub walk_nodes {

    my ($nodes) = @_;

    for my $node ( @{$nodes} ) {

        my @attr = $node->attributes;
        for (@attr) {
            $id{ q{#}. $_->getValue } = 1 if $_ && $_->name eq 'id';
        }

        if ( $node->nodeName eq q{a} ) {
            for (@attr) {
                if ( $_->name eq 'href' ) {
                    if ( index( $_->getValue, q{#} ) == 0 ) {
                        push @href, $_->getValue;
                        last;
                    }
                }
            }
        }

        my @children = $node->nonBlankChildNodes;
        if (@children) {
            walk_nodes( \@children );
        }
        else {
            my $text = $node->to_literal;
            if ($text) {
                $all_chars += length $text;
                $text      =~ s/\s+//gsm;
                $chars     += length $text;
            }
        }
    }
}

# -----------------------------------------------------------------------------
# That's All, Folks!
# -----------------------------------------------------------------------------