4 |
use English; |
use English; |
5 |
use XML::Parser; |
use XML::Parser; |
6 |
use neb::Parser; |
use neb::Parser; |
7 |
|
use neb::Exception; |
8 |
|
|
9 |
sub new |
sub new |
10 |
{ |
{ |
20 |
{ |
{ |
21 |
my $self = shift; |
my $self = shift; |
22 |
my $file = shift; |
my $file = shift; |
|
my $root = shift; |
|
23 |
|
|
24 |
$self->root($root) if defined($root); |
if ($file) |
25 |
$self->parsefile($file) if $file; |
{ |
26 |
|
$self->root($file); |
27 |
|
$self->parsefile($file); |
28 |
|
} |
29 |
|
|
30 |
return $self; |
return $self; |
31 |
} |
} |
39 |
|
|
40 |
local $INPUT_RECORD_SEPARATOR = undef; |
local $INPUT_RECORD_SEPARATOR = undef; |
41 |
open (F, $file) or confess "Unable to open $file: $OS_ERROR"; |
open (F, $file) or confess "Unable to open $file: $OS_ERROR"; |
42 |
$self->parse(<F>); |
$self->parse(<F>, $file, 0); |
43 |
close F; |
close F; |
44 |
|
|
45 |
return $self; |
return $self; |
60 |
{ |
{ |
61 |
my $self = shift; |
my $self = shift; |
62 |
my $text = shift; |
my $text = shift; |
63 |
# $self->{PARSE} = new XML::Parser(Style => 'neb::Parser')->parse($text) |
my $file = shift; |
64 |
# if defined $text; |
my $offset = shift; |
65 |
|
|
66 |
if (defined $text) |
if (defined $text) |
67 |
{ |
{ |
68 |
my $p = new XML::Parser(Style => 'neb::Parser'); |
my $p = new XML::Parser(Style => 'neb::Parser', ErrorContext => 0); |
69 |
$self->{PARSE} = $p->parse($text, 'neb_root_name' => $self->root); |
eval {$self->{PARSE} = $p->parse($text, 'neb_root_name' => $self->root, |
70 |
|
'neb_file_name' => $file, 'neb_offset' => $offset); }; |
71 |
|
if ($EVAL_ERROR) |
72 |
|
{ |
73 |
|
my $errmsg = $EVAL_ERROR; |
74 |
|
my ($msg, $line, $col) = $errmsg =~ m/^(.*?)\s*at line (\d+), column (\d+), byte \d+:$/m; |
75 |
|
$errmsg =~ s/^\s*//; |
76 |
|
$errmsg =~ s/^.*$//m; |
77 |
|
$errmsg =~ s/^.//s; |
78 |
|
$errmsg =~ s/^.*\Z//m; |
79 |
|
my @context = split /\n/, $errmsg; |
80 |
|
|
81 |
|
$col -= $offset; |
82 |
|
|
83 |
|
throw $msg, $file, $line, $col, @context; |
84 |
|
} |
85 |
} |
} |
86 |
|
|
87 |
return $self->{PARSE}; |
return $self->{PARSE}; |