png results from the CPAN

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>";

bin/zen view on Meta::CPAN

            my $s = html_escape_code($1 . $2);
            $s = ' ' unless $s; # Force to show a line in pretty
            print "$s";
          } else {
            my $s = html_escape_code($t);
            $s = ' ' unless $s; # Force to show a line in pretty
            print "$s";
          }
        
          if ($label) {
            my $lab = find_label($label, $section);
            print "<a name=\"$lab->{id}\"></a>";
          }
          print "\n";
        }
        print "</code></pre>\n";
      }
    } elsif ($t =~ m/^(```+)(\w+)?\s+%(.*)/) {
      
      my $backticks = $1;
      my $lang = $2;
      my $cmd = $3;
      my @a = ();
      while (@lines > 0) {
        my $l = shift @lines;
        last if ($l->{text} =~ m/^$backticks\s*$/);
        push @a, expand1($l);
      }
      my $src = join("\n", map {$_->{text}} xtrim(@a));
      my $input_file;
      my $output_file;
      my $file_id = sha256_hex($src);
      my $dir = dirname($zenfile->{path}) . "/gen";
      if ( !-d  $dir) {
          make_path $dir or die "Failed to create path: $dir";
      }
      
      if ($cmd) {
      } else {
        if ($lang eq "plantuml") {
          $input_file = $dir . "/$file_id.puml";
          $output_file = $dir . "/$file_id.svg";
          $cmd = "plantuml -tsvg $input_file";
        } elsif ($lang eq "gnuplot") {
          $input_file = $dir . "$file_id.gnuplot";
          $output_file = $dir . "$file_id.svg";
          $src = "set term svg\nset output \"$output_file\"\n$src";
          $cmd = "gnuplot -c $input_file";
        }
      }
      
      if ($input_file && $cmd) {
        open(my $fh, '>', $input_file) or die "Could not open file '$input_file' $!";
        print $fh $src;
        close $fh;
        dbg("running: $cmd");
        system($cmd);
      }
      
      my $relpath = "gen/" . basename($output_file);
      if ($output_file =~ m/\.(jpg|png)$/) {
        print "<figure>";
        print "<img src=\"$relpath\">";
        print "</figure>\n";
      } elsif ($output_file =~ m/\.(svg)$/) {
        my $content = read_file($output_file);
        $content =~ s/^\<\?.*+\?\>//;
        print "<figure>";
        print $content;
        print "<figcaption>";
        print "<button click=\"export-svg\">download</button>";
        print "<a href=\"gen/$file_id.svg\">imgurl</a>";
        print "</figcaption>";
        print "</figure>\n";
      } else {
        print "<xmp>$src</xmp>";
      }
      
    } elsif ($t =~ m/^(```+)(\w+)?/) {
      my $backticks = $1;
      my $lang = $2 || 'text';
      
      print "<pre><code class=\"language-$lang\">";
      my @a = ();
      while (@lines > 0) {
        my $l = shift @lines;
        last if ($l->{text} =~ m/^$backticks\s*$/);
        push @a, $l;
      }
      foreach (xtrim(@a)) {
        print html_escape_code($_->{text}), "\n";
      }
      print "</code></pre>\n";
    } elsif ($t =~ m/^\s*\.label\s+(\w+)/) {
      my $lab = find_label($1, $section);
      print "<a name=\"$lab->{id}\"></a>";
    } elsif ($t =~ m/^\.def\s+(\w+)\s+(.*)/) {
      print "{<b>$1</b>} &equiv; <code>",html_escape_code($2),"</code><br>\n";
    } elsif ($t =~ m/$re_defvar/) {
      print "<div>{<b>$1</b>} &equiv; <code>",html_escape_code($2),"</code></div>\n";
    } elsif ($t =~ m/$re_defvar_inline/) {
      print "<div>{<b>$1</b>} &equiv; <code>",html_escape_code($2),"</code></div>\n";
    } elsif ($t =~ m/$re_code_inline/) {
      my $spaces = '';
      my @names = split /;/, $1;
      print "<div>";
      print $spaces,"<span class=\"nocode\">&#x27e6;</span>";
      my $n = 0;
      foreach (@names) {
        $n++;
        my ($name, $params) = split /:/,trim($_);
        my $section = find_section($name);
        my $id = $section->{id};
        if ($params) {
          $params = "<small>(" . html_escape($params) . ")</small>";
        }
        print "; " if $n > 1;
        $name = $section->{heading} if index($name, '...') != -1;
        print "<span><a href=\"#$id\" title=\"$section->{heading}\"><b>$name</b></a>$params</span>";
      }
      print "&#x27e7;</span>";

bin/zen view on Meta::CPAN

    }
    if (scalar(@fixed) == scalar(@names)) {
      push @fixed, '';
    }
    return sub {
      my $t = shift;
      my @vals = mpart($t, @fixed);
      return unless @vals;
      my $ret = {};
      for (my $i = 0; $i < scalar(@names); $i++) {
        my $name = $names[$i];
        if ($name ne '...') {
           $ret->{$name} = $vals[$i];
        }
      }
      return $ret;
    };
  }
}


use Carp qw<longmess>;

sub err
{
  my $msg = shift;
  my $i = 0;
  print STDERR "! Error: $msg\n";
  foreach (@env_chain) {
    print STDERR "  $i: ",$_->{__loc},"\n";
    $i++;
  }
  my $mess = longmess();
  print Dumper( $mess );
  exit(1);
}


if ($opt_port) {
  use warnings;
  use strict;
  
  {
  package App::zen::WebServer;
  
  use HTTP::Server::Simple::CGI;
  use base qw(HTTP::Server::Simple::CGI);
  use File::Slurp;
  use File::stat;
  use JSON;
  use Fcntl qw(:flock);
  use POSIX qw( strftime );
  use Data::Dumper;
  
  my %mimeTypes = (
    html => 'text/html',
    css => 'text/css',
    js => 'text/javascript',
    json => 'application/json',
    svg => 'image/svg+xml',
    png => 'image/png',
    jpeg => 'image/jpeg',
    jpg => 'image/jpeg',
    gif => 'image/gif',
    txt => 'text/plain',
  );
  
  sub handle_request {
      my ($self, $cgi) = @_;
  
      my $path = $cgi->path_info();
      my $method = $cgi->request_method();
  
      if ($method eq 'GET' && $path =~ m/\/$/) {
        on_list_dir($cgi, ".$path");
      } elsif ($method eq 'GET' && $path eq '/hello') {
        on_hello($cgi);
      } elsif ($method eq 'GET') {
        on_get_file($cgi, ".$path");
      } elsif ($method eq 'POST') {
        on_append_file($cgi, ".$path");
      } elsif ($method eq 'PUT') {
        on_put_file($cgi, ".$path");
      } else {
        print "HTTP/1.0 400 Bad Request\r\n\r\nUnsupported Request\n";
      }
  }
  
   # Should return  the data since last fetch offset.
  sub on_append_file {
    my ($cgi, $path) = @_;
    my $data = $cgi->param('POSTDATA');
    append_to_file($path, $data);
    my @stat_info = stat($path);
    if (@stat_info) {
      # Extract the last modification time
      my $mtime = $stat_info[9];
      print "HTTP/1.0 200 OK\r\n";
      print "Last-Modified: $mtime\r\n";
      print "Content-Length: 0\r\n\r\n";
    } else {
      print "HTTP/1.0 500 Server error\r\n";
    }
  }
  
  sub write_error {
    my ($code, $message, $body) = @_;
    print "HTTP/1.1 $code $message\r\n\r\n";
    print $body, "\n";
  }
  
  sub on_put_file {
    my ($cgi, $path) = @_;
  
    my $l = $cgi->url_param('l') || 0;
    my $n = $cgi->url_param('n') || 0;
    my $last_mtime = $cgi->url_param('last_modified');
  
    if (-f $path) {
      # override require last_mtime
      my $stat = stat($path);

( run in 0.964 second using v1.01-cache-2.11-cpan-df04353d9ac )