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