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