Skip to content

Instantly share code, notes, and snippets.

@klopp
Last active March 1, 2020 04:57
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save klopp/aadf718977ae698e407c2edf243310c3 to your computer and use it in GitHub Desktop.
Save klopp/aadf718977ae698e407c2edf243310c3 to your computer and use it in GitHub Desktop.
Парсинг XML - |||
#!/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::Parser;
use utf8;
use open qw/:std :utf8/;
# ------------------------------------------------------------------------------
my ( $chars, $all_chars, %id, @href ) = ( 0, 0 );
XML::Parser->new(
Handlers => {
Start => \&handle_start,
Char => \&handle_char,
}
)->parsefile( @ARGV ? $ARGV[0] : 'test.xml' );;
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 handle_start {
my ( undef, $tag, %attr ) = @_;
$id{ q{#}. $attr{id} } = 1 if exists $attr{id};
if ( $tag eq 'a' ) {
while ( my ( $key, $val ) = each %attr ) {
$key =~ s/^[^:]*?://sm;
if ( $key eq 'href' ) {
if ( index( $val, q{#} ) == 0 ) {
push @href, $val;
last;
}
}
}
}
}
# ------------------------------------------------------------------------------
sub handle_char {
my ( undef, $text ) = @_;
$text =~ s/^\s+|\s+$//gsm;
if ($text) {
$all_chars += length $text;
$text =~ s/\s+//gsm;
$chars += length $text;
}
}
# -----------------------------------------------------------------------------
# That's All, Folks!
# -----------------------------------------------------------------------------
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment