TomeRaidser | Creating | RFCDocs.pl
Here's the Internet RFC database for offline and handheld reading.
The TomeRaider version is abridged. All RFCs that either has not been obsoleted (according to the RFC XML index) or has been promoted to standard are included, the rest just links to the newer RFCs that made them obsolete.
Indexes has been created for:
In case you want to modify the way the database is created, fetch the perl script used to create this database and make it do what you want.
Regards
/Jonas
use strict;
use Cwd;
use File::Path;
use File::Copy;
use LWP::UserAgent;
use XML::Parser;
use XML::Parser::EasyTree;
use XML::Dumper;
use Date::Format;
use Date::Parse;
use XML::Mini::Document;
$| = 1;
my $docroot = 'C:/Documents and Settings/Jonas/My Documents/RFCs';
#my $dataurl = 'http://ftp.rfc-editor.org/in-notes/';
#my $dataurl = 'ftp://ftp.rfc-editor.org/in-notes/';
my $dataurl = 'http://10.0.7.11/rfcs/';
#my $htmlurl = 'http://www.apps.ietf.org/rfc/'; #rfc99.html
my $htmlurl = 'http://asg.web.cmu.edu/rfc/';
my $tomebin = 'c:/Program Files/TomeRaider3/TomeRaider.exe';
my $isilobin = 'c:/Misc/iSiloXC.exe';
my $publish = 'C:/HTMLRoot/tomerefer';
my $highplf = 'c:/Misc/code2html.pl';
my $zipbin = 'c:/Misc/zip.exe';
my $tarbin = 'c:/Misc/UnxUtils/tar.exe';
my $xzipbin = 'c:/Misc/UnxUtils/bzip2.exe';
my $packext = 'bz2';
my $idxcss = "<style type=\"text/css\">".
" .odd { background: rgb(230,255,230); }".
" .even { background: rgb(230,230,255); }".
"</style>\n";
my $datanam = 'data';
#my $hdocnam = 'htdocs';
my $datadir = "$docroot/$datanam";
#my $hdocdir = "$docroot/$hdocnam";
my $hdocdir = "C:/HTMLRoot/RFCs";
my $dontfetch = 0;
my $dontreget = 0;
my $dontwrite = 0;
my $dontcreat = 0;
my $dontpubht = 0;
my $dontindex = 0;
my $dontisilo = 0;
my $doreindex = 0;
my $dontclean = 0;
my $incerrata = 0;
my $incobsolete = 0;
my $refresh = 6*60*60;
my $recheck = 24*60*60;
my $dbgx = 0;
my $dbgmaxwrite = 0;
my $dbgfirstwrite = 0;
my $dbgnohtmldocs = 0;
if (-f "$docroot/donttomeraider") {
$dontwrite = 1;
$dontcreat = 1;
}
$dontisilo = 1 if (-f "$docroot/dontisilo");
$dontindex = 1 if (-f "$docroot/dontindex");
$dontpubht = 1 if (-f "$docroot/dontpublish");
for my $p (@ARGV) {
$p =~ s/^[-\/\s]+//;
my $no = 0;
if ($p =~ /^h(elp)?/i || $p =~ /^\?+$/) {
print "DontFetch\nDontWrite\nDontCreate\nDontPublish\nDontIndex\n";
next;
}
if ($p =~ /^(dont|no|d|n)[-_\s]?(.*)$/i) {
$no = 1;
$p = $2;
}
if ($p =~ /^f(etch)?$/i) {
$dontfetch = $no;
} elsif ($p =~ /^re?f(etch)?$/i) {
$dontreget = $no;
} elsif ($p =~ /^w(rite)?$/i) {
$dontwrite = $no;
} elsif ($p =~ /^c(reate)?$/i) {
$dontcreat = $no;
} elsif ($p =~ /^p(ublish)?$/i) {
$dontpubht = $no;
} elsif ($p =~ /^i(ndex)?$/i) {
$dontindex = $no;
} elsif ($p =~ /^re?i(ndex)?$/i) {
$doreindex = !$no;
} elsif ($p =~ /^i(ndex)?xc?$/i) {
$dontisilo = $no;
} elsif ($p =~ /^c(lean)?$/i) {
$dontclean = $no;
} elsif ($p =~ /^a(ny)?(thing)?$/i) {
$dontfetch = $no;
$dontreget = $no;
$dontwrite = $no;
$dontcreat = $no;
$dontpubht = $no;
$dontindex = $no;
$dontisilo = $no;
$dontclean = $no;
} elsif ($p) {
print "?? $p\n";
}
}
my $started = time2str('%Y-%m-%d',time);
my $filename = 'RFCs';
$filename = "RFCs ($started)" unless ($dbgx || $dbgmaxwrite || $dbgfirstwrite || $dbgnohtmldocs);
my $appname = $0;
$appname =~ s/^.*[\\\/]//;
my $appdate = time2str('%Y%m%d.%H%M',(stat($0))[9],'GMT');
print "$appname v$appdate\n";
mkpath($datadir);
my $ua = LWP::UserAgent->new;
my $state;
my $statesaved;
sub loadstate {
$statesaved = time;
my $f = "$datadir/RFCDocs_state.xml";
if (-f $f) {
eval{ $state = xml2pl($f) };
print "LS: $state->{lastsave}\n" if (defined($state) && defined($state->{lastsave}));
}
unless (defined($state)) {
my %s = ();
$state = \%s;
return 0;
}
return 1;
}
sub savestate {
my $f = "$datadir/RFCDocs_state.xml";
$state->{lastsave} = time2str('%Y-%m-%d %H:%M',time);
pl2xml($state,$f);
$statesaved = time;
return 1;
}
sub maybesavestate {
savestate() if (time-$statesaved>60);
}
loadstate();
sub s2h {
my $r = '';
foreach my $p (@_) {
next unless (defined($p) && $p ne '');
$r .= ' ' if ($r);
$r .= $p;
}
$r =~ s/&/&/gs;
$r =~ s/</</gs;
$r =~ s/>/>/gs;
#$r =~ s/\"/"/gs;
return $r;
}
sub s2k {
my $r = join(' ',@_);
$r =~ s/&/&/gs;
$r =~ s/</</gs;
$r =~ s/>/>/gs;
$r =~ s/\"/'/gs;
#print " K: $r\n" if ($r =~ /[^-+_.,:;='#\$\*?!<>\@%\&\[\]\s\/\(\)a-zA-Z0-9]/);
return $r;
}
sub lastmodified {
my $p = shift;
my $f = shift;
return $state->{lmods}{"$p$f"} if (defined($state->{lmods}) && defined($state->{lmods}{"$p$f"}) && $state->{lmods}{"$p$f"});
return '';
}
sub refreshd {
my $p = shift;
my $f = shift;
my $u = shift;
my $d = 0;
my $x = $state->{pdfs}{"$p$f"};
$x = 0 unless ($x);
if (!($u)) {
$u = "$dataurl$p$f";
} elsif ($u =~ /\/$/) {
$u .= "$p$f";
}
my $n = "$datadir/$p$f";
if ($dontfetch) {
return (1,$x) if (-f $n);
return (0,$x);
}
mkpath("$datadir/$p");
if (defined($state->{lgets}) && defined($state->{lgets}{"$p$f"}) && $state->{lgets}{"$p$f"}) {
return (1,$x) if (time - $state->{lgets}{"$p$f"} < $refresh);
}
#print "? $n\n"; # -
if (-f $n) {
#print "X $n\n"; # -
return (1,$x) if ($dontreget);
if (defined($state->{lgets}) && defined($state->{lgets}{"$p$f"}) && $state->{lgets}{"$p$f"}) {
return (1,$x) if (time - $state->{lgets}{"$p$f"} < $recheck);
}
if (defined($state->{lmods}) && defined($state->{lmods}{"$p$f"}) && $state->{lmods}{"$p$f"}) {
#print "\rGH: $u\n"; # -
my $hr = $ua->head($u);
return (1,$x) unless ($hr->is_success);
$state->{lgets}{"$p$f"} = time;
return (1,$x) if ($hr->header('Last-Modified') && $hr->header('Last-Modified') eq $state->{lmods}{"$p$f"});
}
$d = 1;
}
print "\rGF: $u\n";
my $r = $ua->get($u);
unless ($r->is_success) {
$state->{lgets}{"$p$f"} = time if ($r->code == 404);
#print 'GR: '.$r->status_line."\n"; # -
return ($d,$x);
}
if ($f =~ /^rfc.*\.txt$/i) {
$state->{pdfs}{"$p$f"} = (length($r->content)<512 && $r->content =~ /[\r\n\s]+available([\r\n\s]+only)?[\r\n\s]+in[\r\n\s]+(postscript|ps|pdf)[\r\n\s]+/i);
my $x = $state->{pdfs}{"$p$f"};
$x = 0 unless ($x);
}
return ($d,$x) unless (open(F,'>',$n));
binmode(F);
print F $r->content;
close(F);
$state->{lgets}{"$p$f"} = time;
$state->{lmods}{"$p$f"} = $r->header('Last-Modified') if ($r->header('Last-Modified'));
#print "GR: OK\n"; # -
return (1,$x);
}
sub refresh {
my ($r,$z) = refreshd(@_);
return $r;
}
sub clean_docroot {
return 0 if ($dontclean);
return 0 unless (opendir(D,$docroot));
print "CO: $docroot\n";
my %fl = ();
while (my $fn = readdir(D)) {
next if ($fn =~ /^\./);
my $ft = '';
if ($fn =~ /\.pdb$/i) {
$ft = 'i';
} elsif ($fn =~ /\.tr3$/i) {
$ft = 'r';
} elsif ($fn =~ /^R?log_.*\.txt$/i) {
$ft = 'l';
} elsif ($fn =~ /\.txt$/i) {
$ft = 't';
}
next unless ($ft);
unless ($fl{$ft}) {
my @l = ();
$fl{$ft} = \@l;
}
push @{$fl{$ft}}, $fn;
#print "$ft: $fn\n";
}
closedir(D);
while (my ($k,$l) = each %fl) {
my @cl = sort {$b cmp $a} @{$l};
shift @cl;
while (my $fn = pop @cl) {
#print "$k: $fn\n";
unlink("$docroot/$fn");
}
}
}
sub clean_publish {
return 0 if ($dontclean);
return 0 unless (opendir(D,$publish));
print "CO: $publish\n";
my %fl = ();
my @dl = ();
while (my $fn = readdir(D)) {
next if ($fn =~ /^\./);
if ($fn =~ /^zia\d+$/) {
push @dl, $fn;
} else {
my $ft = '';
if ($fn =~ /^RFCs.*\.pdb$/i) {
$ft = 'i';
} elsif ($fn =~ /^RFCs.*\.tr3$/i) {
$ft = 'r';
} elsif ($fn =~ /^RFCs.*\.zip$/i) {
$ft = 'z';
} elsif ($fn =~ /^RFCs.*\.tr3txt\.(zip|$packext)$/i) {
$ft = 'zt';
} elsif ($fn =~ /^RFCs.*\.html\.(zip|tar\.$packext)$/i) {
$ft = 'zh';
}
next unless ($ft);
unless ($fl{$ft}) {
my @l = ();
$fl{$ft} = \@l;
}
push @{$fl{$ft}}, $fn;
#print "$ft: $fn\n";
}
}
closedir(D);
while (my ($k,$l) = each %fl) {
my @cl = sort {$b cmp $a} @{$l};
shift @cl;
while (my $fn = pop @cl) {
#print "$k: $fn\n";
unlink("$docroot/$fn");
}
}
while (my $fn = shift @dl) {
#print "$fn\n";
unlink("$docroot/$fn");
}
}
my %docs = ();
my %cnts = ();
sub set_attrib {
my $n = lc(shift);
my $a = lc(shift);
my $c = shift;
foreach my $x (@$c) {
next unless ($x->{name} && $x->{type} && $x->{content} && $x->{content}->[0] && $x->{content}->[0]->{type});
if ($x->{name} eq 'doc-id' && $x->{type} eq 'e' && $x->{content}->[0]->{type} eq 't') {
my $i = lc($x->{content}->[0]->{content});
my $t = $i;
$t =~ s/\d+$//;
$i =~ s/^[\D0]+//;
my $x = $a;
$a = "$n-$a" unless ($n eq $t);
$docs{$t}{$i}{'attr'}{$a} = 1;
}
}
}
sub add_docidslist {
my $c = shift;
my $l = shift;
foreach my $d (@{$c}) {
next unless ($d->{name} && $d->{type} && $d->{content} && $d->{content}->[0] && $d->{content}->[0]->{type});
if ($d->{name} eq 'doc-id' && $d->{type} eq 'e' && $d->{content}->[0]->{type} eq 't') {
my $d = lc($d->{content}->[0]->{content});
my $f = 0;
foreach my $o (@{$l}) {
if ($o eq $d) {
$f = 1;
last;
}
}
next if ($f);
push @$l, $d;
}
}
}
sub add_listtodocs {
my $dn = shift;
my $di = shift;
my $n = shift;
my $l = shift;
my $d = sprintf('%s%04u',uc($dn),$di);
foreach my $x (@{$l}) {
my $t = $x;
my $i = $x;
$t =~ s/\d+$//;
$i =~ s/^[\D0]+//;
unless (defined($docs{$t}{$i}{$n})) {
my @lf = ();
$docs{$t}{$i}{$n} = \@lf;
} else {
my $f = 0;
foreach my $o (@{$docs{$t}{$i}{$n}}) {
if ($o eq $d) {
$f = 1;
last;
}
}
next if ($f);
}
push @{$docs{$t}{$i}{$n}}, $d;
}
}
sub xcontentis {
my $x = shift;
my $c = shift;
return 1 if ($x && $x->{content} && $x->{content}->[0] && $x->{content}->[0]->{type} && $x->{content}->[0]->{type} eq $c);
return 0;
}
sub add_this {
my $n = lc(shift);
my $c = shift;
my $i = 0;
my $t = '';
my %dv = ();
my @al = ();
my $ht = 0;
my @kwl = ();
my $ps = '';
my $cs = '';
my @ol = ();
my @obl = ();
my $dsc = '';
my @a = ();
my @ul = ();
my @ubl = ();
my $eru = '';
my $nt = '';
my @sal = ();
my $wlp = 0;
my $gpf = 0;
foreach my $x (@$c) {
next unless ($x->{name} && $x->{type});
next if ($x->{type} ne 'e');
next if ($x->{content} =~ /^ARRAY/ && !$x->{content}->[0]->{type});
if ($x->{name} eq 'doc-id' && $x->{type} eq 'e' && xcontentis($x,'t')) {
$i = lc($x->{content}->[0]->{content});
$i =~ s/^$n//;
$i =~ s/^[\s0]+//;
} elsif ($x->{name} eq 'title' && $x->{type} eq 'e' && xcontentis($x,'t')) {
$t = $x->{content}->[0]->{content};
} elsif ($x->{name} eq 'author' && $x->{type} eq 'e') {
foreach my $d (@{$x->{content}}) {
next unless ($d->{name} && $d->{type} && $d->{content} && $d->{content}->[0] && $d->{content}->[0]->{type});
if ($d->{name} eq 'name' && $d->{type} eq 'e' && $d->{content}->[0]->{type} eq 't') {
push @al, lc($d->{content}->[0]->{content});
}
}
} elsif ($x->{name} eq 'date' && $x->{type} eq 'e') {
foreach my $d (@{$x->{content}}) {
next unless ($d->{name} && $d->{type} && $d->{content} && $d->{content}->[0] && $d->{content}->[0]->{type});
if ($d->{name} && $d->{type} eq 'e' && $d->{content}->[0]->{type} eq 't') {
$dv{$d->{name}} = $d->{content}->[0]->{content};
}
}
} elsif ($x->{name} eq 'format' && $x->{type} eq 'e') {
my $tif = '?';
my $csz = 0;
my $pgc = 0;
foreach my $d (@{$x->{content}}) {
next unless ($d->{name} && $d->{type} && $d->{content} && $d->{content}->[0] && $d->{content}->[0]->{type});
if ($d->{name} eq 'file-format' && $d->{type} eq 'e' && $d->{content}->[0]->{type} eq 't') {
if (lc($d->{content}->[0]->{content}) eq 'ascii') {
$ht = 1;
$tif = 'a';
} elsif (lc($d->{content}->[0]->{content}) eq 'pdf') {
$tif = 'p';
}
} elsif ($d->{name} eq 'char-count' && $d->{type} eq 'e' && $d->{content}->[0]->{type} eq 't') {
$csz = $d->{content}->[0]->{content};
} elsif ($d->{name} eq 'page-count' && $d->{type} eq 'e' && $d->{content}->[0]->{type} eq 't') {
$pgc = $d->{content}->[0]->{content};
}
}
$wlp = 1 if ($tif eq 'a' && $csz<512 && $pgc<2);
$gpf = 1 if ($tif eq 'p' && $csz>512);
} elsif ($x->{name} eq 'keywords' && $x->{type} eq 'e') {
my %kwg = ();
foreach my $d (@{$x->{content}}) {
next unless ($d->{name} && $d->{type} && $d->{content} && $d->{content}->[0] && $d->{content}->[0]->{type});
if ($d->{name} eq 'kw' && $d->{type} eq 'e' && $d->{content}->[0]->{type} eq 't') {
my $kw = $d->{content}->[0]->{content};
$kw =~ s/^\s+//;
$kw =~ s/\s+$//;
next unless ($kw);
next if ($kwg{$kw});
push @kwl, $kw;
$kwg{$kw} = 1;
}
}
} elsif ($x->{name} eq 'publication-status' && $x->{type} eq 'e' && xcontentis($x,'t')) {
$ps = $x->{content}->[0]->{content} if ($x->{content}->[0]->{content});
$ps = join(' ',map { ucfirst(lc($_)) } split(/\s+/,$ps));
$cs = $ps unless ($cs);
} elsif ($x->{name} eq 'current-status' && $x->{type} eq 'e' && xcontentis($x,'t')) {
$cs = $x->{content}->[0]->{content} if ($x->{content}->[0]->{content});
$cs = join(' ',map { ucfirst(lc($_)) } split(/\s+/,$ps));
$ps = $cs unless ($ps);
} elsif ($x->{name} eq 'obsoletes' && $x->{type} eq 'e') {
add_docidslist($x->{content},\@ol);
} elsif ($x->{name} eq 'obsoleted-by' && $x->{type} eq 'e') {
add_docidslist($x->{content},\@obl);
} elsif ($x->{name} eq 'draft' && $x->{type} eq 'e') {
} elsif ($x->{name} eq 'abstract' && $x->{type} eq 'e' && xcontentis($x,'t')) {
$dsc = $x->{content}->[0]->{content};
} elsif ($x->{name} eq 'abstract' && $x->{type} eq 'e' && xcontentis($x,'e') && xcontentis($x->{content}->[0],'t')) {
$dsc = $x->{content}->[0]->{content}->[0]->{content};
} elsif ($x->{name} eq 'is-also' && $x->{type} eq 'e') {
add_docidslist($x->{content},\@a);
} elsif ($x->{name} eq 'updates' && $x->{type} eq 'e') {
add_docidslist($x->{content},\@ul);
} elsif ($x->{name} eq 'updated-by' && $x->{type} eq 'e') {
add_docidslist($x->{content},\@ubl);
} elsif ($x->{name} eq 'see-also' && $x->{type} eq 'e') {
add_docidslist($x->{content},\@sal);
} elsif ($x->{name} eq 'errata-url' && $x->{type} eq 'e' && xcontentis($x,'t')) {
$eru = $x->{content}->[0]->{content};
} elsif ($x->{name} eq 'notes' && $x->{type} eq 'e' && xcontentis($x,'t')) {
$nt = $x->{content}->[0]->{content};
$nt =~ s/^.$//;
$nt =~ s/\.\.$/\./;
} elsif ($x && $x->{content} && $x->{content}->[0] && $x->{content}->[0]->{type}) {
print " $i: $x->{type} $x->{name} $x->{content}->[0]->{type}\n";
} else {
print " $i: $x->{type} $x->{name}\n";
}
}
$cnts{$n} = 0 unless ($cnts{$n});
$cnts{$n} ++;
$docs{$n}{$i}{'pdf'} = 1 if ($gpf && ($wlp || !$ht));
$docs{$n}{$i}{'doc'} = 1;
$docs{$n}{$i}{'title'} = $t;
$docs{$n}{$i}{'date'} = \%dv;
$docs{$n}{$i}{'authors'} = \@al;
$docs{$n}{$i}{'text'} = 1 if ($ht || !@a);
$docs{$n}{$i}{'keywords'} = \@kwl;
$docs{$n}{$i}{'status'}{'pub'} = $ps;
$docs{$n}{$i}{'status'}{'cur'} = $cs;
$docs{$n}{$i}{'obsoletes'} = \@ol;
$docs{$n}{$i}{'obsoletedby'} = \@obl;
$docs{$n}{$i}{'updates'} = \@ul;
$docs{$n}{$i}{'updatedby'} = \@ubl;
$docs{$n}{$i}{'abstract'} = $dsc;
$docs{$n}{$i}{'linkto'} = \@a;
$docs{$n}{$i}{'errata'} = $eru;
$docs{$n}{$i}{'note'} = $nt;
$docs{$n}{$i}{'seealso'} = \@sal;
add_listtodocs($n,$i,'linkfrom',\@a);
add_listtodocs($n,$i,'obsoletedby',\@ol);
add_listtodocs($n,$i,'updatedby',\@ul);
add_listtodocs($n,$i,'obsoletes',\@obl);
add_listtodocs($n,$i,'updates',\@ubl);
$docs{'.max'}{$n} = $i unless ($docs{'.max'}{$n});
$docs{'.max'}{$n} = $i if ($i > $docs{'.max'}{$n});
}
sub get_errata {
my $n = shift;
my $i = shift;
my $u = shift;
if ($u =~ /^http:\/\/www\.rfc-editor\.org\/cgi-bin\/errata\.pl\#(\D+)(\d+)$/i) {
$u = "http://www.rfc-editor.org/cgi-bin/errataSearch.pl?$1=$2";
}
if ($u =~ /^http:\/\/www\.rfc-editor\.org\/cgi-bin\/errataSearch\.pl\?/i) {
my $fn = "$n$i.err";
return '' unless (refresh('err/',$fn,$u));
return $fn;
}
return '';
}
sub get_title {
my $n = shift;
my $i = shift;
my $c = shift;
if ($c->{'linkto'}) {
foreach my $x (@{$c->{'linkto'}}) {
if ($x =~ /^(\D+)(\d+)$/) {
my $xn = $1;
my $xi = $2;
$xn =~ s/\d+//g;
$xi =~ s/\D+//g;
return $docs{$xn}{$xi}{'title'} if ($docs{$xn}{$xi}{'title'});
}
}
}
#my $p = '';
#$p = "$n/" unless ($n eq 'rfc');
#return 0 unless (open(F,'<',"$datadir/$p$n$i.txt"));
#close(F);
#print "!T: $n $i\n";
#return '-' if ($docs{$n}{$i}{'ok'} || $docs{$n}{$i}{'htmlok'});
return '';
}
sub read_std_list {
print "RI: $datadir/std/std1.txt\n";
return 0 unless (open(F,'<',"$datadir/std/std1.txt"));
my $std = '';
while (my $l = <F>) {
$l =~ s/[\r\n]+//gs;
$std .= "$l\n";
}
close(F);
$std =~ s/\n[^\n]*\n\x0C\n[^\n]*\n//gs;
$std =~ s/^.*\n(3\.1)/$1/s;
$std =~ s/\n4\. .*$//s;
$std =~ s/\n+$/\n/gs;
$std =~ s/\s+\[[^\[]+\]\n$/\n/s;
$std =~ s/^\n+//s;
my $ls = '';
my @sn = ();
my ($a,$t,@i);
my @tl = (0,0);
while ($std ne '') {
my $l;
if ($std =~ /^([^\n]*)\n(.*)$/s) {
$l = $1;
$std = $2;
} else {
$l = $std;
$std = '';
$l =~ s/\n+//gs;
}
if ($l =~ /-----------------------------------------/) {
$ls =~ s/^Mnemonic\s+Title\s+//;
$ls =~ s/\#//g;
@sn = split(/\s+/,lc($ls));
} else {
$l =~ s/\*$//;
$a = 0;
if ((@sn == 2) && $l =~ /^(\S+)\s+(.*?)\s+(\d+)\s+(\d+)$/) {
$a = $1;
$t = $2;
$i[0] = $3;
$i[1] = $4;
} elsif ((@sn == 1) && $l =~ /^(\S+)\s+(.*?)\s+(\d+)$/) {
$a = $1;
$t = $2;
$i[0] = $3;
} elsif ((@sn) && $l =~ /^\s+(\S.*)$/) {
my $ta = $1;
for (my $ii=0;$ii<@sn;$ii++) {
$docs{$sn[$ii]}{$i[$ii]}{'title'} .= " $1" if ($tl[$ii]);
}
}
$tl[0] = 0;
$tl[1] = 0;
if ($a) {
$a = '' if ($a =~ /^-+$/);
for (my $ii=0;$ii<@sn;$ii++) {
unless ($docs{$sn[$ii]}{$i[$ii]}{'mnemonic'}) {
$docs{$sn[$ii]}{$i[$ii]}{'mnemonic'} = $a if ($a);
}
unless ($docs{$sn[$ii]}{$i[$ii]}{'title'} || !$t) {
$docs{$sn[$ii]}{$i[$ii]}{'title'} = $t;
$tl[$ii] = 1;
}
}
}
}
$ls = $l;
}
}
sub read_ien_list {
print "RI: $datadir/ien/ien-index.txt\n";
return 0 unless (open(F,'<',"$datadir/ien/ien-index.txt"));
my $li = 0;
while (my $l = <F>) {
$l =~ s/[\r\n]+//gs;
if ($l =~ /^ ? ?(\d+) +[-.]+ +[-.]+ +(not issued\.?|not issued yes\.?)$/i) {
$li = $1;
#print "ien n $li: $2\n";
$docs{'ien'}{$li}{'note'} = $2;
} elsif ($l =~ /^ ? ?(\d+) +(\S+|\S+ \S+|[-.]+) +([A-Z][a-z][a-z][-]\d+|[-.]+) +(\S+.*)$/) {
$li = $1;
#print "ien t $li: $2|$3|$4\n";
$docs{'ien'}{$li}{'doc'} = 1;
$docs{'ien'}{$li}{'text'} = 1;
$docs{'ien'}{$li}{'authors'} = $2;
$docs{'ien'}{$li}{'date'} = $3;
$docs{'ien'}{$li}{'title'} = $4;
$cnts{'ien'} = 0 unless ($cnts{'ien'});
$cnts{'ien'} ++;
$docs{'.max'}{'ien'} = $li unless ($docs{'.max'}{'ien'});
$docs{'.max'}{'ien'} = $li if ($li > $docs{'.max'}{'ien'});
} elsif ($l =~ /^ ? ?(\d+) +(\S+|\S+ \S+|[-.]+) +(\d+[-][A-Z][a-z][a-z][-]\d+|[-.]+) +(\S+.*)$/) {
$li = $1;
#print "ien t $li: $2|$3|$4\n";
$docs{'ien'}{$li}{'doc'} = 1;
$docs{'ien'}{$li}{'text'} = 1;
$docs{'ien'}{$li}{'authors'} = $2;
$docs{'ien'}{$li}{'date'} = $3;
$docs{'ien'}{$li}{'title'} = $4;
$cnts{'ien'} = 0 unless ($cnts{'ien'});
$cnts{'ien'} ++;
$docs{'.max'}{'ien'} = $li unless ($docs{'.max'}{'ien'});
$docs{'.max'}{'ien'} = $li if ($li > $docs{'.max'}{'ien'});
} elsif ($l =~ /^ ? ?(\d+) +(\S+.*)$/) {
$li = $1;
#print "ien n $li: $2\n";
$docs{'ien'}{$li}{'note'} = $2;
} elsif ($li && $docs{'ien'}{$li}{'title'} && $l =~ /^\s+(\S+.*)$/) {
$docs{'ien'}{$li}{'title'} .= " $1";
#print "ien + $li: $docs{'ien'}{$li}{'title'}\n";
} else {
$li = 0;
}
}
close(F);
}
sub xxx2i {
my $x = shift;
return 1 if ($x eq 'rfc');
return 2 if ($x eq 'std');
return 3 if ($x eq 'bcp');
return 4 if ($x eq 'fyi');
return 5 if ($x eq 'ien');
return 6;
}
sub yyy2i {
my $x = shift;
return 1 if ($x eq 'std');
return 2 if ($x eq 'rfc');
return 3 if ($x eq 'ien');
return 4 if ($x eq 'bcp');
return 5 if ($x eq 'fyi');
return 6;
}
sub xxxcmp {
my ($a,$b) = @_;
my $r = xxx2i($a) <=> xxx2i($b);
$r = $a cmp $b unless ($r);
return $r;
}
sub yyycmp {
my ($a,$b) = @_;
my $r = yyy2i($a) <=> yyy2i($b);
$r = $a cmp $b unless ($r);
return $r;
}
sub xxx2s {
my $n = lc(shift);
if ($n eq 'rfc') {
return 'Request For Comments';
} elsif ($n eq 'std') {
return 'Standards';
} elsif ($n eq 'bcp') {
return 'Best Current Practices';
} elsif ($n eq 'fyi') {
return 'For Your Information';
} elsif ($n eq 'ien') {
return 'Internet Experiment Notes';
} else {
return uc($n).'s';
}
}
sub linkex {
foreach my $ll (@_) {
foreach my $l (@{$ll}) {
if ($l =~ /^(\D+?)-?(\d+)$/) {
my $dt = lc($1);
my $di = $2;
$di =~ s/^0+//;
return 1 if ($docs{$dt}{$di});
}
}
}
return 0;
}
sub clncat {
my $cat = shift;
#print "CC: $cat\n";
$cat =~ s/\s\s\s\s\s\s\s\s.*$//s;
$cat =~ s/\(.*?\)//gs;
$cat =~ s/\.//gs;
$cat =~ s/([A-Z])-(\d)/$1$2/gs;
$cat =~ s/(Informational) [A-Z].*$/$1/s;
$cat =~ s/(&|;)/,/gs;
$cat =~ s/ (and|or|or maybe) /,/gs;
$cat =~ s/Updates://;
$cat =~ s/^\s+//s;
$cat =~ s/\s+$//s;
return $cat;
}
sub get_text_body_for_tomeraider {
my $n = shift;
my $i = shift;
my $p = shift;
$p = '' unless ($p);
# print "RB: $datadir/$p$n$i.txt\n";
if (open(F,'<',"$datadir/$p$n$i.txt")) {
my $body = '';
my $cat = '';
while (my $bl = <F>) {
$bl =~ s/[\r\n]+//gs;
$body .= s2h($bl)."\n";
}
close(F);
$body =~ s/\x1A.*$//s;
#$body =~ s/\n[^\n]+\n\x0C\n*$//s;
#$body =~ s/\n\n\n[^\n]+\n\x0C\n[^\n]+\n\n\n/\x0B\n/gs;
#$body =~ s/\n\n\n[^\n]+\n\x0C\n\n\n?[^\n]+\n\n\n/\n\x0B\n/gs;
#$body =~ s/\n\n\n[^\n]+\n([^\n]+\n)?\x0C\n\n\n?[^\n]+\n([^\n]+\n)?([^\n]+\n)?\n\n/\n\x0B\n/gs;
#$body =~ s/\x0C/\x0B/gs;
$body =~ s/^[\s\n]+//s;
$body =~ s/[\s\n]+$//s;
#$body =~ s/([-a-z0-9])\n+\x0B\n+( )/$1\n$2/gs;
#$body =~ s/\n\n\x0B\n/\n\n/gs;
#$body =~ s/\n[^\n]*\x0B[^\n]*\n//gs;
#$body =~ s/\x0B//gs;
$body =~ s/\x0C/<hr>/gs;
$body =~ s/\n\n\n\n+/\n\n\n/gs;
if ($body =~ /^.*?\n\[?Categor(y|ies): ([^\n]*)[;\]]?\n/s) {
$cat = clncat($2);
} elsif ($body =~ /^.*?\n *Category: ([A-Z][ A-Z0-9,]*)\n/s) {
$cat = clncat($1);
} elsif ($body =~ /^.*?\n *\[Categories:([ A-Z0-9,\.]*)\]\n/s) {
$cat = clncat($1);
}
#print "TC: $cat\n" if ($cat);
return ("<!-- Text Body --><pre>$body</pre>",$cat) if ($body);
return ($body,$cat);
}
return ('','');
}
sub cvtalttr {
my $t1 = shift;
my $l = shift;
my $t2 = shift;
my $cn = shift;
my $ci = shift;
$l =~ s/^\s+//;
$l =~ s/\s+$//;
if ($l =~ /^(rfc|std|bcp|fyi)(\d+)\.?(html|txt)?$/i) {
my $n = lc($1);
my $i = $2;
$i =~ s/^0+//;
return sprintf("%s%s%s",$t1,'_remove_',$t2) unless ($docs{$n}{$i} && $docs{$n}{$i}{'doc'});
return sprintf("%s%s%s",$t1,'_remove_',$t2) if ($n eq $cn && $i == $ci);
return sprintf("%s%s%04u%s",uc($t1),uc($n),$i,$t2);
} elsif ($l =~ /^(ien)(\d+)\.?(html|txt)?$/i) {
return sprintf("%s%s%s",$t1,'_remove_',$t2);
} elsif ($l =~ /^stdlist.html\#s(\d+)$/i) {
my $n = 'std';
my $i = $1;
$i =~ s/^0+//;
return sprintf("%s%s%s",$t1,'_remove_',$t2) unless ($docs{$n}{$i} && $docs{$n}{$i}{'doc'});
return sprintf("%s%s%s",$t1,'_remove_',$t2) if ($n eq $cn && $i == $ci);
return sprintf("%s%s%04u%s",uc($t1),uc($n),$i,$t2);
} elsif ($l =~ /^(mailto|ftp|http|ldap):/i || $l =~ /^\#/) {
return sprintf("%s%s%s",$t1,'_remove_',$t2);
} else {
print "?L: $l\n";
return sprintf("%s%s%s",$t1,$l,$t2);
}
}
sub crhc {
my $h = join(' ',@_);
$h =~ s/\n+/ /gs;
$h =~ s/\s+/ /gs;
$h =~ s/\s<p>/<p>/gs;
$h =~ s/<p>\s/<p>/gs;
return $h;
}
sub get_html_body_for_tomeraider {
my $n = shift;
my $i = shift;
my $p = shift;
$p = '' unless ($p);
return ('','') if ($dbgnohtmldocs);
if (open(F,'<',"$datadir/$p$n$i.html")) {
my $body = '';
my $cat = '';
while (my $bl = <F>) {
$bl =~ s/[\r\n]+//gs;
$body .= "$bl\n";
}
close(F);
$body =~ s/^[\s\n]*<\!DOCTYPE\s[^>]*>[\s\n]*//si;
$body =~ s/^.*<body>[\s\n]*//si;
$body =~ s/[\s\n]*<\/body>.*$//si;
$body =~ s/(<a href=\"mailto:)<([^>]*)>(\">)/$1$2$3/gsi;
$body =~ s/\"(\">[^\n<]*)\"</$1</gs;
$body =~ s/(<a [a-z]*)/lc($1)/gsei;
$body =~ s/(<a href=\")([^>]*)(\">)/cvtalttr($1,$2,$3,$n,$i)/gsei;
$body =~ s/<a href=\"_remove_\">(.*?)<\/a>/$1/gsi;
$body =~ s/<a name[^>]*>(.*?)<\/a>/$1/gsi;
$body =~ s/<a [^>]*>(.*?)<\/[aA]>/$1/gs;
$body =~ s/<([-_\.a-zA-Z0-9]+\@[-_\.a-zA-Z0-9]+\.[-_\.a-zA-Z0-9]+)>/<$1>/gs;
while ($body =~ s/<([^>]*)</<$1</gs) {};
$body =~ s/<A HREF/<a href/gs;
if ($body =~ /^.*?\n\[?Categor(y|ies): ([^\n<]*)[;\]]?<br>\n/s) {
$cat = clncat($2);
}
my $bdy = '';
while ($body =~ /^(.*?)(<pre>.*?<\/pre>)(.*)$/si) {
my $b1 = $1;
my $b2 = $2;
$body = $3;
$b2 =~ s/(<br>|<\/h\d>)\n/$1/gsi;
$bdy .= crhc($b1);
$bdy .= $b2;
}
$bdy .= crhc($body) if ($body);
$bdy =~ s/<br>/\n/gsi;
#print "HC: $cat\n" if ($cat);
return ("<!-- HTML Body -->$bdy",$cat) if ($bdy);
return ($bdy,$cat);
}
return ('','');
}
sub get_body_for_tomeraider {
my $n = shift;
my $i = shift;
my $p = '';
$p = "$n/" unless ($n eq 'rfc');
my $body = '';
my $cat = '';
my $ch = 1;
if (defined($state->{lmods}) &&
defined($state->{lmods}{"$p$n$i.html"}) && $state->{lmods}{"$p$n$i.html"} &&
defined($state->{lmods}{"$p$n$i.txt"}) && $state->{lmods}{"$p$n$i.txt"}) {
my $ht = str2time($state->{lmods}{"$p$n$i.html"},'GMT');
my $tt = str2time($state->{lmods}{"$p$n$i.txt"},'GMT');
$ch = 0 if ($ht && $tt && ($ht<$tt));
}
($body,$cat) = get_html_body_for_tomeraider($n,$i) if ($ch);
($body,$cat) = get_text_body_for_tomeraider($n,$i) unless ($body);
return ($body,$cat);
}
sub print_index_list_for_tomeraider {
my $tf = shift;
my $n = shift;
my $tt = uc($n);
print $tf "<ul>";
foreach my $i (sort { $a <=> $b } keys %{$docs{$n}}) {
next unless ($docs{$n}{$i}{'doc'});
print $tf sprintf("<li><a href=\"%s%04u\">%s%04u:</a> %s</li>",$tt,$i,$tt,$i,s2h($docs{$n}{$i}{'title'}));
}
print $tf "</ul>";
}
sub print_index_for_tomeraider {
my $tf = shift;
print $tf "<NEW>Index\n";
my $fg = 1;
foreach my $n (sort { yyycmp($a,$b) } keys %docs) {
next if ($n =~ /^\./);
next if ($n eq 'ien');
next unless ($cnts{$n});
print $tf '<p>' unless ($fg);
$fg = 0;
print $tf sprintf("<b>%s</b>",xxx2s($n));
print_index_list_for_tomeraider($tf,$n);
}
print $tf "\n";
}
sub print_indexes_for_tomeraider {
my $tf = shift;
foreach my $n (sort { yyycmp($a,$b) } keys %docs) {
next if ($n =~ /^\./);
next if ($n eq 'ien');
next unless ($cnts{$n});
print $tf sprintf("<NEW>%s\n",s2k(xxx2s($n)));
print $tf 'Index';
print_index_list_for_tomeraider($tf,$n);
print $tf "\n";
}
}
sub print_links_for_tomeraider {
my $tf = shift;
my $t = shift;
my $ll = shift;
return unless (@{$ll});
my %ld = ();
print $tf "<p>$t:<ul>";
foreach my $l (@{$ll}) {
if ($l =~ /^(\D+?)-?(\d+)$/) {
my $dt = lc($1);
my $di = $2;
$di =~ s/^0+//;
my $dd = sprintf('%s%04u',uc($dt),$di);
next if ($ld{$dd});
$ld{$dd} = 1;
if ($dt ne 'ien' && $docs{$dt}{$di} && $docs{$dt}{$di}{'doc'}) {
print $tf "<li><a href=\"$dd\">$dd</a></li>";
} else {
print $tf "<li>$dd</li>";
}
}
}
print $tf "</ul>";
}
sub print_errata_for_tomeraider {
my $tf = shift;
my $n = shift;
my $i = shift;
my $f = shift;
print $tf sprintf("<NEW>%s%04u: Errata\n",uc($n),$i);
print $tf sprintf("<CATSET>Errata=%s%04u</CATSET>\n",uc($n),$i);
print $tf sprintf("See: <a href=\"%s%04u\">%s%04u</a><p>",uc($n),$i,uc($n),$i);
my $body = '';
if (open(F,'<',"$datadir/err/$f")) {
my $bdy = '';
while (my $l = <F>) {
$l =~ s/[\r\n]+//gs;
$bdy .= "$l\n";
}
close(F);
if ($bdy =~ /^.*<\/table> \n<hr> \n(.*)\n<HR>.*?$/s) {
$bdy = $1;
$bdy =~ s/^[\n\s]*<b>.*?<\/b>\s*\n<p><DT>\s*\n<a [^>]*>\s*\n<B><A [^>]*>[^<]*<\/A>,\s*/<B>/s; # //s;
$bdy =~ s/[\n\s]+$//;
$bdy =~ s/^[\n\s]+//;
while ($bdy =~ /^(.*?)(<pre>.*?<\/pre>)(.*)$/si) {
my $b1 = $1;
my $b2 = $2;
$bdy = $3;
$b1 =~ s/\n+//gs;
$body .= $b1;
$body .= $b2;
}
if ($bdy) {
$bdy =~ s/\n+//gs;
$body .= $bdy;
}
#print "$n,$i,$f|$bdy\n";
}
}
if ($body) {
print $tf "$body\n";
} else {
print $tf "<i>Document missing!</i>\n";
}
}
sub print_documents_for_tomeraider {
my $tf = shift;
my $cnt = 0;
foreach my $n (sort { xxxcmp($a,$b) } keys %docs) {
next if ($n =~ /^\./);
next if ($n eq 'ien');
next unless ($cnts{$n});
my $tt = uc($n);
foreach my $i (sort { $a <=> $b } keys %{$docs{$n}}) {
#next if ($i == 674);
#next unless ($docs{$n}{$i}{'errfile'});
next unless ($docs{$n}{$i}{'doc'});
if ($dbgfirstwrite && $cnt+1<$dbgfirstwrite) { $cnt++; next; }
print sprintf("\rWD: %u",$cnt+1) if ($cnt);
my $ht = $docs{$n}{$i}{'text'};
$ht = 0 unless ($docs{$n}{$i}{'ok'});
$ht = 0 if ($ht && !$incobsolete && @{$docs{$n}{$i}{'obsoletedby'}});
my $body = '';
my $cat = '';
if ($ht) {
($body,$cat) = get_body_for_tomeraider($n,$i);
$ht = 0 unless ($body);
$docs{$n}{$i}{'categories'} = $cat if ($ht);
}
print $tf sprintf("<NEW>%s%04u\n",$tt,$i);
print $tf "<CATSET>\n";
print $tf sprintf(" %s=%u\n",$tt,$i);
print $tf sprintf(" %s=\"%s\"\n",'Titles',s2k($docs{$n}{$i}{'title'}));
print $tf sprintf(" %s=\"%s\"\n",'Mnemonics',uc(s2k($docs{$n}{$i}{'mnemonic'}))) if ($docs{$n}{$i}{'mnemonic'});
print $tf sprintf(" %s=\"%s\"\n",'Status',s2k($docs{$n}{$i}{'status'}{'pub'})) if ($docs{$n}{$i}{'status'}{'pub'} && lc($docs{$n}{$i}{'status'}{'pub'}) ne 'unknown');
#print $tf sprintf(" %s=\"%s\"\n",'Contents',s2h($docs{$n}{$i}{'title'}));
#print $tf sprintf(" %s=\"%s\"\n",'Contents',s2h($docs{$n}{$i}{'abstract'})) if ($docs{$n}{$i}{'abstract'});
if ($docs{$n}{$i}{'keywords'} && @{$docs{$n}{$i}{'keywords'}}) {
my %kwd = ();
foreach my $kw (@{$docs{$n}{$i}{'keywords'}}) {
$kw = lc($kw);
next if ($kwd{$kw});
$kwd{$kw} = 1;
print $tf sprintf(" %s=\"%s\"\n",'Keywords',s2k($kw));
}
}
#print $tf " Keywords=\"gurksoppa\"\n"; # -
#print $tf " Keywords=\"gurksoppa\"\n"; # -
if ($cat) {
my %ccd = ();
foreach my $cc (split(/\s*,\s*/,$cat)) {
next unless ($cc);
$cc = join(' ',map { ucfirst(lc($_)) } split(/\s+/,$cc));
next if ($ccd{$cc});
$ccd{$cc} = 1;
print $tf sprintf(" %s=\"%s\"\n",'Categories',s2k($cc));
}
}
print $tf "</CATSET>\n";
print $tf sprintf("<b>%s</b>",s2h($docs{$n}{$i}{'title'}));
#print $tf sprintf("<a name=\"%s%04u\"></a>\n",$tt,$i);
print $tf sprintf("<p><em>%s</em>",s2h($docs{$n}{$i}{'status'}{'pub'})) if ($docs{$n}{$i}{'status'}{'pub'} && lc($docs{$n}{$i}{'status'}{'pub'}) ne 'unknown');
print $tf sprintf("<p><a href=\"%s%04u: Errata\">Errata</a>",$tt,$i) if ($incerrata && $body && $docs{$n}{$i}{'errfile'});
print_links_for_tomeraider($tf,'See',$docs{$n}{$i}{'linkto'}) unless ($ht);
print_links_for_tomeraider($tf,'Obsoleted by',$docs{$n}{$i}{'obsoletedby'});
print $tf sprintf("<p>%s",s2h($docs{$n}{$i}{'abstract'})) if ($docs{$n}{$i}{'abstract'});
print_links_for_tomeraider($tf,'Updated by',$docs{$n}{$i}{'updatedby'});
print $tf sprintf("<p><em>%s</em>",s2h($docs{$n}{$i}{'note'})) if ($docs{$n}{$i}{'note'});
print $tf "<p>$body" if ($body);
print $tf "<p><i>Document missing!</i>" unless ($body || $docs{$n}{$i}{'note'} || linkex($docs{$n}{$i}{'linkto'},$docs{$n}{$i}{'obsoletedby'}));
print_links_for_tomeraider($tf,'Updates',$docs{$n}{$i}{'updates'});
print_links_for_tomeraider($tf,'Obsoletes',$docs{$n}{$i}{'obsoletes'});
print_links_for_tomeraider($tf,'See',$docs{$n}{$i}{'linkto'}) if ($ht);
print_links_for_tomeraider($tf,'See also',$docs{$n}{$i}{'seealso'}) if ($ht);
print_errata_for_tomeraider($tf,$n,$i,$docs{$n}{$i}{'errfile'}) if ($incerrata && $body && $docs{$n}{$i}{'errfile'});
print $tf "\n";
$cnt ++;
last if ($dbgmaxwrite && $cnt >= $dbgmaxwrite);
}
last if ($dbgmaxwrite && $cnt >= $dbgmaxwrite);
}
print "\rWD: $cnt\n" if ($cnt);
}
sub print_header_for_tomeraider {
my $tf = shift;
print $tf "<META>\n".
#" SORTFILE = NO\n".
#" SORTCATS = YES\n".
" SKIPNEWLINES = NO\n".
"</META>\n";
}
sub print_categories_for_tomeraider {
my $tf = shift;
foreach my $n (sort { xxxcmp($a,$b) } keys %docs) {
next if ($n =~ /^\./);
next if ($n eq 'ien');
next unless ($cnts{$n});
$n = uc($n);
print $tf "<CATDEF>\n".
" NAME = \"$n\"\n".
" TYPE = NUMERIC\n".
" PREMOD = \"$n\"\n".
" DISPLAYINTEXT = NO\n".
"</CATDEF>\n";
}
print $tf "<CATDEF>\n".
" NAME = \"Errata\"\n".
" TYPE = STRING\n".
" DISPLAYINTEXT = NO\n".
"</CATDEF>\n" if ($incerrata);
print $tf "<CATDEF>\n".
" NAME = \"Keywords\"\n".
" TYPE = STRING\n".
" MULTIPLE = YES\n".
" DISPLAYINTEXT = NO\n".
"</CATDEF>\n".
"<CATDEF>\n".
" NAME = \"Mnemonics\"\n".
" TYPE = STRING\n".
#" MULTIPLE = YES\n".
" DISPLAYINTEXT = NO\n".
"</CATDEF>\n".
"<CATDEF>\n".
" NAME = \"Status\"\n".
" TYPE = STRING\n".
#" MULTIPLE = YES\n".
" DISPLAYINTEXT = NO\n".
"</CATDEF>\n".
"<CATDEF>\n".
" NAME = \"Categories\"\n".
" TYPE = STRING\n".
" MULTIPLE = YES\n".
" DISPLAYINTEXT = NO\n".
"</CATDEF>\n".
"<CATDEF>\n".
" NAME = \"Titles\"\n".
" TYPE = STRING\n".
" DISPLAYINTEXT = NO\n".
"</CATDEF>\n";
#"<CATDEF>\n".
#" NAME = \"Contents\"\n".
#" TYPE = STRING\n".
#" MULTIPLE = YES\n".
#" DISPLAYINTEXT = NO\n".
#"</CATDEF>\n";
}
sub print_about_for_tomeraider {
my $tf = shift;
print $tf "<NEW>About\n".
"<b>Abridged RFC database</b>".
"<p>$started".
"<p>There might be a newer version at <http://whatever.frukt.org/>".
"<p>(Created with $appname v$appdate)\n";
}
sub print_script_for_tomeraider {
my $tf = shift;
if (open(SF,'<',$0)) {
my $ss = '';
while (my $l = <SF>) {
$l =~ s/[\r\n]+//gs;
$ss .= s2h($l)."\n";
}
close(SF);
print $tf "<NEW>RFCDocs.pl\n<pre>$ss</pre>\n" if ($ss);
}
}
sub write_for_tomeraider {
return 0 if ($dontwrite);
print "WF: $docroot/$filename.txt\n";
my $tf;
return 0 unless open($tf,'>',"$docroot/$filename.txt");
print_header_for_tomeraider($tf);
print_categories_for_tomeraider($tf);
print_about_for_tomeraider($tf);
print_indexes_for_tomeraider($tf);
print_documents_for_tomeraider($tf);
print_script_for_tomeraider($tf);
print_index_for_tomeraider($tf);
close($tf);
return 1;
}
sub call_tomeraider {
return 0 if ($dontcreat);
print "CT: $docroot/$filename\n";
my $d = getcwd();
chdir($docroot);
system($tomebin,"$filename.txt");
chdir($d);
return 1;
}
sub ishtdocok {
my $ok = shift;
my $n = shift;
my $i = shift;
#return 1 if ($docs{$n}{$i} && $docs{$n}{$i}{'doc'} && $docs{$n}{$i}{'text'} &&
# ($docs{$n}{$i}{'htdocok'} ||
# ($ok && ($docs{$n}{$i}{'ok'} || $docs{$n}{$i}{'htmlok'} || $docs{$n}{$i}{'note'}))));
return 1 if ($docs{$n}{$i} && ($docs{$n}{$i}{'htdocok'} || ($ok && ($docs{$n}{$i}{'ok'} || $docs{$n}{$i}{'htmlok'} || $docs{$n}{$i}{'note'}))));
return 0;
}
sub data_index_doc_link {
my $ok = shift;
my $n = shift;
my $i = shift;
return sprintf('<a href="../pages/%s%u.html">%s%04u</a>',$n,$i,uc($n),$i) if (ishtdocok($ok,$n,$i));
if (@_) {
my $r = data_index_docs_links($ok,@_);
return $r if ($r =~ /<a /i);
}
return sprintf('%s%04u',uc($n),$i);
return '';
}
sub data_index_docs_links {
my $ok = shift;
my $ll = '';
my %d = ();
while (my $a = shift @_) {
foreach my $x (@{$a}) {
if ($x =~ /^([A-Za-z][A-Za-z][A-Za-z])[-\s]*(\d+)$/) {
my $l = data_index_doc_link($ok,lc($1),sprintf('%u',$2));
if ($l && !$d{$l}) {
$d{$l} = 1;
$ll .= ', ' if ($ll);
$ll .= $l;
}
}
}
}
return $ll;
}
sub data_index_htdoc_link_list {
my $ok = shift;
my $t = shift;
my $ls = data_index_docs_links($ok,@_);
return "$t: $ls<br />" if ($ls);
return '';
}
sub data_index_create_htdoc_txt {
my $p = shift;
my $n = shift;
my $i = shift;
return ('','') unless ($docs{$n}{$i}{'ok'});
return ('','') unless (open(F,'<',"$datadir/$p$n$i.txt"));
my $b = '';
my $c = '';
while (my $l = <F>) {
$l =~ s/[\r\n]+//gs;
$b .= s2h("$l\n");
}
close(F);
$b =~ s/\x1A.*$//s;
while ($b =~ s/\n[ \t]+\n/\n\n/gs) {};
$b =~ s/^\n+//s;
$b =~ s/[\s\n\x0C]+$//s;
$b =~ s/\n\n\n+/\n\n/gs;
$b =~ s/\n[ \t]*\x0C/\n\x0C/gs;
$b =~ s/\n?\x0C\n?/<hr>/gs;
if ($b =~ /^.*?\n\[?Categor(y|ies): ([^\n]*)[;\]]?\n/s) {
$c = clncat($2);
} elsif ($b =~ /^.*?\n *Category: ([A-Z][ A-Z0-9,]*)\n/s) {
$c = clncat($1);
} elsif ($b =~ /^.*?\n *\[Categories:([ A-Z0-9,\.]*)\]\n/s) {
$c = clncat($1);
}
return ("<pre>$b</pre>",$c) if ($b);
return ('',$c);
}
sub cvtalhtd {
my $t1 = shift;
my $l = shift;
my $t2 = shift;
my $cn = shift;
my $ci = shift;
$l =~ s/^\s+//;
$l =~ s/\s+$//;
if ($l =~ /^(rfc|std|bcp|fyi)(\d+)\.?(html|txt)?$/i) {
my $n = lc($1);
my $i = $2;
$i =~ s/^0+//;
return sprintf("%s%s%s",$t1,'_remove_',$t2) unless (ishtdocok(1,$n,$i));
return sprintf("%s%s%s",$t1,'_remove_',$t2) if ($n eq $cn && $i == $ci);
return sprintf("%s%s%u.html%s",uc($t1),lc($n),$i,$t2);
} elsif ($l =~ /^stdlist.html\#s(\d+)$/i) {
my $n = 'std';
my $i = $1;
$i =~ s/^0+//;
return sprintf("%s%s%s",$t1,'_remove_',$t2) unless (ishtdocok(1,$n,$i));
return sprintf("%s%s%s",$t1,'_remove_',$t2) if ($n eq $cn && $i == $ci);
return sprintf("%s%s%u.html%s",uc($t1),lc($n),$i,$t2);
#} elsif ($l =~ /^(mailto|ftp|http|ldap):/i || $l =~ /^\#/) {
# return sprintf("%s%s%s",$t1,'_remove_',$t2);
} else {
#print "?L: $l\n";
return sprintf("%s%s%s",$t1,$l,$t2);
}
}
sub data_index_create_htdoc_html {
my $p = shift;
my $n = shift;
my $i = shift;
return ('','') unless ($docs{$n}{$i}{'htmlok'});
return ('','') unless (open(F,'<',"$datadir/$p$n$i.html"));
my $b = '';
my $c = '';
while (my $l = <F>) {
$l =~ s/[\r\n]+//gs;
$b .= "$l\n";
}
close(F);
$b =~ s/^[\s\n]*<\!DOCTYPE\s[^>]*>[\s\n]*//si;
$b =~ s/^.*<body>[\s\n]*//si;
$b =~ s/[\s\n]*<\/body>.*$//isi;
$b =~ s/(<hr ?\/?>[\n\s]*)+$//is;
$b =~ s/^([\n\s]*<hr ?\/?>)+//s;
$b =~ s/<dt><hr><dd>\n(<\/dl>)$/$1/si;
$b =~ s/^[\s\n]+//s;
$b =~ s/[\s\n]+$//s;
$b =~ s/(<a href=\"mailto:)<([^>]*)>(\">)/$1$2$3/gsi;
$b =~ s/\"(\">[^\n<]*)\"</$1</gs;
$b =~ s/(<a [a-z]*)/lc($1)/gsei;
$b =~ s/(<a href=\")([^>]*)(\">)/cvtalhtd($1,$2,$3,$n,$i)/gsei;
$b =~ s/<a href=\"_remove_\">(.*?)<\/a>/$1/gsi;
#$b =~ s/<a name[^>]*>(.*?)<\/a>/$1/gsi;
#$b =~ s/<a [^>]*>(.*?)<\/[aA]>/$1/gs;
$b =~ s/<([-_\.a-zA-Z0-9]+\@[-_\.a-zA-Z0-9]+\.[-_\.a-zA-Z0-9]+)>/<$1>/gs;
while ($b =~ s/<([^>]*)</<$1</gs) {};
$b =~ s/<A HREF/<a href/gs;
#if ($b =~ /\n<dt>[^<]+<dd>\n<dt>[^<]+<dd>\n<dt>[^<]+<dd>\n/s) {
# print "\r$n $i \n";
# $b =~ s/<dd>\n<dt>/\n/gs;
#}
if ($b =~ /^.*?\n\[?Categor(y|ies): ([^\n<]*)[;\]]?<br>\n/s) {
$c = clncat($2);
}
my $bb = '';
while ($b =~ /^(.*?)(<pre>.*?<\/pre>)(.*)$/si) {
my $b1 = $1;
my $b2 = $2;
$b = $3;
$b2 =~ s/(<br>|<\/h\d>)\n/$1/gsi;
$bb .= $b1;
$bb .= $b2;
}
$bb .= $b if ($b);
return ($bb,$c) if ($bb);
return ('',$c);
}
sub data_index_create_htdocs {
my $cnt = 0;
foreach my $n (keys %docs) {
next if ($n =~ /^\./);
next unless ($cnts{$n});
foreach my $i (keys %{$docs{$n}}) {
#next unless ($docs{$n}{$i}{'doc'} && $docs{$n}{$i}{'text'});
if ($dbgfirstwrite && $cnt+1<$dbgfirstwrite) { $cnt++; next; }
print sprintf("\rWD: %u",$cnt+1) if ($cnt);
if ($docs{$n}{$i}{'pdfok'}) {
my $cfd = 0;
my $ofd = 0;
if (-f "$datadir/$n$i.pdf") { $ofd = (stat(_))[10]; }
if (-f "$hdocdir/pages/$n$i.pdf") { $cfd = (stat(_))[10]; }
copy("$datadir/$n$i.pdf","$hdocdir/pages/$n$i.pdf") if ($ofd > $cfd);
}
my $dothis = 1;
my $p = '';
$p = "$n/" if ($n ne 'rfc');
my $fx = 0;
if (-f "$hdocdir/pages/$n$i.html") {
$docs{$n}{$i}{'htdocok'} = 1;
$dothis = 0 if (defined($state->{htlmods}{"$n$i.html"}) && $state->{htlmods}{"$n$i.html"} eq lastmodified($p,"$n$i.html"));
$dothis = 1 if ($doreindex);
$fx = 1;
}
my $gh = 0;
my $gp = 0;
my $body = '';
my $cat = '';
if ($dothis) {
($body,$cat) = data_index_create_htdoc_html($p,$n,$i);
$gh = 1 if ($body);
unless ($gh) {
$dothis = 0 if ($fx && defined($state->{htlmods}{"$n$i.txt"}) && $state->{htlmods}{"$n$i.txt"} eq lastmodified($p,"$n$i.txt"));
$dothis = 1 if ($doreindex);
($body,$cat) = data_index_create_htdoc_txt($p,$n,$i) if ($dothis);
$gp = 1 if ($body);
if (!$gp && $docs{$n}{$i}{'note'}) {
$dothis = 0 if ($fx && defined($state->{htlmods}{"$n$i.def"}) && $state->{htlmods}{"$n$i.def"} eq lastmodified('','rfc-index.xml'));
$dothis = 1 if ($doreindex);
if ($dothis) {
$body = '<p>'.s2h($docs{$n}{$i}{'note'}).'</p>';
$body =~ s/\n/<br>/gs;
}
}
}
}
unless ($fx) {
delete($state->{htlmods}{"$n$i.html"});
delete($state->{htlmods}{"$n$i.txt"});
delete($state->{htlmods}{"$n$i.def"});
}
if ($dothis && $body) {
next unless (open(F,'>',"$hdocdir/pages/$n$i.html"));
my $np = '';
my $j = $i-1;
while ($j>0 && !ishtdocok(1,$n,$j)) { $j--; }
if ($j>0 && ishtdocok(1,$n,$j)) {
$np .= sprintf( '[<a href="%s%u.html">Prev</a>]',$n,$j);
}
$np .= sprintf(' [<a href="../index/index.html">Idx</a>]',$n);
$np .= ' [<a href="../index.html">ToC</a>]';
$j = $i+1;
#print "1 $n j: $j\n" if ($i == 7);
while ($j<=$docs{'.max'}{$n} && !ishtdocok(1,$n,$j)) { $j++; }
#print "2 $n j: $j\n" if ($i == 7);
if ($j<=$docs{'.max'}{$n} && ishtdocok(1,$n,$j)) {
#print "3 $n j: $j\n" if ($i == 7);
$np .= sprintf(' [<a href="%s%u.html">Next</a>]',$n,$j);
}
$np =~ s/^\s*(.*?)\s*$/$1/s;
my $tit = sprintf('%s%04u',uc($n),$i);
$tit .= ': '.s2h($docs{$n}{$i}{'title'}) if ($docs{$n}{$i}{'title'});
print F sprintf("<html><head>%s<title>%s</title></head><body>\n",$idxcss,$tit);
print F sprintf("<p align=\"right\">%s</p>\n",$np);
print F sprintf("<h1>%s</h1>\n",$tit);
print F sprintf("<p><em>%s</em></p>",s2h($docs{$n}{$i}{'status'}{'pub'})) if ($docs{$n}{$i}{'status'}{'pub'} && lc($docs{$n}{$i}{'status'}{'pub'}) ne 'unknown');
my $lhs = '';
$lhs .= sprintf("<a href=\"%s%u%s.html\">Errata</a><br />",$n,$i,'E') if ($incerrata && $docs{$n}{$i}{'errfile'} && $docs{$n}{$i}{'htdocerrok'});
$lhs .= sprintf("<a href=\"%s%u.pdf\">%s%04u PDF</a><br />",$n,$i,uc($n),$i) if ($docs{$n}{$i}{'pdfok'});
$lhs .= data_index_htdoc_link_list(1,'See',$docs{$n}{$i}{'linkto'});
$lhs .= data_index_htdoc_link_list(1,'Obsoleted by',$docs{$n}{$i}{'obsoletedby'});
$lhs .= data_index_htdoc_link_list(1,'Updated by',$docs{$n}{$i}{'updatedby'});
$lhs .= data_index_htdoc_link_list(1,'See also',$docs{$n}{$i}{'seealso'});
$lhs .= data_index_htdoc_link_list(1,'Updates',$docs{$n}{$i}{'updates'});
$lhs .= data_index_htdoc_link_list(1,'Obsoletes',$docs{$n}{$i}{'Onsoletes'});
$lhs =~ s/<br ?\/?>$//;
print F sprintf("<p>%s</p>\n",$lhs) if ($lhs);
print F sprintf("<p>%s</p>\n",s2h($docs{$n}{$i}{'abstract'})) if ($docs{$n}{$i}{'abstract'});
print F "<hr>\n$body\n<hr>\n";
print F sprintf("<p align=\"right\">%s</p>\n",$np);
print F "</body></html>\n";
close(F);
delete($state->{htlmods}{"$n$i.txt"});
delete($state->{htlmods}{"$n$i.html"});
delete($state->{htlmods}{"$n$i.def"});
if ($gh) {
$state->{htlmods}{"$n$i.html"} = lastmodified($p,"$n$i.html");
} elsif ($gp) {
$state->{htlmods}{"$n$i.txt"} = lastmodified($p,"$n$i.txt");
} else {
$state->{htlmods}{"$n$i.def"} = lastmodified('','rfc-index.xml');
}
$docs{$n}{$i}{'htdocok'} = 1;
$docs{$n}{$i}{'categories'} = $cat;
maybesavestate();
}
$cnt ++;
last if ($dbgmaxwrite && $cnt >= $dbgmaxwrite);
}
last if ($dbgmaxwrite && $cnt >= $dbgmaxwrite);
}
print "\rWD: $cnt\n" if ($cnt);
savestate();
return 0 unless (open(HIF,'>',"$hdocdir/pages/index.html"));
print HIF "<html><head>$idxcss<title>RFC Database: Index</title></head><body><p>RFC Database</p><h1>Index</h1><p>$started</p><p>\n";
print HIF "<h2>Misc</h2><p>\n".
"<a href=\"about.html\">About</a><br />\n".
"<a href=\"../index.html\">Contents</a><br />\n".
"<a href=\"../index/index.html\">Index</a><br />\n".
"<a href=\"script.html\">RFCDocs.pl</a><br />\n".
"</p>";
foreach my $n (sort { xxxcmp($a,$b) } keys %docs) {
next if ($n =~ /^\./);
next unless ($cnts{$n});
my $t = uc($n);
print HIF "<h2>$t</h2><p>\n";
print HIF "<a href=\"../index/$n.html\">Index</a><br />\n";
foreach my $i (sort { $a <=> $b } keys %{$docs{$n}}) {
next unless (-f "$hdocdir/pages/$n$i.html");
print HIF sprintf("<a href=\"%s%u.html\">%s%04u</a><br />\n",$n,$i,$t,$i);
}
print HIF "</p>";
}
print HIF "</body></html>\n";
close(HIF);
}
sub data_index_create_about_page {
return 0 unless (open(F,'>',"$hdocdir/pages/about.html"));
print F "<html><head>$idxcss<title>RFC Database: About</title></head><body>\n".
"<h1>Unabridged RFC Database</h1>\n".
"<h2>$started</h2>\n".
"<p>If this is read offline, there might be a newer version at <<a href=\"http://whatever.frukt.org/\">http://whatever.frukt.org/</a>></p>\n".
"<p>(Created with <a href=\"script.html\">$appname</a> v$appdate)</p>\n".
"</body></html>";
close(F);
}
sub data_index_create_script_page {
my $tf = shift;
my $hc = `perl $highplf -lperl -H "$0"`;
return 0 unless ($hc);
return 0 unless (open(F,'>',"$hdocdir/pages/script.html"));
print F "<html><head>$idxcss<title>RFC Database: $appname</title></head><body><p>RFC Database</p>\n".
"<h1>$appname v$appdate</h1>\n".
"<pre>$hc</pre>\n".
"</body></html>";
close(F);
}
sub write_data_index {
return 0 if ($dontindex);
print "WH: $hdocdir\n";
mkpath("$hdocdir/pages");
data_index_create_about_page();
data_index_create_script_page();
data_index_create_htdocs();
print "WI: $hdocdir\n";
mkpath("$hdocdir/index");
return 0 unless (open(HIF,'>',"$hdocdir/index/index.html"));
unless (open(HZF,'>',"$hdocdir/index.html")) {
close(HIF);
return 0;
}
my @tit = ('#','Document','See','Obsoleted by','Updated by','See also','Info','Obsoletes','Updates');
print HZF "<html><head>$idxcss<title>RFC Database: Contents</title></head><body><p>RFC Database</p><h1><a href=\"pages/index.html\">Contents</a></h1><p>$started</p><ul>\n";
print HZF "<li><a href=\"pages/about.html\">About</a></li>\n";
print HZF "<li><a href=\"index/index.html\">Combined</a></li>\n";
print HIF "<html><head>$idxcss<title>RFC Database: Index</title></head><body><p>RFC Database</p><h1>Combined</h1><p>$started</p><p>";
foreach my $n (sort { xxxcmp($a,$b) } keys %docs) {
next if ($n =~ /^\./);
next unless ($cnts{$n});
print HIF sprintf(' [<a href="#%s">%ss</a>]',$n,uc($n));
}
print HIF "</p>\n";
foreach my $n (sort { xxxcmp($a,$b) } keys %docs) {
next if ($n =~ /^\./);
next unless ($cnts{$n});
next unless (open(HCF,'>',"$hdocdir/index/$n.html"));
my $t = uc($n).'s';
my $ts = xxx2s($n);
my @tll = ();
my @au = ();
for (my $j=0;$j<@tit;$j++) { $au[$j] = 0; }
my $pi = 0;
foreach my $i (sort { $a <=> $b } keys %{$docs{$n}}) {
for (my $j=$pi+1;$j<$i;$j++) {
my @mtl = ();
push @mtl, $j;
push @tll, \@mtl;
#print "$j < $i\n";
}
$pi = $i;
my $tit;
#my $dl = data_index_doc_link(0,$n,$i,$docs{$n}{$i}{'linkto'});
my $dl = data_index_doc_link(0,$n,$i);
$dl = '' unless ($dl =~ /<a /i);
my $ltl = data_index_docs_links(0,$docs{$n}{$i}{'linkto'});
#if ($ltl && !$dl && $n ne 'rfc') {
# $dl = $ltl;
# $ltl = '';
#}
$ltl = '' if ($ltl eq $dl);
$ltl = '' if ($n eq 'rfc' && $ltl =~ /^(std|bcp|fyi)/i);
my @tl = ();
push @tl, $i;
push @tl, $dl;
if ($n eq 'rfc') {
push @tl, '';
} else {
push @tl, $ltl;
$ltl = '';
}
push @tl, data_index_docs_links(0,$docs{$n}{$i}{'obsoletedby'});
push @tl, data_index_docs_links(0,$docs{$n}{$i}{'updatedby'});
if ($docs{$n}{$i}{'pdfok'}) {
$ltl .= ', ' if ($ltl);
$ltl .= sprintf("<a href=\"../pages/%s%u.pdf\">PDF</a>",$n,$i,uc($n),$i);
}
$tit = data_index_docs_links(0,$docs{$n}{$i}{'seealso'});
if ($tit) {
$ltl .= ', ' if ($ltl);
$ltl .= $tit;
}
if ($incerrata && $docs{$n}{$i}{'errfile'} && $docs{$n}{$i}{'htdocerrok'}) {
$ltl .= ', ' if ($ltl);
$ltl .= sprintf("<a href=\"%s%u%s.html\">Errata</a>",$n,$i,'E');
}
push @tl, $ltl;
$tit = uc(s2h($docs{$n}{$i}{'mnemonic'}));
if ($docs{$n}{$i}{'title'}) {
$tit .= '<br />' if ($tit);
$tit .= s2h($docs{$n}{$i}{'title'});
}
if ($docs{$n}{$i}{'status'}{'pub'} && lc($docs{$n}{$i}{'status'}{'pub'}) ne 'unknown') {
$tit .= sprintf('<br /><i>Status:</i> %s',s2h($docs{$n}{$i}{'status'}{'pub'}));
}
if ($docs{$n}{$i}{'keywords'} && @{$docs{$n}{$i}{'keywords'}}) {
my $s = '';
my %kwd = ();
foreach my $kw (@{$docs{$n}{$i}{'keywords'}}) {
$kw = lc($kw);
next if ($kwd{$kw});
$kwd{$kw} = 1;
$s .= ', ' if ($s);
$s .= s2h($kw);
}
$tit .= sprintf('<br /><i>Keywords:</i> %s',$s) if ($s);
}
if ($docs{$n}{$i}{'categories'}) {
my $s = '';
my %ccd = ();
foreach my $cc (split(/\s*,\s*/,$docs{$n}{$i}{'categories'})) {
next unless ($cc);
$cc = join(' ',map { ucfirst(lc($_)) } split(/\s+/,$cc));
next if ($ccd{$cc});
$ccd{$cc} = 1;
$s .= ', ' if ($s);
$s .= s2h($cc);
}
$tit .= sprintf('<br /><i>Categories</i>: %s',$s) if ($s);
}
push @tl, $tit;
push @tl, data_index_docs_links(0,$docs{$n}{$i}{'obsoletes'});
push @tl, data_index_docs_links(0,$docs{$n}{$i}{'updates'});
for (my $j=0;$j<@au;$j++) { $au[$j] = 1 if ($tl[$j]); }
push @tll, \@tl;
}
print HZF "<li><a href=\"index/$n.html\">$ts</a></li>\n";
print HIF "<h2 id=\"$n\">$ts</h2>\n";
print HIF "<table>\n";
print HCF "<html><head>$idxcss<title>RFC Database: $ts</title></head><body><p>RFC Database</p><h1>$ts</h1><p>$started</p><table>\n";
print HCF "<tr>";
print HIF "<tr>";
for (my $j=0;$j<@tit;$j++) {
next unless ($au[$j]);
my $ls = sprintf('<th>%s</th>',$tit[$j]);
print HCF $ls;
print HIF $ls;
}
print HCF "</tr>\n";
print HIF "</tr>\n";
my $ec = 'odd';
foreach my $tl (@tll) {
my $ls = sprintf('<tr valign="top" class="%s" id="%s%u">',$ec,$n,$tl->[0]);
if ($ec eq 'odd') {
$ec = 'even';
} else {
$ec = 'odd';
}
$ls .= sprintf('<td align="right">%u</td>',$tl->[0]) if ($au[0]);
for (my $j=1;$j<@tit;$j++) {
next unless ($au[$j]);
if ($j>$#$tl) {
$ls .= '<td></td>';
} else {
$ls .= sprintf('<td>%s</td>',$tl->[$j]) if ($au[$j]);
}
}
$ls .= "</tr>\n";
print HCF $ls;
print HIF $ls;
}
print HCF "</table></body></html>\n";
print HIF "</table>\n";
close(HCF);
}
print HZF "</ul></body></html>\n";
print HIF "</body></html>\n";
close(HZF);
close(HIF);
}
sub zip_something {
my $s = shift;
my $d = shift;
print "CZ: $zipbin\n";
if ($s=~ /\/$/) {
#print "$zipbin -rqX9 '$d.zip' '$s/*'\n";
system($zipbin,'-rqX9',"$d.zip","$s/*");
} else {
#print "$zipbin -qX9 '$d.zip' '$s'\n";
system($zipbin,'-qX9',"$d.zip",$s);
}
}
sub xzip_something {
my $s = shift;
my $d = shift;
if ($s=~ /\/$/) {
$s =~ s/\/$//;
print "CZ: $tarbin\n";
#print "$tarbin -cf '$d.tar' '$s'\n";
system($tarbin,'-cf',"$d.tar","$s");
print "CZ: $xzipbin\n";
#print "$xzipbin -9 '$d.tar'\n";
system($xzipbin,'-f9',"$d.tar");
} else {
print "CZ: $xzipbin\n";
#print "$xzipbin -k9 '$s'\n";
system($xzipbin,'-kf9',$s);
if ($d && "$d.$packext" ne "$s.$packext") {
#print "move '$s.$packext' '$d.$packext'\n";
move("$s.$packext","$d.$packext");
}
}
}
sub pack_file {
my $s = shift;
my $d = shift;
return 0 unless (-f $s);
print "ZF: $s\n";
return zip_something($s,$d) if (lc($packext) eq 'zip');
return xzip_something($s,$d);
}
sub pack_dir {
my $s = shift;
my $d = shift;
return 0 unless (-d $s);
print "ZD: $s\n";
my $c = $s;
$c =~ s/\/[^\/]*$//;
$s =~ s/^.*\///;
my $w = getcwd();
chdir($c);
my $r;
if (lc($packext) eq 'zip') {
$r = zip_something("$s/",$d);
} else {
$r = xzip_something("$s/",$d);
}
chdir($w);
return $r;
}
sub publish_to_web {
return 0 if ($dontpubht);
return 0 unless (-d $publish);
print "PD: $publish\n";
my $fn = "$filename";
$fn =~ s/ /_/g;
copy($0,"$publish/$appname");
copy("$docroot/$filename.tr3","$publish/$fn.tr3");
copy("$docroot/$filename.pdb","$publish/$fn.pdb");
pack_file("$docroot/$filename.txt","$publish/$fn.tr3txt");
pack_dir($hdocdir,"$publish/$fn.html") unless ($dontindex);
my $hc = `perl $highplf -lperl -H "$publish/$appname"`;
if (open(HF,'>',"$publish/$appname.html")) {
print HF $hc;
close(HF);
}
clean_publish();
my @fl = ();
if (opendir(D,$publish)) {
while (my $f = readdir(D)) {
next if ($f =~ /^\./);
next if ($f =~ /^index\./i);
next if ($f !~ /\./);
push @fl, $f;
}
closedir(D);
}
if (open(HF,'>',"$publish/index.html")) {
print HF '<html><head><title>RFCDocs</title></head><body><ul>';
foreach my $f (@fl) {
print HF "<li><a href=\"$f\">$f</a></li>";
}
print HF '</ul></body></html>';
close(HF);
}
return 1;
}
sub create_isilo_ixl {
my $xml = XML::Mini::Document->new();
my $xdr = $xml->getRoot();
$xdr->header('xml')->attribute('version','1.0');
my $d = $xdr->createChild('iSiloXDocumentList')->createChild('iSiloXDocument');
my $x = $d->createChild('Source');
$x->createChild('Sources')->createChild('Path')->text("$hdocdir/index.html");
$x = $d->createChild('Destination');
$x->createChild('Title')->text('RFC Database');
$x->createChild('Files')->createChild('Path')->text("$docroot/$filename.pdb");
$x = $d->createChild('LinkOptions');
$x->createChild('MaximumDepth')->attribute('value','10');
$x->createChild('FollowOffsite')->attribute('value','no');
$x->createChild('SubDirOnly')->attribute('value','yes');
$x->createChild('UnresolvedDetail')->attribute('value','exclude');
$x = $d->createChild('ImageOptions');
$x->createChild('AltText')->attribute('value','exclude');
$x->createChild('Images')->attribute('value','exclude');
$x = $d->createChild('TableOptions');
$x->createChild('IgnoreTables')->attribute('value','yes');
$x->createChild('AddSeparators')->attribute('value','yes');
$x->createChild('UseMinimumDepth')->attribute('value','no');
$x->createChild('UseMaximumBottomReach')->attribute('value','no');
$x->createChild('UnfoldFullPageTables')->attribute('value','yes');
$x->createChild('IgnorePixelWidths')->attribute('value','no');
$x = $d->createChild('ColorOptions');
$x->createChild('BackgroundColors')->attribute('value','keep');
$x->createChild('TextColors')->attribute('value','keep');
$x = $d->createChild('MarginOptions');
$x->createChild('LeftRightMargins')->attribute('value','keep');
$x->createChild('LeftRightPadding')->attribute('value','keep');
$x = $d->createChild('SecurityOptions');
$x->createChild('Convert')->attribute('value','allow');
$x->createChild('CopyBeam')->attribute('value','allow');
$x->createChild('CopyAndPaste')->attribute('value','allow');
$x->createChild('Modify')->attribute('value','allow');
$x->createChild('Print')->attribute('value','allow');
$x = $d->createChild('TextOptions');
$x->createChild('PreUseMonospaceFont')->attribute('value','yes');
$x->createChild('PreSingleLineBreaks')->attribute('value','KeepAll');
$x->createChild('ProcessLineBreaks')->attribute('value','yes');
$x->createChild('ConvertSingleLineBreaks')->attribute('value','no');
$x->createChild('Preformatted')->attribute('value','no');
$x->createChild('UseMonospaceFont')->attribute('value','no');
$x->createChild('MonospaceFontSize')->attribute('value','10');
$x->createChild('TabStopWidth')->attribute('value','8');
$x = $d->createChild('DocumentOptions');
$x->createChild('PageBounds')->attribute('value','soft');
$x->createChild('UseDefaultCategory')->attribute('value','no');
$x->createChild('HomePageNumber')->attribute('value','1');
$x->createChild('OpenHomePageOnDateChange')->attribute('value','no');
my $s = $xml->toString;
$s =~ s/>[\r\n]+\s+([^<\n\r]*)[\r\n]+\s*<\//>$1<\//gs;
return 0 unless (open(F,'>',"$docroot/iSilo.ixl"));
print F $s;
close(F);
}
sub create_isilo_ixs {
my $xml = XML::Mini::Document->new();
my $xdr = $xml->getRoot();
$xdr->header('xml')->attribute('version','1.0');
my $d = $xdr->createChild('iSiloXSettings');
my $x = $d->createChild('Logging');
my $y = $x->createChild('Conversion');
$y->createChild('Log')->attribute('value','yes');
$y->createChild('Path')->text("$docroot/iSilo.log");
$y->createChild('MaxPrevLogSize')->attribute('value','1024');
$x->createChild('Connection')->createChild('Log')->attribute('value','no');
my $s = $xml->toString;
$s =~ s/>[\r\n]+\s+([^<\n\r]*)[\r\n]+\s*<\//>$1<\//gs;
return 0 unless (open(F,'>',"$docroot/iSilo.ixs"));
print F $s;
close(F);
}
sub write_for_isilo {
return if ($dontisilo);
print "WX: $docroot/iSilo\n";
create_isilo_ixs();
create_isilo_ixl();
}
sub call_isilo {
return 0 if ($dontisilo);
print "CX: $docroot/iSilo\n";
my $d = getcwd();
chdir($docroot);
system($isilobin,'-q','-o',"$docroot/iSilo.ixs",'-x',"$docroot/iSilo.ixl");
chdir($d);
return 1;
}
unless ($dontfetch && $dontwrite && $dontindex) {
print "CI: rfc-index.xml\n";
if (refresh('','rfc-index.xml')) {
refresh('std/','std1.txt');
refresh('ien/','ien-index.txt');
print "RX: $datadir/rfc-index.xml\n";
my $xp = new XML::Parser(Style=>'EasyTree');
my $xd = $xp->parsefile("$datadir/rfc-index.xml");
my $xc = 0;
foreach my $xi (@$xd) {
next unless ($xi->{type} eq 'e' && $xi->{name} eq 'rfc-index');
foreach my $xe (@{$xi->{content}}) {
next unless ($xe->{type} eq 'e');
print sprintf("\rPX: %u",$xc+1) if ($xc);
if ($xe->{name} =~ /^([a-zA-Z]+)-(.*)-entry$/) {
set_attrib($1,$2,$xe->{content});
} elsif ($xe->{name} =~ /^(.*)-entry$/) {
add_this($1,$xe->{content});
}
$xc ++;
}
}
print "\rPX: $xc\n" if ($xc);
read_ien_list();
unless ($dontfetch && $dontwrite && $dontindex) {
$xc = 0;
while (my ($n,$l) = each %docs) {
next if ($n =~ /^\./);
next unless ($cnts{$n});
while (my ($i,$c) = each %{$l}) {
#next unless ($c->{'doc'} && $c->{'text'});
#next if (@{$c->{'obsoletedby'}} && !$incobsolete && !($c->{'status'}{'pub'} && lc($c->{'status'}{'pub'}) eq 'standard'));
print sprintf("\rMF: %u",$xc+1) if ($xc);
my $p = '';
$p = "$n/" unless ($n eq 'rfc');
my $gp = 0;
($c->{'ok'},$gp) = refreshd($p,"$n$i.txt");
if ($n eq 'rfc') {
$c->{'htmlok'} = refresh($p,"$n$i.html",$htmlurl);
} elsif ($n eq 'fyi') {
$c->{'htmlok'} = refresh($p,"$n$i.html");
}
$c->{'pdfok'} = refresh($p,"$n$i.pdf") if (($gp || $c->{'pdf'}) && !$p);
$c->{'errfile'} = get_errata($n,$i,$c->{'errata'}) if ($incerrata && $c->{'errata'});
maybesavestate();
$xc ++;
}
}
print "\rMF: $xc\n" if ($xc);
savestate();
read_std_list();
while (my ($n,$l) = each %docs) {
next if ($n =~ /^\./);
next unless ($cnts{$n});
while (my ($i,$c) = each %{$l}) {
$c->{'title'} = get_title($n,$i,$c) unless ($c->{'title'});
}
}
maybesavestate();
write_for_tomeraider();
write_data_index();
}
savestate();
}
}
write_for_isilo();
call_isilo();
call_tomeraider();
publish_to_web();
clean_docroot();
savestate();
(2005-11-24)