Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Branch: master
Fetching contributors…

Cannot retrieve contributors at this time

executable file 667 lines (607 sloc) 19.275 kB
#! /usr/bin/perl
#
# mkdocbook
# - convert ZeroMQ document to DocBook format
# - all images must already have been generated by mkwikidot
#
# Usage: bin/mkdocbook chapter*.txt; docbook2ps book.xml; ps2pdf book.ps
#
# By Pieter Hintjens, free for remixing without conditions.
#
use Digest::SHA qw(sha1_hex);
# Language for the examples
$source = $ENV {'BOOK_LANG'} || "C";
# Output format, book or pdf
$format = $ENV {'BOOK_FORM'} || "book";
printf "Generating $source/$format version of Guide...\n";
# Listings longer than this are truncated and turned into URLs
$cutoff = 60;
# Languages we support
%lexer = ('C' => 'c' ,
'C++' => 'cpp',
'Haxe' => 'haxe',
'Lua' => 'lua',
'PHP' => 'php',
'Python' => 'python',
'Java' => 'java');
# File extensions - copied from mkwikidot
%extension = ('Ada' => 'ada',
'Basic' => 'bas',
'C' => 'c',
'C++' => 'cpp',
'C#' => 'cs',
'CL' => 'lisp',
'Clojure' => 'clj',
'Delphi' => 'dpr',
'Erlang' => 'es',
'F#' => 'fsx',
'Felix' => 'flx',
'Go' => 'go',
'Haskell' => 'hs',
'Haxe' => 'hx',
'Java' => 'java',
'Lua' => 'lua',
'Node.js' => 'js',
'Objective-C' => 'm',
'ooc' => 'ooc',
'Perl' => 'pl',
'PHP' => 'php',
'Python' => 'py',
'Q' => 'q',
'Racket' => 'rkt',
'Ruby' => 'rb',
'Scala' => 'scala',
'Tcl' => 'tcl' );
signatures_load ();
bookmarks_load ();
# If we have parts, content is indented one extra level
$have_parts = 0;
die "Can't create book.xml: $!"
unless open (OUTPUT, ">book.xml");
print OUTPUT "<?xml version=\"1.0\"?>\n";
print OUTPUT "<!DOCTYPE book PUBLIC \"-//OASIS//DTD DocBook XML V4.5//EN\"\n";
print OUTPUT "\"http://www.oasis-open.org/docbook/xml/4.5/docbookx.dtd\">\n";
print OUTPUT "<book>\n";
# Include bookinfo if book directory exists
if ($format eq "book" && open (BOOKINFO, "book/bookinfo.xml")) {
print OUTPUT "<title>ZeroMQ</title>\n";
while (<BOOKINFO>) {
print OUTPUT $_ unless /DOCTYPE/;
}
close (BOOKINFO);
}
else {
print OUTPUT "<title>The ZeroMQ Guide - for $source Developers</title>\n";
print OUTPUT "<bookinfo>\n";
print OUTPUT " <author>\n";
print OUTPUT " <firstname>Pieter</firstname>\n";
print OUTPUT " <surname>Hintjens</surname>\n";
print OUTPUT " </author>\n";
print OUTPUT " <isbn><!-- ISBN goes here --></isbn>\n";
print OUTPUT "</bookinfo>\n";
}
# Hardcoded dedication at this stage
start_block (1, "dedication");
writeln ("<para>This book is dedicated to the 0MQ community.</para>\n");
while (<>) {
chop while /\s$/;
if (/^\./) {
# Process directive
if (/^\.set\s+(\w+)=(.*)/) {
$symbols {$1} = $2;
}
elsif (/^\.\-/) {
# Comment, ignore
}
elsif (/^\.end/) {
last;
}
elsif (/^\.output\s+(\w.*)/) {
# Ignore .output directives here
}
elsif (/^\.inbook\s+(\w.*)/) {
# Include book boilerplate if book directory exists
if ($format eq "book" && open (BOILER, "book/$1")) {
while (<BOILER>) {
print OUTPUT $_;
}
close (BOILER);
}
}
elsif (/^\.bookmark\s+(\w.*)/) {
$anchor = $1;
}
else {
print "Illegal directive $_ at line $.\n";
}
}
elsif (/^\+\s+Part\s+\w+\s+\-\s+/) {
$have_parts = 1;
close_list ();
start_block (1, "part");
writeln (requote ("<title>$'</title>"));
start_block (2, "partintro");
}
elsif (/^\+\s+Preface/) {
$bookmarks{$anchor} = "Preface" if $anchor;
close_list ();
start_block (1 + $have_parts, "preface");
writeln (requote ("<title>Preface</title>"));
}
elsif (/^\+\s+(.*)$/) {
$bookmarks{$anchor} = zmq_symbol ($1) if $anchor;
close_list ();
start_block (1 + $have_parts, "chapter");
writeln (requote ("<title>$1</title>"));
}
elsif (/^\+\s+Postface/) {
$bookmarks{$anchor} = "Postface" if $anchor;
close_list ();
# Don't have a Postface item, so make this a chapter
start_block (1 + $have_parts, "chapter");
writeln (requote ("<title>Postface</title>"));
}
elsif (/^\+\+\s+(.*)$/) {
close_list ();
start_block (2 + $have_parts, "sect1");
writeln (requote ("<title>$1</title>"));
}
elsif (/^\+\+\+\s+(.*)$/) {
close_list ();
start_block (3 + $have_parts, "sect2");
writeln (requote ("<title>$1</title>"));
}
# Process unnamed code listing
elsif (/\[\[code\s+language=\"(.+)\"\]\]/) {
close_list ();
$language = $1;
$lexer = $lexer {$language};
writeln ("<programlisting language=\"$lexer\">");
while (<>) {
chop;
last if /\[\[\/code\]\]/;
writesrc ($_);
}
writeln ("</programlisting>\n");
}
# Process named fragment codeblock
elsif (/\[\[code\s+type=\"fragment\"\s+name=\"([^"]+)\"/) {
close_list ();
# Thunk fragment source code into C directory in any case
$name = $1;
die "Can't create fragments/C/$name.c: $!"
unless open (FRAGMENT, ">fragments/C/$name.c");
while (<>) {
last if /\[\[\/code\]\]/;
print FRAGMENT $_;
}
# Look for translation in current source language, fall back on C if none
$name = $1;
$language = $source;
$filename = "fragments/$language/$name.".$extension{$language};
if (! -f $filename) {
$language = "C";
$filename = "fragments/$language/$name.".$extension{$language};
}
if (! -f $filename) {
print "Can't find $name fragment in any language ($filename)\n";
exit (0);
}
die "Can't create $filename: $!"
unless open (FRAGMENT, "$filename");
$lexer = $lexer {$language};
writeln ("<programlisting language=\"$lexer\">");
while (<FRAGMENT>) {
chop;
writesrc ($_);
}
writeln ("</programlisting>\n");
}
# Process named codeblock
elsif (/\[\[code\s+type=\"example\"\s+title=\"([^"]+)\"\s+name=\"([^"]+)\"(\s+language=\"([^"]+)\")?\]\]/) {
close_list ();
$title = $1;
$name = $2;
$language = $4 || $source;
$lexer = $lexer {$language};
$ext = $extension {$language};
$filename = "examples/$language/$name.$ext";
writeln ("<example id=\"$name-$ext\">");
writeln ("<title>$title ($name.$ext)</title>");
writeln ("<programlisting language=\"$lexer\">");
if (open (EXAMPLE, $filename)) {
$lines = 0;
$split = 0;
$blanks = 0;
$start = 0;
while (<EXAMPLE>) {
chop;
if (/\/\/ \.split\s(.*)/) {
# Long code example, split into separate pieces
writeln ("</programlisting>\n");
writeln ("</example>");
printf ("$filename: $lines lines ($start)\n") if $lines > $cutoff;
$text = "";
$start = $.;
$comment = $1;
while (<EXAMPLE>) {
chop while /\s$/;
last unless /\/\/ /; # End at any non-comment line
$text .= "$' ";
}
$split++;
writeln (requote ("<para>$text\n</para>\n"));
writeln ("<example id=\"$name-$ext-$split\">");
writeln ("<title>$title ($name.$ext) - $1</title>");
writeln ("<programlisting language=\"$lexer\">");
$lines = 0;
}
elsif (/\/\/ \.skip/) {
writesrc ("...");
while (<EXAMPLE>) {
chop while /\s$/;
last if /\/\/ \.until/;
}
}
else {
# Don't output trailing blank lines
if (/^$/) {
$blanks++;
}
else {
print OUTPUT "\n" x $blanks;
$blanks = 0;
writesrc ($_);
}
$lines++;
}
}
close (EXAMPLE);
printf ("$filename: $lines lines ($start)\n")
if $lines > $cutoff
&& $format eq "book";
}
else {
writesrc ("(This example still needs translation into $source)");
}
writeln ("</programlisting>\n");
writeln ("</example>");
# Discard any real contents of code block
while (<>) {
last if /\[\[\/code\]\]/;
print "W: discarding code for $title - $name\n";
}
}
# Process plain code block
elsif (/\[\[code\]\]/) {
close_list ();
writect ("<screen>");
while (<>) {
chop;
last if /\[\[\/code\]\]/;
writesrc ($_);
}
writeln ("</screen>\n");
}
elsif (/\[\[code type=\"textdiagram\"\s+title=\"([^"]+)\"\]\]/) {
close_list ();
# Create text file for diagram
$title = $1;
$figure = $figure + 1;
die "Can't create images/fig$figure.txt: $!"
unless open (IMAGE, ">images/fig$figure.txt");
$longest = 0;
while (<>) {
chop;
last if /\[\[\/code\]\]/;
$longest = length ($_) if length ($_) > $longest;
print IMAGE "$_\n";
}
close (IMAGE);
# Calculate scaling so image looks decent
$scale = 60 / $longest;
$scale = 1 if $scale > 1;
# Convert diagram into image of required format
if (signature_changed ("images/fig$figure.txt")) {
print "Converting fig$figure.txt to SVG...\n";
system ("a2s -iimages/fig$figure.txt -oimages/fig$figure.svg");
system ("rasterizer -d images images/fig$figure.svg");
system ("inkscape -f images/fig$figure.svg -E images/fig$figure.eps");
signature_update ("images/fig$figure.txt");
}
writeln ("<figure id=\"figure-$figure\">");
writeln (" <title>$title</title>");
writeln (" <mediaobject>");
writeln (" <imageobject>");
writeln (" <imagedata fileref=\"images/fig$figure.eps\" format=\"EPS\" width=\"4.8in\"/>");
writeln (" </imageobject>");
writeln (" </mediaobject>");
writeln ("</figure>\n");
}
elsif (/\[\[code/) {
close_list ();
print "E: unparsed code block: $_\n";
}
elsif (/^> /) {
require_list ("blockquote");
writeln (requote (" <para>$'</para>"));
}
elsif (/^\* /) {
require_list ("itemizedlist");
writeln (requote (" <listitem><para>$'</para></listitem>"));
}
elsif (/^# /) {
require_list ("orderedlist");
writeln (requote (" <listitem><para>$'</para></listitem>"));
}
elsif ($_) {
# Normal text
close_list ();
writeln (requote ("<para>$_</para>\n"));
}
}
close_list ();
close_blocks ();
writeln ("</book>");
close (OUTPUT);
signatures_save ();
bookmarks_save ();
exit (0);
# Open and close block elements
sub start_block {
local ($level, $name) = @_;
# Close any open blocks at this or higher levels
while ($cur_level >= $level) {
writeln ("</".$block [$cur_level].">");
$cur_level--;
}
if ($anchor) {
writeln ("<$name id=\"$anchor\">");
$anchor = "";
}
else {
writeln ("<$name>");
}
$block [$level] = $name;
$cur_level = $level;
}
sub close_blocks {
while ($cur_level > 0) {
writeln ("</".$block [$cur_level].">");
$cur_level--;
}
}
# Writes $_ to OUTPUT after expanding all symbols
sub writeln {
local ($_) = @_;
# Do once, since expand_symbols is recursive
s/&/&amp;/g;
$_ = expand_symbols ($_);
print OUTPUT "$_\n";
}
sub writect {
local ($_) = @_;
# Do once, since expand_symbols is recursive
s/&/&amp;/g;
$_ = expand_symbols ($_);
print OUTPUT "$_";
}
sub writesrc {
local ($_) = @_;
s/&/&amp;/g;
s/</&lt;/g;
s/>/&gt;/g;
print OUTPUT "$_\n";
}
# Do smart curly quotes before we add any tags
sub requote {
local ($_) = @_;
# don't have a solid algorithm, so am sticking with straight quotes
# s/"([a-zA-ZØ0-9.\/\(])/&#8220;\1/g;
# s/([a-zA-Z0-9!?.\/\)])"/\1&#8221;/g;
# s/ '([a-zA-Z0-9])/ &#8216;\1/g;
# s/'/&#8217;/g;
#print "$_\n" if /"/;
return $_;
}
# Manage lists
sub require_list {
local ($list) = @_;
close_list if $list ne $cur_list;
$cur_list = $list;
if (!$in_list) {
writeln ("<$cur_list>");
$in_list = 1;
}
}
sub close_list {
if ($in_list) {
$in_list = 0;
writeln ("</$cur_list>");
}
}
# Load signatures hash tables
sub signatures_load {
print "I: loading signatures... ";
undef %signatures;
local $count = 0;
if (open (SIGNATURES, ".signatures")) {
while (<SIGNATURES>) {
/([^\s]+)\s+([^\s]+)/;
$signatures {$2} = $1;
$count++;
}
}
print "$count loaded\n";
}
# If file signature has changed, return 1, else 0
sub signature_changed {
local ($filename) = @_;
$_ = `sha1sum $filename`;
if (/([^\s]+)\s+/) {
if ($signatures {$filename} eq $1) {
return 0;
}
else {
return 1;
}
}
else {
"E: can't sha1sum $filename\n";
return 0;
}
}
# Save file signature into table
sub signature_update {
local ($filename) = @_;
$_ = `sha1sum $filename`;
if (/([^\s]+)\s+/) {
$signatures {$filename} = $1;
}
else {
"E: can't sha1sum $filename\n";
return 0;
}
}
# Save signatures table
sub signatures_save {
print "I: saving signatures... ";
local $count = 0;
local $filename;
if (open (SIGNATURES, ">.signatures")) {
foreach $filename (keys %signatures) {
print SIGNATURES "$signatures{$filename} $filename\n";
$count++;
}
}
print "$count saved\n";
}
# Load bookmarks
sub bookmarks_load {
if (open (BOOKMARKS, ".bookmarks")) {
while (<BOOKMARKS>) {
chop;
if (/(\S+)\s+(.+)/) {
$bookmarks {$1} = $2;
}
}
close (BOOKMARKS);
}
}
# Save bookmarks
sub bookmarks_save {
if (open (BOOKMARKS, ">.bookmarks")) {
foreach $bookmark (keys %bookmarks) {
print BOOKMARKS "$bookmark $bookmarks{$bookmark}\n";
}
close (BOOKMARKS);
}
}
# Expand symbols, hyperlinks, etc
#
sub expand_symbols {
local ($_) = @_;
local ($before,
$match,
$after,
$expr);
return unless ($_); # Quit if input string is empty
# Replace 0MQs
$_ = zmq_symbol ($_);
# Recursively expand symbols like this (and in this order):
# $(xxx) value of variable
# $(xxx?zzz) value of variable, or zzz if undefined
# %(text?zzz) value of environment variable, or zzz if undef
for (;;) {
# Force expansion from end of string first, so things like
# $(xxx?$(yyy)) work properly.
if (/[\$%]\(/ || /\!([a-z_]+)\s*\(/i) {
$before = $`;
$match = $&;
$after = expand_symbols ($');
$_ = $before.$match.$after;
}
# $(xxx)
if (/\$\(([A-Za-z0-9-_\.]+)\)/) {
$_ = $`.&valueof ($1).$';
}
# $(xxx?zzz)
elsif (/\$\(([A-Za-z0-9-_\.]+)\?([^)\$]*)\)/) {
$_ = $`.&valueof ($1, $2).$';
}
# %(text)
elsif (/\%\(([^\)]+)\)/) {
$_ = $`.$ENV {$1}.$';
}
# %(text?zzz)
elsif (/\%\(([^\)]+)\?([^)\$]*)\)/) {
$_ = $`.($ENV {$1}? $ENV {$1}: $2).$';
}
else {
last;
}
}
# Translate bookmark references
while (/\[#(\S+)\]/) {
print "Undefined bookmark: $1\n"
unless defined ($bookmarks {$1});
$_ = $`."$bookmarks{$1}<xref linkend=\"$1\"/>".$';
}
# Translate figure references
local $nextfig = $figure + 1;
s/\[figure\]/<xref linkend="figure-$nextfig"\/>/g;
# Translate man page references
s/zmq_([\w_]+)\[.\]/zmq_$1()/g;
# Translate email addresses
s/\<([\w\.]+@[\w\.]+)\>/<email>$1<\/email>/g;
# Translate character styles
s/([^:])\/\/([^\/]+)\/\//$1<emphasis>$2<\/emphasis>/g;
s/\*\*([^*]+)\*\*/<emphasis role="bold">$1<\/emphasis>/g;
s/\{\{([^{]+)\}\}/<literal>$1<\/literal>/g;
# Translate normal hyperlinks
s/\[(http:\/\/[^ ]+) ([^\]]+)\]/<ulink url="$1">$2<\/ulink>/g;
s/\[(https:\/\/[^ ]+) ([^\]]+)\]/<ulink url="$1">$2<\/ulink>/g;
# Translate footnotes
s/\[\[footnote\]\]([^\]]+)\[\[\/footnote\]\]/<footnote>$1<\/footnote>/g;
# Translate links into zguide.zeromq.org
s/\[\/([^ ]+) ([^\]]+)\]/<ulink url="http:\/\/zguide.zeromq.org\/$1">$2<\/ulink>/g;
# Translate 0MQ into ØMQ unless escaped
s/0MQ/ØMQ/g;
s/0\\MQ/0MQ/g;
# Translate accented characters, presumably there's a module
# that will do this properly...
s/Å/&Aring;/g;
s/É/&Eacute;/g;
s/é/&eacute;/g;
s/è/&egrave;/g;
s/ø/&oslash;/g;
s/ő/&ouml;/g;
s/Ø/&Oslash;/g;
return $_;
}
# Translate 0MQ into ØMQ and 0\MQ into 0MQ
sub zmq_symbol {
local ($_) = @_;
s/0MQ/ØMQ/g;
s/0\\MQ/0MQ/g;
return $_;
}
# Subroutine returns the value of the specified symbol; it issues a
# warning message and returns 'UNDEF' if the symbol is not defined
# and the default value is empty.
#
sub valueof {
local ($symbol, $default) = @_; # Argument is symbol name
local ($return); # Returned value
local ($langed_symbol); # Language-dependent symbol
if (defined ($symbols {$symbol})) {
$return = $symbols {$symbol};
return $return;
}
elsif (defined ($default)) {
return ($default);
}
print ("E: undefined symbol \"$symbol\"");
$symbols {$symbol} = "UNDEF";
return $symbols {$symbol};
}
Jump to Line
Something went wrong with that request. Please try again.