1# This software is copyright (c) 2011 by Jeffrey Kegler
2# This is free software; you can redistribute it and/or modify it
3# under the same terms as the Perl 5 programming language system
4# itself.
5
6package Marpa::HTML::Display;
7
8use 5.010;
9use strict;
10use warnings;
11use integer;
12use Fatal qw(open close);
13use YAML::XS;
14use Data::Dumper;    # for debugging
15use Carp;
16
17package Marpa::HTML::Display::Internal;
18
19use English qw( -no_match_vars );
20
21sub Marpa::HTML::Display::new {
22    my ($class) = @_;
23    my $self = {};
24    $self->{displays}         = {};
25    $self->{ignored_displays} = [];
26    return bless $self, $class;
27} ## end sub Marpa::HTML::Display::new
28
29@Marpa::HTML::Display::Internal::DISPLAY_SPECS = qw(
30    start-after-line end-before-line perltidy normalize-whitespace name
31    remove-display-indent
32    remove-blank-last-line
33    partial flatten inline
34    ignore
35);
36
37sub Marpa::HTML::Display::read {
38    my ( $self, $data_arg, $file_name ) = @_;
39    my @lines;
40    GET_LINES: {
41        if ( not ref $data_arg ) {
42            $file_name //= $data_arg;
43            open my $fh, q{<}, $data_arg;
44            @lines = <$fh>;
45            close $fh;
46            last GET_LINES;
47        } ## end if ( not ref $data_arg )
48        $file_name //= q{?};
49        @lines = split /\n/xms, ${$data_arg};
50    } ## end GET_LINES:
51
52    chomp @lines;
53    my @verbatim_lines;
54    my $in_pod      = 0;
55    my $in_verbatim = 0;
56    my $in_begin;
57    POD_LINE: for my $zero_based_line ( 0 .. $#lines ) {
58        my $line = $lines[$zero_based_line];
59        if ( $in_pod and $line =~ /\A=cut/xms ) {
60            $in_pod      = 0;
61            $in_verbatim = 0;
62            $in_begin    = undef;
63            next POD_LINE;
64        } ## end if ( $in_pod and $line =~ /\A=cut/xms )
65        if ( not $in_pod and $line =~ /\A=[a-zA-Z]/xms ) {
66            $in_pod = 1;
67        }
68        next POD_LINE if not $in_pod;
69
70        # at this point out $in_pod indicates if we are
71        # in a pod sequence
72        if ( $in_pod and not $in_begin and $line =~ /\A=begin\s+(.*)/xms ) {
73            my $begin_identifier = $1;
74            if ( $begin_identifier !~ /\A:/xms ) {
75                $in_begin = $begin_identifier;
76            }
77        } ## end if ( $in_pod and not $in_begin and $line =~ ...)
78        if ( $in_begin and $line =~ /\A=end\s+(.*)/xms ) {
79            my $begin_identifier = $1;
80            if ( $begin_identifier eq $in_begin ) {
81                $in_begin = undef;
82            }
83        } ## end if ( $in_begin and $line =~ /\A=end\s+(.*)/xms )
84
85        # Don't look for verbatim paragraph inside begin
86        next POD_LINE if $in_begin;
87
88        # Is this the start of a verbatim paragraph?
89        if ( not $in_verbatim and $line =~ /\A[ \t]/xms ) {
90            $in_verbatim = 1;
91        }
92        if ( $in_verbatim and $line =~ /\A[ \t]*\z/xms ) {
93            $in_verbatim = 0;
94        }
95        if ($in_verbatim) {
96            $verbatim_lines[ $zero_based_line + 1 ] = $line;
97        }
98    } ## end for my $zero_based_line ( 0 .. $#lines )
99    LINE: for my $zero_based_line ( 0 .. $#lines ) {
100        my $line = $lines[$zero_based_line];
101
102        my $display_spec;
103        my $display_spec_line_number = $zero_based_line + 1;
104        if ( $line =~ /^[#] \s+ Marpa::HTML[:][:]Display/xms ) {
105
106            my $yaml = q{};
107            while ( ( my $yaml_line = $lines[ ++$zero_based_line ] )
108                =~ /^[#]/xms )
109            {
110                $yaml .= "$yaml_line\n";
111            }
112            if ( $yaml =~ / \S /xms ) {
113                $yaml =~ s/^ [#] \s? //xmsg;
114                local $main::EVAL_ERROR = undef;
115                my $eval_ok =
116                    eval { $display_spec = YAML::XS::Load($yaml); 1 };
117                if ( not $eval_ok ) {
118                    say {*STDERR} $main::EVAL_ERROR
119                        or Carp::croak("Cannot print: $ERRNO");
120                    say {*STDERR}
121                        "Fatal error in YAML Display spec at $file_name, line "
122                        . ( $display_spec_line_number + 1 )
123                        or Carp::croak("Cannot print: $ERRNO");
124                } ## end if ( not $eval_ok )
125            } ## end if ( $yaml =~ / \S /xms )
126        } ## end if ( $line =~ /^[#] \s+ Marpa::HTML[:][:]Display/xms )
127
128        if ( $line =~ /^[=]for \s+ Marpa::HTML[:][:]Display/xms ) {
129
130            my $yaml = q{};
131            while (
132                ( my $yaml_line = $lines[ ++$zero_based_line ] ) =~ /\S/xms )
133            {
134                $yaml .= "$yaml_line\n";
135            }
136            if ( $yaml =~ / \S /xms ) {
137                local $main::EVAL_ERROR = undef;
138                my $eval_ok =
139                    eval { $display_spec = YAML::XS::Load($yaml); 1 };
140                if ( not $eval_ok ) {
141                    say {*STDERR} $main::EVAL_ERROR
142                        or Carp::croak("Cannot print: $ERRNO");
143                    say {*STDERR}
144                        "Fatal error in YAML Display spec at $file_name, line "
145                        . ( $display_spec_line_number + 1 )
146                        or Carp::croak("Cannot print: $ERRNO");
147                } ## end if ( not $eval_ok )
148            } ## end if ( $yaml =~ / \S /xms )
149        } ## end if ( $line =~ /^[=]for \s+ Marpa::HTML[:][:]Display/xms)
150
151        next LINE if not defined $display_spec;
152
153        SPEC: for my $spec ( keys %{$display_spec} ) {
154            next SPEC
155                if $spec ~~ \@Marpa::HTML::Display::Internal::DISPLAY_SPECS;
156            say {*STDERR}
157                qq{Warning: Unknown display spec "$spec" in $file_name, line $display_spec_line_number}
158                or Carp::croak("Cannot print: $ERRNO");
159        } ## end for my $spec ( keys %{$display_spec} )
160
161        my $content;
162        my $content_start_line;
163        my $content_end_line;
164        if ( defined( my $end_pattern = $display_spec->{'end-before-line'} ) )
165        {
166            my $end_pat = qr/$end_pattern/xms;
167            if (defined(
168                    my $start_pattern = $display_spec->{'start-after-line'}
169                )
170                )
171            {
172                my $start_pat = qr/$start_pattern/xms;
173                PRE_CONTENT_LINE: while (1) {
174                    my $pre_content_line = $lines[ ++$zero_based_line ];
175                    if ( not defined $pre_content_line ) {
176                        say {*STDERR}
177                            qq{Warning: Pattern "$start_pattern" never found, },
178                            qq{started looking at $file_name, line $display_spec_line_number}
179                            or Carp::croak("Cannot print: $ERRNO");
180                        return $self;
181                    } ## end if ( not defined $pre_content_line )
182                    last PRE_CONTENT_LINE
183                        if $pre_content_line =~ /$start_pat/xms;
184                } ## end while (1)
185            } ## end if ( defined( my $start_pattern = $display_spec->{...}))
186
187            CONTENT_LINE: while (1) {
188                my $content_line = $lines[ ++$zero_based_line ];
189                if ( not defined $content_line ) {
190                    say {*STDERR}
191                        qq{Warning: Pattern "$end_pattern" never found, },
192                        qq{started looking at $file_name, line $display_spec_line_number}
193                        or Carp::croak("Cannot print: $ERRNO");
194                } ## end if ( not defined $content_line )
195                last CONTENT_LINE if $content_line =~ /$end_pat/xms;
196                $content .= "$content_line\n";
197                $content_end_line = $zero_based_line + 1;
198                $content_start_line //= $zero_based_line + 1;
199            } ## end while (1)
200        } ## end if ( defined( my $end_pattern = $display_spec->{...}))
201
202        if ( not defined $content ) {
203            CONTENT_LINE: while (1) {
204                my $content_line = $lines[ ++$zero_based_line ];
205                if ( not defined $content_line ) {
206                    say {*STDERR}
207                        q{Warning: Pattern "Marpa::HTML::Display::End" never found,}
208                        . qq{started looking at $file_name, line $display_spec_line_number}
209                        or Carp::croak("Cannot print: $ERRNO");
210                    return $self;
211                } ## end if ( not defined $content_line )
212                last CONTENT_LINE
213                    if $content_line
214                        =~ /^[=]for \s+ Marpa::HTML[:][:]Display[:][:]End\b/xms;
215                last CONTENT_LINE
216                    if $content_line
217                        =~ /^[#] \s* Marpa::HTML[:][:]Display[:][:]End\b/xms;
218                $content .= "$content_line\n";
219                $content_end_line = $zero_based_line + 1;
220                $content_start_line //= $zero_based_line + 1;
221            } ## end while (1)
222        } ## end if ( not defined $content )
223
224        $content //= '!?! No Content Found !?!';
225
226        my $display_spec_name = $display_spec->{name};
227        my $ignore            = $display_spec->{ignore};
228        if ( not $display_spec_name and not $ignore ) {
229            say {*STDERR} q{Warning: Unnamed display }
230                . qq{at $file_name, line $display_spec_line_number}
231                or Carp::croak("Cannot print: $ERRNO");
232            next LINE;
233        } ## end if ( not $display_spec_name and not $ignore )
234
235        $display_spec->{filename}           = $file_name;
236        $display_spec->{display_spec_line}  = $display_spec_line_number;
237        $display_spec->{content}            = $content;
238        $display_spec->{content_start_line} = $content_start_line;
239        $display_spec->{content_end_line}   = $content_end_line;
240        $display_spec->{line}               = $content_start_line
241            // $display_spec_line_number;
242
243        $verbatim_lines[$_] = undef
244            for $display_spec->{line} .. $display_spec->{content_end_line};
245
246        if ( not $ignore ) {
247            push @{ $self->{displays}->{$display_spec_name} }, $display_spec;
248            next LINE;
249        }
250
251        push @{ $self->{ignored_displays} }, $display_spec;
252
253    } ## end for my $zero_based_line ( 0 .. $#lines )
254
255    $self->{verbatim_lines}->{$file_name} = \@verbatim_lines;
256
257    return $self;
258
259} ## end sub Marpa::HTML::Display::read
260
2611;
262