mkdoc

   1 #!/usr/bin/perl
   2 use strict;
   3 use warnings;
   4 use 5.10.0;
   5
   6 # run from gitolite-doc as "./mkdoc"
   7
   8 # this file is needed for my greps to work without too many errors, but should
   9 # NOT be present when running mkdoc.  So we delete it here and put it back
  10 # later (it's just an empty file anyway).
  11 unlink "html/deleted.html";
  12
  13 # my $OUTDIR = "/tmp/doc2";
  14 my $OUTDIR = "$ENV{HOME}/data/gits/sitaramc.github.com/gitolite";
  15 unless (@ARGV) {
  16     system("rm     $OUTDIR/*.html");
  17     system("rm -rf $OUTDIR/images");
  18     system("mkdir  $OUTDIR/images");
  19 }
  20
  21 # collect names of all markdown files
  22 my @mkd = `find . -name "*.mkd" | sort`;
  23 chomp(@mkd);
  24
  25 # if arguments were supplied, save them, else pretend all markdown files were supplied as arguments
  26 my @argv = @ARGV;
  27 @argv = @mkd unless @argv;
  28
  29 my %linkrefs;
  30 my $base;
  31 my %seen;
  32
  33 # first round runs through all markdown files, @mkd
  34 @ARGV = @mkd;
  35 while (<>) {
  36     unless ( $seen{$ARGV}++ ) {
  37         # on each change of file, compute the base name...
  38         $base = ( $ARGV =~ m(([^/]+)\.mkd) ? $1 : '' );
  39         # ...and add linkref to the file
  40         $linkrefs{TITLE} .= "\[$base\]: $base.html\n";
  41     }
  42
  43     # now add linkrefs for everything else
  44     if ( /^#+ .* \{#(\S+)( .*?)?\}/ or /^#+ #(\S+) / ) {            # XXX last clause is transition code
  45         $linkrefs{$base} .= "\[$1\]: $base.html\#$1\n";
  46     }
  47 }
  48
  49 # second round runs through markdown files supplied as arguments
  50 while (@argv) {
  51     $_ = shift @argv;
  52
  53     m(([^/]+)\.mkd) or die "bad mkd file: '$_'";
  54     $base = $1;
  55     next if $base eq 'gitolite';                             # single page stuff needs different treatment
  56
  57     open( my $mdp, "|-", "cat $_ - > pdh.temp") or die $!;
  58     print $mdp "\n" . linkrefs_except($base);
  59     close $mdp;
  60     system("pdh -t html-N -i pdh.temp -o $OUTDIR/$base.html" ) and warn "WARNING: '$base.html' was not created";
  61     print STDERR "\r    \r" . scalar(@argv);
  62 }
  63 print STDERR "\r    \n";
  64
  65 unlink "pdh.temp";
  66 say STDERR "----";
  67 rename "sidebar-toc", $$;
  68 system("touch sidebar-toc; pdh -t html-N -i gitolite.mkd -o $OUTDIR/gitolite.html");
  69 rename $$, "sidebar-toc";
  70
  71 # send manually created HTML pages and images
  72 system("cp -d html/*.html $OUTDIR");
  73 system("cp images/* $OUTDIR/images");
  74
  75 # put the empty file back
  76 _print("html/deleted.html", "");
  77
  78 # bloody github doesn't like symlinks...
  79 convert_symlinks();
  80
  81 # ----------------------------------------------------------------------
  82
  83 sub linkrefs_except {
  84     my $base = shift;
  85     return join " ", map { $_ eq $base ? '' : $linkrefs{$_} } keys %linkrefs;
  86 }
  87
  88 sub convert_symlinks {
  89     chdir $OUTDIR or die $!;
  90     chdir ".." or die $!;
  91     print STDERR "in: " . `pwd`;
  92
  93     for my $l (`find . -name "*.html" -type l`) {
  94         chomp($l);
  95
  96         # crude, but effective...
  97         my $t = slurp($l);
  98         unlink $l;
  99         _print($l, $t);
 100     }
 101 }
 102
 103 # ----------------------------------------------------------------------
 104
 105 sub _open {
 106     open( my $fh, $_[0], $_[1] ) or die "open $_[1] failed: $!\n";
 107     return $fh;
 108 }
 109
 110 sub _print {
 111     my ( $file, @text ) = @_;
 112     my $fh = _open( ">", "$file.$$" );
 113     print $fh @text;
 114     close($fh) or die "close $file failed: $! at ", (caller)[1], " line ", (caller)[2], "\n";
 115     my $oldmode = ( ( stat $file )[2] );
 116     rename "$file.$$", $file;
 117     chmod $oldmode, $file if $oldmode;
 118 }
 119
 120 sub slurp {
 121     return unless defined wantarray;
 122     local $/ = undef unless wantarray;
 123     my $fh = _open( "<", $_[0] );
 124     return <$fh>;
 125 }
 126