The Perl Toolchain Summit 2025 Needs You: You can help 🙏 Learn more

CHORNY / Padre-Plugin-XML-0.10 / lib / Padre / Task / SyntaxChecker / XML.pm 

            

              
1
2
3
4
5
6
7
8
—
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
—
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159

              
package Padre::Task::SyntaxChecker::XML;
use strict;
use warnings;
our $VERSION = '0.10';
use base 'Padre::Task::Syntax';
use XML::LibXML;
=pod
=head1 NAME
Padre::Task::SyntaxChecker::XML - XML document syntax-checking in the background
=head1 SYNOPSIS
  # by default, the text of the current document
  # will be fetched as will the document's notebook page.
  my $task = Padre::Task::SyntaxChecker::XML->new();
  $task->schedule;
  my $task2 = Padre::Task::SyntaxChecker::XML->new(
    text          => Padre::Documents->current->text_get,
    filename      => Padre::Documents->current->editor->{Document}->filename,
    on_finish     => sub { my $task = shift; ... },
  );
  $task2->schedule;
=head1 DESCRIPTION
This class implements syntax checking of XML documents in
the background. It inherits from L<Padre::Task::Syntax>.
Please read its documentation!
=cut
=for cmt
sub run {
        my $self = shift;
        $self->_check_syntax();
        return 1;
}
=cut
sub _valid {
        my $base_uri = shift;
        my $text = shift;
        my $validator = XML::LibXML->new();
        $validator->validation(0);
        $validator->line_numbers(1);
        $validator->base_uri($base_uri);
        $validator->load_ext_dtd(1);
        $validator->expand_entities(1);
        my $doc = '';
        eval {
                $doc = $validator->parse_string($text , $base_uri );
        };
        if ($@) {
                # parser error
                return _parse_msg( $@, $base_uri );
        }
        else {
                if ( $doc->internalSubset() ) {
                        $validator->validation(1);
                        eval {
                                $doc = $validator->parse_string( $text, $base_uri );
                        };
                        if ($@) {
                                # validation error
                                return _parse_msg( $@, $base_uri );
                        }
                        else {
                                return [];
                        }
                }
                else {
                         return [];
                }
        }
}
sub _check_syntax {
        my $self = shift;
        my $base_uri = $self->{filename};
        $self->{syntax_check} = _valid ($base_uri, $self->{text});
        return;
}
sub _parse_msg {
        my ( $error, $base_uri ) = @_;
        $error =~ s/${base_uri}:/:/g;
        $error =~ s/\sat\s.+?LibXML.pm\sline.+//go;
        my @messages = split( /\n:/, $error );
        my $issues = [];
        my $m = shift @messages;
        if ( $m =~ m/^:(\d+):\s+(.+)/o ) {
                push @{$issues}, { msg => $2, line => $1, severity => 'E', desc => '' };
        }
        else {
                push @{$issues}, { msg => $m, line => $error, severity => 'E', desc => '' };
        }
        foreach my $m (@messages) {
                $m =~ m/^(\d+):\s+(.+)/o;
                push @{$issues}, { msg => $2, line => $1, severity => 'E', desc => '' };
        }
        return $issues;
}
sub syntax {
        my $self = shift;
        my $text = shift;
        if (not $self->{filename}) {
                print "error - no filename\n";
        }
        my $base_uri = $self->{filename};
        return _valid($base_uri, $text);
}
1;
__END__
=head1 SEE ALSO
This class inherits from L<Padre::Task::Syntax> which
in turn is a L<Padre::Task> and its instances can be scheduled
using L<Padre::TaskManager>.
The transfer of the objects to and from the worker threads is implemented
with L<Storable>.
=head1 AUTHOR
Heiko Jansen, C<< <heiko_jansen@web.de> >>
=head1 COPYRIGHT AND LICENSE
Copyright 2008 Heiko Jansen
Copyright 2010 Alexandr Ciornii
This program is free software; you can redistribute it and/or
modify it under the same terms as Perl 5 itself.
=cut