File: fmt_info.pl

package info (click to toggle)
linuxdoc-tools 0.9.86-1
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid, trixie
  • size: 3,312 kB
  • sloc: ansic: 16,247; perl: 3,769; sh: 1,134; makefile: 813; lex: 566; lisp: 309
file content (170 lines) | stat: -rw-r--r-- 5,616 bytes parent folder | download | duplicates (2)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
#
#  fmt_info.pl
#
# ------------------------------------------------------------------
#  GNU Info-specific driver stuff
#
#  Copyright (C) 1994-1996, Matt Welsh
#  Copyright (C) 1996, Cees de Groot
#  Copyright (C) 1999-2000, Taketoshi Sano
#  Copyright (C) 2008-2020 Agustin Martin
# ------------------------------------------------------------------

package LinuxDocTools::fmt_info;
use strict;

use LinuxDocTools::Vars;

use File::Copy;
use Text::EntityMap;
use LinuxDocTools::CharEnts;
use LinuxDocTools::Lang;
use LinuxDocTools::Vars;
use LinuxDocTools::InfoUtils qw{info_process_texi};

my $info = {};
$info->{NAME}           = "info";
$info->{HELP}           = "";
$Formats{$info->{NAME}} = $info;
$info->{OPTIONS}        = [
			   ];

# ------------------------------------------------------------------
$info->{preNSGMLS} = sub {
# ------------------------------------------------------------------
  $global->{NsgmlsOpts} .= " -ifmtinfo ";
  $global->{NsgmlsPrePipe} = "cat  $global->{file}";
};

# ------------------------------------------------------------------
my $info_escape = sub {
# ------------------------------------------------------------------
# Ascii escape sub.  this is called-back by `parse_data' below in
# `info_preASP' to properly escape `\' characters coming from the SGML
# source.
# ------------------------------------------------------------------
  my ($data) = @_;

  #    $data =~ s|"| \"|g;	# Insert zero-width space in front of "
  #    $data =~ s|^\.| .|;	# ditto in front of . at start of line
  #    $data =~ s|\\|\\\\|g;	# Escape backslashes

  return ($data);
};

# ------------------------------------------------------------------
$info->{preASP} = sub {
# ------------------------------------------------------------------
  my ($INFILE, $OUTFILE) = @_;
  my $suffix     = ( $global->{charset} eq "latin1" ) ? '.2l1texi' : '.2texi';
  my $char_maps  = load_char_maps ($suffix, [ Text::EntityMap::sdata_dirs() ]);
  my $inpreamble = 1;
  my $inheading;

  # Replace some symbols in the file before sgmlsasp is called. This
  # has been done in preNSGMLS, but if the specified sgml file is
  # divided into multiple pieces, the preNSGMLS is not enough.
  while ( <$INFILE> ) {
    s/\@/\@\@/g;
    s/\{/\@\{/g;
    s/\}/\@\}/g;
#      s/-\((.*)\)/-\'\($1\)\'/;
    s/-\((.*)\)/-\[$1\]/;
    s/\\\|urlnam\\\|/ /g;
    s/\\\|refnam\\\|/ /g;

    if ( s/^-// ) {
      chomp;
      s/([^\\])\\n/$1 /g if $inheading;      # Remove spurious \n in headings
      s/(\\n|^)\\011/$1/g if $inpreamble;    # Remove leading tabs in abstract.
      print $OUTFILE "-" .
	parse_data ($_, $char_maps, $info_escape) . "\n";
    } elsif (/^A/) {
      /^A(\S+) (IMPLIED|CDATA|NOTATION|ENTITY|TOKEN)( (.*))?$/
	|| die "bad attribute data: $_\n";
      my ($name,$type,$value) = ($1,$2,$4);
      if ($type eq "CDATA") {
	# CDATA attributes get translated also
	$value = parse_data ($value, $char_maps, $info_escape);
      }
      print $OUTFILE "A$name $type $value\n";
    } else {
      if (/^\(HEADING/){
        $inheading = 1;
	$inpreamble = '';          # No longer in preamble if found a HEADING
      } elsif (/^\)HEADING/){
        $inheading = '';
      }
      #  Default action if not skipped over by previous conditions: copy in to out.
      print $OUTFILE $_;
    }
  }

  return 0;
};

# ------------------------------------------------------------------
$info->{postASP} = sub {
# ------------------------------------------------------------------
#  Take the sgmlsasp output, and make something useful from it.
# ------------------------------------------------------------------
  my $INFILE    = shift;                       # File handle reference to input file
  my $rawtexi   = "$global->{tmpbase}.2.texi"; # Encoding replaced if appropriate
  my $texifile  = "$global->{tmpbase}.3.texi"; # File ready for makeinfo
  my $infofile0 = "$global->{tmpbase}.4.info"; # makeinfo output
  my $infofile  = "$global->{filename}.info";  # Final info file.

  my $msgheader = "fmt_info::postASP";
  my $fileinfo  = "info file generated from $global->{file} by means of linuxdoc-tools";

  my @tmp_texi = <$INFILE>;

  # Explicitly set encoding if required. texinfo default is now utf-8
  # texinfo seems not to support other linuxdoc supported encodings
  my $info_charset_mapping = { # map linuxdoc charset names to texinfo names
     'latin' => "ISO-8859-1",
     'uft-8' => "UTF-8"
    };
  for (@tmp_texi) {
    if ( defined $info_charset_mapping->{$global->{charset}} ){
      s/\@comment \@encoding\@/\@documentencoding $info_charset_mapping->{$global->{charset}}/;
    }
  }

  open (my $OUTFILE, "> $rawtexi")
    or die "fmt_info::postASP: Could not open \"$rawtexi\" for writing. Aborting ...\n";
  print $OUTFILE @tmp_texi;
  close $OUTFILE;

  # Preprocess the raw texinfo file
  info_process_texi($rawtexi,$texifile,$infofile);

  system ("makeinfo $texifile -o $infofile") == 0
    or die "$msgheader: Failed to run makeinfo. Aborting ...\n";

  move $infofile, $infofile0;

  my $infotext;
  open ( my $TMPINFO, "< $infofile0")
    or die "Could not open $infofile0 for read. Aborting ... \n";
  {
    local $/ = undef;
    $infotext = <$TMPINFO>;
  }
  close $TMPINFO;

  # Change origin filename given by makeinfo to something useful
  $infotext =~ s/\Q$texifile\E/$fileinfo/;

  # Remove not needed line in resulting info file. Only first match.
  $infotext =~ s/\\input texinfo//;

  open (my $OUTFILE, "> $infofile")
    or die "Could not open $infofile for write. Aborting ... \n";
  print $OUTFILE $infotext;
  close $OUTFILE;

  return 0;
};

1;