File: make-readme

package info (click to toggle)
derivations 0.53.20120414-1.2
  • links: PTS
  • area: main
  • in suites: jessie, jessie-kfreebsd
  • size: 2,208 kB
  • ctags: 486
  • sloc: cpp: 1,634; perl: 600; makefile: 153; sh: 116
file content (271 lines) | stat: -rw-r--r-- 7,343 bytes parent folder | download | duplicates (6)
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
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
#! /usr/bin/perl
use warnings;
use strict;
use integer;
use FindBin;
use lib $FindBin::RealBin;
use Def;

# This script generates an appropriate README from the following listed
# sections of the manpage.  It clobbers the existing README.
#
# (This highly specialized helper script is perhaps the result of
# overenthusiasm.  It automates an otherwise slightly annoying
# package-maintenance task, but in retrospect it is not clear that the
# effort spent in writing the script justifies the gain.  Nevertheless,
# I like the script.  Here it is.  ---THB---)
#
# (By the way, I thought about extending the script to autogenerate the
# long description in debian/control.  However, overenthusiasm has
# bounds.  The long description is twenty times as important as the
# README.  It merits manual crafting.  But maybe we should generate the
# manpage "SUMMARY" section from the long description?  No, not
# today.  ---THB---)
#
# The Makefile and debian/rules probably should not invoke this script.
# Probably only the developer should invoke it, manually, if and when he
# wants to.
#
# As a developer, you do not need to use this script.  You can write
# your own README if you want to.  The only reason the script exists is
# that the author couldn't really think of anything at the moment to
# write in the README which wasn't already in the manpage, but if you
# can think of something else to write there, go right ahead.  However,
# if you do use this script and if you modify it, note the "Make special
# corrections" block below.
#
# One possible use of this script is to autogenerate a candidate README
# which you then manually edit.

# Relevant manpage sections.
our @sh = (
  'DESCRIPTION',
  'READING THE BOOK',
  'AUTHOR',
);

our $marker        = "\001";
our $headlead_trad = 'The Debian Package';
our $mark_lic      = qr/^Copyright\s+\(C\)/;
our $time_dflt     = '00:00:00 +0000';
our $cmd_date      = 'date -uRd';
our $cmd_fmt       = "fmt -w${Def::width} -u";
our $cmd_tempfile  = 'tempfile';

my $manpage  = "${FindBin::RealBin}/../doc/${Def::out}.${Def::mansect}";
my $deb_cprt = "${FindBin::RealBin}/../debian/copyright";
my $readme   = "${FindBin::RealBin}/../${Def::name_readme}";
my $bar      = '-' x ${Def::width} ."\n";
my $mp_date;
my $mp_author;
my $mp_title;

# Subroutine: splice lines ending in backslash-newline.
sub splice_lines (;\@) {
  local $_ = @_ ? shift : \$_;
  for my $i ( reverse 0 .. $#$_ ) {
    chomp $_->[$i];
    next unless $_->[$i] =~ /\\$/;
    chop  $_->[$i];
    splice @$_, $i, 2, $_->[$i] . $_->[$i+1] . "\n" if $i < $#$_;
  }
  $_ .= "\n" for @$_;
  return $_;
}

our @escape_save = ();
# Subroutines: recognize, convert, save and restore escaped characters.
sub escape (;\$) {
  local $_ = @_ ? shift : \$_;
  @escape_save = ();
  $$_ =~ /$marker/ and die "$0: marker character is reserved\n";
  my $ends_newline = $$_ =~ /\n\z/;
  chomp $$_;
  {
    my $i;
    while ( ( $i = index $$_, '\\' ) >= 0 ) {
      substr( $$_, $i, 5 ) =~ /^\\\*\(/
        and push( @escape_save, substr( $$_, $i, 5, $marker ) ), next;
      substr( $$_, $i, 4 ) =~ /^\\\(/
        and push( @escape_save, substr( $$_, $i, 4, $marker ) ), next;
      push( @escape_save, substr( $$_, $i, 2, $marker ) );
    }
  }
  $$_ .= "\n" if $ends_newline;
  return $$_;
}
sub convescape () {
  for ( @escape_save ) {
    $_ =~ /^\\&$/       and $_ = ''   , next;
    $_ =~ /^\\-$/       and $_ = '-'  , next;
    $_ =~ /^\\\(em$/i   and $_ = '---', next;
    $_ =~ /^\\\*\(lq$/i and $_ = '"'  , next;
    $_ =~ /^\\\*\(rq$/i and $_ = '"'  , next;
  }
}
sub unescape (;\$) {
  local $_ = @_ ? shift : \$_;
  while ( @escape_save ) {
    my $c = shift @escape_save;
    $$_ =~ s/$marker/$c/;
  }
  @escape_save = ();
  return $$_;
}
sub convall (;\$) {
  local $_ = @_ ? shift : \$_;
  defined $$_ or return $$_;
  escape   $$_;
  convescape  ;
  unescape $$_;
  return   $$_;
}

# Subroutine: dequote a quoted string.
sub dequote (;\$) {
  local $_ = @_ ? shift : \$_;
  chomp    $$_;
  escape   $$_;
  $$_ =~ s/^\s*"([^"]*?)"\s*$/$1/;
  unescape $$_;
  return   $$_;
}

# Subroutine: collapse an alternating emphasizor.
sub collapse (;\$) {
  local $_ = @_ ? shift : \$_;
  chomp    $$_;
  escape   $$_;
  my @w = $$_ =~ /"[^"]*?"|[^"\s]+/g;
  dequote for @w;
  $$_ = join( '', @w );
  unescape $$_;
  return   $$_;
}

# Subroutine: format text to a maximum width.
sub format_text (@) {
  my $file = `$cmd_tempfile`; chomp $file;
  open  FILE, '>', $file;
    print FILE @_;
  close FILE;
  my @ret = `$cmd_fmt $file`;
  unlink $file;
  return @ret;
}

# Read the manpage in.
my @man;
open  MAN, '<', $manpage;
  @man = <MAN>;
close MAN;
splice_lines @man;

# Parse the manpage.
my %sect;
{
  my $sh;
  my $text = [];
  for ( @man ) {
    next unless /\S/;
    my( $cmd, $arg ) = /^\.(\S+)(?:\s+(\S(?:.*?\S)??))??\s*$/;
    if ( defined $cmd ) {
      if    ( $cmd =~ /^(?:B|I)$/i ) {
        dequote       $arg;
        $_         = "$arg\n";
        $cmd       = undef;
      }
      elsif ( $cmd =~ /^(?:BR|RB|IR|RI|BI|IB)$/i ) {
        collapse      $arg;
        $_         = "$arg\n";
        $cmd       = undef;
      }
      elsif ( $cmd =~ /^TH$/i ) {
        ( $mp_date, $mp_author, $mp_title ) = $arg =~
          /^.*"([^()"]*?)"\s*"([^()"]*?)"\s*"([^()"]*?)"\s*$/
          or die "$0: cannot parse .TH line";
      }
      elsif ( $cmd =~ /^SH$/i ) {
        $sect{$sh} = $text if defined $sh;
        $text      = [];
        $sh        = $arg;
        dequote $sh;
      }
      elsif ( $cmd =~ /^PP$/i ) {
        $_         = undef;
        $cmd       = undef;
      }
      # (Ignore lines beginning with other commands.)
    }
    push @$text, $_ unless defined $cmd;
  }
  $sect{$sh} = $text if defined $sh;
  $text = undef;
  $sh   = undef;
}

# If debian/copyright exists, pull licensing text from it.
my @lic;
if ( -e $deb_cprt ) {
  my @lic0;
  open  CPRT, '<', $deb_cprt;
  {
    my $in = '';
    while ( <CPRT> ) {
      $in = '1' if /$mark_lic/;
      $in or next;
      push @lic0, $_;
    }
  }
  close CPRT;
  @lic = format_text @lic0;
  unshift @lic, $bar, "\n";
  push    @lic,       "\n";
}

# Calculate the manpage date, then prepare the readme's header and
# footer.
my $date = `$cmd_date '$mp_date $time_dflt'`; chomp $date;
my @head = (
  $Def::traditional_readme
  ? $headlead_trad     . " ${Def::out}\n"
  : ${Def::full_title} .             "\n"
);
my @foot = ( "${Def::author} <${Def::email}>\n", "$date\n" );
if ( $Def::traditional_readme ) {
  push @head, '-' x (length($head[0])-1) . "\n";
}
else {
  unshift @head, $bar;
  unshift @head, "\n";
  push    @head, $bar;
  unshift @foot, $bar;
  push    @foot, "\n";
}
push @head, "\n";

# Make special corrections.
if ( defined $sect{'AUTHOR'} ) {
  for ( @{ $sect{'AUTHOR'} } ) {
    next if s/^(The book) (and this manpage are\b)/$1 is/;
    next if s/^(${Def::out})$/'$1'/;
    next if s/^(in which) (they are) (distributed.)/$1 the book is $3/;
  }
}

# Build the readme.
my @body0;
for my $sh ( @sh ) {
  defined $sect{$sh} or next;
  convall for @{ $sect{$sh} };
  push @body0, map { defined() ? $_ : "\n" } @{ $sect{$sh} };
  push @body0, "\n";
}
my @body   = format_text @body0;
my @readme = ( @head, @body, @lic, @foot );

# Write the readme out.
open  README, '>', $readme;
  print README @readme;
close README;