Парсинг XML - II

xml-twig.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::Twig;
use utf8;
use open qw/:std :utf8/;

# -----------------------------------------------------------------------------
my @nodes = XML::Twig->new->parsefile( @ARGV ? $ARGV[0] : 'test.xml')->findnodes(q{});

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->atts;
        $id{ q{#}. $attr->{id} } = 1 if exists $attr->{id};

        if ( $node->name eq q{a} ) {
            while ( my ( $key, $val ) = each %{$attr} ) {
                $key =~ s/^[^:]*?://sm;
                if ( $key eq 'href' ) {
                    if ( index( $val, q{#} ) == 0 ) {
                        push @href, $val;
                        last;
                    }
                }
            }
        }

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

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