App-zen
view release on metacpan or search on metacpan
}
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;
}
( run in 2.707 seconds using v1.01-cache-2.11-cpan-8f98c5d2c55 )