App-zen
view release on metacpan or search on metacpan
rev => 1,
instance_id => 'i-'.gen_uuid(),
sections => \@a
});
}
use integer; # otherwise it's float point, and won't work at all for large integer!
my $sortable_b64_alphabet = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ^_abcdefghijklmnopqrstuvwxyz";
sub sortable_b64_encode_int {
my $integ = int(shift);
my $l = shift;
my $alphabet = $sortable_b64_alphabet;
my $encoded = '';
my $base = length($alphabet);
my @digits = ();
my $n = $integ;
while ($n > 0) {
my $remainder = $n % $base;
$encoded = substr($alphabet, $remainder, 1) . $encoded;
$n = int($n / $base);
push @digits, $remainder;
}
return substr($alphabet, 0, 1) x ($l - length($encoded)) . $encoded;
}
#use UUID 'uuid';
use Time::HiRes qw(time);
my $uuid_seq = 1;
sub gen_uuid {
my $ms = int(time()*1000);
my $r = int(rand(64));
# my $id = ($ms << 18) + ($uuid_seq << 6) + $r;
#my $id = ($uuid_seq << 6) + $r;
my $id = ($ms << 18) + ($uuid_seq << 6) + $r;
$uuid_seq = ($uuid_seq + 1) % 4096;
return sortable_b64_encode_int($id, 12),
}
my %options = (
"--loc" => [\$opt_loc, 'Generate code location in the output'],
"--debug" => [\$opt_debug, 'Enable debug'],
"--live" => [\$opt_live, 'Render for httpd server'],
"--draft" => [\$opt_draft, 'Generate draft for latex'],
"--lang LANG" => [\$opt_lang, 'Program language for output source '],
"--target SECTION" => [\$opt_target, 'starting section'],
"--section SECTION" => [\$opt_target, 'starting section'],
"--exec SECTION" => [\$opt_exec, 'execute section'],
"--toc" => [\$opt_toc, 'generate toc'],
"--html" => [\$opt_html, 'Set output format for documentation'],
"--latex" => [\$opt_latex, 'Set output format for documentation'],
"--source-map FILENAME" => [\$opt_source_map, 'Generate source map'],
"--top-heading LEVEL" => [\$opt_top_heading, 'Set top level section type: <part|chapter|section>'],
"--document-class CLASS" => [\$opt_document_class, 'Set latex document class'],
"--verbose" => [\$opt_verbose, 'More logging'],
"--output FILENAME" => [\$opt_output_file, 'Set output file'],
"--port PORT:i" => [\$opt_port, 'Start HTTP Server at port'],
"--daemon" => [\$opt_daemon, "Run server in background"],
"--json-dump" => [\$opt_json_dump, 'Dump the document'],
"-x SECTION" => [\$opt_exec, 'short for --exec'],
"-o OUTPUTFILE" => [\$opt_output_file, 'short for --output'],
"-t SECTION" => [\$opt_target, 'short for --target'],
"-s SECTION" => [\$opt_target, 'short for --section'],
"-h" => [\$opt_help, 'Shows help information'],
);
my %optionsSpec = map {
my $k = $_;
my $ref = $options{$_}[0];
my @x = split /\s+/, $k;
my $name = $x[0];
$name =~ s/^-+//;
my $suffix;
if ($x[1]) {
my @a = split /:/, $x[1];
$suffix = "=".($a[1]||'s');
}
$name.$suffix => $ref
} keys %options;
GetOptions(%optionsSpec) or usage("Invalid options");
usage() if $opt_help || (scalar @ARGV == 0 && !$opt_port);
if ($opt_top_heading) {
while ($section_levels[0] ne $opt_top_heading) {
die "Invalid top heading: $opt_top_heading" if scalar(@section_levels) < 2;
shift @section_levels;
}
}
sub usage {
my $msg = shift;
print STDERR $msg,"\n" if $msg;
print STDERR "zen [options] <file.zen>\n";
foreach (sort keys %options) {
my @desc = split(/\n/, $options{$_}[1]);
s/:.*//;
print STDERR sprintf(" %-24s %s\n", $_, shift @desc);
print STDERR sprintf(" %-24s $_\n", '') foreach (@desc);
}
print STDERR "Zen Version: 0.11\n";
exit(1);
};
sub add_label
{
my ($sec,$name,$ln) = @_;
die unless $sec;
if (exists $sec->{labels}->{$name}) {
die "$sec->{file}:$ln: duplicated labels in same section";
}
my $lab = {
id => 'L-'.($global_label_id++),
section => $sec,
file =>$sec->{file},
ln => $ln
};
$sec->{labels}->{$name} = $lab;
}
push @ret, split /\s+/, trim($s);
return @ret;
}
sub xtrim
{
my @a = @_;
my $n = 10000;
foreach (@a) {
my $s = $_->{text};
$s =~ m/^(\s*)/;
next if "$'" eq '';
$n = length($1) if $n > length($1);
}
return @a if $n == 0;
return map {
my $s = $_->{text};
if ($n < length($s)) {
$s = substr($s, $n);
} else {
$s = '';
}
$_->{text} = $s;
$_
} @a;
}
sub emit {
my $output = shift;
my $output_filename = shift;
my @lines = @_;
my $loc_format;
my $lang = ($opt_lang || $g_curr_lang);
$loc_format = $loc_formats{$lang} if ($lang && $opt_loc);
my $last_file;
my $last_ln;
dbg("emit: ", scalar(@lines), " lines");
my $ln = 1;
foreach (@lines) {
if ($loc_format) {
if (($last_file ne $_->{file}) || ($last_ln+1 != $_->{ln})) {
my $x = &$loc_format($_->{file}, $_->{ln});
print $output $x;
}
$last_file = $_->{file};
$last_ln = $_->{ln};
} elsif ($output_source_map) {
print $output_source_map "$output_filename:$ln:$_->{file}:$_->{ln}\n";
$ln++;
}
print $output $_->{text},"\n";
}
}
use Data::Dumper;
sub docgen_html {
my $zf = shift;
my $old = select(shift);
print "<!DOCTYPE HTML>\n\n<html>\n<head>\n <meta charset=\"UTF-8\">\n <meta name=\"viewport\" content=\"width=device-width, initial-scale=1\">\n\n<link rel=\"stylesheet\" href=\"https://cdn.jsdelivr.net/gh/highlightjs/cdn-release\@10.7.3/build/style...
print "<script>";
print "window.zen = ";
print JSON::encode_json({
last_modified => $zf->{last_modified},
size => $zf->{size},
});
print "</script>";
print '<div class="container">';
print '<aside class="col foldable narrow">';
print '<div class="col-header sticky-top">';
print '<span class="fill-parent">';
if ($opt_live) {
print '<a href="/">home</a>';
print '<a href="..">up</a>';
}
print '</span>';
print '<span class="flex fill-parent collapse" id="search">';
print '<button click="cancel-search">cancel</button>';
print '<input type="text" id="search-text"></input>';
print '</span>';
print "<button click=\"search\">search</button>";
print "<button click=\"expand\">++</button>";
print "<button click=\"fold\">fold</button>";
print '</div>';
print '<article>';
print '<section id="tags"></section>';
print '<section class="vskip">';
foreach (@sections) {
my $section = $_;
next if is_section_hidden($section);
my $level = $section->{level};
my $id = $section->{id};
print "<a class=\"L-$level\" href=\"#$id\">$section->{heading}</a><br>\n";
}
print '</section></article>';
print '</aside>';
my @cols = ([]);
foreach my $section (@sections) {
next if is_section_hidden($section);
if (exists $section->{fields}->{break}) {
push @cols, [];
}
push @{$cols[-1]}, $section;
}
foreach my $col (@cols) {
next if scalar @{$col} == 0;
print "<div class=\"col foldable\">";
print "<div class=\"col-header\">";
print '<span class="fill-parent">', scalar @{$col}, ' sections</span>';
print "<button click=\"show-outline\">outline</button>";
print "<button click=\"expand\">+</button>";
print "<button click=\"fold\">fold</button>";
print "</div>";
print "<article>";
my $filesize = -s $path;
print "HTTP/1.1 200 OK\r\n";
print "Content-Type: $mime_type\r\n";
print "Last-Modified: $mtime\r\n";
print "Content-Length: $filesize\r\n";
print "\r\n";
# Print the binary content of the file to the CGI output
binmode STDOUT;
while (read $fh, my $buffer, 4096) {
print $buffer;
}
close $fh;
}
}
sub on_list_dir {
my ($cgi, $path) = @_;
if (!-d $path) {
write_error(404, "Not found");
return;
}
my @contents = ();
opendir(my $dh, $path) or die "Cannot open directory: $!";
while (my $file = readdir $dh) {
next if $file =~ /^\./;
next if $file =~ /~$/;
my $filepath = "$path/$file";
my $mtime = stat($filepath)->mtime;
push @contents, {
name => -d $filepath ? "$file/" : $file,
size => -s "$path/$file",
mtime => $mtime,
};
}
@contents = sort { $a->{name} cmp $b->{name} } @contents;
my $fmt = $cgi->param('fmt');
if ($fmt) {
if ($fmt eq "csv") {
print "HTTP/1.1 200 OK\r\n";
print "\r\n";
for (@contents) {
print "$_->{name},$_->{size},$_->{mtime}\n";
}
return;
} elsif ($fmt eq 'json') {
print "HTTP/1.1 200 OK\r\n";
print "\r\n";
print JSON::encode_json(\@contents);
return;
} else {
write_error(400, "Bad parameter: unsupported fmt");
return;
}
}
print "HTTP/1.0 200 OK\r\n\r\n";
print "<!doctype html>\n<html>\n <head>\n <meta charset=\"utf-8\">\n <meta name=\"viewport\" content=\"width=device-width, initial-scale=1\">\n <title>Index</title>\n <style>\n :root {\n --navbar-height: 1.6rem;\n }\...
print "<div class=\"xxpad\"><h1>Index</h1>\n";
print "<table>\n";
print "<thead><tr class=\"sticky-top\"><th>Name</th><th>Size</th><th>Last Modified</th></tr></thead>\n";
for (@contents) {
my $timestr = strftime('%FT%TZ%z', localtime($_->{mtime}));
print "<tr>";
print "<td><a href=\"$_->{name}\">$_->{name}</a></td>";
print "<td class=\"align-right\">$_->{size}</td>";
print "<td>$timestr</td>";
print "</tr>\n";
}
print "</table></div>";
print " </body>\n</html>";
}
sub on_hello {
my $cgi = shift; # CGI.pm object
return if !ref $cgi;
my $name = $cgi->param('name');
open FH, "perl ./zen2.pl --html $name|";
while (<FH>) {
print $_;
}
close FH
}
}
my $server = App::zen::WebServer->new($opt_port);
if ($opt_daemon) {
$server->background();
} else {
$server->run();
}
exit;
}
if (scalar @ARGV != 1) {
usage();
}
$zenfile = load_zen_file(shift @ARGV);
if ($opt_debug) {
foreach (@sections) {
print STDERR "Section [$_->{pattern}] $_->{heading} ", scalar(@{$_->{lines}}), " lines\n";
}
}
if ($opt_output_file) {
open $output,">$opt_output_file" or die "Can not write to `$opt_output_file'";
} else {
$output = *STDOUT;
}
if ($opt_json_dump) {
print $output sections_to_json($zenfile->{sections});
close $output;
exit;
}
if ($opt_exec) {
my $s = find_section($opt_exec);
my $lang;
foreach (@{$s->{blocks}}) {
$lang = $_->{lang};
last if $lang;
}
if ($lang eq 'pl') {
$lang = 'perl';
} elsif ($lang eq 'js') {
$lang = 'node';
} elsif ($lang eq 'ts') {
$lang = 'ts-node';
}
my ($fh, $filename) = tempfile();
emit($fh, $opt_output_file, expand($opt_exec));
close $fh;
system("$lang $filename");
#TODO remove temp file
} elsif (!$opt_html && !$opt_latex) {
if ($opt_source_map) {
open $output_source_map, ">$opt_source_map"
or die "Can not write to source map";
}
emit($output, $opt_output_file, expand($opt_target));
close $output_source_map if $output_source_map;
} else {
build_refs();
if ($opt_html) {
docgen_html($zenfile, $output);
( run in 2.109 seconds using v1.01-cache-2.11-cpan-f56aa216473 )