src/man2hlp/man2hlp.in

   1 #! @PERL@ -w
   2 #
   3 #  Man page to help file converter
   4 #  Copyright (C) 1994, 1995, 1998, 2000, 2001, 2002, 2003, 2004, 2005,
   5 #  2007, 2010 Free Software Foundation, Inc.
   6 #
   7 #  Originally written by:
   8 #   2002  Andrew V. Samoilov
   9 #   2002  Pavel Roskin
  10 #   2010  Andrew Borodin
  11 #  Completely rewriten on perl by:
  12 #   2010  Alexandr Prenko
  13 #
  14 #  This program is free software; you can redistribute it and/or modify
  15 #  it under the terms of the GNU General Public License as published by
  16 #  the Free Software Foundation; either version 2 of the License, or
  17 #  (at your option) any later version.
  18 #
  19 #  This program is distributed in the hope that it will be useful,
  20 #  but WITHOUT ANY WARRANTY; without even the implied warranty of
  21 #  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  22 #  GNU General Public License for more details.
  23 #
  24 #  You should have received a copy of the GNU General Public License
  25 #  along with this program; if not, write to the Free Software
  26 #  Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.  */
  27 #
  28 # \file man2hlp.c
  29 # \brief Source: man page to help file converter
  30
  31 # include "help.h"
  32 # end of include "help.h"
  33
  34 use strict;
  35 use warnings;
  36
  37 # Perl have no static variables, so this hash emulates them
  38 my %static = (
  39     "string_len anchor_flag"    => 0,
  40     "string_len lc_link_flag"   => 0,
  41     "handle_link old"           => undef
  42 );
  43
  44 # Imported constants
  45 my $CHAR_LINK_START     = chr(01);      # Ctrl-A
  46 my $CHAR_LINK_POINTER   = chr(02);      # Ctrl-B
  47 my $CHAR_LINK_END       = chr(03);      # Ctrl-C
  48 my $CHAR_NODE_END       = chr(04);      # Ctrl-D
  49 my $CHAR_ALTERNATE      = chr(05);      # Ctrl-E
  50 my $CHAR_NORMAL         = chr(06);      # Ctrl-F
  51 my $CHAR_VERSION        = chr(07);      # Ctrl-G
  52 my $CHAR_FONT_BOLD      = chr(010);     # Ctrl-H
  53 my $CHAR_FONT_NORMAL    = chr(013);     # Ctrl-K
  54 my $CHAR_FONT_ITALIC    = chr(024);     # Ctrl-T
  55 # end of import
  56
  57 my $col = 0;            # Current output column
  58 my $out_row = 1;        # Current output row
  59 my $in_row = 0;         # Current input row
  60 my $no_split_flag = 0;  # Flag: Don't split section on next ".SH"
  61 my $skip_flag = 0;      # Flag: Skip this section.
  62                         #       0 = don't skip,
  63                         #       1 = skipping title,
  64                         #       2 = title skipped, skipping text
  65 my $link_flag = 0;      # Flag: Next line is a link
  66 my $verbatim_flag = 0;  # Flag: Copy input to output verbatim
  67 my $node = 0;           # Flag: This line is an original ".SH"
  68
  69 my $c_out;              # Output filename
  70 my $f_out;              # Output file
  71
  72 my $c_in;               # Current input filename
  73
  74 my $indentation;        # Indentation level, n spaces
  75 my $tp_flag;            # Flag: .TP paragraph
  76                         #       1 = this line is .TP label,
  77                         #       2 = first line of label description.
  78 my $topics = undef;
  79
  80 # Emulate C strtok()
  81 my $strtok;
  82
  83 sub strtok($$) {
  84     my ($str, $chars) = @_;
  85
  86     if (! defined $chars || $chars eq "")
  87     {
  88         my $result = $strtok;
  89         $strtok = undef;
  90         return $result;
  91     }
  92
  93     $str = $strtok unless defined $str;
  94     return undef unless defined $str;
  95
  96     my $result;
  97     $str =~ s/^[$chars]+//;
  98     ($result, $strtok) = split /[$chars]+/, $str, 2;
  99     ($result, $strtok) = split /[$chars]+/, $strtok, 2 if defined $result && $result eq "";
 100     $strtok = undef if ! defined $strtok || $strtok eq "";
 101     return $result;
 102 }
 103
 104 # Attempt to handle backslash quoting
 105 sub handle_backslash($)
 106 {
 107     my ($s) = @_;
 108     my $backslash_flag = 0;
 109     my $result = '';
 110     foreach my $c (split //, $s)
 111     {
 112         if ($c eq '\\' && ! $backslash_flag)
 113         {
 114             $backslash_flag = 1;
 115             next;
 116         }
 117         $backslash_flag = 0;
 118         $result .= $c;
 119     }
 120     return $result;
 121 }
 122
 123 sub struct_node() {
 124     return {
 125         "node"          => undef,   # Section name
 126         "lname"         => undef,   # Translated .SH, undef if not translated
 127         "next"          => undef,
 128         "heading_level" => undef
 129     }
 130 }
 131
 132 my $nodes = struct_node();
 133 my $cnode;              # Current node
 134
 135 # Report error in input
 136 sub print_error($)
 137 {
 138     my ($message) = @_;
 139     warn sprintf  "man2hlp: %s in file \"%s\" on line %d\n", $message, $c_in, $in_row;
 140 }
 141
 142 # Do open, exit if it fails
 143 sub fopen_check ($$)
 144 {
 145     my ($mode, $filename) = @_;
 146     my $f;
 147
 148     unless (open $f, $mode, $filename)
 149     {
 150         warn sprintf("man2hlp: Cannot open file \"%s\" ($!)\n", $filename);
 151         exit 3;
 152     }
 153     return $f;
 154 }
 155
 156 # Do close, exit if it fails
 157 sub fclose_check($)
 158 {
 159     my ($f) = @_;
 160     unless (close $f)
 161     {
 162         warn "man2hlp: Cannot close file ($!)\n";
 163         exit 3;
 164     }
 165 }
 166
 167 # Change output line
 168 sub newline()
 169 {
 170     $out_row++;
 171     $col = 0;
 172     print $f_out "\n";
 173 }
 174
 175 # Calculate the length of string
 176 sub string_len
 177 {
 178     my ($buffer) = @_;
 179     my $anchor_flag = \$static{"string_len anchor_flag"}; # Flag: Inside hypertext anchor name ho4u_v_Ariom
 180     my $lc_link_flag = \$static{"string_len lc_link_flag"}; # Flag: Inside hypertext link target name
 181     my $backslash_flag = 0;     # Flag: Backslash quoting
 182     my $len = 0;                # Result: the length of the string
 183
 184
 185     foreach my $c (split //, $buffer)
 186     {
 187         if ($c eq $CHAR_LINK_POINTER)
 188         {
 189             $$lc_link_flag = 1;   # Link target name starts
 190         }
 191         elsif ($c eq $CHAR_LINK_END)
 192         {
 193             $$lc_link_flag = 0;   # Link target name ends
 194         }
 195         elsif ($c eq $CHAR_NODE_END)
 196         {
 197             # Node anchor name starts
 198             $$anchor_flag = 1;
 199             # Ugly hack to prevent loss of one space
 200             $len++;
 201         }
 202         # Don't add control characters to the length
 203         next if ord($c) >= 0 && ord($c) < 32;
 204         # Attempt to handle backslash quoting
 205         if ($c eq '\\' && !$backslash_flag)
 206         {
 207             $backslash_flag = 1;
 208             next;
 209         }
 210         $backslash_flag = 0;
 211         # Increase length if not inside anchor name or link target name
 212         $len++ if !$$anchor_flag && !$$lc_link_flag;
 213         if ($$anchor_flag && $c eq ']')
 214         {
 215             # Node anchor name ends
 216             $$anchor_flag = 0;
 217         }
 218     }
 219     return $len;
 220 }
 221
 222 # Output the string
 223 sub print_string($)
 224 {
 225     my ($buffer) = @_;
 226     my $len;                    # The length of current word
 227     my $c;                      # Current character
 228     my $backslash_flag = 0;
 229
 230     # Skipping lines?
 231     return if $skip_flag;
 232     # Copying verbatim?
 233     if ($verbatim_flag)
 234     {
 235         # Attempt to handle backslash quoting
 236         $buffer = handle_backslash $buffer;
 237         print $f_out $buffer;
 238     }
 239     else
 240     {
 241         # Split into words
 242         $buffer = strtok($buffer, " \t\n");
 243         # Repeat for each word
 244         while (defined $buffer)
 245         {
 246             # Skip empty strings
 247             if ($buffer ne '')
 248             {
 249                 $len = length($buffer);
 250                 # Words are separated by spaces
 251                 if ($col > 0)
 252                 {
 253                     print $f_out ' ';
 254                     $col++;
 255                 }
 256                 elsif ($indentation)
 257                 {
 258                     print $f_out ' ' while $col++ < $indentation;
 259                 }
 260                 # Attempt to handle backslash quoting
 261                 $buffer = handle_backslash $buffer;
 262                 print $f_out $buffer;
 263                 # Increase column
 264                 $col += $len;
 265             }
 266             # Get the next word
 267             $buffer = strtok(undef, " \t\n");
 268         }                       # while
 269     }
 270 }
 271
 272 # Like print_string but with printf-like syntax
 273 sub printf_string
 274 {
 275     print_string sprintf shift, @_;
 276 }
 277
 278 # Handle NODE and .SH commands.  is_sh is 1 for .SH, 0 for NODE
 279 # FIXME: Consider to remove first parameter
 280 sub handle_node($$)
 281 {
 282     my ($buffer, $is_sh) = @_;
 283     my ($len, $heading_level);
 284
 285     # If we already skipped a section, don't skip another
 286     $skip_flag = 0 if $skip_flag == 2;
 287
 288     # Get the command parameters
 289     $buffer = strtok(undef, "");
 290     if (! defined $buffer)
 291     {
 292         print_error "Syntax error: .SH: no title";
 293         return;
 294     }
 295     else
 296     {
 297         # Remove quotes
 298         $buffer =~ s/^"// and $buffer =~ s/"$//;
 299         # Calculate heading level
 300         $heading_level = 0;
 301         $heading_level++ while substr($buffer, $heading_level, 1) eq ' ';
 302         # Heading level must be even
 303         unless ($heading_level % 2)
 304         {
 305             print_error "Syntax error: .SH: odd heading level";
 306         }
 307         if ($no_split_flag)
 308         {
 309             # Don't start a new section
 310             newline;
 311             print_string $buffer;
 312             newline;
 313             newline;
 314             $no_split_flag = 0;
 315         }
 316         elsif ($skip_flag)
 317         {
 318             # Skipping title and marking text for skipping
 319             $skip_flag = 2;
 320         }
 321         else
 322         {
 323             $buffer = substr($buffer, $heading_level);
 324             if (! $is_sh || ! $node)
 325             {
 326                 # Start a new section, but omit empty section names
 327                 if ($buffer ne '')
 328                 {
 329                     printf $f_out "%s[%s]", $CHAR_NODE_END, $buffer;
 330                     newline;
 331                 }
 332
 333                 # Add section to the linked list
 334                 if (! defined $cnode)
 335                 {
 336                     $cnode = $nodes;
 337                 }
 338                 else
 339                 {
 340                     $cnode->{'next'} = struct_node();
 341                     $cnode = $cnode->{'next'};
 342                 }
 343                 $cnode->{'node'} = $buffer;
 344                 $cnode->{'lname'} = undef;
 345                 $cnode->{'next'} = undef;
 346                 $cnode->{'heading_level'} = $heading_level;
 347             }
 348             if ($is_sh)
 349             {
 350                 $cnode->{'lname'} = $buffer;
 351                 print_string $buffer;
 352                 newline;
 353                 newline;
 354             }
 355         }                       # Start new section
 356     }                         # Has parameters
 357     $node = ! $is_sh;
 358 }
 359
 360 # Convert character from the macro name to the font marker
 361 sub char_to_font($)
 362 {
 363     my ($c) = @_;
 364     my %font = (
 365         'R' => $CHAR_FONT_NORMAL,
 366         'B' => $CHAR_FONT_BOLD,
 367         'I' => $CHAR_FONT_ITALIC
 368     );
 369     return exists $font{$c} ? $font{$c} : chr(0);
 370 }
 371
 372 #
 373 # Handle alternate font commands (.BR, .IR, .RB, .RI, .BI, .IB)
 374 # Return 0 if the command wasn't recognized, 1 otherwise
 375 #
 376 sub handle_alt_font($)
 377 {
 378     my ($buffer) = @_;
 379     my $in_quotes = 0;
 380     my $alt_state = 0;
 381
 382     return 0 if length($buffer) != 3;
 383     return 0 if substr($buffer, 0, 1) ne '.';
 384
 385     my @font = (
 386         char_to_font substr($buffer, 1, 1),
 387         char_to_font substr($buffer, 2, 1)
 388     );
 389
 390     # Exclude names with unknown characters, .BB, .II and .RR
 391     if ($font[0] eq chr(0) || $font[1] eq chr(0) || $font[0] eq $font[1])
 392     {
 393         return 0;
 394     }
 395
 396     my $p = strtok(undef, "");
 397     return 1 unless defined $p;
 398
 399     $buffer = $font[0];
 400
 401     my @p = split //, $p;
 402     while (@p)
 403     {
 404
 405         if ($p[0] eq '"')
 406         {
 407             $in_quotes = !$in_quotes;
 408             shift @p;
 409             next;
 410         }
 411
 412         if ($p[0] eq ' ' && !$in_quotes)
 413         {
 414             shift @p;
 415             # Don't change font if we are at the end
 416             if ($#p)
 417             {
 418                 $alt_state = $alt_state ? 0 : 1;
 419                 $buffer .= $font[$alt_state];
 420             }
 421
 422             # Skip more spaces
 423             shift @p while $p[0] eq ' ';
 424
 425             next;
 426         }
 427
 428         $buffer .= shift @p;
 429     }
 430
 431     # Turn off attributes if necessary
 432     if ($font[$alt_state] ne $CHAR_FONT_NORMAL)
 433     {
 434         $buffer .= $CHAR_FONT_NORMAL;
 435     }
 436
 437     print_string $buffer;
 438
 439     return 1;
 440 }
 441
 442 # Handle .IP and .TP commands.  is_tp is 1 for .TP, 0 for .IP */
 443 sub handle_tp_ip($)
 444 {
 445     my ($is_tp) = @_;
 446     newline if $col > 0;
 447     newline;
 448     if ($is_tp)
 449     {
 450         $tp_flag = 1;
 451         $indentation = 0;
 452     }
 453     else
 454     {
 455         $indentation = 8;
 456     }
 457 }
 458
 459 # Handle all the roff dot commands.  See man groff_man for details
 460 sub handle_command($)
 461 {
 462     my ($buffer) = @_;
 463     my $len;
 464
 465     # Get the command name
 466     $buffer = strtok($buffer, " \t");
 467
 468     if ($buffer eq ".SH")
 469     {
 470         $indentation = 0;
 471         handle_node $buffer, 1;
 472     }
 473     elsif ($buffer eq ".\\\"NODE")
 474     {
 475         handle_node $buffer, 0;
 476     }
 477     elsif ($buffer eq ".\\\"DONT_SPLIT\"")
 478     {
 479         $no_split_flag = 1;
 480     }
 481     elsif ($buffer eq ".\\\"SKIP_SECTION\"")
 482     {
 483         $skip_flag = 1;
 484     }
 485     elsif ($buffer eq ".\\\"LINK2\"")
 486     {
 487         # Next two input lines form a link
 488         $link_flag = 2;
 489     }
 490     elsif ($buffer eq ".PP" || $buffer eq ".P" || $buffer eq ".LP")
 491     {
 492         $indentation = 0;
 493         # End of paragraph
 494         newline if $col > 0;
 495         newline;
 496     }
 497     elsif ($buffer eq ".nf")
 498     {
 499         # Following input lines are to be handled verbatim
 500         $verbatim_flag = 1;
 501         newline if $col > 0;
 502     }
 503     elsif ($buffer eq ".I" || $buffer eq ".B" || $buffer eq ".SB")
 504     {
 505         # Bold text or italics text
 506
 507         # .SB [text]
 508         # Causes the text on the same line or the text on the
 509         # next  line  to  appear  in boldface font, one point
 510         # size smaller than the default font.
 511         #
 512
 513         # FIXME: text is optional, so there is no error
 514         my $p = strtok(undef, "");
 515         if (! defined $p)
 516         {
 517             print_error "Syntax error: .I | .B | .SB : no text";
 518             return;
 519         }
 520
 521         $buffer = substr($buffer, 1, 1) eq 'I' ? $CHAR_FONT_ITALIC : $CHAR_FONT_BOLD;
 522
 523         # Attempt to handle backslash quoting
 524         $p = handle_backslash $p;
 525         print_string $buffer . $p . $CHAR_FONT_NORMAL;
 526     }
 527     elsif ($buffer eq ".TP")
 528     {
 529         handle_tp_ip 1;
 530     }
 531     elsif ($buffer eq ".IP")
 532     {
 533         handle_tp_ip 0;
 534     }
 535     elsif ($buffer eq ".\\\"TOPICS")
 536     {
 537         if ($out_row > 1)
 538         {
 539             print_error "Syntax error: .\\\"TOPICS must be first command";
 540             return;
 541         }
 542         $buffer = strtok(undef, "");
 543         if (! defined $buffer)
 544         {
 545             print_error "Syntax error: .\\\"TOPICS: no text";
 546             return;
 547         }
 548         # Remove quotes
 549         $buffer =~ s/^"// and $buffer =~ s/"$//;
 550         $topics = $buffer;
 551     }
 552     elsif ($buffer eq ".br")
 553     {
 554         newline if $col;
 555     }
 556     elsif ($buffer =~  /^\.\\"/)
 557     {
 558         # Comment { Hello from K.O. ;-) }
 559     }
 560     elsif ($buffer eq ".TH")
 561     {
 562         # Title header
 563     }
 564     elsif ($buffer eq ".SM")
 565     {
 566         # Causes the text on the same line or the text on the
 567         # next  line  to  appear  in a font that is one point
 568         # size smaller than the default font.
 569         $buffer = strtok(undef, "");
 570         print_string $buffer if defined $buffer;
 571     }
 572     elsif (handle_alt_font($buffer) == 1)
 573     {
 574         return;
 575     }
 576     else
 577     {
 578         # Other commands are ignored
 579         print_error sprintf "Warning: unsupported command %s", $buffer;
 580         return;
 581     }
 582 }
 583
 584 sub struct_links()
 585 {
 586     return {
 587         'linkname'  => undef,   # Section name
 588         'line'      => undef,   # Input line in ...
 589         'filename'  => undef,
 590         'next'      => undef
 591     }
 592 }
 593
 594 my $links = struct_links();
 595 my $current_link;
 596
 597
 598 sub handle_link($)
 599 {
 600     my ($buffer) = @_;
 601     my $old = \$static{"handle_link old"};
 602     my $len;
 603     my $amp;
 604     my $amp_arg;
 605
 606     if ($link_flag == 1)
 607     {
 608         # Old format link, not supported
 609     }
 610     elsif ($link_flag == 2)
 611     {
 612         # First part of new format link
 613         # Bold text or italics text
 614         if (substr($buffer, 0, 2) eq '.I' || substr($buffer, 0, 2) eq '.B')
 615         {
 616             $buffer =~ s/^..[\s\t]*//;
 617         }
 618         $$old = $buffer;
 619         $link_flag = 3;
 620
 621     }
 622     elsif ($link_flag == 3)
 623     {
 624         # Second part of new format link
 625         $buffer =~ s/^\.//;
 626         $buffer =~ s/^\\//;
 627         $buffer =~ s/^"//;
 628         $buffer =~ s/"$//;
 629
 630         # "Layout\&)," -- "Layout" should be highlighted, but not "),"
 631         ($$old, $amp_arg) = split /\\&/, $$old, 2;
 632         printf_string "%s%s%s%s%s%s\n", $CHAR_LINK_START, $$old,
 633                        $CHAR_LINK_POINTER, $buffer, $CHAR_LINK_END, $amp_arg;
 634         $link_flag = 0;
 635         # Add to the linked list
 636         if (defined $current_link)
 637         {
 638             $current_link->{'next'} = struct_links();
 639             $current_link = $current_link->{'next'};
 640             $current_link->{'next'} = undef;
 641         }
 642         else
 643         {
 644             $current_link = $links;
 645         }
 646         $current_link->{'linkname'} = $buffer;
 647         $current_link->{'filename'} = $c_in;
 648         $current_link->{'line'} = $in_row;
 649     }
 650 }
 651
 652 sub main
 653 {
 654     my $len;                    # Length of input line
 655     my $c_man;                  # Manual filename
 656     my $c_tmpl;                 # Template filename
 657     my $f_man;                  # Manual file
 658     my $f_tmpl;                 # Template file
 659     my $buffer;                 # Full input line
 660     my $lc_node = undef;
 661     my $outfile_buffer;         # Large buffer to keep the output file
 662     my $cont_start;             # Start of [Contents]
 663     my $file_end;               # Length of the output file
 664
 665     # Validity check for arguments
 666     if (@ARGV != 3)
 667     {
 668         warn "Usage: man2hlp file.man template_file helpfile\n";
 669         return 3;
 670     }
 671
 672     $c_man  = $ARGV[0];
 673     $c_tmpl = $ARGV[1];
 674     $c_out  = $ARGV[2];
 675
 676     # First stage - process the manual, write to the output file
 677
 678     $f_man = fopen_check "<", $c_man;
 679     $f_out = fopen_check ">", $c_out;
 680     $c_in = $c_man;
 681
 682     # Repeat for each input line
 683     while (<$f_man>)
 684     {
 685         # Remove terminating newline
 686         chomp;
 687         $buffer = $_;
 688         my $input_line;       # Input line without initial "\&"
 689
 690         if (substr($buffer, 0, 2) eq '\\&')
 691         {
 692             $input_line = substr($buffer, 2);
 693         }
 694         else
 695         {
 696             $input_line = $buffer;
 697         }
 698
 699         $in_row++;
 700         $len = length($input_line);
 701
 702         if ($verbatim_flag)
 703         {
 704             # Copy the line verbatim
 705             if ($input_line eq ".fi")
 706             {
 707                 $verbatim_flag = 0;
 708             }
 709             else
 710             {
 711                 print_string $input_line;
 712                 newline;
 713             }
 714         }
 715         elsif ($link_flag)
 716         {
 717             # The line is a link
 718             handle_link $input_line;
 719         }
 720         elsif (substr($buffer, 0, 1) eq '.')
 721         {
 722             # The line is a roff command
 723             handle_command $input_line;
 724         }
 725         else
 726         {
 727             #A normal line, just output it
 728             print_string $input_line;
 729         }
 730         # .TP label processed as usual line
 731         if ($tp_flag)
 732         {
 733             if ($tp_flag == 1)
 734             {
 735                 $tp_flag = 2;
 736             }
 737             else
 738             {
 739                 $tp_flag = 0;
 740                 $indentation = 8;
 741                 if ($col >= $indentation)
 742                 {
 743                     newline;
 744                 }
 745                 else
 746                 {
 747                     print $f_out " " while ++$col < $indentation;
 748                 }
 749             }
 750         }
 751     }
 752
 753     newline;
 754     fclose_check $f_man;
 755     # First stage ends here, closing the manual
 756
 757     # Second stage - process the template file
 758     $f_tmpl = fopen_check "<", $c_tmpl;
 759     $c_in = $c_tmpl;
 760
 761     # Repeat for each input line
 762     # Read a line
 763     while (<$f_tmpl>)
 764     {
 765         $buffer = $_;
 766         if (defined $lc_node)
 767         {
 768             if ($buffer ne "\n")
 769             {
 770                 $cnode->{'lname'} = $buffer;
 771                 chomp $cnode->{'lname'};
 772             }
 773             $lc_node = undef;
 774         }
 775         else
 776         {
 777             my $char_node_end = index($buffer, $CHAR_NODE_END);
 778             $lc_node = $char_node_end < 0 ? undef : substr($buffer, $char_node_end);
 779
 780             if (defined $lc_node && substr($lc_node, 1, 1) eq '[')
 781             {
 782                 my $p = index($lc_node, ']');
 783                 if ($p >= 0) {
 784                     if (substr($lc_node, 1, 6) eq '[main]')
 785                     {
 786                         $lc_node = undef;
 787                     }
 788                     else
 789                     {
 790                         if (! defined $cnode)
 791                         {
 792                             $cnode = $nodes;
 793                         }
 794                         else
 795                         {
 796                             $cnode->{'next'} = struct_node();
 797                             $cnode = $cnode->{'next'};
 798                         }
 799                         $cnode->{'node'} = substr($lc_node, 2, $p-2);
 800                         $cnode->{'lname'} = undef;
 801                         $cnode->{'next'} = undef;
 802                         $cnode->{'heading_level'} = 0;
 803                     }
 804                 }
 805                 else
 806                 {
 807                   $lc_node = undef;
 808                 }
 809             }
 810             else
 811             {
 812                 $lc_node = undef;
 813             }
 814         }
 815         print $f_out $buffer;
 816     }
 817
 818     $cont_start = tell $f_out;
 819     if ($cont_start <= 0)
 820     {
 821         perror $c_out;
 822         return 1;
 823     }
 824
 825     if ($topics)
 826     {
 827         printf $f_out "\004[Contents]\n%s\n\n", $topics;
 828     }
 829     else
 830     {
 831         print $f_out "\004[Contents]\n";
 832     }
 833
 834     for ($current_link = $links; defined $current_link && defined $current_link->{'linkname'};)
 835     {
 836         my $found = 0;
 837         my $next = $current_link->{'next'};
 838
 839         if ($current_link->{'linkname'} eq "Contents")
 840         {
 841             $found = 1;
 842         }
 843         else
 844         {
 845             for ($cnode = $nodes; defined $cnode && defined $cnode->{'node'}; $cnode = $cnode->{'next'})
 846             {
 847                 if ($cnode->{'node'} eq $current_link->{'linkname'})
 848                 {
 849                     $found = 1;
 850                     last;
 851                 }
 852             }
 853         }
 854         if (! $found)
 855         {
 856             $buffer = sprintf "Stale link \"%s\"", $current_link->{'linkname'};
 857             $c_in = $current_link->{'filename'};
 858             $in_row = $current_link->{'line'};
 859             print_error $buffer;
 860         }
 861
 862         $current_link = $next;
 863     }
 864
 865     for ($cnode = $nodes; defined $cnode && defined $cnode->{'node'};)
 866     {
 867         my $next = $cnode->{'next'};
 868         $lc_node = $cnode->{'node'};
 869
 870         if (defined $lc_node && $lc_node ne '') {
 871             printf $f_out "  %*s\001%s\002%s\003", $cnode->{'heading_level'},
 872                 "", $cnode->{'lname'} ? $cnode->{'lname'} : $lc_node, $lc_node;
 873         }
 874         print $f_out "\n";
 875         $cnode = $next;
 876     }
 877
 878     $file_end = tell $f_out;
 879
 880     # Sanity check
 881     if (($file_end <= 0) || ($file_end - $cont_start <= 0))
 882     {
 883         warn $c_out ."\n";
 884         return 1;
 885     }
 886
 887     fclose_check $f_out;
 888     fclose_check $f_tmpl;
 889     # Second stage ends here, closing all files, note the end of output
 890
 891     #
 892     # Third stage - swap two parts of the output file.
 893     # First, open the output file for reading and load it into the memory.
 894     #
 895     ## TODO: replace writing to f_out by writing to a string
 896     $outfile_buffer = '';
 897     $f_out = fopen_check '<', $c_out;
 898     $outfile_buffer .= $_ while <$f_out>;
 899     fclose_check $f_out;
 900     # Now the output file is in the memory
 901
 902     # Again open output file for writing
 903     $f_out = fopen_check '>', $c_out;
 904
 905     # Write part after the "Contents" node
 906     print $f_out substr($outfile_buffer, $cont_start, $file_end - $cont_start);
 907
 908     # Write part before the "Contents" node
 909     print $f_out substr($outfile_buffer, 0, $cont_start-1);
 910     fclose_check $f_out;
 911
 912     return 0;
 913 }
 914
 915 exit main();