1 package System::Introspector::Report::Publish::MediaWiki::Parser;
5 my $_rx_front = qr{\A<!--\s+SI:};
6 my $_rx_end = qr{\s+-->\Z};
7 my $_rx_table_begin = qr{ $_rx_front TABLE \s+ begin \s+ }x;
8 my $_rx_table_end = qr{ $_rx_front TABLE \s+ end \s+ }x;
9 my $_rx_title_begin = qr{ $_rx_front TITLE \s+ begin \s+ }x;
10 my $_rx_title_end = qr{ $_rx_front TITLE \s+ end \s+ }x;
11 my $_rx_any_begin = qr{ $_rx_front (TABLE|TITLE) \s+ begin \s }x;
12 my $_rx_id = qr{(\S+)};
15 my ($self, $body) = @_;
16 my $lines = [split m{\n}, $body];
18 my $state = '_parse_text';
20 $state = $self->$state($lines, $parts);
26 my ($self, $lines, $done) = @_;
27 my ($id, $title) = $self->_read_title($lines);
29 $self->_parse_text($lines, $description);
30 my $report = $self->_read_report($lines, $id);
31 $report->{title} = $title;
32 $report->{description} = $description;
38 my ($self, $lines, $id) = @_;
39 shift(@$lines) =~ m{ $_rx_table_begin \Q$id\E $_rx_end }x
40 or die "Expected table for '$id' after title\n";
43 my $line = shift @$lines;
44 if ($line =~ m{ $_rx_table_end $_rx_id $_rx_end }x) {
45 return $self->_inflate_report(join('', @report_lines), $id);
47 push @report_lines, $line;
49 die "Missing end of '$id' report\n";
53 my ($markup, $type, $tag) = @_;
54 my $next = $markup->peek;
57 ($next->{name} || '') eq $tag
58 and ($next->{type} || '') eq uc($type)
63 my $_collect_content = sub {
64 my ($stream, $type) = @_;
66 until ($stream->$_is_type(close => $type)) {
67 my $next = $stream->next;
68 if ($next->{type} eq 'OPEN' and $next->{name} eq 'br') {
69 push @events, { type => 'TEXT', raw => "\n" };
75 return HTML::Zoom->from_events(\@events)->to_html;
78 my $_get_class = sub {
79 my ($event, $rx) = @_;
80 my $class = $event->{attrs}{class} || '';
87 sub _inflate_columns {
88 my ($self, $stream) = @_;
91 while (my $next = $stream->next) {
92 if (my $ev = $stream->$_is_type(open => 'th')) {
93 my $key = $ev->$_get_class(qr{si-colhead-(\S+)});
94 my $label = $stream->$_collect_content('th');
96 key => defined($key) ? $key : '__usercol_' . $user_col_idx++,
98 defined($key) ? () : (user => 1),
101 elsif ($stream->$_is_type(close => 'tr')) {
109 my ($self, $stream, $cols) = @_;
111 my $user_col_orph_idx = 0;
112 while (my $next = $stream->next) {
113 if ($stream->$_is_type(open => 'tr')) {
117 if (my $ev = $stream->$_is_type(open => 'td')) {
119 if ($#$cols >= scalar keys %{$rows[-1]}) {
120 $key = $cols->[scalar keys %{$rows[-1]}]{key};
124 key => "__usercol_orph_" . $user_col_orph_idx++,
127 push @$cols, $newcol;
128 $key = $newcol->{key};
130 my $value = $stream->$_collect_content('td');
131 $rows[-1]{$key} = $value;
137 sub _inflate_report {
138 my ($self, $table, $id) = @_;
139 my $markup = HTML::Zoom->from_html($table);
140 my $stream = $markup->to_stream;
141 my @columns = $self->_inflate_columns($stream);
142 my $rows = $self->_inflate_rows($stream, \@columns);
144 id => [split m{:}, $id],
145 columns => [@columns],
151 my ($self, $lines) = @_;
152 my $start_line = shift @$lines;
153 $start_line =~ m{ $_rx_title_begin ($_rx_id) $_rx_end }x
154 or die "Unable to parse table start: $start_line\n";
156 my $title_line = shift @$lines;
157 $title_line =~ m{ \A == \s+ (.+) \s+ == \Z }x
158 or die "Unable to parse title line: $title_line\n";
160 my $end_line = shift(@$lines);
161 $end_line =~ m{ $_rx_title_end \Q$id\E $_rx_end }x
162 or die "Missing title end marker, found: $end_line\n";
167 my ($self, $lines, $done) = @_;
169 if ($lines->[0] =~ m{ $_rx_any_begin $_rx_id $_rx_end }x) {
170 return '_parse_table';
172 my $line = shift @$lines;