\s*(.*)',
'
|
NetBSD Documentation:
$SUB1
|
'
,
'\s*(.*)',
'|
|
NetBSD Developer Documentation:
$SUB1
|
'
,
'',
''
,
'',
''
,
'',
''
,
'',
''
,
'',
''
);
# XXX Should DTRT with faqs not under Documentation
&makelist(@ARGV, &extras_generate(%extras));
exit;
sub check_date
{
my($date) = @_;
my($month, $when);
if ($date !~ /(\S+)\s*(\d+)/)
{ &fail("Unable to parse date '$date'"); }
if (!defined($month = $months{$1}))
{
&warn("Unable to parse month '$1'");
$month = 12;
}
$when = sprintf("%04d%02d", $2, $month);
( $when>$months_previous );
}
sub extract_tags
{
my($file, @tags) = @_;
my($tag, %map);
if (!open(FILE, $file))
{ return; }
while ()
{
foreach $tag (@tags)
{
if ( /($tag)/ )
{ $map{$tag} = $1; }
}
}
close(FILE);
%map;
}
sub extras_generate
{
my(%extras) = @_;
my($pathtodoc, $pathtodev, $pathtoports, $pathtogal, $str, $home);
$home = $0;
# extract the relative pathname from our name, no trailing / or
# language
if ($home =~ m#^/#) {
$home = dirname($home);
if ($home =~ m#.*?/(\.\.?/?.*)$#) {
($home = $1) =~ s#/$##;
$home =~ s#/../[a-z]{2}##;
}
} else {
if ($home !~ m#(.*)/[^/]+.pl#) {
&fail("Unable to extract path from '$0'");
}
$home = $1;
}
$pathtodoc = "$home/Documentation/";
$pathtodev = "$home/developers/";
$pathtoports = "$home/Ports/";
$pathtogal = "$home/gallery/";
foreach $str ( keys %extras )
{
$extras{$str} =~ s#\$HOME#$home#g;
$extras{$str} =~ s#\$DEVELOPERS#$pathtodev#g;
$extras{$str} =~ s#\$DOCS#$pathtodoc#g;
$extras{$str} =~ s#\$PORTS#$pathtoports#g;
$extras{$str} =~ s#\$GALLERY#$pathtogal#g;
}
(%extras);
}
sub extras_process
{
my($data, %extras) = @_;
my($key, $sub1, $sub2, $value);
foreach $key ( keys %extras )
{
$value = $extras{$key};
if ($data =~ /$key/)
{
($sub1, $sub2) = ($1, $2);
if (defined($sub1))
{ $value =~ s#\$SUB1#$sub1#g; }
if (defined($sub2))
{ $value =~ s#\$SUB2#$sub2#g; }
$data =~ s/$key.*/$value/;
}
}
$data;
}
sub fail
{
print STDERR "ABORTING: ", @_, "\n";
exit 3
}
sub get_minmonth
{
my($monthsback) = @_;
my($year, $month);
($month, $year) = (localtime(time))[4, 5];
++$month;
$month -= $monthsback;
while ($month<1)
{
$month += 12;
--$year;
}
sprintf("%04d%02d", $year+1900, $month);
}
# Collect $list containing forward links as we go. In general each entry will
# generate something in $list and some expanded data in the main $data.
#
sub makelist
{
my($infile, $outfile, %extras) = @_;
my($data, $section, $href, $header, $list, $pre, %tags, $date_month);
my($date_num, $date_num_used, $entry_num, $ignore, @date_links);
my($in_entry, $in_section, $endlist);
my($title_font) = "";
my($end_title_font) = "";
my(%rcsmap) = &extract_tags($outfile, '\$NetBSD.*\$');
my($rcstag, $in_trow);
$list = '';
$data = $date_month = '';
$entry_num = $date_num = $date_num_used = 0;
open(FILE, $infile) || die("Unable to open '$infile': $!");
foreach( )
{
foreach $rcstag (%rcsmap)
{ s/$rcstag/$rcsmap{$rcstag}/; }
if (defined($pre)) # Handle continuation lines
{ $_ = $pre.$_; $pre = undef; }
if (substr($_, -2) eq "\\\n") # Handle continuation lines
{
s/\\\n$//;
$pre = $_;
next;
}
if (m#^\s*(.+\S)#) # Changes
{
my($year, $month, $date, $link, $linkwrapped);
if ($in_entry)
{
$data .= "\n";
$in_entry = undef;
}
$ignore = undef;
++$date_num;
$header = $1;
if ($header !~ /^([-a-z0-9_.+]+)\s+(\d+) (\S+) (\d+) - (\S.*)/)
{ &fail("'$header' not in expected 'date - event' format"); }
$href = $1;
$month = $months{"$3"};
$date = sprintf("%d-%02d-%02d", $4, $month, $2);
$header = "$5 ($2 $3)";
$month = "$3 $4";
$link = $5;
if (defined($tags{$href}))
{ &fail("Duplicate name tag '$href'"); }
$tags{$href} = 1;
if (!&check_date($month))
{ $ignore = 1; }
else
{
$_ = '';
++$date_num_used;
if ($month ne $date_month)
{
if ($date_month ne '')
{ $list .= "\n"; }
$list .= "$month
\n\n";
$_ .= "
$month
\n";
$date_month = $month;
}
$_.= "\n$title_font".
"$header$end_title_font\n".
"".
"(top)\n".
"
- \n";
$list .= "
- $title_font\n$link".
"$end_title_font
\n";
if (@date_links < $list_date_links)
{
$linkwrapped = wrap("", " ", $link);
push(@date_links, "- \n".
" $linkwrapped\n".
"
\n");
}
$in_entry = 1;
}
}
if (m#^\s*(.+\S)#)
{
if (! $in_section )
{ $list .= "\n"; } # Start title list
if ($in_entry)
{
$data .= "
\n";
$in_entry = undef;
}
$ignore = undef;
++$entry_num;
$_ = $1;
if (! /^([-a-zA-Z0-9_.+,]+)\s+(.*)/)
{ &fail("Invalid ($_), not ([-a-zA-Z0-9_.+,]+)\s+(.*)"); }
$href = $1;
$header = $2;
if (defined($tags{$href}))
{ &fail("Duplicate name tag '$href'"); }
$tags{$href} = 1;
$_ = "\n$title_font".
"$header$end_title_font\n".
"".
"(top)\n".
"
- \n";
$list .= "
- $title_font\n$header".
"$end_title_font
\n";
$in_entry = $in_section = 1;
&verbose("\t$href\n");
}
if (m#^\s*(.+\S)#)
{
if ( ! $in_section )
{ $list .= "\n"; } # Start title list
$ignore = undef;
++$entry_num;
$_ = $1;
if (! m#^(\S+)\s+(.*)#)
{ &fail("Invalid ($_), not (\S+)\s+(.*)"); }
$href = $1;
$header = $2;
$_ = '';
$list .= "- $title_font\n$header".
"$end_title_font
\n";
$in_section = 1;
&verbose("\t$href\n");
}
if (m#^\s*(.+\S)#)
{
if ( ! $in_section )
{ $list .= "\n"; } # Start title list
if ($in_entry)
{
$data .= "
\n";
$in_entry = undef;
}
$ignore = undef;
++$entry_num;
$_ = $1;
if (! m#^(\S+)\s+(.*)#)
{ &fail("Invalid ($_), not (\S+)\s+(.*)"); }
$href = $1;
$header = $2;
$_ = "\n$title_font".
"$header$end_title_font\n".
"".
"(top)\n".
"
- \n";
$list .= "
- $title_font\n$header".
"$end_title_font
\n";
$in_entry = $in_section = 1;
&verbose("\t$href\n");
}
if (m#^\s*(.+\S)#)
{
if ($in_entry)
{
$data .= "
\n";
$in_entry = undef;
}
else # In case no entries
{ $data =~ s#
\n.*
\n*$##; }
$ignore = undef;
if (defined($section))
{
$list .= "
\n";
$section = $1;
$list .= "$section
\n";
$list .= "\n"; # Start title list
}
else
{ # If we have never seen remember top link!
$section = $1;
$list .= "\n".
"\n";
}
$_ = "
\n$section
";
$in_section = 1;
&verbose(" $section\n");
}
if (m#^\s*(.*)#)
{
$_ = $1;
if (! m#^([^:]+:)\s+(.*)#)
{ &fail(" should match ([^:]+:)\s+(.*)"); }
$ignore = undef;
$_ = "| $1 | \n $2 |
|---|
\n";
$in_trow = 1;
}
elsif ($in_trow)
{
if (m##i)
{ $in_trow = 0; }
else
{ # Append to last
substr($data, -11, 0) = ' '.&sub_external_links($_);
$_ = '';
}
}
if (m#^#)
{
if ($in_entry)
{
$data .= "\n";
$in_entry = undef;
}
if ($endlist)
{ &fail("Duplicate "); }
$endlist = 1;
$ignore = undef;
$_ = "
\n";
}
if (! $ignore)
{ $data .= &sub_external_links($_); }
}
close(FILE);
$list .= "
\n";
if (!$endlist)
{ &warn("Unable to locate tag, check header to see if this is desired\n"); }
if ($data !~ s//$list/)
{ &warn("Unable to locate tag, check header to see if this is desired\n"); }
$_ = "\n\n\n";
if ($data !~ s/(]*>)/$1$_/i)
{ &fail("Unable to locate tag"); }
open(FILE, ">$outfile") || die("Unable to write '$outfile': $!");
print FILE &extras_process($data, %extras);
close(FILE);
if ($date_num) {
if ($verbose) {
print "$date_num date entr", ($date_num == 1)?'y':'ies';
if ($date_num_used != $date_num)
{ print " ($date_num_used used)"; }
print ".\n";
if (@date_links && !$opt{'d'}) {
print "First $list_date_links date links (for main index.html):\n",
@date_links;
}
}
}
if ($entry_num && $verbose)
{ print "$entry_num entr", ($entry_num == 1)?'y':'ies', ".\n"; }
}
sub sub_external_links
{
my($text) = @_;
# Man page references. As of 1.4 matches every page except '[' and 'w'.
#
$_ = $text; # Output text include match string, so handle in sections
$text = '';
while ( m#([a-zA-Z_][-\w.+]*[\w+])\((\d)(|\.(\w+))(|\+(\W+))\)# )
{
my($page, $section, $arch, $collection) = ($1, $2, $4, $6);
my($link);
$link = 'http://man.NetBSD.org/man/';
$link .= "$page+$section";
if (defined($arch))
{ $link .= ".$arch"; }
elsif ($opt{'a'})
{ $link .= ".$opt{'a'}"; }
if (defined($collection))
{ $link .= "+NetBSD-$collection"; }
elsif ($opt{'c'})
{ $link .= "+$opt{'c'}"; }
else
{ $link .= "+NetBSD-current"; }
$text .= $` . "$page($section)";
$_ = $';
}
$text .= $_;
# Expand path
#
while ($text =~ m#([^\s<>]+\w)#)
{
my($path);
$path = $1;
$path =~ s#^/##;
$path =~ s#^usr/##;
$path =~ s#^src/##;
if ($path =~ m#^(sys|share|gnu)src#) {
my($module) = $1;
$path =~ s#^${module}src##;
$path = "src/".$module.$path;
}
elsif ($path !~ m#^(pkgsrc|xsrc|othersrc)#) {
$path = "src/$path";
}
$text =~ s#([^\s<>]+\w)#$1#;
}
# Expand [^\s<]+[^<\s.]
$text =~ s#([^\s<]+[^<\s.])#$1#g;
# Expand category/name entries
#
while ($text =~ m#(([-\w.]+/|)([^\s<>]+\w))#)
{
my($n) = $3;
if (defined($pkgname{$n}))
{ $n = $pkgname{$n}; }
$text =~ s#(([-\w.]+/|)([^\s<>]+\w))#$n#;
}
# Expand RFCxxxx entries
#
while ($text =~ m#([^\s<>]+\w)#)
{
my($o, $n);
$o = $n = $1;
$n =~ s#^rfc##i;
if ($n =~ /^\d+$/)
{
$text =~ s#$o#$o#;
}
else
{
$text =~ s#$o#$o#;
}
}
# Expand email addresses
#
$text =~ s#<([-\w.]+@[-\w.]+)>#<$1>#g;
$text;
}
sub verbose
{ $verbose && print @_; }
sub warn
{ $verbose && print "WARNING: ", @_; }
