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