blackbox.pm

source of perl for linux application,

  return;
}

#~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`

{
my $m = -321;   # magic line number

sub _gen_errata {
  my $self = $_[0];
  # Return 0 or more fake-o paragraphs explaining the accumulated
  #  errors on this document.

  return() unless $self->{'errata'} and keys %{$self->{'errata'}};

  my @out;
  
  foreach my $line (sort {$a <=> $b} keys %{$self->{'errata'}}) {
    push @out,
      ['=item', {'start_line' => $m}, "Around line $line:"],
      map( ['~Para', {'start_line' => $m, '~cooked' => 1},
        #['~Top', {'start_line' => $m},
        $_
        #]
        ],
        @{$self->{'errata'}{$line}}
      )
    ;
  }
  
  # TODO: report of unknown entities? unrenderable characters?

  unshift @out,
    ['=head1', {'start_line' => $m, 'errata' => 1}, 'POD ERRORS'],
    ['~Para', {'start_line' => $m, '~cooked' => 1, 'errata' => 1},
     "Hey! ",
     ['B', {},
      'The above document had some coding errors, which are explained below:'
     ]
    ],
    ['=over',  {'start_line' => $m, 'errata' => 1}, ''],
  ;

  push @out, 
    ['=back',  {'start_line' => $m, 'errata' => 1}, ''],
  ;

  DEBUG and print "\n<<\n", pretty(\@out), "\n>>\n\n";

  return @out;
}

}

#@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@

##############################################################################
##
##  stop reading now stop reading now stop reading now stop reading now stop
##
##                         HERE IT BECOMES REALLY SCARY
##
##  stop reading now stop reading now stop reading now stop reading now stop
##
##############################################################################

sub _ponder_paragraph_buffer {

  # Para-token types as found in the buffer.
  #   ~Verbatim, ~Para, ~end, =head1..4, =for, =begin, =end,
  #   =over, =back, =item
  #   and the null =pod (to be complained about if over one line)
  #
  # "~data" paragraphs are something we generate at this level, depending on
  # a currently open =over region

  # Events fired:  Begin and end for:
  #                   directivename (like head1 .. head4), item, extend,
  #                   for (from =begin...=end, =for),
  #                   over-bullet, over-number, over-text, over-block,
  #                   item-bullet, item-number, item-text,
  #                   Document,
  #                   Data, Para, Verbatim
  #                   B, C, longdirname (TODO -- wha?), etc. for all directives
  # 

  my $self = $_[0];
  my $paras;
  return unless @{$paras = $self->{'paras'}};
  my $curr_open = ($self->{'curr_open'} ||= []);

  my $scratch;

  DEBUG > 10 and print "# Paragraph buffer: <<", pretty($paras), ">>\n";

  # We have something in our buffer.  So apparently the document has started.
  unless($self->{'doc_has_started'}) {
    $self->{'doc_has_started'} = 1;
    
    my $starting_contentless;
    $starting_contentless =
     (
       !@$curr_open  
       and @$paras and ! grep $_->[0] ne '~end', @$paras
        # i.e., if the paras is all ~ends
     )
    ;
    DEBUG and print "# Starting ", 
      $starting_contentless ? 'contentless' : 'contentful',
      " document\n"
    ;
    
    $self->_handle_element_start(
      ($scratch = 'Document'),
      {
        'start_line' => $paras->[0][1]{'start_line'},
        $starting_contentless ? ( 'contentless' => 1 ) : (),
      },
    );
  }

  my($para, $para_type);
  while(@$paras) {
    last if @$paras == 1 and
      ( $paras->[0][0] eq '=over' or $paras->[0][0] eq '~Verbatim'
        or $paras->[0][0] eq '=item' )
    ;
    # Those're the three kinds of paragraphs that require lookahead.
    #   Actually, an "=item Foo" inside an <over type=text> region
    #   and any =item inside an <over type=block> region (rare)
    #   don't require any lookahead, but all others (bullets
    #   and numbers) do.

# TODO: winge about many kinds of directives in non-resolving =for regions?
# TODO: many?  like what?  =head1 etc?

    $para = shift @$paras;
    $para_type = $para->[0];

    DEBUG > 1 and print "Pondering a $para_type paragraph, given the stack: (",
      $self->_dump_curr_open(), ")\n";
    
    if($para_type eq '=for') {
      next if $self->_ponder_for($para,$curr_open,$paras);

    } elsif($para_type eq '=begin') {
      next if $self->_ponder_begin($para,$curr_open,$paras);

    } elsif($para_type eq '=end') {
      next if $self->_ponder_end($para,$curr_open,$paras);

    } elsif($para_type eq '~end') { # The virtual end-document signal
      next if $self->_ponder_doc_end($para,$curr_open,$paras);
    }


    # ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
    #~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
    if(grep $_->[1]{'~ignore'}, @$curr_open) {
      DEBUG > 1 and
       print "Skipping $para_type paragraph because in ignore mode.\n";
      next;
    }
    #~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
    # ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~

    if($para_type eq '=pod') {
      $self->_ponder_pod($para,$curr_open,$paras);

    } elsif($para_type eq '=over') {
      next if $self->_ponder_over($para,$curr_open,$paras);

    } elsif($para_type eq '=back') {
      next if $self->_ponder_back($para,$curr_open,$paras);

    } else {

      # All non-magical codes!!!
      
      # Here we start using $para_type for our own twisted purposes, to
      #  mean how it should get treated, not as what the element name
      #  should be.

      DEBUG > 1 and print "Pondering non-magical $para_type\n";

      my $i;

      # Enforce some =headN discipline
      if($para_type =~ m/^=head\d$/s
         and ! $self->{'accept_heads_anywhere'}
         and @$curr_open
         and $curr_open->[-1][0] eq '=over'
      ) {
        DEBUG > 2 and print "'=$para_type' inside an '=over'!\n";
        $self->whine(
          $para->[1]{'start_line'},
          "You forgot a '=back' before '$para_type'"
        );
        unshift @$paras, ['=back', {}, ''], $para;   # close the =over
        next;
      }


      if($para_type eq '=item') {

        my $over;
        unless(@$curr_open and ($over = $curr_open->[-1])->[0] eq '=over') {
          $self->whine(
            $para->[1]{'start_line'},
            "'=item' outside of any '=over'"
          );
          unshift @$paras,
            ['=over', {'start_line' => $para->[1]{'start_line'}}, ''],
            $para
          ;
          next;
        }
        
        
        my $over_type = $over->[1]{'~type'};
        
        if(!$over_type) {
          # Shouldn't happen1
          die "Typeless over in stack, starting at line "
           . $over->[1]{'start_line'};

        } elsif($over_type eq 'block') {
          unless($curr_open->[-1][1]{'~bitched_about'}) {
            $curr_open->[-1][1]{'~bitched_about'} = 1;
            $self->whine(
              $curr_open->[-1][1]{'start_line'},
              "You can't have =items (as at line "
              . $para->[1]{'start_line'}
              . ") unless the first thing after the =over is an =item"
            );
          }
          # Just turn it into a paragraph and reconsider it
          $para->[0] = '~Para';
          unshift @$paras, $para;
          next;

        } elsif($over_type eq 'text') {
          my $item_type = $self->_get_item_type($para);
            # That kills the content of the item if it's a number or bullet.
          DEBUG and print " Item is of type ", $para->[0], " under $over_type\n";
          
          if($item_type eq 'text') {
            # Nothing special needs doing for 'text'
          } elsif($item_type eq 'number' or $item_type eq 'bullet') {
            die "Unknown item type $item_type"
             unless $item_type eq 'number' or $item_type eq 'bullet';
            # Undo our clobbering:
            push @$para, $para->[1]{'~orig_content'};
            delete $para->[1]{'number'};
             # Only a PROPER item-number element is allowed
             #  to have a number attribute.
          } else {
            die "Unhandled item type $item_type"; # should never happen
          }
          
          # =item-text thingies don't need any assimilation, it seems.

        } elsif($over_type eq 'number') {
          my $item_type = $self->_get_item_type($para);
            # That kills the content of the item if it's a number or bullet.
          DEBUG and print " Item is of type ", $para->[0], " under $over_type\n";
          
          my $expected_value = ++ $curr_open->[-1][1]{'~counter'};
          
          if($item_type eq 'bullet') {
            # Hm, it's not numeric.  Correct for this.
            $para->[1]{'number'} = $expected_value;
            $self->whine(
              $para->[1]{'start_line'},
              "Expected '=item $expected_value'"
            );
            push @$para, $para->[1]{'~orig_content'};
              # restore the bullet, blocking the assimilation of next para

          } elsif($item_type eq 'text') {
            # Hm, it's not numeric.  Correct for this.
            $para->[1]{'number'} = $expected_value;
            $self->whine(
              $para->[1]{'start_line'},
              "Expected '=item $expected_value'"
            );
            # Text content will still be there and will block next ~Para

          } elsif($item_type ne 'number') {
            die "Unknown item type $item_type"; # should never happen

          } elsif($expected_value == $para->[1]{'number'}) {
            DEBUG > 1 and print " Numeric item has the expected value of $expected_value\n";
            
          } else {
            DEBUG > 1 and print " Numeric item has ", $para->[1]{'number'},
             " instead of the expected value of $expected_value\n";
            $self->whine(
              $para->[1]{'start_line'},
              "You have '=item " . $para->[1]{'number'} .
              "' instead of the expected '=item $expected_value'"
            );
            $para->[1]{'number'} = $expected_value;  # correcting!!
          }
            
          if(@$para == 2) {
            # For the cases where we /didn't/ push to @$para
            if($paras->[0][0] eq '~Para') {
              DEBUG and print "Assimilating following ~Para content into $over_type item\n";
              push @$para, splice @{shift @$paras},2;
            } else {
              DEBUG and print "Can't assimilate following ", $paras->[0][0], "\n";
              push @$para, '';  # Just so it's not contentless
            }
          }


        } elsif($over_type eq 'bullet') {
          my $item_type = $self->_get_item_type($para);
            # That kills the content of the item if it's a number or bullet.
          DEBUG and print " Item is of type ", $para->[0], " under $over_type\n";
          
          if($item_type eq 'bullet') {
            # as expected!

            if( $para->[1]{'~_freaky_para_hack'} ) {
              DEBUG and print "Accomodating '=item * Foo' tolerance hack.\n";
              push @$para, delete $para->[1]{'~_freaky_para_hack'};
            }

          } elsif($item_type eq 'number') {
            $self->whine(
              $para->[1]{'start_line'},
              "Expected '=item *'"
            );
            push @$para, $para->[1]{'~orig_content'};
             # and block assimilation of the next paragraph
            delete $para->[1]{'number'};
             # Only a PROPER item-number element is allowed
             #  to have a number attribute.
          } elsif($item_type eq 'text') {
            $self->whine(
              $para->[1]{'start_line'},
              "Expected '=item *'"
            );
             # But doesn't need processing.  But it'll block assimilation
             #  of the next para.
          } else {
            die "Unhandled item type $item_type"; # should never happen
          }

          if(@$para == 2) {
            # For the cases where we /didn't/ push to @$para
            if($paras->[0][0] eq '~Para') {
              DEBUG and print "Assimilating following ~Para content into $over_type item\n";
              push @$para, splice @{shift @$paras},2;
            } else {
              DEBUG and print "Can't assimilate following ", $paras->[0][0], "\n";
              push @$para, '';  # Just so it's not contentless
            }
          }

        } else {
          die "Unhandled =over type \"$over_type\"?";
          # Shouldn't happen!
        }

        $para_type = 'Plain';
        $para->[0] .= '-' . $over_type;
        # Whew.  Now fall thru and process it.


      } elsif($para_type eq '=extend') {
        # Well, might as well implement it here.
        $self->_ponder_extend($para);
        next;  # and skip
      } elsif($para_type eq '=encoding') {
        # Not actually acted on here, but we catch errors here.
        $self->_handle_encoding_second_level($para);

        next;  # and skip
      } elsif($para_type eq '~Verbatim') {
        $para->[0] = 'Verbatim';
        $para_type = '?Verbatim';
      } elsif($para_type eq '~Para') {