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 push @events, $stream->next;
69 return HTML::Zoom->from_events(\@events)->to_html;
72 my $_get_class = sub {
73 my ($event, $rx) = @_;
74 my $class = $event->{attrs}{class} || '';
81 sub _inflate_columns {
82 my ($self, $stream) = @_;
85 while (my $next = $stream->next) {
86 if (my $ev = $stream->$_is_type(open => 'th')) {
87 my $key = $ev->$_get_class(qr{si-colhead-(\S+)});
88 my $label = $stream->$_collect_content('th');
90 key => defined($key) ? $key : '__usercol_' . $user_col_idx++,
92 defined($key) ? () : (user => 1),
95 elsif ($stream->$_is_type(close => 'tr')) {
103 my ($self, $stream, $cols) = @_;
105 my $user_col_orph_idx = 0;
106 while (my $next = $stream->next) {
107 if ($stream->$_is_type(open => 'tr')) {
111 if (my $ev = $stream->$_is_type(open => 'td')) {
113 if ($#$cols >= scalar keys %{$rows[-1]}) {
114 $key = $cols->[scalar keys %{$rows[-1]}]{key};
118 key => "__usercol_orph_" . $user_col_orph_idx++,
121 push @$cols, $newcol;
122 $key = $newcol->{key};
124 my $value = $stream->$_collect_content('td');
125 $rows[-1]{$key} = $value;
131 sub _inflate_report {
132 my ($self, $table, $id) = @_;
133 my $markup = HTML::Zoom->from_html($table);
134 my $stream = $markup->to_stream;
135 my @columns = $self->_inflate_columns($stream);
136 my $rows = $self->_inflate_rows($stream, \@columns);
138 id => [split m{:}, $id],
139 columns => [@columns],
145 my ($self, $lines) = @_;
146 my $start_line = shift @$lines;
147 $start_line =~ m{ $_rx_title_begin ($_rx_id) $_rx_end }x
148 or die "Unable to parse table start: $start_line\n";
150 my $title_line = shift @$lines;
151 $title_line =~ m{ \A == \s+ (.+) \s+ == \Z }x
152 or die "Unable to parse title line: $title_line\n";
154 my $end_line = shift(@$lines);
155 $end_line =~ m{ $_rx_title_end \Q$id\E $_rx_end }x
156 or die "Missing title end marker, found: $end_line\n";
161 my ($self, $lines, $done) = @_;
163 if ($lines->[0] =~ m{ $_rx_any_begin $_rx_id $_rx_end }x) {
164 return '_parse_table';
166 my $line = shift @$lines;